aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
authorKenichi Handa2002-03-01 01:39:56 +0000
committerKenichi Handa2002-03-01 01:39:56 +0000
commit38583a692b598c59dffc99a05a786ff1c630e427 (patch)
tree53aa6f2bdcc646f2e1e9f0ba37e82ef6a3787bd7 /src
parentdb327c7e5a7faa4c5124be4ee09ebe6ef06e37c2 (diff)
downloademacs-38583a692b598c59dffc99a05a786ff1c630e427.tar.gz
emacs-38583a692b598c59dffc99a05a786ff1c630e427.zip
Include "character.h" instead of "charset.h".
(copy_sub_char_table): Moved to chartab.c. (Fcopy_sequence): Call copy_char_table for a char table. (concat): Delete codes calling count_multibyte. (string_char_to_byte): Adjusted for the new multibyte form. (string_byte_to_char): Likewise. (internal_equal): Adjusted for the change of char table structure. (Fchar_table_subtype, Fchar_table_parent, Fset_char_table_parent, Fchar_table_extra_slot, Fset_char_table_extra_slot, Fchar_table_range, Fset_char_table_range, Fset_char_table_default, char_table_translate, optimize_sub_char_table, Foptimize_char_table, map_char_table, Fmap_char_table): Moved to chartab.c. (char_table_ref_and_index): Deleted. (HASH_KEY, HASH_VALUE): Moved to lisp.h. (Fmd5): Call preferred_coding_system instead of accessing Vcoding_category_list. Adjusted for the new code-conversion API. (syms_of_fns): Defsubr for char table related functions moved to chartab.c.
Diffstat (limited to 'src')
-rw-r--r--src/fns.c626
1 files changed, 46 insertions, 580 deletions
diff --git a/src/fns.c b/src/fns.c
index 279dba0fd88..7d27a9fdca1 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -33,7 +33,7 @@ Boston, MA 02111-1307, USA. */
33 33
34#include "lisp.h" 34#include "lisp.h"
35#include "commands.h" 35#include "commands.h"
36#include "charset.h" 36#include "character.h"
37 37
38#include "buffer.h" 38#include "buffer.h"
39#include "keyboard.h" 39#include "keyboard.h"
@@ -443,27 +443,6 @@ usage: (vconcat &rest SEQUENCES) */)
443 return concat (nargs, args, Lisp_Vectorlike, 0); 443 return concat (nargs, args, Lisp_Vectorlike, 0);
444} 444}
445 445
446/* Retrun a copy of a sub char table ARG. The elements except for a
447 nested sub char table are not copied. */
448static Lisp_Object
449copy_sub_char_table (arg)
450 Lisp_Object arg;
451{
452 Lisp_Object copy = make_sub_char_table (XCHAR_TABLE (arg)->defalt);
453 int i;
454
455 /* Copy all the contents. */
456 bcopy (XCHAR_TABLE (arg)->contents, XCHAR_TABLE (copy)->contents,
457 SUB_CHAR_TABLE_ORDINARY_SLOTS * sizeof (Lisp_Object));
458 /* Recursively copy any sub char-tables in the ordinary slots. */
459 for (i = 32; i < SUB_CHAR_TABLE_ORDINARY_SLOTS; i++)
460 if (SUB_CHAR_TABLE_P (XCHAR_TABLE (arg)->contents[i]))
461 XCHAR_TABLE (copy)->contents[i]
462 = copy_sub_char_table (XCHAR_TABLE (copy)->contents[i]);
463
464 return copy;
465}
466
467 446
468DEFUN ("copy-sequence", Fcopy_sequence, Scopy_sequence, 1, 1, 0, 447DEFUN ("copy-sequence", Fcopy_sequence, Scopy_sequence, 1, 1, 0,
469 doc: /* Return a copy of a list, vector or string. 448 doc: /* Return a copy of a list, vector or string.
@@ -476,26 +455,8 @@ with the original. */)
476 455
477 if (CHAR_TABLE_P (arg)) 456 if (CHAR_TABLE_P (arg))
478 { 457 {
479 int i; 458 return copy_char_table (arg);
480 Lisp_Object copy;
481
482 copy = Fmake_char_table (XCHAR_TABLE (arg)->purpose, Qnil);
483 /* Copy all the slots, including the extra ones. */
484 bcopy (XVECTOR (arg)->contents, XVECTOR (copy)->contents,
485 ((XCHAR_TABLE (arg)->size & PSEUDOVECTOR_SIZE_MASK)
486 * sizeof (Lisp_Object)));
487
488 /* Recursively copy any sub char tables in the ordinary slots
489 for multibyte characters. */
490 for (i = CHAR_TABLE_SINGLE_BYTE_SLOTS;
491 i < CHAR_TABLE_ORDINARY_SLOTS; i++)
492 if (SUB_CHAR_TABLE_P (XCHAR_TABLE (arg)->contents[i]))
493 XCHAR_TABLE (copy)->contents[i]
494 = copy_sub_char_table (XCHAR_TABLE (copy)->contents[i]);
495
496 return copy;
497 } 459 }
498
499 if (BOOL_VECTOR_P (arg)) 460 if (BOOL_VECTOR_P (arg))
500 { 461 {
501 Lisp_Object val; 462 Lisp_Object val;
@@ -696,25 +657,17 @@ concat (nargs, args, target_type, last_special)
696 && STRING_MULTIBYTE (this) == some_multibyte) 657 && STRING_MULTIBYTE (this) == some_multibyte)
697 { 658 {
698 int thislen_byte = STRING_BYTES (XSTRING (this)); 659 int thislen_byte = STRING_BYTES (XSTRING (this));
699 int combined;
700 660
701 bcopy (XSTRING (this)->data, XSTRING (val)->data + toindex_byte, 661 bcopy (XSTRING (this)->data, XSTRING (val)->data + toindex_byte,
702 STRING_BYTES (XSTRING (this))); 662 STRING_BYTES (XSTRING (this)));
703 combined = (some_multibyte && toindex_byte > 0
704 ? count_combining (XSTRING (val)->data,
705 toindex_byte + thislen_byte,
706 toindex_byte)
707 : 0);
708 if (! NULL_INTERVAL_P (XSTRING (this)->intervals)) 663 if (! NULL_INTERVAL_P (XSTRING (this)->intervals))
709 { 664 {
710 textprops[num_textprops].argnum = argnum; 665 textprops[num_textprops].argnum = argnum;
711 /* We ignore text properties on characters being combined. */ 666 textprops[num_textprops].from = 0;
712 textprops[num_textprops].from = combined;
713 textprops[num_textprops++].to = toindex; 667 textprops[num_textprops++].to = toindex;
714 } 668 }
715 toindex_byte += thislen_byte; 669 toindex_byte += thislen_byte;
716 toindex += thisleni - combined; 670 toindex += thisleni;
717 XSTRING (val)->size -= combined;
718 } 671 }
719 /* Copy a single-byte string to a multibyte string. */ 672 /* Copy a single-byte string to a multibyte string. */
720 else if (STRINGP (this) && STRINGP (val)) 673 else if (STRINGP (this) && STRINGP (val))
@@ -757,9 +710,7 @@ concat (nargs, args, target_type, last_special)
757 { 710 {
758 XSETFASTINT (elt, XSTRING (this)->data[thisindex++]); 711 XSETFASTINT (elt, XSTRING (this)->data[thisindex++]);
759 if (some_multibyte 712 if (some_multibyte
760 && (XINT (elt) >= 0240 713 && XINT (elt) >= 0200
761 || (XINT (elt) >= 0200
762 && ! NILP (Vnonascii_translation_table)))
763 && XINT (elt) < 0400) 714 && XINT (elt) < 0400)
764 { 715 {
765 c = unibyte_char_to_multibyte (XINT (elt)); 716 c = unibyte_char_to_multibyte (XINT (elt));
@@ -792,34 +743,13 @@ concat (nargs, args, target_type, last_special)
792 else 743 else
793 { 744 {
794 CHECK_NUMBER (elt); 745 CHECK_NUMBER (elt);
795 if (SINGLE_BYTE_CHAR_P (XINT (elt))) 746 if (some_multibyte)
796 { 747 toindex_byte
797 if (some_multibyte) 748 += CHAR_STRING (XINT (elt),
798 toindex_byte 749 XSTRING (val)->data + toindex_byte);
799 += CHAR_STRING (XINT (elt),
800 XSTRING (val)->data + toindex_byte);
801 else
802 XSTRING (val)->data[toindex_byte++] = XINT (elt);
803 if (some_multibyte
804 && toindex_byte > 0
805 && count_combining (XSTRING (val)->data,
806 toindex_byte, toindex_byte - 1))
807 XSTRING (val)->size--;
808 else
809 toindex++;
810 }
811 else 750 else
812 /* If we have any multibyte characters, 751 XSTRING (val)->data[toindex_byte++] = XINT (elt);
813 we already decided to make a multibyte string. */ 752 toindex++;
814 {
815 int c = XINT (elt);
816 /* P exists as a variable
817 to avoid a bug on the Masscomp C compiler. */
818 unsigned char *p = & XSTRING (val)->data[toindex_byte];
819
820 toindex_byte += CHAR_STRING (c, p);
821 toindex++;
822 }
823 } 753 }
824 } 754 }
825 } 755 }
@@ -894,40 +824,30 @@ string_char_to_byte (string, char_index)
894 824
895 if (char_index - best_below < best_above - char_index) 825 if (char_index - best_below < best_above - char_index)
896 { 826 {
827 unsigned char *p = XSTRING (string)->data + best_below_byte;
828
897 while (best_below < char_index) 829 while (best_below < char_index)
898 { 830 {
899 int c; 831 p += BYTES_BY_CHAR_HEAD (*p);
900 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string, 832 best_below++;
901 best_below, best_below_byte);
902 } 833 }
903 i = best_below; 834 i_byte = p - XSTRING (string)->data;
904 i_byte = best_below_byte;
905 } 835 }
906 else 836 else
907 { 837 {
838 unsigned char *p = XSTRING (string)->data + best_above_byte;
839
908 while (best_above > char_index) 840 while (best_above > char_index)
909 { 841 {
910 unsigned char *pend = XSTRING (string)->data + best_above_byte; 842 p--;
911 unsigned char *pbeg = pend - best_above_byte; 843 while (!CHAR_HEAD_P (*p)) p--;
912 unsigned char *p = pend - 1;
913 int bytes;
914
915 while (p > pbeg && !CHAR_HEAD_P (*p)) p--;
916 PARSE_MULTIBYTE_SEQ (p, pend - p, bytes);
917 if (bytes == pend - p)
918 best_above_byte -= bytes;
919 else if (bytes > pend - p)
920 best_above_byte -= (pend - p);
921 else
922 best_above_byte--;
923 best_above--; 844 best_above--;
924 } 845 }
925 i = best_above; 846 i_byte = p - XSTRING (string)->data;
926 i_byte = best_above_byte;
927 } 847 }
928 848
929 string_char_byte_cache_bytepos = i_byte; 849 string_char_byte_cache_bytepos = i_byte;
930 string_char_byte_cache_charpos = i; 850 string_char_byte_cache_charpos = char_index;
931 string_char_byte_cache_string = string; 851 string_char_byte_cache_string = string;
932 852
933 return i_byte; 853 return i_byte;
@@ -967,36 +887,30 @@ string_byte_to_char (string, byte_index)
967 887
968 if (byte_index - best_below_byte < best_above_byte - byte_index) 888 if (byte_index - best_below_byte < best_above_byte - byte_index)
969 { 889 {
970 while (best_below_byte < byte_index) 890 unsigned char *p = XSTRING (string)->data + best_below_byte;
891 unsigned char *pend = XSTRING (string)->data + byte_index;
892
893 while (p < pend)
971 { 894 {
972 int c; 895 p += BYTES_BY_CHAR_HEAD (*p);
973 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string, 896 best_below++;
974 best_below, best_below_byte);
975 } 897 }
976 i = best_below; 898 i = best_below;
977 i_byte = best_below_byte; 899 i_byte = p - XSTRING (string)->data;
978 } 900 }
979 else 901 else
980 { 902 {
981 while (best_above_byte > byte_index) 903 unsigned char *p = XSTRING (string)->data + best_above_byte;
904 unsigned char *pbeg = XSTRING (string)->data + byte_index;
905
906 while (p > pbeg)
982 { 907 {
983 unsigned char *pend = XSTRING (string)->data + best_above_byte; 908 p--;
984 unsigned char *pbeg = pend - best_above_byte; 909 while (!CHAR_HEAD_P (*p)) p--;
985 unsigned char *p = pend - 1;
986 int bytes;
987
988 while (p > pbeg && !CHAR_HEAD_P (*p)) p--;
989 PARSE_MULTIBYTE_SEQ (p, pend - p, bytes);
990 if (bytes == pend - p)
991 best_above_byte -= bytes;
992 else if (bytes > pend - p)
993 best_above_byte -= (pend - p);
994 else
995 best_above_byte--;
996 best_above--; 910 best_above--;
997 } 911 }
998 i = best_above; 912 i = best_above;
999 i_byte = best_above_byte; 913 i_byte = p - XSTRING (string)->data;
1000 } 914 }
1001 915
1002 string_char_byte_cache_bytepos = i_byte; 916 string_char_byte_cache_bytepos = i_byte;
@@ -2034,7 +1948,8 @@ internal_equal (o1, o2, depth)
2034 functions are sensible to compare, so eliminate the others now. */ 1948 functions are sensible to compare, so eliminate the others now. */
2035 if (size & PSEUDOVECTOR_FLAG) 1949 if (size & PSEUDOVECTOR_FLAG)
2036 { 1950 {
2037 if (!(size & (PVEC_COMPILED | PVEC_CHAR_TABLE))) 1951 if (!(size & (PVEC_COMPILED | PVEC_CHAR_TABLE
1952 | PVEC_SUB_CHAR_TABLE)))
2038 return 0; 1953 return 0;
2039 size &= PSEUDOVECTOR_SIZE_MASK; 1954 size &= PSEUDOVECTOR_SIZE_MASK;
2040 } 1955 }
@@ -2088,11 +2003,11 @@ ARRAY is a vector, string, char-table, or bool-vector. */)
2088 } 2003 }
2089 else if (CHAR_TABLE_P (array)) 2004 else if (CHAR_TABLE_P (array))
2090 { 2005 {
2091 register Lisp_Object *p = XCHAR_TABLE (array)->contents; 2006 int i;
2092 size = CHAR_TABLE_ORDINARY_SLOTS; 2007
2093 for (index = 0; index < size; index++) 2008 for (i = 0; i < (1 << CHARTAB_SIZE_BITS_0); i++)
2094 p[index] = item; 2009 XCHAR_TABLE (array)->contents[i] = item;
2095 XCHAR_TABLE (array)->defalt = Qnil; 2010 XCHAR_TABLE (array)->defalt = item;
2096 } 2011 }
2097 else if (STRINGP (array)) 2012 else if (STRINGP (array))
2098 { 2013 {
@@ -2140,437 +2055,6 @@ ARRAY is a vector, string, char-table, or bool-vector. */)
2140 } 2055 }
2141 return array; 2056 return array;
2142} 2057}
2143
2144DEFUN ("char-table-subtype", Fchar_table_subtype, Schar_table_subtype,
2145 1, 1, 0,
2146 doc: /* Return the subtype of char-table CHAR-TABLE. The value is a symbol. */)
2147 (char_table)
2148 Lisp_Object char_table;
2149{
2150 CHECK_CHAR_TABLE (char_table);
2151
2152 return XCHAR_TABLE (char_table)->purpose;
2153}
2154
2155DEFUN ("char-table-parent", Fchar_table_parent, Schar_table_parent,
2156 1, 1, 0,
2157 doc: /* Return the parent char-table of CHAR-TABLE.
2158The value is either nil or another char-table.
2159If CHAR-TABLE holds nil for a given character,
2160then the actual applicable value is inherited from the parent char-table
2161\(or from its parents, if necessary). */)
2162 (char_table)
2163 Lisp_Object char_table;
2164{
2165 CHECK_CHAR_TABLE (char_table);
2166
2167 return XCHAR_TABLE (char_table)->parent;
2168}
2169
2170DEFUN ("set-char-table-parent", Fset_char_table_parent, Sset_char_table_parent,
2171 2, 2, 0,
2172 doc: /* Set the parent char-table of CHAR-TABLE to PARENT.
2173PARENT must be either nil or another char-table. */)
2174 (char_table, parent)
2175 Lisp_Object char_table, parent;
2176{
2177 Lisp_Object temp;
2178
2179 CHECK_CHAR_TABLE (char_table);
2180
2181 if (!NILP (parent))
2182 {
2183 CHECK_CHAR_TABLE (parent);
2184
2185 for (temp = parent; !NILP (temp); temp = XCHAR_TABLE (temp)->parent)
2186 if (EQ (temp, char_table))
2187 error ("Attempt to make a chartable be its own parent");
2188 }
2189
2190 XCHAR_TABLE (char_table)->parent = parent;
2191
2192 return parent;
2193}
2194
2195DEFUN ("char-table-extra-slot", Fchar_table_extra_slot, Schar_table_extra_slot,
2196 2, 2, 0,
2197 doc: /* Return the value of CHAR-TABLE's extra-slot number N. */)
2198 (char_table, n)
2199 Lisp_Object char_table, n;
2200{
2201 CHECK_CHAR_TABLE (char_table);
2202 CHECK_NUMBER (n);
2203 if (XINT (n) < 0
2204 || XINT (n) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table)))
2205 args_out_of_range (char_table, n);
2206
2207 return XCHAR_TABLE (char_table)->extras[XINT (n)];
2208}
2209
2210DEFUN ("set-char-table-extra-slot", Fset_char_table_extra_slot,
2211 Sset_char_table_extra_slot,
2212 3, 3, 0,
2213 doc: /* Set CHAR-TABLE's extra-slot number N to VALUE. */)
2214 (char_table, n, value)
2215 Lisp_Object char_table, n, value;
2216{
2217 CHECK_CHAR_TABLE (char_table);
2218 CHECK_NUMBER (n);
2219 if (XINT (n) < 0
2220 || XINT (n) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table)))
2221 args_out_of_range (char_table, n);
2222
2223 return XCHAR_TABLE (char_table)->extras[XINT (n)] = value;
2224}
2225
2226DEFUN ("char-table-range", Fchar_table_range, Schar_table_range,
2227 2, 2, 0,
2228 doc: /* Return the value in CHAR-TABLE for a range of characters RANGE.
2229RANGE should be nil (for the default value)
2230a vector which identifies a character set or a row of a character set,
2231a character set name, or a character code. */)
2232 (char_table, range)
2233 Lisp_Object char_table, range;
2234{
2235 CHECK_CHAR_TABLE (char_table);
2236
2237 if (EQ (range, Qnil))
2238 return XCHAR_TABLE (char_table)->defalt;
2239 else if (INTEGERP (range))
2240 return Faref (char_table, range);
2241 else if (SYMBOLP (range))
2242 {
2243 Lisp_Object charset_info;
2244
2245 charset_info = Fget (range, Qcharset);
2246 CHECK_VECTOR (charset_info);
2247
2248 return Faref (char_table,
2249 make_number (XINT (XVECTOR (charset_info)->contents[0])
2250 + 128));
2251 }
2252 else if (VECTORP (range))
2253 {
2254 if (XVECTOR (range)->size == 1)
2255 return Faref (char_table,
2256 make_number (XINT (XVECTOR (range)->contents[0]) + 128));
2257 else
2258 {
2259 int size = XVECTOR (range)->size;
2260 Lisp_Object *val = XVECTOR (range)->contents;
2261 Lisp_Object ch = Fmake_char_internal (size <= 0 ? Qnil : val[0],
2262 size <= 1 ? Qnil : val[1],
2263 size <= 2 ? Qnil : val[2]);
2264 return Faref (char_table, ch);
2265 }
2266 }
2267 else
2268 error ("Invalid RANGE argument to `char-table-range'");
2269 return Qt;
2270}
2271
2272DEFUN ("set-char-table-range", Fset_char_table_range, Sset_char_table_range,
2273 3, 3, 0,
2274 doc: /* Set the value in CHAR-TABLE for a range of characters RANGE to VALUE.
2275RANGE should be t (for all characters), nil (for the default value)
2276a vector which identifies a character set or a row of a character set,
2277a coding system, or a character code. */)
2278 (char_table, range, value)
2279 Lisp_Object char_table, range, value;
2280{
2281 int i;
2282
2283 CHECK_CHAR_TABLE (char_table);
2284
2285 if (EQ (range, Qt))
2286 for (i = 0; i < CHAR_TABLE_ORDINARY_SLOTS; i++)
2287 XCHAR_TABLE (char_table)->contents[i] = value;
2288 else if (EQ (range, Qnil))
2289 XCHAR_TABLE (char_table)->defalt = value;
2290 else if (SYMBOLP (range))
2291 {
2292 Lisp_Object charset_info;
2293
2294 charset_info = Fget (range, Qcharset);
2295 CHECK_VECTOR (charset_info);
2296
2297 return Faset (char_table,
2298 make_number (XINT (XVECTOR (charset_info)->contents[0])
2299 + 128),
2300 value);
2301 }
2302 else if (INTEGERP (range))
2303 Faset (char_table, range, value);
2304 else if (VECTORP (range))
2305 {
2306 if (XVECTOR (range)->size == 1)
2307 return Faset (char_table,
2308 make_number (XINT (XVECTOR (range)->contents[0]) + 128),
2309 value);
2310 else
2311 {
2312 int size = XVECTOR (range)->size;
2313 Lisp_Object *val = XVECTOR (range)->contents;
2314 Lisp_Object ch = Fmake_char_internal (size <= 0 ? Qnil : val[0],
2315 size <= 1 ? Qnil : val[1],
2316 size <= 2 ? Qnil : val[2]);
2317 return Faset (char_table, ch, value);
2318 }
2319 }
2320 else
2321 error ("Invalid RANGE argument to `set-char-table-range'");
2322
2323 return value;
2324}
2325
2326DEFUN ("set-char-table-default", Fset_char_table_default,
2327 Sset_char_table_default, 3, 3, 0,
2328 doc: /* Set the default value in CHAR-TABLE for a generic character CHAR to VALUE.
2329The generic character specifies the group of characters.
2330See also the documentation of make-char. */)
2331 (char_table, ch, value)
2332 Lisp_Object char_table, ch, value;
2333{
2334 int c, charset, code1, code2;
2335 Lisp_Object temp;
2336
2337 CHECK_CHAR_TABLE (char_table);
2338 CHECK_NUMBER (ch);
2339
2340 c = XINT (ch);
2341 SPLIT_CHAR (c, charset, code1, code2);
2342
2343 /* Since we may want to set the default value for a character set
2344 not yet defined, we check only if the character set is in the
2345 valid range or not, instead of it is already defined or not. */
2346 if (! CHARSET_VALID_P (charset))
2347 invalid_character (c);
2348
2349 if (charset == CHARSET_ASCII)
2350 return (XCHAR_TABLE (char_table)->defalt = value);
2351
2352 /* Even if C is not a generic char, we had better behave as if a
2353 generic char is specified. */
2354 if (!CHARSET_DEFINED_P (charset) || CHARSET_DIMENSION (charset) == 1)
2355 code1 = 0;
2356 temp = XCHAR_TABLE (char_table)->contents[charset + 128];
2357 if (!code1)
2358 {
2359 if (SUB_CHAR_TABLE_P (temp))
2360 XCHAR_TABLE (temp)->defalt = value;
2361 else
2362 XCHAR_TABLE (char_table)->contents[charset + 128] = value;
2363 return value;
2364 }
2365 if (SUB_CHAR_TABLE_P (temp))
2366 char_table = temp;
2367 else
2368 char_table = (XCHAR_TABLE (char_table)->contents[charset + 128]
2369 = make_sub_char_table (temp));
2370 temp = XCHAR_TABLE (char_table)->contents[code1];
2371 if (SUB_CHAR_TABLE_P (temp))
2372 XCHAR_TABLE (temp)->defalt = value;
2373 else
2374 XCHAR_TABLE (char_table)->contents[code1] = value;
2375 return value;
2376}
2377
2378/* Look up the element in TABLE at index CH,
2379 and return it as an integer.
2380 If the element is nil, return CH itself.
2381 (Actually we do that for any non-integer.) */
2382
2383int
2384char_table_translate (table, ch)
2385 Lisp_Object table;
2386 int ch;
2387{
2388 Lisp_Object value;
2389 value = Faref (table, make_number (ch));
2390 if (! INTEGERP (value))
2391 return ch;
2392 return XINT (value);
2393}
2394
2395static void
2396optimize_sub_char_table (table, chars)
2397 Lisp_Object *table;
2398 int chars;
2399{
2400 Lisp_Object elt;
2401 int from, to;
2402
2403 if (chars == 94)
2404 from = 33, to = 127;
2405 else
2406 from = 32, to = 128;
2407
2408 if (!SUB_CHAR_TABLE_P (*table))
2409 return;
2410 elt = XCHAR_TABLE (*table)->contents[from++];
2411 for (; from < to; from++)
2412 if (NILP (Fequal (elt, XCHAR_TABLE (*table)->contents[from])))
2413 return;
2414 *table = elt;
2415}
2416
2417DEFUN ("optimize-char-table", Foptimize_char_table, Soptimize_char_table,
2418 1, 1, 0, doc: /* Optimize char table TABLE. */)
2419 (table)
2420 Lisp_Object table;
2421{
2422 Lisp_Object elt;
2423 int dim;
2424 int i, j;
2425
2426 CHECK_CHAR_TABLE (table);
2427
2428 for (i = CHAR_TABLE_SINGLE_BYTE_SLOTS; i < CHAR_TABLE_ORDINARY_SLOTS; i++)
2429 {
2430 elt = XCHAR_TABLE (table)->contents[i];
2431 if (!SUB_CHAR_TABLE_P (elt))
2432 continue;
2433 dim = CHARSET_DIMENSION (i - 128);
2434 if (dim == 2)
2435 for (j = 32; j < SUB_CHAR_TABLE_ORDINARY_SLOTS; j++)
2436 optimize_sub_char_table (XCHAR_TABLE (elt)->contents + j, dim);
2437 optimize_sub_char_table (XCHAR_TABLE (table)->contents + i, dim);
2438 }
2439 return Qnil;
2440}
2441
2442
2443/* Map C_FUNCTION or FUNCTION over SUBTABLE, calling it for each
2444 character or group of characters that share a value.
2445 DEPTH is the current depth in the originally specified
2446 chartable, and INDICES contains the vector indices
2447 for the levels our callers have descended.
2448
2449 ARG is passed to C_FUNCTION when that is called. */
2450
2451void
2452map_char_table (c_function, function, subtable, arg, depth, indices)
2453 void (*c_function) P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
2454 Lisp_Object function, subtable, arg, *indices;
2455 int depth;
2456{
2457 int i, to;
2458
2459 if (depth == 0)
2460 {
2461 /* At first, handle ASCII and 8-bit European characters. */
2462 for (i = 0; i < CHAR_TABLE_SINGLE_BYTE_SLOTS; i++)
2463 {
2464 Lisp_Object elt = XCHAR_TABLE (subtable)->contents[i];
2465 if (c_function)
2466 (*c_function) (arg, make_number (i), elt);
2467 else
2468 call2 (function, make_number (i), elt);
2469 }
2470#if 0 /* If the char table has entries for higher characters,
2471 we should report them. */
2472 if (NILP (current_buffer->enable_multibyte_characters))
2473 return;
2474#endif
2475 to = CHAR_TABLE_ORDINARY_SLOTS;
2476 }
2477 else
2478 {
2479 int charset = XFASTINT (indices[0]) - 128;
2480
2481 i = 32;
2482 to = SUB_CHAR_TABLE_ORDINARY_SLOTS;
2483 if (CHARSET_CHARS (charset) == 94)
2484 i++, to--;
2485 }
2486
2487 for (; i < to; i++)
2488 {
2489 Lisp_Object elt;
2490 int charset;
2491
2492 elt = XCHAR_TABLE (subtable)->contents[i];
2493 XSETFASTINT (indices[depth], i);
2494 charset = XFASTINT (indices[0]) - 128;
2495 if (depth == 0
2496 && (!CHARSET_DEFINED_P (charset)
2497 || charset == CHARSET_8_BIT_CONTROL
2498 || charset == CHARSET_8_BIT_GRAPHIC))
2499 continue;
2500
2501 if (SUB_CHAR_TABLE_P (elt))
2502 {
2503 if (depth >= 3)
2504 error ("Too deep char table");
2505 map_char_table (c_function, function, elt, arg, depth + 1, indices);
2506 }
2507 else
2508 {
2509 int c1, c2, c;
2510
2511 if (NILP (elt))
2512 elt = XCHAR_TABLE (subtable)->defalt;
2513 c1 = depth >= 1 ? XFASTINT (indices[1]) : 0;
2514 c2 = depth >= 2 ? XFASTINT (indices[2]) : 0;
2515 c = MAKE_CHAR (charset, c1, c2);
2516 if (c_function)
2517 (*c_function) (arg, make_number (c), elt);
2518 else
2519 call2 (function, make_number (c), elt);
2520 }
2521 }
2522}
2523
2524DEFUN ("map-char-table", Fmap_char_table, Smap_char_table,
2525 2, 2, 0,
2526 doc: /* Call FUNCTION for each (normal and generic) characters in CHAR-TABLE.
2527FUNCTION is called with two arguments--a key and a value.
2528The key is always a possible IDX argument to `aref'. */)
2529 (function, char_table)
2530 Lisp_Object function, char_table;
2531{
2532 /* The depth of char table is at most 3. */
2533 Lisp_Object indices[3];
2534
2535 CHECK_CHAR_TABLE (char_table);
2536
2537 map_char_table (NULL, function, char_table, char_table, 0, indices);
2538 return Qnil;
2539}
2540
2541/* Return a value for character C in char-table TABLE. Store the
2542 actual index for that value in *IDX. Ignore the default value of
2543 TABLE. */
2544
2545Lisp_Object
2546char_table_ref_and_index (table, c, idx)
2547 Lisp_Object table;
2548 int c, *idx;
2549{
2550 int charset, c1, c2;
2551 Lisp_Object elt;
2552
2553 if (SINGLE_BYTE_CHAR_P (c))
2554 {
2555 *idx = c;
2556 return XCHAR_TABLE (table)->contents[c];
2557 }
2558 SPLIT_CHAR (c, charset, c1, c2);
2559 elt = XCHAR_TABLE (table)->contents[charset + 128];
2560 *idx = MAKE_CHAR (charset, 0, 0);
2561 if (!SUB_CHAR_TABLE_P (elt))
2562 return elt;
2563 if (c1 < 32 || NILP (XCHAR_TABLE (elt)->contents[c1]))
2564 return XCHAR_TABLE (elt)->defalt;
2565 elt = XCHAR_TABLE (elt)->contents[c1];
2566 *idx = MAKE_CHAR (charset, c1, 0);
2567 if (!SUB_CHAR_TABLE_P (elt))
2568 return elt;
2569 if (c2 < 32 || NILP (XCHAR_TABLE (elt)->contents[c2]))
2570 return XCHAR_TABLE (elt)->defalt;
2571 *idx = c;
2572 return XCHAR_TABLE (elt)->contents[c2];
2573}
2574 2058
2575 2059
2576/* ARGSUSED */ 2060/* ARGSUSED */
@@ -3753,14 +3237,6 @@ base64_decode_1 (from, to, length, multibyte, nchars_return)
3753 if a `:linear-search t' argument is given to make-hash-table. */ 3237 if a `:linear-search t' argument is given to make-hash-table. */
3754 3238
3755 3239
3756/* Value is the key part of entry IDX in hash table H. */
3757
3758#define HASH_KEY(H, IDX) AREF ((H)->key_and_value, 2 * (IDX))
3759
3760/* Value is the value part of entry IDX in hash table H. */
3761
3762#define HASH_VALUE(H, IDX) AREF ((H)->key_and_value, 2 * (IDX) + 1)
3763
3764/* Value is the index of the next entry following the one at IDX 3240/* Value is the index of the next entry following the one at IDX
3765 in hash table H. */ 3241 in hash table H. */
3766 3242
@@ -5084,7 +4560,7 @@ guesswork fails. Normally, an error is signaled in such case. */)
5084 4560
5085 if (STRING_MULTIBYTE (object)) 4561 if (STRING_MULTIBYTE (object))
5086 /* use default, we can't guess correct value */ 4562 /* use default, we can't guess correct value */
5087 coding_system = SYMBOL_VALUE (XCAR (Vcoding_category_list)); 4563 coding_system = preferred_coding_system ();
5088 else 4564 else
5089 coding_system = Qraw_text; 4565 coding_system = Qraw_text;
5090 } 4566 }
@@ -5101,7 +4577,7 @@ guesswork fails. Normally, an error is signaled in such case. */)
5101 } 4577 }
5102 4578
5103 if (STRING_MULTIBYTE (object)) 4579 if (STRING_MULTIBYTE (object))
5104 object = code_convert_string1 (object, coding_system, Qnil, 1); 4580 object = code_convert_string (object, coding_system, Qnil, 1, 0, 1);
5105 4581
5106 size = XSTRING (object)->size; 4582 size = XSTRING (object)->size;
5107 size_byte = STRING_BYTES (XSTRING (object)); 4583 size_byte = STRING_BYTES (XSTRING (object));
@@ -5233,7 +4709,7 @@ guesswork fails. Normally, an error is signaled in such case. */)
5233 object = make_buffer_string (b, e, 0); 4709 object = make_buffer_string (b, e, 0);
5234 4710
5235 if (STRING_MULTIBYTE (object)) 4711 if (STRING_MULTIBYTE (object))
5236 object = code_convert_string1 (object, coding_system, Qnil, 1); 4712 object = code_convert_string (object, coding_system, Qnil, 1, 0, 1);
5237 } 4713 }
5238 4714
5239 md5_buffer (XSTRING (object)->data + start_byte, 4715 md5_buffer (XSTRING (object)->data + start_byte,
@@ -5371,16 +4847,6 @@ invoked by mouse clicks and mouse menu items. */);
5371 defsubr (&Sput); 4847 defsubr (&Sput);
5372 defsubr (&Sequal); 4848 defsubr (&Sequal);
5373 defsubr (&Sfillarray); 4849 defsubr (&Sfillarray);
5374 defsubr (&Schar_table_subtype);
5375 defsubr (&Schar_table_parent);
5376 defsubr (&Sset_char_table_parent);
5377 defsubr (&Schar_table_extra_slot);
5378 defsubr (&Sset_char_table_extra_slot);
5379 defsubr (&Schar_table_range);
5380 defsubr (&Sset_char_table_range);
5381 defsubr (&Sset_char_table_default);
5382 defsubr (&Soptimize_char_table);
5383 defsubr (&Smap_char_table);
5384 defsubr (&Snconc); 4850 defsubr (&Snconc);
5385 defsubr (&Smapcar); 4851 defsubr (&Smapcar);
5386 defsubr (&Smapc); 4852 defsubr (&Smapc);