1 /* XEmacs routines to deal with char tables.
2 Copyright (C) 1992, 1995 Free Software Foundation, Inc.
3 Copyright (C) 1995 Sun Microsystems, Inc.
4 Copyright (C) 1995, 1996 Ben Wing.
5 Copyright (C) 1995, 1997, 1999 Electrotechnical Laboratory, JAPAN.
6 Licensed to the Free Software Foundation.
7 Copyright (C) 1999,2000,2001,2002,2003 MORIOKA Tomohiko
9 This file is part of XEmacs.
11 XEmacs is free software; you can redistribute it and/or modify it
12 under the terms of the GNU General Public License as published by the
13 Free Software Foundation; either version 2, or (at your option) any
16 XEmacs is distributed in the hope that it will be useful, but WITHOUT
17 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
18 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
21 You should have received a copy of the GNU General Public License
22 along with XEmacs; see the file COPYING. If not, write to
23 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 Boston, MA 02111-1307, USA. */
26 /* Synched up with: Mule 2.3. Not synched with FSF.
28 This file was written independently of the FSF implementation,
29 and is not compatible. */
33 Ben Wing: wrote, for 19.13 (Mule). Some category table stuff
34 loosely based on the original Mule.
35 Jareth Hein: fixed a couple of bugs in the implementation, and
36 added regex support for categories with check_category_at
37 MORIOKA Tomohiko: Rewritten for XEmacs UTF-2000
50 Lisp_Object Qchar_tablep, Qchar_table;
52 Lisp_Object Vall_syntax_tables;
55 Lisp_Object Qcategory_table_p;
56 Lisp_Object Qcategory_designator_p;
57 Lisp_Object Qcategory_table_value_p;
59 Lisp_Object Vstandard_category_table;
61 /* Variables to determine word boundary. */
62 Lisp_Object Vword_combining_categories, Vword_separating_categories;
67 Lisp_Object Vchise_db_directory;
68 Lisp_Object Vchise_system_db_directory;
70 CHISE_DS *default_chise_data_source = NULL;
75 EXFUN (Fchar_refs_simplify_char_specs, 1);
76 extern Lisp_Object Qideographic_structure;
78 EXFUN (Fmap_char_attribute, 3);
81 EXFUN (Fmount_char_attribute_table, 1);
85 EXFUN (Fload_char_attribute_table, 1);
87 Lisp_Object Vchar_db_stingy_mode;
90 #define BT_UINT8_MIN 0
91 #define BT_UINT8_MAX (UCHAR_MAX - 4)
92 #define BT_UINT8_t (UCHAR_MAX - 3)
93 #define BT_UINT8_nil (UCHAR_MAX - 2)
94 #define BT_UINT8_unbound (UCHAR_MAX - 1)
95 #define BT_UINT8_unloaded UCHAR_MAX
97 INLINE_HEADER int INT_UINT8_P (Lisp_Object obj);
98 INLINE_HEADER int UINT8_VALUE_P (Lisp_Object obj);
99 INLINE_HEADER unsigned char UINT8_ENCODE (Lisp_Object obj);
100 INLINE_HEADER Lisp_Object UINT8_DECODE (unsigned char n);
101 INLINE_HEADER unsigned short UINT8_TO_UINT16 (unsigned char n);
104 INT_UINT8_P (Lisp_Object obj)
108 int num = XINT (obj);
110 return (BT_UINT8_MIN <= num) && (num <= BT_UINT8_MAX);
117 UINT8_VALUE_P (Lisp_Object obj)
119 return EQ (obj, Qunloaded) || EQ (obj, Qunbound)
120 || EQ (obj, Qnil) || EQ (obj, Qt) || INT_UINT8_P (obj);
123 INLINE_HEADER unsigned char
124 UINT8_ENCODE (Lisp_Object obj)
126 if (EQ (obj, Qunloaded))
127 return BT_UINT8_unloaded;
128 else if (EQ (obj, Qunbound))
129 return BT_UINT8_unbound;
130 else if (EQ (obj, Qnil))
132 else if (EQ (obj, Qt))
138 INLINE_HEADER Lisp_Object
139 UINT8_DECODE (unsigned char n)
141 if (n == BT_UINT8_unloaded)
143 else if (n == BT_UINT8_unbound)
145 else if (n == BT_UINT8_nil)
147 else if (n == BT_UINT8_t)
154 mark_uint8_byte_table (Lisp_Object obj)
160 print_uint8_byte_table (Lisp_Object obj,
161 Lisp_Object printcharfun, int escapeflag)
163 Lisp_Uint8_Byte_Table *bte = XUINT8_BYTE_TABLE (obj);
165 struct gcpro gcpro1, gcpro2;
166 GCPRO2 (obj, printcharfun);
168 write_c_string ("\n#<uint8-byte-table", printcharfun);
169 for (i = 0; i < 256; i++)
171 unsigned char n = bte->property[i];
173 write_c_string ("\n ", printcharfun);
174 write_c_string (" ", printcharfun);
175 if (n == BT_UINT8_unbound)
176 write_c_string ("void", printcharfun);
177 else if (n == BT_UINT8_nil)
178 write_c_string ("nil", printcharfun);
179 else if (n == BT_UINT8_t)
180 write_c_string ("t", printcharfun);
185 sprintf (buf, "%hd", n);
186 write_c_string (buf, printcharfun);
190 write_c_string (">", printcharfun);
194 uint8_byte_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
196 Lisp_Uint8_Byte_Table *te1 = XUINT8_BYTE_TABLE (obj1);
197 Lisp_Uint8_Byte_Table *te2 = XUINT8_BYTE_TABLE (obj2);
200 for (i = 0; i < 256; i++)
201 if (te1->property[i] != te2->property[i])
207 uint8_byte_table_hash (Lisp_Object obj, int depth)
209 Lisp_Uint8_Byte_Table *te = XUINT8_BYTE_TABLE (obj);
213 for (i = 0; i < 256; i++)
214 hash = HASH2 (hash, te->property[i]);
218 static const struct lrecord_description uint8_byte_table_description[] = {
222 DEFINE_LRECORD_IMPLEMENTATION ("uint8-byte-table", uint8_byte_table,
223 mark_uint8_byte_table,
224 print_uint8_byte_table,
225 0, uint8_byte_table_equal,
226 uint8_byte_table_hash,
227 uint8_byte_table_description,
228 Lisp_Uint8_Byte_Table);
231 make_uint8_byte_table (unsigned char initval)
235 Lisp_Uint8_Byte_Table *cte;
237 cte = alloc_lcrecord_type (Lisp_Uint8_Byte_Table,
238 &lrecord_uint8_byte_table);
240 for (i = 0; i < 256; i++)
241 cte->property[i] = initval;
243 XSETUINT8_BYTE_TABLE (obj, cte);
248 copy_uint8_byte_table (Lisp_Object entry)
250 Lisp_Uint8_Byte_Table *cte = XUINT8_BYTE_TABLE (entry);
253 Lisp_Uint8_Byte_Table *ctenew
254 = alloc_lcrecord_type (Lisp_Uint8_Byte_Table,
255 &lrecord_uint8_byte_table);
257 for (i = 0; i < 256; i++)
259 ctenew->property[i] = cte->property[i];
262 XSETUINT8_BYTE_TABLE (obj, ctenew);
267 uint8_byte_table_same_value_p (Lisp_Object obj)
269 Lisp_Uint8_Byte_Table *bte = XUINT8_BYTE_TABLE (obj);
270 unsigned char v0 = bte->property[0];
273 for (i = 1; i < 256; i++)
275 if (bte->property[i] != v0)
282 map_over_uint8_byte_table (Lisp_Uint8_Byte_Table *ct, Lisp_Char_Table* root,
283 Emchar ofs, int place,
284 int (*fn) (struct chartab_range *range,
285 Lisp_Object val, void *arg),
288 struct chartab_range rainj;
290 int unit = 1 << (8 * place);
294 rainj.type = CHARTAB_RANGE_CHAR;
296 for (i = 0, retval = 0; i < 256 && retval == 0; i++)
298 if (ct->property[i] == BT_UINT8_unloaded)
302 for (; c < c1 && retval == 0; c++)
304 Lisp_Object ret = get_char_id_table (root, c);
309 retval = (fn) (&rainj, ret, arg);
313 ct->property[i] = BT_UINT8_unbound;
317 else if (ct->property[i] != BT_UINT8_unbound)
320 for (; c < c1 && retval == 0; c++)
323 retval = (fn) (&rainj, UINT8_DECODE (ct->property[i]), arg);
334 save_uint8_byte_table (Lisp_Uint8_Byte_Table *ct, Lisp_Char_Table* root,
336 CHISE_Feature feature,
340 Emchar ofs, int place,
341 Lisp_Object (*filter)(Lisp_Object value))
343 struct chartab_range rainj;
345 int unit = 1 << (8 * place);
349 rainj.type = CHARTAB_RANGE_CHAR;
351 for (i = 0, retval = 0; i < 256 && retval == 0; i++)
353 if (ct->property[i] == BT_UINT8_unloaded)
357 else if (ct->property[i] != BT_UINT8_unbound)
360 for (; c < c1 && retval == 0; c++)
363 chise_char_set_feature_value
366 (Fprin1_to_string (UINT8_DECODE (ct->property[i]),
369 Fput_database (Fprin1_to_string (make_char (c), Qnil),
370 Fprin1_to_string (UINT8_DECODE (ct->property[i]),
382 #define BT_UINT16_MIN 0
383 #define BT_UINT16_MAX (USHRT_MAX - 4)
384 #define BT_UINT16_t (USHRT_MAX - 3)
385 #define BT_UINT16_nil (USHRT_MAX - 2)
386 #define BT_UINT16_unbound (USHRT_MAX - 1)
387 #define BT_UINT16_unloaded USHRT_MAX
389 INLINE_HEADER int INT_UINT16_P (Lisp_Object obj);
390 INLINE_HEADER int UINT16_VALUE_P (Lisp_Object obj);
391 INLINE_HEADER unsigned short UINT16_ENCODE (Lisp_Object obj);
392 INLINE_HEADER Lisp_Object UINT16_DECODE (unsigned short us);
395 INT_UINT16_P (Lisp_Object obj)
399 int num = XINT (obj);
401 return (BT_UINT16_MIN <= num) && (num <= BT_UINT16_MAX);
408 UINT16_VALUE_P (Lisp_Object obj)
410 return EQ (obj, Qunloaded) || EQ (obj, Qunbound)
411 || EQ (obj, Qnil) || EQ (obj, Qt) || INT_UINT16_P (obj);
414 INLINE_HEADER unsigned short
415 UINT16_ENCODE (Lisp_Object obj)
417 if (EQ (obj, Qunloaded))
418 return BT_UINT16_unloaded;
419 else if (EQ (obj, Qunbound))
420 return BT_UINT16_unbound;
421 else if (EQ (obj, Qnil))
422 return BT_UINT16_nil;
423 else if (EQ (obj, Qt))
429 INLINE_HEADER Lisp_Object
430 UINT16_DECODE (unsigned short n)
432 if (n == BT_UINT16_unloaded)
434 else if (n == BT_UINT16_unbound)
436 else if (n == BT_UINT16_nil)
438 else if (n == BT_UINT16_t)
444 INLINE_HEADER unsigned short
445 UINT8_TO_UINT16 (unsigned char n)
447 if (n == BT_UINT8_unloaded)
448 return BT_UINT16_unloaded;
449 else if (n == BT_UINT8_unbound)
450 return BT_UINT16_unbound;
451 else if (n == BT_UINT8_nil)
452 return BT_UINT16_nil;
453 else if (n == BT_UINT8_t)
460 mark_uint16_byte_table (Lisp_Object obj)
466 print_uint16_byte_table (Lisp_Object obj,
467 Lisp_Object printcharfun, int escapeflag)
469 Lisp_Uint16_Byte_Table *bte = XUINT16_BYTE_TABLE (obj);
471 struct gcpro gcpro1, gcpro2;
472 GCPRO2 (obj, printcharfun);
474 write_c_string ("\n#<uint16-byte-table", printcharfun);
475 for (i = 0; i < 256; i++)
477 unsigned short n = bte->property[i];
479 write_c_string ("\n ", printcharfun);
480 write_c_string (" ", printcharfun);
481 if (n == BT_UINT16_unbound)
482 write_c_string ("void", printcharfun);
483 else if (n == BT_UINT16_nil)
484 write_c_string ("nil", printcharfun);
485 else if (n == BT_UINT16_t)
486 write_c_string ("t", printcharfun);
491 sprintf (buf, "%hd", n);
492 write_c_string (buf, printcharfun);
496 write_c_string (">", printcharfun);
500 uint16_byte_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
502 Lisp_Uint16_Byte_Table *te1 = XUINT16_BYTE_TABLE (obj1);
503 Lisp_Uint16_Byte_Table *te2 = XUINT16_BYTE_TABLE (obj2);
506 for (i = 0; i < 256; i++)
507 if (te1->property[i] != te2->property[i])
513 uint16_byte_table_hash (Lisp_Object obj, int depth)
515 Lisp_Uint16_Byte_Table *te = XUINT16_BYTE_TABLE (obj);
519 for (i = 0; i < 256; i++)
520 hash = HASH2 (hash, te->property[i]);
524 static const struct lrecord_description uint16_byte_table_description[] = {
528 DEFINE_LRECORD_IMPLEMENTATION ("uint16-byte-table", uint16_byte_table,
529 mark_uint16_byte_table,
530 print_uint16_byte_table,
531 0, uint16_byte_table_equal,
532 uint16_byte_table_hash,
533 uint16_byte_table_description,
534 Lisp_Uint16_Byte_Table);
537 make_uint16_byte_table (unsigned short initval)
541 Lisp_Uint16_Byte_Table *cte;
543 cte = alloc_lcrecord_type (Lisp_Uint16_Byte_Table,
544 &lrecord_uint16_byte_table);
546 for (i = 0; i < 256; i++)
547 cte->property[i] = initval;
549 XSETUINT16_BYTE_TABLE (obj, cte);
554 copy_uint16_byte_table (Lisp_Object entry)
556 Lisp_Uint16_Byte_Table *cte = XUINT16_BYTE_TABLE (entry);
559 Lisp_Uint16_Byte_Table *ctenew
560 = alloc_lcrecord_type (Lisp_Uint16_Byte_Table,
561 &lrecord_uint16_byte_table);
563 for (i = 0; i < 256; i++)
565 ctenew->property[i] = cte->property[i];
568 XSETUINT16_BYTE_TABLE (obj, ctenew);
573 expand_uint8_byte_table_to_uint16 (Lisp_Object table)
577 Lisp_Uint8_Byte_Table* bte = XUINT8_BYTE_TABLE(table);
578 Lisp_Uint16_Byte_Table* cte;
580 cte = alloc_lcrecord_type (Lisp_Uint16_Byte_Table,
581 &lrecord_uint16_byte_table);
582 for (i = 0; i < 256; i++)
584 cte->property[i] = UINT8_TO_UINT16 (bte->property[i]);
586 XSETUINT16_BYTE_TABLE (obj, cte);
591 uint16_byte_table_same_value_p (Lisp_Object obj)
593 Lisp_Uint16_Byte_Table *bte = XUINT16_BYTE_TABLE (obj);
594 unsigned short v0 = bte->property[0];
597 for (i = 1; i < 256; i++)
599 if (bte->property[i] != v0)
606 map_over_uint16_byte_table (Lisp_Uint16_Byte_Table *ct, Lisp_Char_Table* root,
607 Emchar ofs, int place,
608 int (*fn) (struct chartab_range *range,
609 Lisp_Object val, void *arg),
612 struct chartab_range rainj;
614 int unit = 1 << (8 * place);
618 rainj.type = CHARTAB_RANGE_CHAR;
620 for (i = 0, retval = 0; i < 256 && retval == 0; i++)
622 if (ct->property[i] == BT_UINT16_unloaded)
626 for (; c < c1 && retval == 0; c++)
628 Lisp_Object ret = get_char_id_table (root, c);
633 retval = (fn) (&rainj, ret, arg);
637 ct->property[i] = BT_UINT16_unbound;
641 else if (ct->property[i] != BT_UINT16_unbound)
644 for (; c < c1 && retval == 0; c++)
647 retval = (fn) (&rainj, UINT16_DECODE (ct->property[i]), arg);
658 save_uint16_byte_table (Lisp_Uint16_Byte_Table *ct, Lisp_Char_Table* root,
660 CHISE_Feature feature,
664 Emchar ofs, int place,
665 Lisp_Object (*filter)(Lisp_Object value))
667 struct chartab_range rainj;
669 int unit = 1 << (8 * place);
673 rainj.type = CHARTAB_RANGE_CHAR;
675 for (i = 0, retval = 0; i < 256 && retval == 0; i++)
677 if (ct->property[i] == BT_UINT16_unloaded)
681 else if (ct->property[i] != BT_UINT16_unbound)
684 for (; c < c1 && retval == 0; c++)
687 chise_char_set_feature_value
690 (Fprin1_to_string (UINT16_DECODE (ct->property[i]),
693 Fput_database (Fprin1_to_string (make_char (c), Qnil),
694 Fprin1_to_string (UINT16_DECODE (ct->property[i]),
708 mark_byte_table (Lisp_Object obj)
710 Lisp_Byte_Table *cte = XBYTE_TABLE (obj);
713 for (i = 0; i < 256; i++)
715 mark_object (cte->property[i]);
721 print_byte_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
723 Lisp_Byte_Table *bte = XBYTE_TABLE (obj);
725 struct gcpro gcpro1, gcpro2;
726 GCPRO2 (obj, printcharfun);
728 write_c_string ("\n#<byte-table", printcharfun);
729 for (i = 0; i < 256; i++)
731 Lisp_Object elt = bte->property[i];
733 write_c_string ("\n ", printcharfun);
734 write_c_string (" ", printcharfun);
735 if (EQ (elt, Qunbound))
736 write_c_string ("void", printcharfun);
738 print_internal (elt, printcharfun, escapeflag);
741 write_c_string (">", printcharfun);
745 byte_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
747 Lisp_Byte_Table *cte1 = XBYTE_TABLE (obj1);
748 Lisp_Byte_Table *cte2 = XBYTE_TABLE (obj2);
751 for (i = 0; i < 256; i++)
752 if (BYTE_TABLE_P (cte1->property[i]))
754 if (BYTE_TABLE_P (cte2->property[i]))
756 if (!byte_table_equal (cte1->property[i],
757 cte2->property[i], depth + 1))
764 if (!internal_equal (cte1->property[i], cte2->property[i], depth + 1))
770 byte_table_hash (Lisp_Object obj, int depth)
772 Lisp_Byte_Table *cte = XBYTE_TABLE (obj);
774 return internal_array_hash (cte->property, 256, depth);
777 static const struct lrecord_description byte_table_description[] = {
778 { XD_LISP_OBJECT_ARRAY, offsetof(Lisp_Byte_Table, property), 256 },
782 DEFINE_LRECORD_IMPLEMENTATION ("byte-table", byte_table,
787 byte_table_description,
791 make_byte_table (Lisp_Object initval)
795 Lisp_Byte_Table *cte;
797 cte = alloc_lcrecord_type (Lisp_Byte_Table, &lrecord_byte_table);
799 for (i = 0; i < 256; i++)
800 cte->property[i] = initval;
802 XSETBYTE_TABLE (obj, cte);
807 copy_byte_table (Lisp_Object entry)
809 Lisp_Byte_Table *cte = XBYTE_TABLE (entry);
812 Lisp_Byte_Table *ctnew
813 = alloc_lcrecord_type (Lisp_Byte_Table, &lrecord_byte_table);
815 for (i = 0; i < 256; i++)
817 if (UINT8_BYTE_TABLE_P (cte->property[i]))
819 ctnew->property[i] = copy_uint8_byte_table (cte->property[i]);
821 else if (UINT16_BYTE_TABLE_P (cte->property[i]))
823 ctnew->property[i] = copy_uint16_byte_table (cte->property[i]);
825 else if (BYTE_TABLE_P (cte->property[i]))
827 ctnew->property[i] = copy_byte_table (cte->property[i]);
830 ctnew->property[i] = cte->property[i];
833 XSETBYTE_TABLE (obj, ctnew);
838 byte_table_same_value_p (Lisp_Object obj)
840 Lisp_Byte_Table *bte = XBYTE_TABLE (obj);
841 Lisp_Object v0 = bte->property[0];
844 for (i = 1; i < 256; i++)
846 if (!internal_equal (bte->property[i], v0, 0))
853 map_over_byte_table (Lisp_Byte_Table *ct, Lisp_Char_Table* root,
854 Emchar ofs, int place,
855 int (*fn) (struct chartab_range *range,
856 Lisp_Object val, void *arg),
861 int unit = 1 << (8 * place);
864 for (i = 0, retval = 0; i < 256 && retval == 0; i++)
867 if (UINT8_BYTE_TABLE_P (v))
870 = map_over_uint8_byte_table (XUINT8_BYTE_TABLE(v), root,
871 c, place - 1, fn, arg);
874 else if (UINT16_BYTE_TABLE_P (v))
877 = map_over_uint16_byte_table (XUINT16_BYTE_TABLE(v), root,
878 c, place - 1, fn, arg);
881 else if (BYTE_TABLE_P (v))
883 retval = map_over_byte_table (XBYTE_TABLE(v), root,
884 c, place - 1, fn, arg);
887 else if (EQ (v, Qunloaded))
890 struct chartab_range rainj;
891 Emchar c1 = c + unit;
893 rainj.type = CHARTAB_RANGE_CHAR;
895 for (; c < c1 && retval == 0; c++)
897 Lisp_Object ret = get_char_id_table (root, c);
902 retval = (fn) (&rainj, ret, arg);
906 ct->property[i] = Qunbound;
910 else if (!UNBOUNDP (v))
912 struct chartab_range rainj;
913 Emchar c1 = c + unit;
915 rainj.type = CHARTAB_RANGE_CHAR;
917 for (; c < c1 && retval == 0; c++)
920 retval = (fn) (&rainj, v, arg);
931 save_byte_table (Lisp_Byte_Table *ct, Lisp_Char_Table* root,
933 CHISE_Feature feature,
937 Emchar ofs, int place,
938 Lisp_Object (*filter)(Lisp_Object value))
942 int unit = 1 << (8 * place);
945 for (i = 0, retval = 0; i < 256 && retval == 0; i++)
948 if (UINT8_BYTE_TABLE_P (v))
950 save_uint8_byte_table (XUINT8_BYTE_TABLE(v), root,
956 c, place - 1, filter);
959 else if (UINT16_BYTE_TABLE_P (v))
961 save_uint16_byte_table (XUINT16_BYTE_TABLE(v), root,
967 c, place - 1, filter);
970 else if (BYTE_TABLE_P (v))
972 save_byte_table (XBYTE_TABLE(v), root,
978 c, place - 1, filter);
981 else if (EQ (v, Qunloaded))
985 else if (!UNBOUNDP (v))
987 struct chartab_range rainj;
988 Emchar c1 = c + unit;
993 rainj.type = CHARTAB_RANGE_CHAR;
995 for (; c < c1 && retval == 0; c++)
998 chise_char_set_feature_value
999 (c, feature, XSTRING_DATA (Fprin1_to_string (v, Qnil)));
1001 Fput_database (Fprin1_to_string (make_char (c), Qnil),
1002 Fprin1_to_string (v, Qnil),
1014 get_byte_table (Lisp_Object table, unsigned char idx)
1016 if (UINT8_BYTE_TABLE_P (table))
1017 return UINT8_DECODE (XUINT8_BYTE_TABLE(table)->property[idx]);
1018 else if (UINT16_BYTE_TABLE_P (table))
1019 return UINT16_DECODE (XUINT16_BYTE_TABLE(table)->property[idx]);
1020 else if (BYTE_TABLE_P (table))
1021 return XBYTE_TABLE(table)->property[idx];
1027 put_byte_table (Lisp_Object table, unsigned char idx, Lisp_Object value)
1029 if (UINT8_BYTE_TABLE_P (table))
1031 if (UINT8_VALUE_P (value))
1033 XUINT8_BYTE_TABLE(table)->property[idx] = UINT8_ENCODE (value);
1034 if (!UINT8_BYTE_TABLE_P (value) &&
1035 !UINT16_BYTE_TABLE_P (value) && !BYTE_TABLE_P (value)
1036 && uint8_byte_table_same_value_p (table))
1041 else if (UINT16_VALUE_P (value))
1043 Lisp_Object new = expand_uint8_byte_table_to_uint16 (table);
1045 XUINT16_BYTE_TABLE(new)->property[idx] = UINT16_ENCODE (value);
1050 Lisp_Object new = make_byte_table (Qnil);
1053 for (i = 0; i < 256; i++)
1055 XBYTE_TABLE(new)->property[i]
1056 = UINT8_DECODE (XUINT8_BYTE_TABLE(table)->property[i]);
1058 XBYTE_TABLE(new)->property[idx] = value;
1062 else if (UINT16_BYTE_TABLE_P (table))
1064 if (UINT16_VALUE_P (value))
1066 XUINT16_BYTE_TABLE(table)->property[idx] = UINT16_ENCODE (value);
1067 if (!UINT8_BYTE_TABLE_P (value) &&
1068 !UINT16_BYTE_TABLE_P (value) && !BYTE_TABLE_P (value)
1069 && uint16_byte_table_same_value_p (table))
1076 Lisp_Object new = make_byte_table (Qnil);
1079 for (i = 0; i < 256; i++)
1081 XBYTE_TABLE(new)->property[i]
1082 = UINT16_DECODE (XUINT16_BYTE_TABLE(table)->property[i]);
1084 XBYTE_TABLE(new)->property[idx] = value;
1088 else if (BYTE_TABLE_P (table))
1090 XBYTE_TABLE(table)->property[idx] = value;
1091 if (!UINT8_BYTE_TABLE_P (value) &&
1092 !UINT16_BYTE_TABLE_P (value) && !BYTE_TABLE_P (value)
1093 && byte_table_same_value_p (table))
1098 else if (!internal_equal (table, value, 0))
1100 if (UINT8_VALUE_P (table) && UINT8_VALUE_P (value))
1102 table = make_uint8_byte_table (UINT8_ENCODE (table));
1103 XUINT8_BYTE_TABLE(table)->property[idx] = UINT8_ENCODE (value);
1105 else if (UINT16_VALUE_P (table) && UINT16_VALUE_P (value))
1107 table = make_uint16_byte_table (UINT16_ENCODE (table));
1108 XUINT16_BYTE_TABLE(table)->property[idx] = UINT16_ENCODE (value);
1112 table = make_byte_table (table);
1113 XBYTE_TABLE(table)->property[idx] = value;
1121 make_char_id_table (Lisp_Object initval)
1124 obj = Fmake_char_table (Qgeneric);
1125 fill_char_table (XCHAR_TABLE (obj), initval);
1130 #if defined(HAVE_CHISE) && !defined(HAVE_LIBCHISE_LIBCHISE)
1131 Lisp_Object Qsystem_char_id;
1134 Lisp_Object Qcomposition;
1135 Lisp_Object Q_decomposition;
1136 Lisp_Object Qto_ucs;
1137 Lisp_Object Q_ucs_unified;
1138 Lisp_Object Qcompat;
1139 Lisp_Object Qisolated;
1140 Lisp_Object Qinitial;
1141 Lisp_Object Qmedial;
1143 Lisp_Object Qvertical;
1144 Lisp_Object QnoBreak;
1145 Lisp_Object Qfraction;
1148 Lisp_Object Qcircle;
1149 Lisp_Object Qsquare;
1151 Lisp_Object Qnarrow;
1155 Emchar to_char_id (Lisp_Object v, char* err_msg, Lisp_Object err_arg);
1158 to_char_id (Lisp_Object v, char* err_msg, Lisp_Object err_arg)
1164 else if (EQ (v, Qcompat))
1166 else if (EQ (v, Qisolated))
1168 else if (EQ (v, Qinitial))
1170 else if (EQ (v, Qmedial))
1172 else if (EQ (v, Qfinal))
1174 else if (EQ (v, Qvertical))
1176 else if (EQ (v, QnoBreak))
1178 else if (EQ (v, Qfraction))
1180 else if (EQ (v, Qsuper))
1182 else if (EQ (v, Qsub))
1184 else if (EQ (v, Qcircle))
1186 else if (EQ (v, Qsquare))
1188 else if (EQ (v, Qwide))
1190 else if (EQ (v, Qnarrow))
1192 else if (EQ (v, Qsmall))
1194 else if (EQ (v, Qfont))
1197 signal_simple_error (err_msg, err_arg);
1200 DEFUN ("get-composite-char", Fget_composite_char, 1, 1, 0, /*
1201 Return character corresponding with list.
1205 Lisp_Object base, modifier;
1209 signal_simple_error ("Invalid value for composition", list);
1212 while (!NILP (rest))
1217 signal_simple_error ("Invalid value for composition", list);
1218 modifier = Fcar (rest);
1220 base = Fcdr (Fassq (modifier,
1221 Fget_char_attribute (base, Qcomposition, Qnil)));
1226 DEFUN ("char-variants", Fchar_variants, 1, 1, 0, /*
1227 Return variants of CHARACTER.
1233 CHECK_CHAR (character);
1234 ret = Fget_char_attribute (character, Q_ucs_unified, Qnil);
1236 return Fcopy_list (ret);
1244 /* A char table maps from ranges of characters to values.
1246 Implementing a general data structure that maps from arbitrary
1247 ranges of numbers to values is tricky to do efficiently. As it
1248 happens, it should suffice (and is usually more convenient, anyway)
1249 when dealing with characters to restrict the sorts of ranges that
1250 can be assigned values, as follows:
1253 2) All characters in a charset.
1254 3) All characters in a particular row of a charset, where a "row"
1255 means all characters with the same first byte.
1256 4) A particular character in a charset.
1258 We use char tables to generalize the 256-element vectors now
1259 littering the Emacs code.
1261 Possible uses (all should be converted at some point):
1267 5) keyboard-translate-table?
1270 abstract type to generalize the Emacs vectors and Mule
1271 vectors-of-vectors goo.
1274 /************************************************************************/
1275 /* Char Table object */
1276 /************************************************************************/
1278 #if defined(MULE)&&!defined(UTF2000)
1281 mark_char_table_entry (Lisp_Object obj)
1283 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj);
1286 for (i = 0; i < 96; i++)
1288 mark_object (cte->level2[i]);
1294 char_table_entry_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
1296 Lisp_Char_Table_Entry *cte1 = XCHAR_TABLE_ENTRY (obj1);
1297 Lisp_Char_Table_Entry *cte2 = XCHAR_TABLE_ENTRY (obj2);
1300 for (i = 0; i < 96; i++)
1301 if (!internal_equal (cte1->level2[i], cte2->level2[i], depth + 1))
1307 static unsigned long
1308 char_table_entry_hash (Lisp_Object obj, int depth)
1310 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj);
1312 return internal_array_hash (cte->level2, 96, depth);
1315 static const struct lrecord_description char_table_entry_description[] = {
1316 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table_Entry, level2), 96 },
1320 DEFINE_LRECORD_IMPLEMENTATION ("char-table-entry", char_table_entry,
1321 mark_char_table_entry, internal_object_printer,
1322 0, char_table_entry_equal,
1323 char_table_entry_hash,
1324 char_table_entry_description,
1325 Lisp_Char_Table_Entry);
1329 mark_char_table (Lisp_Object obj)
1331 Lisp_Char_Table *ct = XCHAR_TABLE (obj);
1334 mark_object (ct->table);
1335 mark_object (ct->name);
1336 #ifndef HAVE_LIBCHISE
1337 mark_object (ct->db);
1342 for (i = 0; i < NUM_ASCII_CHARS; i++)
1343 mark_object (ct->ascii[i]);
1345 for (i = 0; i < NUM_LEADING_BYTES; i++)
1346 mark_object (ct->level1[i]);
1350 return ct->default_value;
1352 return ct->mirror_table;
1356 /* WARNING: All functions of this nature need to be written extremely
1357 carefully to avoid crashes during GC. Cf. prune_specifiers()
1358 and prune_weak_hash_tables(). */
1361 prune_syntax_tables (void)
1363 Lisp_Object rest, prev = Qnil;
1365 for (rest = Vall_syntax_tables;
1367 rest = XCHAR_TABLE (rest)->next_table)
1369 if (! marked_p (rest))
1371 /* This table is garbage. Remove it from the list. */
1373 Vall_syntax_tables = XCHAR_TABLE (rest)->next_table;
1375 XCHAR_TABLE (prev)->next_table =
1376 XCHAR_TABLE (rest)->next_table;
1382 char_table_type_to_symbol (enum char_table_type type)
1387 case CHAR_TABLE_TYPE_GENERIC: return Qgeneric;
1388 case CHAR_TABLE_TYPE_SYNTAX: return Qsyntax;
1389 case CHAR_TABLE_TYPE_DISPLAY: return Qdisplay;
1390 case CHAR_TABLE_TYPE_CHAR: return Qchar;
1392 case CHAR_TABLE_TYPE_CATEGORY: return Qcategory;
1397 static enum char_table_type
1398 symbol_to_char_table_type (Lisp_Object symbol)
1400 CHECK_SYMBOL (symbol);
1402 if (EQ (symbol, Qgeneric)) return CHAR_TABLE_TYPE_GENERIC;
1403 if (EQ (symbol, Qsyntax)) return CHAR_TABLE_TYPE_SYNTAX;
1404 if (EQ (symbol, Qdisplay)) return CHAR_TABLE_TYPE_DISPLAY;
1405 if (EQ (symbol, Qchar)) return CHAR_TABLE_TYPE_CHAR;
1407 if (EQ (symbol, Qcategory)) return CHAR_TABLE_TYPE_CATEGORY;
1410 signal_simple_error ("Unrecognized char table type", symbol);
1411 return CHAR_TABLE_TYPE_GENERIC; /* not reached */
1416 print_chartab_range (Emchar first, Emchar last, Lisp_Object val,
1417 Lisp_Object printcharfun)
1421 write_c_string (" (", printcharfun);
1422 print_internal (make_char (first), printcharfun, 0);
1423 write_c_string (" ", printcharfun);
1424 print_internal (make_char (last), printcharfun, 0);
1425 write_c_string (") ", printcharfun);
1429 write_c_string (" ", printcharfun);
1430 print_internal (make_char (first), printcharfun, 0);
1431 write_c_string (" ", printcharfun);
1433 print_internal (val, printcharfun, 1);
1437 #if defined(MULE)&&!defined(UTF2000)
1440 print_chartab_charset_row (Lisp_Object charset,
1442 Lisp_Char_Table_Entry *cte,
1443 Lisp_Object printcharfun)
1446 Lisp_Object cat = Qunbound;
1449 for (i = 32; i < 128; i++)
1451 Lisp_Object pam = cte->level2[i - 32];
1463 print_chartab_range (MAKE_CHAR (charset, first, 0),
1464 MAKE_CHAR (charset, i - 1, 0),
1467 print_chartab_range (MAKE_CHAR (charset, row, first),
1468 MAKE_CHAR (charset, row, i - 1),
1478 print_chartab_range (MAKE_CHAR (charset, first, 0),
1479 MAKE_CHAR (charset, i - 1, 0),
1482 print_chartab_range (MAKE_CHAR (charset, row, first),
1483 MAKE_CHAR (charset, row, i - 1),
1489 print_chartab_two_byte_charset (Lisp_Object charset,
1490 Lisp_Char_Table_Entry *cte,
1491 Lisp_Object printcharfun)
1495 for (i = 32; i < 128; i++)
1497 Lisp_Object jen = cte->level2[i - 32];
1499 if (!CHAR_TABLE_ENTRYP (jen))
1503 write_c_string (" [", printcharfun);
1504 print_internal (XCHARSET_NAME (charset), printcharfun, 0);
1505 sprintf (buf, " %d] ", i);
1506 write_c_string (buf, printcharfun);
1507 print_internal (jen, printcharfun, 0);
1510 print_chartab_charset_row (charset, i, XCHAR_TABLE_ENTRY (jen),
1518 print_char_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1520 Lisp_Char_Table *ct = XCHAR_TABLE (obj);
1523 struct gcpro gcpro1, gcpro2;
1524 GCPRO2 (obj, printcharfun);
1526 write_c_string ("#s(char-table ", printcharfun);
1527 write_c_string (" ", printcharfun);
1528 write_c_string (string_data
1530 (XSYMBOL (char_table_type_to_symbol (ct->type)))),
1532 write_c_string ("\n ", printcharfun);
1533 print_internal (ct->default_value, printcharfun, escapeflag);
1534 for (i = 0; i < 256; i++)
1536 Lisp_Object elt = get_byte_table (ct->table, i);
1537 if (i != 0) write_c_string ("\n ", printcharfun);
1538 if (EQ (elt, Qunbound))
1539 write_c_string ("void", printcharfun);
1541 print_internal (elt, printcharfun, escapeflag);
1544 #else /* non UTF2000 */
1547 sprintf (buf, "#s(char-table type %s data (",
1548 string_data (symbol_name (XSYMBOL
1549 (char_table_type_to_symbol (ct->type)))));
1550 write_c_string (buf, printcharfun);
1552 /* Now write out the ASCII/Control-1 stuff. */
1556 Lisp_Object val = Qunbound;
1558 for (i = 0; i < NUM_ASCII_CHARS; i++)
1567 if (!EQ (ct->ascii[i], val))
1569 print_chartab_range (first, i - 1, val, printcharfun);
1576 print_chartab_range (first, i - 1, val, printcharfun);
1583 for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES;
1586 Lisp_Object ann = ct->level1[i - MIN_LEADING_BYTE];
1587 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (i);
1589 if (!CHARSETP (charset) || i == LEADING_BYTE_ASCII
1590 || i == LEADING_BYTE_CONTROL_1)
1592 if (!CHAR_TABLE_ENTRYP (ann))
1594 write_c_string (" ", printcharfun);
1595 print_internal (XCHARSET_NAME (charset),
1597 write_c_string (" ", printcharfun);
1598 print_internal (ann, printcharfun, 0);
1602 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (ann);
1603 if (XCHARSET_DIMENSION (charset) == 1)
1604 print_chartab_charset_row (charset, -1, cte, printcharfun);
1606 print_chartab_two_byte_charset (charset, cte, printcharfun);
1611 #endif /* non UTF2000 */
1613 write_c_string ("))", printcharfun);
1617 char_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
1619 Lisp_Char_Table *ct1 = XCHAR_TABLE (obj1);
1620 Lisp_Char_Table *ct2 = XCHAR_TABLE (obj2);
1623 if (CHAR_TABLE_TYPE (ct1) != CHAR_TABLE_TYPE (ct2))
1627 for (i = 0; i < 256; i++)
1629 if (!internal_equal (get_byte_table (ct1->table, i),
1630 get_byte_table (ct2->table, i), 0))
1634 for (i = 0; i < NUM_ASCII_CHARS; i++)
1635 if (!internal_equal (ct1->ascii[i], ct2->ascii[i], depth + 1))
1639 for (i = 0; i < NUM_LEADING_BYTES; i++)
1640 if (!internal_equal (ct1->level1[i], ct2->level1[i], depth + 1))
1643 #endif /* non UTF2000 */
1648 static unsigned long
1649 char_table_hash (Lisp_Object obj, int depth)
1651 Lisp_Char_Table *ct = XCHAR_TABLE (obj);
1653 return byte_table_hash (ct->table, depth + 1);
1655 unsigned long hashval = internal_array_hash (ct->ascii, NUM_ASCII_CHARS,
1658 hashval = HASH2 (hashval,
1659 internal_array_hash (ct->level1, NUM_LEADING_BYTES, depth));
1665 static const struct lrecord_description char_table_description[] = {
1667 { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, table) },
1668 { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, default_value) },
1669 { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, name) },
1670 #ifndef HAVE_LIBCHISE
1671 { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, db) },
1674 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, ascii), NUM_ASCII_CHARS },
1676 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, level1), NUM_LEADING_BYTES },
1680 { XD_LISP_OBJECT, offsetof (Lisp_Char_Table, mirror_table) },
1682 { XD_LO_LINK, offsetof (Lisp_Char_Table, next_table) },
1686 DEFINE_LRECORD_IMPLEMENTATION ("char-table", char_table,
1687 mark_char_table, print_char_table, 0,
1688 char_table_equal, char_table_hash,
1689 char_table_description,
1692 DEFUN ("char-table-p", Fchar_table_p, 1, 1, 0, /*
1693 Return non-nil if OBJECT is a char table.
1695 A char table is a table that maps characters (or ranges of characters)
1696 to values. Char tables are specialized for characters, only allowing
1697 particular sorts of ranges to be assigned values. Although this
1698 loses in generality, it makes for extremely fast (constant-time)
1699 lookups, and thus is feasible for applications that do an extremely
1700 large number of lookups (e.g. scanning a buffer for a character in
1701 a particular syntax, where a lookup in the syntax table must occur
1702 once per character).
1704 When Mule support exists, the types of ranges that can be assigned
1708 -- an entire charset
1709 -- a single row in a two-octet charset
1710 -- a single character
1712 When Mule support is not present, the types of ranges that can be
1716 -- a single character
1718 To create a char table, use `make-char-table'.
1719 To modify a char table, use `put-char-table' or `remove-char-table'.
1720 To retrieve the value for a particular character, use `get-char-table'.
1721 See also `map-char-table', `clear-char-table', `copy-char-table',
1722 `valid-char-table-type-p', `char-table-type-list',
1723 `valid-char-table-value-p', and `check-char-table-value'.
1727 return CHAR_TABLEP (object) ? Qt : Qnil;
1730 DEFUN ("char-table-type-list", Fchar_table_type_list, 0, 0, 0, /*
1731 Return a list of the recognized char table types.
1732 See `valid-char-table-type-p'.
1737 return list5 (Qchar, Qcategory, Qdisplay, Qgeneric, Qsyntax);
1739 return list4 (Qchar, Qdisplay, Qgeneric, Qsyntax);
1743 DEFUN ("valid-char-table-type-p", Fvalid_char_table_type_p, 1, 1, 0, /*
1744 Return t if TYPE if a recognized char table type.
1746 Each char table type is used for a different purpose and allows different
1747 sorts of values. The different char table types are
1750 Used for category tables, which specify the regexp categories
1751 that a character is in. The valid values are nil or a
1752 bit vector of 95 elements. Higher-level Lisp functions are
1753 provided for working with category tables. Currently categories
1754 and category tables only exist when Mule support is present.
1756 A generalized char table, for mapping from one character to
1757 another. Used for case tables, syntax matching tables,
1758 `keyboard-translate-table', etc. The valid values are characters.
1760 An even more generalized char table, for mapping from a
1761 character to anything.
1763 Used for display tables, which specify how a particular character
1764 is to appear when displayed. #### Not yet implemented.
1766 Used for syntax tables, which specify the syntax of a particular
1767 character. Higher-level Lisp functions are provided for
1768 working with syntax tables. The valid values are integers.
1773 return (EQ (type, Qchar) ||
1775 EQ (type, Qcategory) ||
1777 EQ (type, Qdisplay) ||
1778 EQ (type, Qgeneric) ||
1779 EQ (type, Qsyntax)) ? Qt : Qnil;
1782 DEFUN ("char-table-type", Fchar_table_type, 1, 1, 0, /*
1783 Return the type of CHAR-TABLE.
1784 See `valid-char-table-type-p'.
1788 CHECK_CHAR_TABLE (char_table);
1789 return char_table_type_to_symbol (XCHAR_TABLE (char_table)->type);
1793 fill_char_table (Lisp_Char_Table *ct, Lisp_Object value)
1796 ct->table = Qunbound;
1797 ct->default_value = value;
1802 for (i = 0; i < NUM_ASCII_CHARS; i++)
1803 ct->ascii[i] = value;
1805 for (i = 0; i < NUM_LEADING_BYTES; i++)
1806 ct->level1[i] = value;
1811 if (ct->type == CHAR_TABLE_TYPE_SYNTAX)
1812 update_syntax_table (ct);
1816 DEFUN ("reset-char-table", Freset_char_table, 1, 1, 0, /*
1817 Reset CHAR-TABLE to its default state.
1821 Lisp_Char_Table *ct;
1823 CHECK_CHAR_TABLE (char_table);
1824 ct = XCHAR_TABLE (char_table);
1828 case CHAR_TABLE_TYPE_CHAR:
1829 fill_char_table (ct, make_char (0));
1831 case CHAR_TABLE_TYPE_DISPLAY:
1832 case CHAR_TABLE_TYPE_GENERIC:
1834 case CHAR_TABLE_TYPE_CATEGORY:
1836 fill_char_table (ct, Qnil);
1839 case CHAR_TABLE_TYPE_SYNTAX:
1840 fill_char_table (ct, make_int (Sinherit));
1850 DEFUN ("make-char-table", Fmake_char_table, 1, 1, 0, /*
1851 Return a new, empty char table of type TYPE.
1852 Currently recognized types are 'char, 'category, 'display, 'generic,
1853 and 'syntax. See `valid-char-table-type-p'.
1857 Lisp_Char_Table *ct;
1859 enum char_table_type ty = symbol_to_char_table_type (type);
1861 ct = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table);
1864 if (ty == CHAR_TABLE_TYPE_SYNTAX)
1866 ct->mirror_table = Fmake_char_table (Qgeneric);
1867 fill_char_table (XCHAR_TABLE (ct->mirror_table),
1871 ct->mirror_table = Qnil;
1874 #ifndef HAVE_LIBCHISE
1878 ct->next_table = Qnil;
1879 XSETCHAR_TABLE (obj, ct);
1880 if (ty == CHAR_TABLE_TYPE_SYNTAX)
1882 ct->next_table = Vall_syntax_tables;
1883 Vall_syntax_tables = obj;
1885 Freset_char_table (obj);
1889 #if defined(MULE)&&!defined(UTF2000)
1892 make_char_table_entry (Lisp_Object initval)
1896 Lisp_Char_Table_Entry *cte =
1897 alloc_lcrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry);
1899 for (i = 0; i < 96; i++)
1900 cte->level2[i] = initval;
1902 XSETCHAR_TABLE_ENTRY (obj, cte);
1907 copy_char_table_entry (Lisp_Object entry)
1909 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (entry);
1912 Lisp_Char_Table_Entry *ctenew =
1913 alloc_lcrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry);
1915 for (i = 0; i < 96; i++)
1917 Lisp_Object new = cte->level2[i];
1918 if (CHAR_TABLE_ENTRYP (new))
1919 ctenew->level2[i] = copy_char_table_entry (new);
1921 ctenew->level2[i] = new;
1924 XSETCHAR_TABLE_ENTRY (obj, ctenew);
1930 DEFUN ("copy-char-table", Fcopy_char_table, 1, 1, 0, /*
1931 Return a new char table which is a copy of CHAR-TABLE.
1932 It will contain the same values for the same characters and ranges
1933 as CHAR-TABLE. The values will not themselves be copied.
1937 Lisp_Char_Table *ct, *ctnew;
1943 CHECK_CHAR_TABLE (char_table);
1944 ct = XCHAR_TABLE (char_table);
1945 ctnew = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table);
1946 ctnew->type = ct->type;
1948 ctnew->default_value = ct->default_value;
1949 /* [tomo:2002-01-21] Perhaps this code seems wrong */
1950 ctnew->name = ct->name;
1951 #ifndef HAVE_LIBCHISE
1955 if (UINT8_BYTE_TABLE_P (ct->table))
1957 ctnew->table = copy_uint8_byte_table (ct->table);
1959 else if (UINT16_BYTE_TABLE_P (ct->table))
1961 ctnew->table = copy_uint16_byte_table (ct->table);
1963 else if (BYTE_TABLE_P (ct->table))
1965 ctnew->table = copy_byte_table (ct->table);
1967 else if (!UNBOUNDP (ct->table))
1968 ctnew->table = ct->table;
1969 #else /* non UTF2000 */
1971 for (i = 0; i < NUM_ASCII_CHARS; i++)
1973 Lisp_Object new = ct->ascii[i];
1975 assert (! (CHAR_TABLE_ENTRYP (new)));
1977 ctnew->ascii[i] = new;
1982 for (i = 0; i < NUM_LEADING_BYTES; i++)
1984 Lisp_Object new = ct->level1[i];
1985 if (CHAR_TABLE_ENTRYP (new))
1986 ctnew->level1[i] = copy_char_table_entry (new);
1988 ctnew->level1[i] = new;
1992 #endif /* non UTF2000 */
1995 if (CHAR_TABLEP (ct->mirror_table))
1996 ctnew->mirror_table = Fcopy_char_table (ct->mirror_table);
1998 ctnew->mirror_table = ct->mirror_table;
2000 ctnew->next_table = Qnil;
2001 XSETCHAR_TABLE (obj, ctnew);
2002 if (ctnew->type == CHAR_TABLE_TYPE_SYNTAX)
2004 ctnew->next_table = Vall_syntax_tables;
2005 Vall_syntax_tables = obj;
2010 INLINE_HEADER int XCHARSET_CELL_RANGE (Lisp_Object ccs);
2012 XCHARSET_CELL_RANGE (Lisp_Object ccs)
2014 switch (XCHARSET_CHARS (ccs))
2017 return (33 << 8) | 126;
2019 return (32 << 8) | 127;
2022 return (0 << 8) | 127;
2024 return (0 << 8) | 255;
2036 decode_char_table_range (Lisp_Object range, struct chartab_range *outrange)
2039 outrange->type = CHARTAB_RANGE_ALL;
2041 else if (EQ (range, Qnil))
2042 outrange->type = CHARTAB_RANGE_DEFAULT;
2044 else if (CHAR_OR_CHAR_INTP (range))
2046 outrange->type = CHARTAB_RANGE_CHAR;
2047 outrange->ch = XCHAR_OR_CHAR_INT (range);
2051 signal_simple_error ("Range must be t or a character", range);
2053 else if (VECTORP (range))
2055 Lisp_Vector *vec = XVECTOR (range);
2056 Lisp_Object *elts = vector_data (vec);
2057 int cell_min, cell_max;
2059 outrange->type = CHARTAB_RANGE_ROW;
2060 outrange->charset = Fget_charset (elts[0]);
2061 CHECK_INT (elts[1]);
2062 outrange->row = XINT (elts[1]);
2063 if (XCHARSET_DIMENSION (outrange->charset) < 2)
2064 signal_simple_error ("Charset in row vector must be multi-byte",
2068 int ret = XCHARSET_CELL_RANGE (outrange->charset);
2070 cell_min = ret >> 8;
2071 cell_max = ret & 0xFF;
2073 if (XCHARSET_DIMENSION (outrange->charset) == 2)
2074 check_int_range (outrange->row, cell_min, cell_max);
2076 else if (XCHARSET_DIMENSION (outrange->charset) == 3)
2078 check_int_range (outrange->row >> 8 , cell_min, cell_max);
2079 check_int_range (outrange->row & 0xFF, cell_min, cell_max);
2081 else if (XCHARSET_DIMENSION (outrange->charset) == 4)
2083 check_int_range ( outrange->row >> 16 , cell_min, cell_max);
2084 check_int_range ((outrange->row >> 8) & 0xFF, cell_min, cell_max);
2085 check_int_range ( outrange->row & 0xFF, cell_min, cell_max);
2093 if (!CHARSETP (range) && !SYMBOLP (range))
2095 ("Char table range must be t, charset, char, or vector", range);
2096 outrange->type = CHARTAB_RANGE_CHARSET;
2097 outrange->charset = Fget_charset (range);
2102 #if defined(MULE)&&!defined(UTF2000)
2104 /* called from CHAR_TABLE_VALUE(). */
2106 get_non_ascii_char_table_value (Lisp_Char_Table *ct, Charset_ID leading_byte,
2111 Lisp_Object charset;
2113 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (leading_byte);
2118 BREAKUP_CHAR (c, charset, byte1, byte2);
2120 BREAKUP_CHAR_1_UNSAFE (c, charset, byte1, byte2);
2122 val = ct->level1[leading_byte - MIN_LEADING_BYTE];
2123 if (CHAR_TABLE_ENTRYP (val))
2125 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
2126 val = cte->level2[byte1 - 32];
2127 if (CHAR_TABLE_ENTRYP (val))
2129 cte = XCHAR_TABLE_ENTRY (val);
2130 assert (byte2 >= 32);
2131 val = cte->level2[byte2 - 32];
2132 assert (!CHAR_TABLE_ENTRYP (val));
2142 get_char_table (Emchar ch, Lisp_Char_Table *ct)
2146 Lisp_Object ret = get_char_id_table (ct, ch);
2151 if (EQ (CHAR_TABLE_NAME (ct), Qdowncase))
2152 ret = Fget_char_attribute (make_char (ch), Q_lowercase, Qnil);
2153 else if (EQ (CHAR_TABLE_NAME (ct), Qflippedcase))
2154 ret = Fget_char_attribute (make_char (ch), Q_uppercase, Qnil);
2159 ret = Ffind_char (ret);
2167 Lisp_Object charset;
2171 BREAKUP_CHAR (ch, charset, byte1, byte2);
2173 if (EQ (charset, Vcharset_ascii))
2174 val = ct->ascii[byte1];
2175 else if (EQ (charset, Vcharset_control_1))
2176 val = ct->ascii[byte1 + 128];
2179 int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE;
2180 val = ct->level1[lb];
2181 if (CHAR_TABLE_ENTRYP (val))
2183 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
2184 val = cte->level2[byte1 - 32];
2185 if (CHAR_TABLE_ENTRYP (val))
2187 cte = XCHAR_TABLE_ENTRY (val);
2188 assert (byte2 >= 32);
2189 val = cte->level2[byte2 - 32];
2190 assert (!CHAR_TABLE_ENTRYP (val));
2197 #else /* not MULE */
2198 return ct->ascii[(unsigned char)ch];
2199 #endif /* not MULE */
2203 DEFUN ("get-char-table", Fget_char_table, 2, 2, 0, /*
2204 Find value for CHARACTER in CHAR-TABLE.
2206 (character, char_table))
2208 CHECK_CHAR_TABLE (char_table);
2209 CHECK_CHAR_COERCE_INT (character);
2211 return get_char_table (XCHAR (character), XCHAR_TABLE (char_table));
2214 DEFUN ("get-range-char-table", Fget_range_char_table, 2, 3, 0, /*
2215 Find value for a range in CHAR-TABLE.
2216 If there is more than one value, return MULTI (defaults to nil).
2218 (range, char_table, multi))
2220 Lisp_Char_Table *ct;
2221 struct chartab_range rainj;
2223 if (CHAR_OR_CHAR_INTP (range))
2224 return Fget_char_table (range, char_table);
2225 CHECK_CHAR_TABLE (char_table);
2226 ct = XCHAR_TABLE (char_table);
2228 decode_char_table_range (range, &rainj);
2231 case CHARTAB_RANGE_ALL:
2234 if (UINT8_BYTE_TABLE_P (ct->table))
2236 else if (UINT16_BYTE_TABLE_P (ct->table))
2238 else if (BYTE_TABLE_P (ct->table))
2242 #else /* non UTF2000 */
2244 Lisp_Object first = ct->ascii[0];
2246 for (i = 1; i < NUM_ASCII_CHARS; i++)
2247 if (!EQ (first, ct->ascii[i]))
2251 for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES;
2254 if (!CHARSETP (CHARSET_BY_LEADING_BYTE (i))
2255 || i == LEADING_BYTE_ASCII
2256 || i == LEADING_BYTE_CONTROL_1)
2258 if (!EQ (first, ct->level1[i - MIN_LEADING_BYTE]))
2264 #endif /* non UTF2000 */
2268 case CHARTAB_RANGE_CHARSET:
2272 if (EQ (rainj.charset, Vcharset_ascii))
2275 Lisp_Object first = ct->ascii[0];
2277 for (i = 1; i < 128; i++)
2278 if (!EQ (first, ct->ascii[i]))
2283 if (EQ (rainj.charset, Vcharset_control_1))
2286 Lisp_Object first = ct->ascii[128];
2288 for (i = 129; i < 160; i++)
2289 if (!EQ (first, ct->ascii[i]))
2295 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (rainj.charset) -
2297 if (CHAR_TABLE_ENTRYP (val))
2303 case CHARTAB_RANGE_ROW:
2308 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (rainj.charset) -
2310 if (!CHAR_TABLE_ENTRYP (val))
2312 val = XCHAR_TABLE_ENTRY (val)->level2[rainj.row - 32];
2313 if (CHAR_TABLE_ENTRYP (val))
2317 #endif /* not UTF2000 */
2318 #endif /* not MULE */
2324 return Qnil; /* not reached */
2328 check_valid_char_table_value (Lisp_Object value, enum char_table_type type,
2329 Error_behavior errb)
2333 case CHAR_TABLE_TYPE_SYNTAX:
2334 if (!ERRB_EQ (errb, ERROR_ME))
2335 return INTP (value) || (CONSP (value) && INTP (XCAR (value))
2336 && CHAR_OR_CHAR_INTP (XCDR (value)));
2339 Lisp_Object cdr = XCDR (value);
2340 CHECK_INT (XCAR (value));
2341 CHECK_CHAR_COERCE_INT (cdr);
2348 case CHAR_TABLE_TYPE_CATEGORY:
2349 if (!ERRB_EQ (errb, ERROR_ME))
2350 return CATEGORY_TABLE_VALUEP (value);
2351 CHECK_CATEGORY_TABLE_VALUE (value);
2355 case CHAR_TABLE_TYPE_GENERIC:
2358 case CHAR_TABLE_TYPE_DISPLAY:
2360 maybe_signal_simple_error ("Display char tables not yet implemented",
2361 value, Qchar_table, errb);
2364 case CHAR_TABLE_TYPE_CHAR:
2365 if (!ERRB_EQ (errb, ERROR_ME))
2366 return CHAR_OR_CHAR_INTP (value);
2367 CHECK_CHAR_COERCE_INT (value);
2374 return 0; /* not reached */
2378 canonicalize_char_table_value (Lisp_Object value, enum char_table_type type)
2382 case CHAR_TABLE_TYPE_SYNTAX:
2385 Lisp_Object car = XCAR (value);
2386 Lisp_Object cdr = XCDR (value);
2387 CHECK_CHAR_COERCE_INT (cdr);
2388 return Fcons (car, cdr);
2391 case CHAR_TABLE_TYPE_CHAR:
2392 CHECK_CHAR_COERCE_INT (value);
2400 DEFUN ("valid-char-table-value-p", Fvalid_char_table_value_p, 2, 2, 0, /*
2401 Return non-nil if VALUE is a valid value for CHAR-TABLE-TYPE.
2403 (value, char_table_type))
2405 enum char_table_type type = symbol_to_char_table_type (char_table_type);
2407 return check_valid_char_table_value (value, type, ERROR_ME_NOT) ? Qt : Qnil;
2410 DEFUN ("check-valid-char-table-value", Fcheck_valid_char_table_value, 2, 2, 0, /*
2411 Signal an error if VALUE is not a valid value for CHAR-TABLE-TYPE.
2413 (value, char_table_type))
2415 enum char_table_type type = symbol_to_char_table_type (char_table_type);
2417 check_valid_char_table_value (value, type, ERROR_ME);
2422 Lisp_Char_Table* char_attribute_table_to_put;
2423 Lisp_Object Qput_char_table_map_function;
2424 Lisp_Object value_to_put;
2426 DEFUN ("put-char-table-map-function",
2427 Fput_char_table_map_function, 2, 2, 0, /*
2428 For internal use. Don't use it.
2432 put_char_id_table_0 (char_attribute_table_to_put,
2433 XCHAR (c), value_to_put);
2438 /* Assign VAL to all characters in RANGE in char table CT. */
2441 put_char_table (Lisp_Char_Table *ct, struct chartab_range *range,
2444 switch (range->type)
2446 case CHARTAB_RANGE_ALL:
2447 /* printf ("put-char-table: range = all\n"); */
2448 fill_char_table (ct, val);
2449 return; /* avoid the duplicate call to update_syntax_table() below,
2450 since fill_char_table() also did that. */
2453 case CHARTAB_RANGE_DEFAULT:
2454 ct->default_value = val;
2459 case CHARTAB_RANGE_CHARSET:
2462 Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (range->charset);
2464 /* printf ("put-char-table: range = charset: %d\n",
2465 XCHARSET_LEADING_BYTE (range->charset));
2467 if ( CHAR_TABLEP (encoding_table) )
2469 Lisp_Object mother = XCHARSET_MOTHER (range->charset);
2471 char_attribute_table_to_put = ct;
2473 Fmap_char_attribute (Qput_char_table_map_function,
2474 XCHAR_TABLE_NAME (encoding_table),
2476 if ( CHARSETP (mother) )
2478 struct chartab_range r;
2480 r.type = CHARTAB_RANGE_CHARSET;
2482 put_char_table (ct, &r, val);
2490 for (c = 0; c < 1 << 24; c++)
2492 if ( charset_code_point (range->charset, c) >= 0 )
2493 put_char_id_table_0 (ct, c, val);
2499 if (EQ (range->charset, Vcharset_ascii))
2502 for (i = 0; i < 128; i++)
2505 else if (EQ (range->charset, Vcharset_control_1))
2508 for (i = 128; i < 160; i++)
2513 int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE;
2514 ct->level1[lb] = val;
2519 case CHARTAB_RANGE_ROW:
2522 int cell_min, cell_max, i;
2524 i = XCHARSET_CELL_RANGE (range->charset);
2526 cell_max = i & 0xFF;
2527 for (i = cell_min; i <= cell_max; i++)
2529 Emchar ch = DECODE_CHAR (range->charset, (range->row << 8) | i);
2531 if ( charset_code_point (range->charset, ch, 0) >= 0 )
2532 put_char_id_table_0 (ct, ch, val);
2537 Lisp_Char_Table_Entry *cte;
2538 int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE;
2539 /* make sure that there is a separate entry for the row. */
2540 if (!CHAR_TABLE_ENTRYP (ct->level1[lb]))
2541 ct->level1[lb] = make_char_table_entry (ct->level1[lb]);
2542 cte = XCHAR_TABLE_ENTRY (ct->level1[lb]);
2543 cte->level2[range->row - 32] = val;
2545 #endif /* not UTF2000 */
2549 case CHARTAB_RANGE_CHAR:
2551 /* printf ("put-char-table: range = char: 0x%x\n", range->ch); */
2552 put_char_id_table_0 (ct, range->ch, val);
2556 Lisp_Object charset;
2559 BREAKUP_CHAR (range->ch, charset, byte1, byte2);
2560 if (EQ (charset, Vcharset_ascii))
2561 ct->ascii[byte1] = val;
2562 else if (EQ (charset, Vcharset_control_1))
2563 ct->ascii[byte1 + 128] = val;
2566 Lisp_Char_Table_Entry *cte;
2567 int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE;
2568 /* make sure that there is a separate entry for the row. */
2569 if (!CHAR_TABLE_ENTRYP (ct->level1[lb]))
2570 ct->level1[lb] = make_char_table_entry (ct->level1[lb]);
2571 cte = XCHAR_TABLE_ENTRY (ct->level1[lb]);
2572 /* now CTE is a char table entry for the charset;
2573 each entry is for a single row (or character of
2574 a one-octet charset). */
2575 if (XCHARSET_DIMENSION (charset) == 1)
2576 cte->level2[byte1 - 32] = val;
2579 /* assigning to one character in a two-octet charset. */
2580 /* make sure that the charset row contains a separate
2581 entry for each character. */
2582 if (!CHAR_TABLE_ENTRYP (cte->level2[byte1 - 32]))
2583 cte->level2[byte1 - 32] =
2584 make_char_table_entry (cte->level2[byte1 - 32]);
2585 cte = XCHAR_TABLE_ENTRY (cte->level2[byte1 - 32]);
2586 cte->level2[byte2 - 32] = val;
2590 #else /* not MULE */
2591 ct->ascii[(unsigned char) (range->ch)] = val;
2593 #endif /* not MULE */
2597 if (ct->type == CHAR_TABLE_TYPE_SYNTAX)
2598 update_syntax_table (ct);
2602 DEFUN ("put-char-table", Fput_char_table, 3, 3, 0, /*
2603 Set the value for chars in RANGE to be VALUE in CHAR-TABLE.
2605 RANGE specifies one or more characters to be affected and should be
2606 one of the following:
2608 -- t (all characters are affected)
2609 -- A charset (only allowed when Mule support is present)
2610 -- A vector of two elements: a two-octet charset and a row number
2611 (only allowed when Mule support is present)
2612 -- A single character
2614 VALUE must be a value appropriate for the type of CHAR-TABLE.
2615 See `valid-char-table-type-p'.
2617 (range, value, char_table))
2619 Lisp_Char_Table *ct;
2620 struct chartab_range rainj;
2622 CHECK_CHAR_TABLE (char_table);
2623 ct = XCHAR_TABLE (char_table);
2624 check_valid_char_table_value (value, ct->type, ERROR_ME);
2625 decode_char_table_range (range, &rainj);
2626 value = canonicalize_char_table_value (value, ct->type);
2627 put_char_table (ct, &rainj, value);
2632 /* Map FN over the ASCII chars in CT. */
2635 map_over_charset_ascii (Lisp_Char_Table *ct,
2636 int (*fn) (struct chartab_range *range,
2637 Lisp_Object val, void *arg),
2640 struct chartab_range rainj;
2649 rainj.type = CHARTAB_RANGE_CHAR;
2651 for (i = start, retval = 0; i < stop && retval == 0; i++)
2653 rainj.ch = (Emchar) i;
2654 retval = (fn) (&rainj, ct->ascii[i], arg);
2662 /* Map FN over the Control-1 chars in CT. */
2665 map_over_charset_control_1 (Lisp_Char_Table *ct,
2666 int (*fn) (struct chartab_range *range,
2667 Lisp_Object val, void *arg),
2670 struct chartab_range rainj;
2673 int stop = start + 32;
2675 rainj.type = CHARTAB_RANGE_CHAR;
2677 for (i = start, retval = 0; i < stop && retval == 0; i++)
2679 rainj.ch = (Emchar) (i);
2680 retval = (fn) (&rainj, ct->ascii[i], arg);
2686 /* Map FN over the row ROW of two-byte charset CHARSET.
2687 There must be a separate value for that row in the char table.
2688 CTE specifies the char table entry for CHARSET. */
2691 map_over_charset_row (Lisp_Char_Table_Entry *cte,
2692 Lisp_Object charset, int row,
2693 int (*fn) (struct chartab_range *range,
2694 Lisp_Object val, void *arg),
2697 Lisp_Object val = cte->level2[row - 32];
2699 if (!CHAR_TABLE_ENTRYP (val))
2701 struct chartab_range rainj;
2703 rainj.type = CHARTAB_RANGE_ROW;
2704 rainj.charset = charset;
2706 return (fn) (&rainj, val, arg);
2710 struct chartab_range rainj;
2712 int charset94_p = (XCHARSET_CHARS (charset) == 94);
2713 int start = charset94_p ? 33 : 32;
2714 int stop = charset94_p ? 127 : 128;
2716 cte = XCHAR_TABLE_ENTRY (val);
2718 rainj.type = CHARTAB_RANGE_CHAR;
2720 for (i = start, retval = 0; i < stop && retval == 0; i++)
2722 rainj.ch = MAKE_CHAR (charset, row, i);
2723 retval = (fn) (&rainj, cte->level2[i - 32], arg);
2731 map_over_other_charset (Lisp_Char_Table *ct, Charset_ID lb,
2732 int (*fn) (struct chartab_range *range,
2733 Lisp_Object val, void *arg),
2736 Lisp_Object val = ct->level1[lb - MIN_LEADING_BYTE];
2737 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (lb);
2739 if (!CHARSETP (charset)
2740 || lb == LEADING_BYTE_ASCII
2741 || lb == LEADING_BYTE_CONTROL_1)
2744 if (!CHAR_TABLE_ENTRYP (val))
2746 struct chartab_range rainj;
2748 rainj.type = CHARTAB_RANGE_CHARSET;
2749 rainj.charset = charset;
2750 return (fn) (&rainj, val, arg);
2754 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
2755 int charset94_p = (XCHARSET_CHARS (charset) == 94);
2756 int start = charset94_p ? 33 : 32;
2757 int stop = charset94_p ? 127 : 128;
2760 if (XCHARSET_DIMENSION (charset) == 1)
2762 struct chartab_range rainj;
2763 rainj.type = CHARTAB_RANGE_CHAR;
2765 for (i = start, retval = 0; i < stop && retval == 0; i++)
2767 rainj.ch = MAKE_CHAR (charset, i, 0);
2768 retval = (fn) (&rainj, cte->level2[i - 32], arg);
2773 for (i = start, retval = 0; i < stop && retval == 0; i++)
2774 retval = map_over_charset_row (cte, charset, i, fn, arg);
2782 #endif /* not UTF2000 */
2785 struct map_char_table_for_charset_arg
2787 int (*fn) (struct chartab_range *range, Lisp_Object val, void *arg);
2788 Lisp_Char_Table *ct;
2793 map_char_table_for_charset_fun (struct chartab_range *range,
2794 Lisp_Object val, void *arg)
2796 struct map_char_table_for_charset_arg *closure =
2797 (struct map_char_table_for_charset_arg *) arg;
2800 switch (range->type)
2802 case CHARTAB_RANGE_ALL:
2805 case CHARTAB_RANGE_DEFAULT:
2808 case CHARTAB_RANGE_CHARSET:
2811 case CHARTAB_RANGE_ROW:
2814 case CHARTAB_RANGE_CHAR:
2815 ret = get_char_table (range->ch, closure->ct);
2816 if (!UNBOUNDP (ret))
2817 return (closure->fn) (range, ret, closure->arg);
2829 /* Map FN (with client data ARG) over range RANGE in char table CT.
2830 Mapping stops the first time FN returns non-zero, and that value
2831 becomes the return value of map_char_table(). */
2834 map_char_table (Lisp_Char_Table *ct,
2835 struct chartab_range *range,
2836 int (*fn) (struct chartab_range *range,
2837 Lisp_Object val, void *arg),
2840 switch (range->type)
2842 case CHARTAB_RANGE_ALL:
2844 if (!UNBOUNDP (ct->default_value))
2846 struct chartab_range rainj;
2849 rainj.type = CHARTAB_RANGE_DEFAULT;
2850 retval = (fn) (&rainj, ct->default_value, arg);
2854 if (UINT8_BYTE_TABLE_P (ct->table))
2855 return map_over_uint8_byte_table (XUINT8_BYTE_TABLE(ct->table), ct,
2857 else if (UINT16_BYTE_TABLE_P (ct->table))
2858 return map_over_uint16_byte_table (XUINT16_BYTE_TABLE(ct->table), ct,
2860 else if (BYTE_TABLE_P (ct->table))
2861 return map_over_byte_table (XBYTE_TABLE(ct->table), ct,
2863 else if (EQ (ct->table, Qunloaded))
2866 struct chartab_range rainj;
2869 Emchar c1 = c + unit;
2872 rainj.type = CHARTAB_RANGE_CHAR;
2874 for (retval = 0; c < c1 && retval == 0; c++)
2876 Lisp_Object ret = get_char_id_table (ct, c);
2878 if (!UNBOUNDP (ret))
2881 retval = (fn) (&rainj, ct->table, arg);
2886 ct->table = Qunbound;
2889 else if (!UNBOUNDP (ct->table))
2890 return (fn) (range, ct->table, arg);
2896 retval = map_over_charset_ascii (ct, fn, arg);
2900 retval = map_over_charset_control_1 (ct, fn, arg);
2905 Charset_ID start = MIN_LEADING_BYTE;
2906 Charset_ID stop = start + NUM_LEADING_BYTES;
2908 for (i = start, retval = 0; i < stop && retval == 0; i++)
2910 retval = map_over_other_charset (ct, i, fn, arg);
2919 case CHARTAB_RANGE_DEFAULT:
2920 if (!UNBOUNDP (ct->default_value))
2921 return (fn) (range, ct->default_value, arg);
2926 case CHARTAB_RANGE_CHARSET:
2929 Lisp_Object encoding_table
2930 = XCHARSET_ENCODING_TABLE (range->charset);
2932 if (!NILP (encoding_table))
2934 struct chartab_range rainj;
2935 struct map_char_table_for_charset_arg mcarg;
2938 if (XCHAR_TABLE_UNLOADED(encoding_table))
2939 Fload_char_attribute_table (XCHAR_TABLE_NAME (encoding_table));
2944 rainj.type = CHARTAB_RANGE_ALL;
2945 return map_char_table (XCHAR_TABLE(encoding_table),
2947 &map_char_table_for_charset_fun,
2953 return map_over_other_charset (ct,
2954 XCHARSET_LEADING_BYTE (range->charset),
2958 case CHARTAB_RANGE_ROW:
2961 int cell_min, cell_max, i;
2963 struct chartab_range rainj;
2965 i = XCHARSET_CELL_RANGE (range->charset);
2967 cell_max = i & 0xFF;
2968 rainj.type = CHARTAB_RANGE_CHAR;
2969 for (retval =0, i = cell_min; i <= cell_max && retval == 0; i++)
2971 Emchar ch = DECODE_CHAR (range->charset, (range->row << 8) | i);
2973 if ( charset_code_point (range->charset, ch, 0) >= 0 )
2976 = get_byte_table (get_byte_table
2980 (unsigned char)(ch >> 24)),
2981 (unsigned char) (ch >> 16)),
2982 (unsigned char) (ch >> 8)),
2983 (unsigned char) ch);
2986 val = ct->default_value;
2988 retval = (fn) (&rainj, val, arg);
2995 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (range->charset)
2996 - MIN_LEADING_BYTE];
2997 if (!CHAR_TABLE_ENTRYP (val))
2999 struct chartab_range rainj;
3001 rainj.type = CHARTAB_RANGE_ROW;
3002 rainj.charset = range->charset;
3003 rainj.row = range->row;
3004 return (fn) (&rainj, val, arg);
3007 return map_over_charset_row (XCHAR_TABLE_ENTRY (val),
3008 range->charset, range->row,
3011 #endif /* not UTF2000 */
3014 case CHARTAB_RANGE_CHAR:
3016 Emchar ch = range->ch;
3017 Lisp_Object val = CHAR_TABLE_VALUE_UNSAFE (ct, ch);
3019 if (!UNBOUNDP (val))
3021 struct chartab_range rainj;
3023 rainj.type = CHARTAB_RANGE_CHAR;
3025 return (fn) (&rainj, val, arg);
3037 struct slow_map_char_table_arg
3039 Lisp_Object function;
3044 slow_map_char_table_fun (struct chartab_range *range,
3045 Lisp_Object val, void *arg)
3047 Lisp_Object ranjarg = Qnil;
3048 struct slow_map_char_table_arg *closure =
3049 (struct slow_map_char_table_arg *) arg;
3051 switch (range->type)
3053 case CHARTAB_RANGE_ALL:
3058 case CHARTAB_RANGE_DEFAULT:
3064 case CHARTAB_RANGE_CHARSET:
3065 ranjarg = XCHARSET_NAME (range->charset);
3068 case CHARTAB_RANGE_ROW:
3069 ranjarg = vector2 (XCHARSET_NAME (range->charset),
3070 make_int (range->row));
3073 case CHARTAB_RANGE_CHAR:
3074 ranjarg = make_char (range->ch);
3080 closure->retval = call2 (closure->function, ranjarg, val);
3081 return !NILP (closure->retval);
3084 DEFUN ("map-char-table", Fmap_char_table, 2, 3, 0, /*
3085 Map FUNCTION over entries in CHAR-TABLE, calling it with two args,
3086 each key and value in the table.
3088 RANGE specifies a subrange to map over and is in the same format as
3089 the RANGE argument to `put-range-table'. If omitted or t, it defaults to
3092 (function, char_table, range))
3094 Lisp_Char_Table *ct;
3095 struct slow_map_char_table_arg slarg;
3096 struct gcpro gcpro1, gcpro2;
3097 struct chartab_range rainj;
3099 CHECK_CHAR_TABLE (char_table);
3100 ct = XCHAR_TABLE (char_table);
3103 decode_char_table_range (range, &rainj);
3104 slarg.function = function;
3105 slarg.retval = Qnil;
3106 GCPRO2 (slarg.function, slarg.retval);
3107 map_char_table (ct, &rainj, slow_map_char_table_fun, &slarg);
3110 return slarg.retval;
3114 /************************************************************************/
3115 /* Character Attributes */
3116 /************************************************************************/
3120 Lisp_Object Vchar_attribute_hash_table;
3122 /* We store the char-attributes in hash tables with the names as the
3123 key and the actual char-id-table object as the value. Occasionally
3124 we need to use them in a list format. These routines provide us
3126 struct char_attribute_list_closure
3128 Lisp_Object *char_attribute_list;
3132 add_char_attribute_to_list_mapper (Lisp_Object key, Lisp_Object value,
3133 void *char_attribute_list_closure)
3135 /* This function can GC */
3136 struct char_attribute_list_closure *calcl
3137 = (struct char_attribute_list_closure*) char_attribute_list_closure;
3138 Lisp_Object *char_attribute_list = calcl->char_attribute_list;
3140 *char_attribute_list = Fcons (key, *char_attribute_list);
3144 #ifdef HAVE_LIBCHISE
3146 char_attribute_list_reset_map_func (CHISE_DS *ds, unsigned char *name)
3148 Fmount_char_attribute_table (intern (name));
3152 DEFUN ("char-attribute-list", Fchar_attribute_list, 0, 1, 0, /*
3153 Return the list of all existing character attributes except coded-charsets.
3157 DEFUN ("char-attribute-list", Fchar_attribute_list, 0, 0, 0, /*
3158 Return the list of all existing character attributes except coded-charsets.
3163 Lisp_Object char_attribute_list = Qnil;
3164 struct gcpro gcpro1;
3165 struct char_attribute_list_closure char_attribute_list_closure;
3167 #ifdef HAVE_LIBCHISE
3170 open_chise_data_source_maybe ();
3171 chise_ds_foreach_char_feature_name
3172 (default_chise_data_source, &char_attribute_list_reset_map_func);
3175 GCPRO1 (char_attribute_list);
3176 char_attribute_list_closure.char_attribute_list = &char_attribute_list;
3177 elisp_maphash (add_char_attribute_to_list_mapper,
3178 Vchar_attribute_hash_table,
3179 &char_attribute_list_closure);
3181 return char_attribute_list;
3184 DEFUN ("find-char-attribute-table", Ffind_char_attribute_table, 1, 1, 0, /*
3185 Return char-id-table corresponding to ATTRIBUTE.
3189 return Fgethash (attribute, Vchar_attribute_hash_table, Qnil);
3193 /* We store the char-id-tables in hash tables with the attributes as
3194 the key and the actual char-id-table object as the value. Each
3195 char-id-table stores values of an attribute corresponding with
3196 characters. Occasionally we need to get attributes of a character
3197 in a association-list format. These routines provide us with
3199 struct char_attribute_alist_closure
3202 Lisp_Object *char_attribute_alist;
3206 add_char_attribute_alist_mapper (Lisp_Object key, Lisp_Object value,
3207 void *char_attribute_alist_closure)
3209 /* This function can GC */
3210 struct char_attribute_alist_closure *caacl =
3211 (struct char_attribute_alist_closure*) char_attribute_alist_closure;
3213 = get_char_id_table (XCHAR_TABLE(value), caacl->char_id);
3214 if (!UNBOUNDP (ret))
3216 Lisp_Object *char_attribute_alist = caacl->char_attribute_alist;
3217 *char_attribute_alist
3218 = Fcons (Fcons (key, ret), *char_attribute_alist);
3223 DEFUN ("char-attribute-alist", Fchar_attribute_alist, 1, 1, 0, /*
3224 Return the alist of attributes of CHARACTER.
3228 struct gcpro gcpro1;
3229 struct char_attribute_alist_closure char_attribute_alist_closure;
3230 Lisp_Object alist = Qnil;
3232 CHECK_CHAR (character);
3235 char_attribute_alist_closure.char_id = XCHAR (character);
3236 char_attribute_alist_closure.char_attribute_alist = &alist;
3237 elisp_maphash (add_char_attribute_alist_mapper,
3238 Vchar_attribute_hash_table,
3239 &char_attribute_alist_closure);
3245 DEFUN ("get-char-attribute", Fget_char_attribute, 2, 3, 0, /*
3246 Return the value of CHARACTER's ATTRIBUTE.
3247 Return DEFAULT-VALUE if the value is not exist.
3249 (character, attribute, default_value))
3253 CHECK_CHAR (character);
3255 if (CHARSETP (attribute))
3256 attribute = XCHARSET_NAME (attribute);
3258 table = Fgethash (attribute, Vchar_attribute_hash_table,
3260 if (!UNBOUNDP (table))
3262 Lisp_Object ret = get_char_id_table (XCHAR_TABLE(table),
3264 if (!UNBOUNDP (ret))
3267 return default_value;
3270 void put_char_composition (Lisp_Object character, Lisp_Object value);
3272 put_char_composition (Lisp_Object character, Lisp_Object value)
3275 signal_simple_error ("Invalid value for ->decomposition",
3278 if (CONSP (Fcdr (value)))
3280 if (NILP (Fcdr (Fcdr (value))))
3282 Lisp_Object base = Fcar (value);
3283 Lisp_Object modifier = Fcar (Fcdr (value));
3287 base = make_char (XINT (base));
3288 Fsetcar (value, base);
3290 if (INTP (modifier))
3292 modifier = make_char (XINT (modifier));
3293 Fsetcar (Fcdr (value), modifier);
3298 = Fget_char_attribute (base, Qcomposition, Qnil);
3299 Lisp_Object ret = Fassq (modifier, alist);
3302 Fput_char_attribute (base, Qcomposition,
3303 Fcons (Fcons (modifier, character),
3306 Fsetcdr (ret, character);
3312 Lisp_Object v = Fcar (value);
3316 Emchar c = XINT (v);
3318 = Fget_char_attribute (make_char (c), Q_ucs_unified, Qnil);
3322 Fput_char_attribute (make_char (c), Q_ucs_unified,
3323 Fcons (character, Qnil));
3325 else if (NILP (Fmemq (character, ret)))
3327 Fput_char_attribute (make_char (c), Q_ucs_unified,
3328 Fcons (character, ret));
3334 DEFUN ("put-char-attribute", Fput_char_attribute, 3, 3, 0, /*
3335 Store CHARACTER's ATTRIBUTE with VALUE.
3337 (character, attribute, value))
3339 Lisp_Object ccs = Ffind_charset (attribute);
3341 CHECK_CHAR (character);
3345 value = put_char_ccs_code_point (character, ccs, value);
3346 attribute = XCHARSET_NAME (ccs);
3348 else if (EQ (attribute, Q_decomposition))
3349 put_char_composition (character, value);
3350 else if (EQ (attribute, Qto_ucs))
3356 signal_simple_error ("Invalid value for =>ucs", value);
3360 ret = Fget_char_attribute (make_char (c), Q_ucs_unified, Qnil);
3363 Fput_char_attribute (make_char (c), Q_ucs_unified,
3364 Fcons (character, Qnil));
3366 else if (NILP (Fmemq (character, ret)))
3368 Fput_char_attribute (make_char (c), Q_ucs_unified,
3369 Fcons (character, ret));
3373 else if (EQ (attribute, Qideographic_structure))
3374 value = Fcopy_sequence (Fchar_refs_simplify_char_specs (value));
3377 Lisp_Object table = Fgethash (attribute,
3378 Vchar_attribute_hash_table,
3383 table = make_char_id_table (Qunbound);
3384 Fputhash (attribute, table, Vchar_attribute_hash_table);
3386 XCHAR_TABLE_NAME (table) = attribute;
3389 put_char_id_table (XCHAR_TABLE(table), character, value);
3394 DEFUN ("remove-char-attribute", Fremove_char_attribute, 2, 2, 0, /*
3395 Remove CHARACTER's ATTRIBUTE.
3397 (character, attribute))
3401 CHECK_CHAR (character);
3402 ccs = Ffind_charset (attribute);
3405 return remove_char_ccs (character, ccs);
3409 Lisp_Object table = Fgethash (attribute,
3410 Vchar_attribute_hash_table,
3412 if (!UNBOUNDP (table))
3414 put_char_id_table (XCHAR_TABLE(table), character, Qunbound);
3423 int char_table_open_db_maybe (Lisp_Char_Table* cit);
3424 void char_table_close_db_maybe (Lisp_Char_Table* cit);
3425 Lisp_Object char_table_get_db (Lisp_Char_Table* cit, Emchar ch);
3427 #ifdef HAVE_LIBCHISE
3429 open_chise_data_source_maybe ()
3431 if (default_chise_data_source == NULL)
3433 Lisp_Object db_dir = Vexec_directory;
3434 int modemask = 0755; /* rwxr-xr-x */
3437 db_dir = build_string ("../lib-src");
3438 db_dir = Fexpand_file_name (build_string ("chise-db"), db_dir);
3440 default_chise_data_source
3441 = CHISE_DS_open (CHISE_DS_Berkeley_DB, XSTRING_DATA (db_dir),
3442 0 /* DB_HASH */, modemask);
3443 if (default_chise_data_source == NULL)
3448 #endif /* HAVE_LIBCHISE */
3450 DEFUN ("close-char-data-source", Fclose_char_data_source, 0, 0, 0, /*
3451 Close data-source of CHISE.
3455 #ifdef HAVE_LIBCHISE
3456 int status = CHISE_DS_close (default_chise_data_source);
3458 default_chise_data_source = NULL;
3461 #endif /* HAVE_LIBCHISE */
3466 char_table_open_db_maybe (Lisp_Char_Table* cit)
3468 Lisp_Object attribute = CHAR_TABLE_NAME (cit);
3470 if (!NILP (attribute))
3472 #ifdef HAVE_LIBCHISE
3473 if ( open_chise_data_source_maybe () )
3475 #else /* HAVE_LIBCHISE */
3476 if (NILP (Fdatabase_live_p (cit->db)))
3479 = char_attribute_system_db_file (Qsystem_char_id, attribute, 0);
3481 cit->db = Fopen_database (db_file, Qnil, Qnil,
3482 build_string ("r"), Qnil);
3486 #endif /* not HAVE_LIBCHISE */
3494 char_table_close_db_maybe (Lisp_Char_Table* cit)
3496 #ifndef HAVE_LIBCHISE
3497 if (!NILP (cit->db))
3499 if (!NILP (Fdatabase_live_p (cit->db)))
3500 Fclose_database (cit->db);
3503 #endif /* not HAVE_LIBCHISE */
3507 char_table_get_db (Lisp_Char_Table* cit, Emchar ch)
3510 #ifdef HAVE_LIBCHISE
3513 = chise_ds_load_char_feature_value (default_chise_data_source, ch,
3514 XSTRING_DATA(Fsymbol_name
3520 val = Fread (make_string (chise_value_data (&value),
3521 chise_value_size (&value) ));
3525 #else /* HAVE_LIBCHISE */
3526 val = Fget_database (Fprin1_to_string (make_char (ch), Qnil),
3528 if (!UNBOUNDP (val))
3532 #endif /* not HAVE_LIBCHISE */
3536 #ifndef HAVE_LIBCHISE
3538 char_attribute_system_db_file (Lisp_Object key_type, Lisp_Object attribute,
3541 Lisp_Object db_dir = Vexec_directory;
3544 db_dir = build_string ("../lib-src");
3546 db_dir = Fexpand_file_name (build_string ("chise-db"), db_dir);
3547 if (writing_mode && NILP (Ffile_exists_p (db_dir)))
3548 Fmake_directory_internal (db_dir);
3550 db_dir = Fexpand_file_name (Fsymbol_name (key_type), db_dir);
3551 if (writing_mode && NILP (Ffile_exists_p (db_dir)))
3552 Fmake_directory_internal (db_dir);
3555 Lisp_Object attribute_name = Fsymbol_name (attribute);
3556 Lisp_Object dest = Qnil, ret;
3558 struct gcpro gcpro1, gcpro2;
3559 int len = XSTRING_CHAR_LENGTH (attribute_name);
3563 for (i = 0; i < len; i++)
3565 Emchar c = string_char (XSTRING (attribute_name), i);
3567 if ( (c == '/') || (c == '%') )
3571 sprintf (str, "%%%02X", c);
3572 dest = concat3 (dest,
3573 Fsubstring (attribute_name,
3574 make_int (base), make_int (i)),
3575 build_string (str));
3579 ret = Fsubstring (attribute_name, make_int (base), make_int (len));
3580 dest = concat2 (dest, ret);
3582 return Fexpand_file_name (dest, db_dir);
3585 #endif /* not HAVE_LIBCHISE */
3587 DEFUN ("save-char-attribute-table", Fsave_char_attribute_table, 1, 1, 0, /*
3588 Save values of ATTRIBUTE into database file.
3592 Lisp_Object table = Fgethash (attribute,
3593 Vchar_attribute_hash_table, Qunbound);
3594 Lisp_Char_Table *ct;
3595 #ifdef HAVE_LIBCHISE
3596 CHISE_Feature feature;
3597 #else /* HAVE_LIBCHISE */
3598 Lisp_Object db_file;
3600 #endif /* not HAVE_LIBCHISE */
3602 if (CHAR_TABLEP (table))
3603 ct = XCHAR_TABLE (table);
3607 #ifdef HAVE_LIBCHISE
3608 if ( open_chise_data_source_maybe () )
3611 = chise_ds_get_feature (default_chise_data_source,
3612 XSTRING_DATA (Fsymbol_name (attribute)));
3613 #else /* HAVE_LIBCHISE */
3614 db_file = char_attribute_system_db_file (Qsystem_char_id, attribute, 1);
3615 db = Fopen_database (db_file, Qnil, Qnil, build_string ("w+"), Qnil);
3616 #endif /* not HAVE_LIBCHISE */
3618 #ifdef HAVE_LIBCHISE
3620 #else /* HAVE_LIBCHISE */
3622 #endif /* not HAVE_LIBCHISE */
3625 Lisp_Object (*filter)(Lisp_Object value);
3627 if (EQ (attribute, Qideographic_structure))
3628 filter = &Fchar_refs_simplify_char_specs;
3632 if (UINT8_BYTE_TABLE_P (ct->table))
3633 save_uint8_byte_table (XUINT8_BYTE_TABLE(ct->table), ct,
3634 #ifdef HAVE_LIBCHISE
3636 #else /* HAVE_LIBCHISE */
3638 #endif /* not HAVE_LIBCHISE */
3640 else if (UINT16_BYTE_TABLE_P (ct->table))
3641 save_uint16_byte_table (XUINT16_BYTE_TABLE(ct->table), ct,
3642 #ifdef HAVE_LIBCHISE
3644 #else /* HAVE_LIBCHISE */
3646 #endif /* not HAVE_LIBCHISE */
3648 else if (BYTE_TABLE_P (ct->table))
3649 save_byte_table (XBYTE_TABLE(ct->table), ct,
3650 #ifdef HAVE_LIBCHISE
3652 #else /* HAVE_LIBCHISE */
3654 #endif /* not HAVE_LIBCHISE */
3656 #ifdef HAVE_LIBCHISE
3657 chise_feature_sync (feature);
3658 #else /* HAVE_LIBCHISE */
3659 Fclose_database (db);
3660 #endif /* not HAVE_LIBCHISE */
3667 DEFUN ("mount-char-attribute-table", Fmount_char_attribute_table, 1, 1, 0, /*
3668 Mount database file on char-attribute-table ATTRIBUTE.
3672 Lisp_Object table = Fgethash (attribute,
3673 Vchar_attribute_hash_table, Qunbound);
3675 if (UNBOUNDP (table))
3677 Lisp_Char_Table *ct;
3679 table = make_char_id_table (Qunbound);
3680 Fputhash (attribute, table, Vchar_attribute_hash_table);
3681 XCHAR_TABLE_NAME(table) = attribute;
3682 ct = XCHAR_TABLE (table);
3683 ct->table = Qunloaded;
3684 XCHAR_TABLE_UNLOADED(table) = 1;
3685 #ifndef HAVE_LIBCHISE
3687 #endif /* not HAVE_LIBCHISE */
3693 DEFUN ("close-char-attribute-table", Fclose_char_attribute_table, 1, 1, 0, /*
3694 Close database of ATTRIBUTE.
3698 Lisp_Object table = Fgethash (attribute,
3699 Vchar_attribute_hash_table, Qunbound);
3700 Lisp_Char_Table *ct;
3702 if (CHAR_TABLEP (table))
3703 ct = XCHAR_TABLE (table);
3706 char_table_close_db_maybe (ct);
3710 DEFUN ("reset-char-attribute-table", Freset_char_attribute_table, 1, 1, 0, /*
3711 Reset values of ATTRIBUTE with database file.
3715 #ifdef HAVE_LIBCHISE
3716 CHISE_Feature feature
3717 = chise_ds_get_feature (default_chise_data_source,
3718 XSTRING_DATA (Fsymbol_name
3721 if (feature == NULL)
3724 if (chise_feature_setup_db (feature, 0) == 0)
3726 Lisp_Object table = Fgethash (attribute,
3727 Vchar_attribute_hash_table, Qunbound);
3728 Lisp_Char_Table *ct;
3730 chise_feature_sync (feature);
3731 if (UNBOUNDP (table))
3733 table = make_char_id_table (Qunbound);
3734 Fputhash (attribute, table, Vchar_attribute_hash_table);
3735 XCHAR_TABLE_NAME(table) = attribute;
3737 ct = XCHAR_TABLE (table);
3738 ct->table = Qunloaded;
3739 char_table_close_db_maybe (ct);
3740 XCHAR_TABLE_UNLOADED(table) = 1;
3744 Lisp_Object table = Fgethash (attribute,
3745 Vchar_attribute_hash_table, Qunbound);
3746 Lisp_Char_Table *ct;
3748 = char_attribute_system_db_file (Qsystem_char_id, attribute, 0);
3750 if (!NILP (Ffile_exists_p (db_file)))
3752 if (UNBOUNDP (table))
3754 table = make_char_id_table (Qunbound);
3755 Fputhash (attribute, table, Vchar_attribute_hash_table);
3756 XCHAR_TABLE_NAME(table) = attribute;
3758 ct = XCHAR_TABLE (table);
3759 ct->table = Qunloaded;
3760 char_table_close_db_maybe (ct);
3761 XCHAR_TABLE_UNLOADED(table) = 1;
3769 load_char_attribute_maybe (Lisp_Char_Table* cit, Emchar ch)
3771 Lisp_Object attribute = CHAR_TABLE_NAME (cit);
3773 if (!NILP (attribute))
3777 if (char_table_open_db_maybe (cit))
3780 val = char_table_get_db (cit, ch);
3782 if (!NILP (Vchar_db_stingy_mode))
3783 char_table_close_db_maybe (cit);
3790 Lisp_Char_Table* char_attribute_table_to_load;
3792 #ifdef HAVE_LIBCHISE
3794 load_char_attribute_table_map_func (CHISE_Char_ID cid,
3795 CHISE_Feature feature,
3796 CHISE_Value *value);
3798 load_char_attribute_table_map_func (CHISE_Char_ID cid,
3799 CHISE_Feature feature,
3803 Lisp_Object ret = get_char_id_table_0 (char_attribute_table_to_load, code);
3805 if (EQ (ret, Qunloaded))
3806 put_char_id_table_0 (char_attribute_table_to_load, code,
3807 Fread (make_string ((Bufbyte *) value->data,
3811 #else /* HAVE_LIBCHISE */
3812 Lisp_Object Qload_char_attribute_table_map_function;
3814 DEFUN ("load-char-attribute-table-map-function",
3815 Fload_char_attribute_table_map_function, 2, 2, 0, /*
3816 For internal use. Don't use it.
3820 Lisp_Object c = Fread (key);
3821 Emchar code = XCHAR (c);
3822 Lisp_Object ret = get_char_id_table_0 (char_attribute_table_to_load, code);
3824 if (EQ (ret, Qunloaded))
3825 put_char_id_table_0 (char_attribute_table_to_load, code, Fread (value));
3828 #endif /* not HAVE_LIBCHISE */
3830 DEFUN ("load-char-attribute-table", Fload_char_attribute_table, 1, 1, 0, /*
3831 Load values of ATTRIBUTE into database file.
3835 Lisp_Object table = Fgethash (attribute,
3836 Vchar_attribute_hash_table,
3838 if (CHAR_TABLEP (table))
3840 Lisp_Char_Table *cit = XCHAR_TABLE (table);
3842 if (char_table_open_db_maybe (cit))
3845 char_attribute_table_to_load = XCHAR_TABLE (table);
3847 struct gcpro gcpro1;
3850 #ifdef HAVE_LIBCHISE
3851 chise_feature_foreach_char_with_value
3852 (chise_ds_get_feature (default_chise_data_source,
3853 XSTRING_DATA (Fsymbol_name (cit->name))),
3854 &load_char_attribute_table_map_func);
3855 #else /* HAVE_LIBCHISE */
3856 Fmap_database (Qload_char_attribute_table_map_function, cit->db);
3857 #endif /* not HAVE_LIBCHISE */
3860 char_table_close_db_maybe (cit);
3861 XCHAR_TABLE_UNLOADED(table) = 0;
3866 #endif /* HAVE_CHISE */
3868 DEFUN ("map-char-attribute", Fmap_char_attribute, 2, 3, 0, /*
3869 Map FUNCTION over entries in ATTRIBUTE, calling it with two args,
3870 each key and value in the table.
3872 RANGE specifies a subrange to map over and is in the same format as
3873 the RANGE argument to `put-range-table'. If omitted or t, it defaults to
3876 (function, attribute, range))
3879 Lisp_Char_Table *ct;
3880 struct slow_map_char_table_arg slarg;
3881 struct gcpro gcpro1, gcpro2;
3882 struct chartab_range rainj;
3884 if (!NILP (ccs = Ffind_charset (attribute)))
3886 Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (ccs);
3888 if (CHAR_TABLEP (encoding_table))
3889 ct = XCHAR_TABLE (encoding_table);
3895 Lisp_Object table = Fgethash (attribute,
3896 Vchar_attribute_hash_table,
3898 if (CHAR_TABLEP (table))
3899 ct = XCHAR_TABLE (table);
3905 decode_char_table_range (range, &rainj);
3907 if (CHAR_TABLE_UNLOADED(ct))
3908 Fload_char_attribute_table (attribute);
3910 slarg.function = function;
3911 slarg.retval = Qnil;
3912 GCPRO2 (slarg.function, slarg.retval);
3913 map_char_table (ct, &rainj, slow_map_char_table_fun, &slarg);
3916 return slarg.retval;
3919 DEFUN ("define-char", Fdefine_char, 1, 1, 0, /*
3920 Store character's ATTRIBUTES.
3924 Lisp_Object rest = attributes;
3925 Lisp_Object code = Fcdr (Fassq (Qmap_ucs, attributes));
3926 Lisp_Object character;
3929 code = Fcdr (Fassq (Qucs, attributes));
3932 while (CONSP (rest))
3934 Lisp_Object cell = Fcar (rest);
3938 signal_simple_error ("Invalid argument", attributes);
3939 if (!NILP (ccs = Ffind_charset (Fcar (cell)))
3940 && ((XCHARSET_FINAL (ccs) != 0) ||
3941 (XCHARSET_MAX_CODE (ccs) > 0) ||
3942 (EQ (ccs, Vcharset_chinese_big5))) )
3946 character = Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
3948 character = Fdecode_char (ccs, cell, Qnil);
3949 if (!NILP (character))
3950 goto setup_attributes;
3954 if ( (!NILP (code = Fcdr (Fassq (Qto_ucs, attributes)))) )
3957 signal_simple_error ("Invalid argument", attributes);
3959 character = make_char (XINT (code) + 0x100000);
3960 goto setup_attributes;
3964 else if (!INTP (code))
3965 signal_simple_error ("Invalid argument", attributes);
3967 character = make_char (XINT (code));
3971 while (CONSP (rest))
3973 Lisp_Object cell = Fcar (rest);
3976 signal_simple_error ("Invalid argument", attributes);
3978 Fput_char_attribute (character, Fcar (cell), Fcdr (cell));
3984 DEFUN ("find-char", Ffind_char, 1, 1, 0, /*
3985 Retrieve the character of the given ATTRIBUTES.
3989 Lisp_Object rest = attributes;
3992 while (CONSP (rest))
3994 Lisp_Object cell = Fcar (rest);
3998 signal_simple_error ("Invalid argument", attributes);
3999 if (!NILP (ccs = Ffind_charset (Fcar (cell))))
4003 return Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
4005 return Fdecode_char (ccs, cell, Qnil);
4009 if ( (!NILP (code = Fcdr (Fassq (Qto_ucs, attributes)))) )
4012 signal_simple_error ("Invalid argument", attributes);
4014 return make_char (XINT (code) + 0x100000);
4022 /************************************************************************/
4023 /* Char table read syntax */
4024 /************************************************************************/
4027 chartab_type_validate (Lisp_Object keyword, Lisp_Object value,
4028 Error_behavior errb)
4030 /* #### should deal with ERRB */
4031 symbol_to_char_table_type (value);
4036 chartab_data_validate (Lisp_Object keyword, Lisp_Object value,
4037 Error_behavior errb)
4041 /* #### should deal with ERRB */
4042 EXTERNAL_LIST_LOOP (rest, value)
4044 Lisp_Object range = XCAR (rest);
4045 struct chartab_range dummy;
4049 signal_simple_error ("Invalid list format", value);
4052 if (!CONSP (XCDR (range))
4053 || !NILP (XCDR (XCDR (range))))
4054 signal_simple_error ("Invalid range format", range);
4055 decode_char_table_range (XCAR (range), &dummy);
4056 decode_char_table_range (XCAR (XCDR (range)), &dummy);
4059 decode_char_table_range (range, &dummy);
4066 chartab_instantiate (Lisp_Object data)
4068 Lisp_Object chartab;
4069 Lisp_Object type = Qgeneric;
4070 Lisp_Object dataval = Qnil;
4072 while (!NILP (data))
4074 Lisp_Object keyw = Fcar (data);
4080 if (EQ (keyw, Qtype))
4082 else if (EQ (keyw, Qdata))
4086 chartab = Fmake_char_table (type);
4089 while (!NILP (data))
4091 Lisp_Object range = Fcar (data);
4092 Lisp_Object val = Fcar (Fcdr (data));
4094 data = Fcdr (Fcdr (data));
4097 if (CHAR_OR_CHAR_INTP (XCAR (range)))
4099 Emchar first = XCHAR_OR_CHAR_INT (Fcar (range));
4100 Emchar last = XCHAR_OR_CHAR_INT (Fcar (Fcdr (range)));
4103 for (i = first; i <= last; i++)
4104 Fput_char_table (make_char (i), val, chartab);
4110 Fput_char_table (range, val, chartab);
4119 /************************************************************************/
4120 /* Category Tables, specifically */
4121 /************************************************************************/
4123 DEFUN ("category-table-p", Fcategory_table_p, 1, 1, 0, /*
4124 Return t if OBJECT is a category table.
4125 A category table is a type of char table used for keeping track of
4126 categories. Categories are used for classifying characters for use
4127 in regexps -- you can refer to a category rather than having to use
4128 a complicated [] expression (and category lookups are significantly
4131 There are 95 different categories available, one for each printable
4132 character (including space) in the ASCII charset. Each category
4133 is designated by one such character, called a "category designator".
4134 They are specified in a regexp using the syntax "\\cX", where X is
4135 a category designator.
4137 A category table specifies, for each character, the categories that
4138 the character is in. Note that a character can be in more than one
4139 category. More specifically, a category table maps from a character
4140 to either the value nil (meaning the character is in no categories)
4141 or a 95-element bit vector, specifying for each of the 95 categories
4142 whether the character is in that category.
4144 Special Lisp functions are provided that abstract this, so you do not
4145 have to directly manipulate bit vectors.
4149 return (CHAR_TABLEP (object) &&
4150 XCHAR_TABLE_TYPE (object) == CHAR_TABLE_TYPE_CATEGORY) ?
4155 check_category_table (Lisp_Object object, Lisp_Object default_)
4159 while (NILP (Fcategory_table_p (object)))
4160 object = wrong_type_argument (Qcategory_table_p, object);
4165 check_category_char (Emchar ch, Lisp_Object table,
4166 unsigned int designator, unsigned int not_p)
4168 REGISTER Lisp_Object temp;
4169 Lisp_Char_Table *ctbl;
4170 #ifdef ERROR_CHECK_TYPECHECK
4171 if (NILP (Fcategory_table_p (table)))
4172 signal_simple_error ("Expected category table", table);
4174 ctbl = XCHAR_TABLE (table);
4175 temp = get_char_table (ch, ctbl);
4180 return bit_vector_bit (XBIT_VECTOR (temp), designator) ? !not_p : not_p;
4183 DEFUN ("check-category-at", Fcheck_category_at, 2, 4, 0, /*
4184 Return t if category of the character at POSITION includes DESIGNATOR.
4185 Optional third arg BUFFER specifies which buffer to use, and defaults
4186 to the current buffer.
4187 Optional fourth arg CATEGORY-TABLE specifies the category table to
4188 use, and defaults to BUFFER's category table.
4190 (position, designator, buffer, category_table))
4195 struct buffer *buf = decode_buffer (buffer, 0);
4197 CHECK_INT (position);
4198 CHECK_CATEGORY_DESIGNATOR (designator);
4199 des = XCHAR (designator);
4200 ctbl = check_category_table (category_table, Vstandard_category_table);
4201 ch = BUF_FETCH_CHAR (buf, XINT (position));
4202 return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil;
4205 DEFUN ("char-in-category-p", Fchar_in_category_p, 2, 3, 0, /*
4206 Return t if category of CHARACTER includes DESIGNATOR, else nil.
4207 Optional third arg CATEGORY-TABLE specifies the category table to use,
4208 and defaults to the standard category table.
4210 (character, designator, category_table))
4216 CHECK_CATEGORY_DESIGNATOR (designator);
4217 des = XCHAR (designator);
4218 CHECK_CHAR (character);
4219 ch = XCHAR (character);
4220 ctbl = check_category_table (category_table, Vstandard_category_table);
4221 return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil;
4224 DEFUN ("category-table", Fcategory_table, 0, 1, 0, /*
4225 Return BUFFER's current category table.
4226 BUFFER defaults to the current buffer.
4230 return decode_buffer (buffer, 0)->category_table;
4233 DEFUN ("standard-category-table", Fstandard_category_table, 0, 0, 0, /*
4234 Return the standard category table.
4235 This is the one used for new buffers.
4239 return Vstandard_category_table;
4242 DEFUN ("copy-category-table", Fcopy_category_table, 0, 1, 0, /*
4243 Return a new category table which is a copy of CATEGORY-TABLE.
4244 CATEGORY-TABLE defaults to the standard category table.
4248 if (NILP (Vstandard_category_table))
4249 return Fmake_char_table (Qcategory);
4252 check_category_table (category_table, Vstandard_category_table);
4253 return Fcopy_char_table (category_table);
4256 DEFUN ("set-category-table", Fset_category_table, 1, 2, 0, /*
4257 Select CATEGORY-TABLE as the new category table for BUFFER.
4258 BUFFER defaults to the current buffer if omitted.
4260 (category_table, buffer))
4262 struct buffer *buf = decode_buffer (buffer, 0);
4263 category_table = check_category_table (category_table, Qnil);
4264 buf->category_table = category_table;
4265 /* Indicate that this buffer now has a specified category table. */
4266 buf->local_var_flags |= XINT (buffer_local_flags.category_table);
4267 return category_table;
4270 DEFUN ("category-designator-p", Fcategory_designator_p, 1, 1, 0, /*
4271 Return t if OBJECT is a category designator (a char in the range ' ' to '~').
4275 return CATEGORY_DESIGNATORP (object) ? Qt : Qnil;
4278 DEFUN ("category-table-value-p", Fcategory_table_value_p, 1, 1, 0, /*
4279 Return t if OBJECT is a category table value.
4280 Valid values are nil or a bit vector of size 95.
4284 return CATEGORY_TABLE_VALUEP (object) ? Qt : Qnil;
4288 #define CATEGORYP(x) \
4289 (CHARP (x) && XCHAR (x) >= 0x20 && XCHAR (x) <= 0x7E)
4291 #define CATEGORY_SET(c) \
4292 (get_char_table(c, XCHAR_TABLE(current_buffer->category_table)))
4294 /* Return 1 if CATEGORY_SET contains CATEGORY, else return 0.
4295 The faster version of `!NILP (Faref (category_set, category))'. */
4296 #define CATEGORY_MEMBER(category, category_set) \
4297 (bit_vector_bit(XBIT_VECTOR (category_set), category - 32))
4299 /* Return 1 if there is a word boundary between two word-constituent
4300 characters C1 and C2 if they appear in this order, else return 0.
4301 Use the macro WORD_BOUNDARY_P instead of calling this function
4304 int word_boundary_p (Emchar c1, Emchar c2);
4306 word_boundary_p (Emchar c1, Emchar c2)
4308 Lisp_Object category_set1, category_set2;
4313 if (COMPOSITE_CHAR_P (c1))
4314 c1 = cmpchar_component (c1, 0, 1);
4315 if (COMPOSITE_CHAR_P (c2))
4316 c2 = cmpchar_component (c2, 0, 1);
4320 if (EQ (CHAR_CHARSET (c1), CHAR_CHARSET (c2)))
4323 tail = Vword_separating_categories;
4329 tail = Vword_combining_categories;
4334 category_set1 = CATEGORY_SET (c1);
4335 if (NILP (category_set1))
4336 return default_result;
4337 category_set2 = CATEGORY_SET (c2);
4338 if (NILP (category_set2))
4339 return default_result;
4341 for (; CONSP (tail); tail = XCONS (tail)->cdr)
4343 Lisp_Object elt = XCONS(tail)->car;
4346 && CATEGORYP (XCONS (elt)->car)
4347 && CATEGORYP (XCONS (elt)->cdr)
4348 && CATEGORY_MEMBER (XCHAR (XCONS (elt)->car), category_set1)
4349 && CATEGORY_MEMBER (XCHAR (XCONS (elt)->cdr), category_set2))
4350 return !default_result;
4352 return default_result;
4358 syms_of_chartab (void)
4361 INIT_LRECORD_IMPLEMENTATION (uint8_byte_table);
4362 INIT_LRECORD_IMPLEMENTATION (uint16_byte_table);
4363 INIT_LRECORD_IMPLEMENTATION (byte_table);
4365 #if defined(HAVE_CHISE) && !defined(HAVE_LIBCHISE_LIBCHISE)
4366 defsymbol (&Qsystem_char_id, "system-char-id");
4369 defsymbol (&Qto_ucs, "=>ucs");
4370 defsymbol (&Q_ucs_unified, "->ucs-unified");
4371 defsymbol (&Qcomposition, "composition");
4372 defsymbol (&Q_decomposition, "->decomposition");
4373 defsymbol (&Qcompat, "compat");
4374 defsymbol (&Qisolated, "isolated");
4375 defsymbol (&Qinitial, "initial");
4376 defsymbol (&Qmedial, "medial");
4377 defsymbol (&Qfinal, "final");
4378 defsymbol (&Qvertical, "vertical");
4379 defsymbol (&QnoBreak, "noBreak");
4380 defsymbol (&Qfraction, "fraction");
4381 defsymbol (&Qsuper, "super");
4382 defsymbol (&Qsub, "sub");
4383 defsymbol (&Qcircle, "circle");
4384 defsymbol (&Qsquare, "square");
4385 defsymbol (&Qwide, "wide");
4386 defsymbol (&Qnarrow, "narrow");
4387 defsymbol (&Qsmall, "small");
4388 defsymbol (&Qfont, "font");
4390 DEFSUBR (Fchar_attribute_list);
4391 DEFSUBR (Ffind_char_attribute_table);
4392 defsymbol (&Qput_char_table_map_function, "put-char-table-map-function");
4393 DEFSUBR (Fput_char_table_map_function);
4395 DEFSUBR (Fsave_char_attribute_table);
4396 DEFSUBR (Fmount_char_attribute_table);
4397 DEFSUBR (Freset_char_attribute_table);
4398 DEFSUBR (Fclose_char_attribute_table);
4399 DEFSUBR (Fclose_char_data_source);
4400 #ifndef HAVE_LIBCHISE
4401 defsymbol (&Qload_char_attribute_table_map_function,
4402 "load-char-attribute-table-map-function");
4403 DEFSUBR (Fload_char_attribute_table_map_function);
4405 DEFSUBR (Fload_char_attribute_table);
4407 DEFSUBR (Fchar_attribute_alist);
4408 DEFSUBR (Fget_char_attribute);
4409 DEFSUBR (Fput_char_attribute);
4410 DEFSUBR (Fremove_char_attribute);
4411 DEFSUBR (Fmap_char_attribute);
4412 DEFSUBR (Fdefine_char);
4413 DEFSUBR (Ffind_char);
4414 DEFSUBR (Fchar_variants);
4416 DEFSUBR (Fget_composite_char);
4419 INIT_LRECORD_IMPLEMENTATION (char_table);
4423 INIT_LRECORD_IMPLEMENTATION (char_table_entry);
4426 defsymbol (&Qcategory_table_p, "category-table-p");
4427 defsymbol (&Qcategory_designator_p, "category-designator-p");
4428 defsymbol (&Qcategory_table_value_p, "category-table-value-p");
4431 defsymbol (&Qchar_table, "char-table");
4432 defsymbol (&Qchar_tablep, "char-table-p");
4434 DEFSUBR (Fchar_table_p);
4435 DEFSUBR (Fchar_table_type_list);
4436 DEFSUBR (Fvalid_char_table_type_p);
4437 DEFSUBR (Fchar_table_type);
4438 DEFSUBR (Freset_char_table);
4439 DEFSUBR (Fmake_char_table);
4440 DEFSUBR (Fcopy_char_table);
4441 DEFSUBR (Fget_char_table);
4442 DEFSUBR (Fget_range_char_table);
4443 DEFSUBR (Fvalid_char_table_value_p);
4444 DEFSUBR (Fcheck_valid_char_table_value);
4445 DEFSUBR (Fput_char_table);
4446 DEFSUBR (Fmap_char_table);
4449 DEFSUBR (Fcategory_table_p);
4450 DEFSUBR (Fcategory_table);
4451 DEFSUBR (Fstandard_category_table);
4452 DEFSUBR (Fcopy_category_table);
4453 DEFSUBR (Fset_category_table);
4454 DEFSUBR (Fcheck_category_at);
4455 DEFSUBR (Fchar_in_category_p);
4456 DEFSUBR (Fcategory_designator_p);
4457 DEFSUBR (Fcategory_table_value_p);
4463 vars_of_chartab (void)
4466 DEFVAR_LISP ("char-db-stingy-mode", &Vchar_db_stingy_mode /*
4468 Vchar_db_stingy_mode = Qt;
4470 #ifdef HAVE_LIBCHISE
4471 Vchise_db_directory = build_string(chise_db_dir);
4472 DEFVAR_LISP ("chise-db-directory", &Vchise_db_directory /*
4473 Directory of CHISE character databases.
4476 Vchise_system_db_directory = build_string(chise_system_db_dir);
4477 DEFVAR_LISP ("chise-system-db-directory", &Vchise_system_db_directory /*
4478 Directory of system character database of CHISE.
4482 #endif /* HAVE_CHISE */
4483 /* DO NOT staticpro this. It works just like Vweak_hash_tables. */
4484 Vall_syntax_tables = Qnil;
4485 dump_add_weak_object_chain (&Vall_syntax_tables);
4489 structure_type_create_chartab (void)
4491 struct structure_type *st;
4493 st = define_structure_type (Qchar_table, 0, chartab_instantiate);
4495 define_structure_type_keyword (st, Qtype, chartab_type_validate);
4496 define_structure_type_keyword (st, Qdata, chartab_data_validate);
4500 complex_vars_of_chartab (void)
4503 staticpro (&Vchar_attribute_hash_table);
4504 Vchar_attribute_hash_table
4505 = make_lisp_hash_table (16, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
4506 #endif /* UTF2000 */
4508 /* Set this now, so first buffer creation can refer to it. */
4509 /* Make it nil before calling copy-category-table
4510 so that copy-category-table will know not to try to copy from garbage */
4511 Vstandard_category_table = Qnil;
4512 Vstandard_category_table = Fcopy_category_table (Qnil);
4513 staticpro (&Vstandard_category_table);
4515 DEFVAR_LISP ("word-combining-categories", &Vword_combining_categories /*
4516 List of pair (cons) of categories to determine word boundary.
4518 Emacs treats a sequence of word constituent characters as a single
4519 word (i.e. finds no word boundary between them) iff they belongs to
4520 the same charset. But, exceptions are allowed in the following cases.
4522 \(1) The case that characters are in different charsets is controlled
4523 by the variable `word-combining-categories'.
4525 Emacs finds no word boundary between characters of different charsets
4526 if they have categories matching some element of this list.
4528 More precisely, if an element of this list is a cons of category CAT1
4529 and CAT2, and a multibyte character C1 which has CAT1 is followed by
4530 C2 which has CAT2, there's no word boundary between C1 and C2.
4532 For instance, to tell that ASCII characters and Latin-1 characters can
4533 form a single word, the element `(?l . ?l)' should be in this list
4534 because both characters have the category `l' (Latin characters).
4536 \(2) The case that character are in the same charset is controlled by
4537 the variable `word-separating-categories'.
4539 Emacs find a word boundary between characters of the same charset
4540 if they have categories matching some element of this list.
4542 More precisely, if an element of this list is a cons of category CAT1
4543 and CAT2, and a multibyte character C1 which has CAT1 is followed by
4544 C2 which has CAT2, there's a word boundary between C1 and C2.
4546 For instance, to tell that there's a word boundary between Japanese
4547 Hiragana and Japanese Kanji (both are in the same charset), the
4548 element `(?H . ?C) should be in this list.
4551 Vword_combining_categories = Qnil;
4553 DEFVAR_LISP ("word-separating-categories", &Vword_separating_categories /*
4554 List of pair (cons) of categories to determine word boundary.
4555 See the documentation of the variable `word-combining-categories'.
4558 Vword_separating_categories = Qnil;