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,2004 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 CHISE
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 Lisp_Object Vnext_defined_char_id;
79 EXFUN (Fdefine_char, 1);
81 EXFUN (Fmap_char_attribute, 3);
84 EXFUN (Fmount_char_attribute_table, 1);
88 EXFUN (Fload_char_attribute_table, 1);
90 Lisp_Object Vchar_db_stingy_mode;
93 #define BT_UINT8_MIN 0
94 #define BT_UINT8_MAX (UCHAR_MAX - 4)
95 #define BT_UINT8_t (UCHAR_MAX - 3)
96 #define BT_UINT8_nil (UCHAR_MAX - 2)
97 #define BT_UINT8_unbound (UCHAR_MAX - 1)
98 #define BT_UINT8_unloaded UCHAR_MAX
100 INLINE_HEADER int INT_UINT8_P (Lisp_Object obj);
101 INLINE_HEADER int UINT8_VALUE_P (Lisp_Object obj);
102 INLINE_HEADER unsigned char UINT8_ENCODE (Lisp_Object obj);
103 INLINE_HEADER Lisp_Object UINT8_DECODE (unsigned char n);
104 INLINE_HEADER unsigned short UINT8_TO_UINT16 (unsigned char n);
107 INT_UINT8_P (Lisp_Object obj)
111 int num = XINT (obj);
113 return (BT_UINT8_MIN <= num) && (num <= BT_UINT8_MAX);
120 UINT8_VALUE_P (Lisp_Object obj)
122 return EQ (obj, Qunloaded) || EQ (obj, Qunbound)
123 || EQ (obj, Qnil) || EQ (obj, Qt) || INT_UINT8_P (obj);
126 INLINE_HEADER unsigned char
127 UINT8_ENCODE (Lisp_Object obj)
129 if (EQ (obj, Qunloaded))
130 return BT_UINT8_unloaded;
131 else if (EQ (obj, Qunbound))
132 return BT_UINT8_unbound;
133 else if (EQ (obj, Qnil))
135 else if (EQ (obj, Qt))
141 INLINE_HEADER Lisp_Object
142 UINT8_DECODE (unsigned char n)
144 if (n == BT_UINT8_unloaded)
146 else if (n == BT_UINT8_unbound)
148 else if (n == BT_UINT8_nil)
150 else if (n == BT_UINT8_t)
157 mark_uint8_byte_table (Lisp_Object obj)
163 print_uint8_byte_table (Lisp_Object obj,
164 Lisp_Object printcharfun, int escapeflag)
166 Lisp_Uint8_Byte_Table *bte = XUINT8_BYTE_TABLE (obj);
168 struct gcpro gcpro1, gcpro2;
169 GCPRO2 (obj, printcharfun);
171 write_c_string ("\n#<uint8-byte-table", printcharfun);
172 for (i = 0; i < 256; i++)
174 unsigned char n = bte->property[i];
176 write_c_string ("\n ", printcharfun);
177 write_c_string (" ", printcharfun);
178 if (n == BT_UINT8_unbound)
179 write_c_string ("void", printcharfun);
180 else if (n == BT_UINT8_nil)
181 write_c_string ("nil", printcharfun);
182 else if (n == BT_UINT8_t)
183 write_c_string ("t", printcharfun);
188 sprintf (buf, "%hd", n);
189 write_c_string (buf, printcharfun);
193 write_c_string (">", printcharfun);
197 uint8_byte_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
199 Lisp_Uint8_Byte_Table *te1 = XUINT8_BYTE_TABLE (obj1);
200 Lisp_Uint8_Byte_Table *te2 = XUINT8_BYTE_TABLE (obj2);
203 for (i = 0; i < 256; i++)
204 if (te1->property[i] != te2->property[i])
210 uint8_byte_table_hash (Lisp_Object obj, int depth)
212 Lisp_Uint8_Byte_Table *te = XUINT8_BYTE_TABLE (obj);
216 for (i = 0; i < 256; i++)
217 hash = HASH2 (hash, te->property[i]);
221 static const struct lrecord_description uint8_byte_table_description[] = {
225 DEFINE_LRECORD_IMPLEMENTATION ("uint8-byte-table", uint8_byte_table,
226 mark_uint8_byte_table,
227 print_uint8_byte_table,
228 0, uint8_byte_table_equal,
229 uint8_byte_table_hash,
230 uint8_byte_table_description,
231 Lisp_Uint8_Byte_Table);
234 make_uint8_byte_table (unsigned char initval)
238 Lisp_Uint8_Byte_Table *cte;
240 cte = alloc_lcrecord_type (Lisp_Uint8_Byte_Table,
241 &lrecord_uint8_byte_table);
243 for (i = 0; i < 256; i++)
244 cte->property[i] = initval;
246 XSETUINT8_BYTE_TABLE (obj, cte);
251 copy_uint8_byte_table (Lisp_Object entry)
253 Lisp_Uint8_Byte_Table *cte = XUINT8_BYTE_TABLE (entry);
256 Lisp_Uint8_Byte_Table *ctenew
257 = alloc_lcrecord_type (Lisp_Uint8_Byte_Table,
258 &lrecord_uint8_byte_table);
260 for (i = 0; i < 256; i++)
262 ctenew->property[i] = cte->property[i];
265 XSETUINT8_BYTE_TABLE (obj, ctenew);
270 uint8_byte_table_same_value_p (Lisp_Object obj)
272 Lisp_Uint8_Byte_Table *bte = XUINT8_BYTE_TABLE (obj);
273 unsigned char v0 = bte->property[0];
276 for (i = 1; i < 256; i++)
278 if (bte->property[i] != v0)
285 map_over_uint8_byte_table (Lisp_Uint8_Byte_Table *ct, Lisp_Char_Table* root,
286 Emchar ofs, int place,
287 int (*fn) (struct chartab_range *range,
288 Lisp_Object val, void *arg),
291 struct chartab_range rainj;
293 int unit = 1 << (8 * place);
297 rainj.type = CHARTAB_RANGE_CHAR;
299 for (i = 0, retval = 0; i < 256 && retval == 0; i++)
301 if (ct->property[i] == BT_UINT8_unloaded)
305 for (; c < c1 && retval == 0; c++)
307 Lisp_Object ret = get_char_id_table (root, c);
312 retval = (fn) (&rainj, ret, arg);
316 ct->property[i] = BT_UINT8_unbound;
320 else if (ct->property[i] != BT_UINT8_unbound)
323 for (; c < c1 && retval == 0; c++)
326 retval = (fn) (&rainj, UINT8_DECODE (ct->property[i]), arg);
337 save_uint8_byte_table (Lisp_Uint8_Byte_Table *ct, Lisp_Char_Table* root,
339 CHISE_Feature feature,
343 Emchar ofs, int place,
344 Lisp_Object (*filter)(Lisp_Object value))
346 struct chartab_range rainj;
348 int unit = 1 << (8 * place);
352 rainj.type = CHARTAB_RANGE_CHAR;
354 for (i = 0, retval = 0; i < 256 && retval == 0; i++)
356 if (ct->property[i] == BT_UINT8_unloaded)
360 else if (ct->property[i] != BT_UINT8_unbound)
363 for (; c < c1 && retval == 0; c++)
366 chise_char_set_feature_value
369 (Fprin1_to_string (UINT8_DECODE (ct->property[i]),
372 Fput_database (Fprin1_to_string (make_char (c), Qnil),
373 Fprin1_to_string (UINT8_DECODE (ct->property[i]),
385 #define BT_UINT16_MIN 0
386 #define BT_UINT16_MAX (USHRT_MAX - 4)
387 #define BT_UINT16_t (USHRT_MAX - 3)
388 #define BT_UINT16_nil (USHRT_MAX - 2)
389 #define BT_UINT16_unbound (USHRT_MAX - 1)
390 #define BT_UINT16_unloaded USHRT_MAX
392 INLINE_HEADER int INT_UINT16_P (Lisp_Object obj);
393 INLINE_HEADER int UINT16_VALUE_P (Lisp_Object obj);
394 INLINE_HEADER unsigned short UINT16_ENCODE (Lisp_Object obj);
395 INLINE_HEADER Lisp_Object UINT16_DECODE (unsigned short us);
398 INT_UINT16_P (Lisp_Object obj)
402 int num = XINT (obj);
404 return (BT_UINT16_MIN <= num) && (num <= BT_UINT16_MAX);
411 UINT16_VALUE_P (Lisp_Object obj)
413 return EQ (obj, Qunloaded) || EQ (obj, Qunbound)
414 || EQ (obj, Qnil) || EQ (obj, Qt) || INT_UINT16_P (obj);
417 INLINE_HEADER unsigned short
418 UINT16_ENCODE (Lisp_Object obj)
420 if (EQ (obj, Qunloaded))
421 return BT_UINT16_unloaded;
422 else if (EQ (obj, Qunbound))
423 return BT_UINT16_unbound;
424 else if (EQ (obj, Qnil))
425 return BT_UINT16_nil;
426 else if (EQ (obj, Qt))
432 INLINE_HEADER Lisp_Object
433 UINT16_DECODE (unsigned short n)
435 if (n == BT_UINT16_unloaded)
437 else if (n == BT_UINT16_unbound)
439 else if (n == BT_UINT16_nil)
441 else if (n == BT_UINT16_t)
447 INLINE_HEADER unsigned short
448 UINT8_TO_UINT16 (unsigned char n)
450 if (n == BT_UINT8_unloaded)
451 return BT_UINT16_unloaded;
452 else if (n == BT_UINT8_unbound)
453 return BT_UINT16_unbound;
454 else if (n == BT_UINT8_nil)
455 return BT_UINT16_nil;
456 else if (n == BT_UINT8_t)
463 mark_uint16_byte_table (Lisp_Object obj)
469 print_uint16_byte_table (Lisp_Object obj,
470 Lisp_Object printcharfun, int escapeflag)
472 Lisp_Uint16_Byte_Table *bte = XUINT16_BYTE_TABLE (obj);
474 struct gcpro gcpro1, gcpro2;
475 GCPRO2 (obj, printcharfun);
477 write_c_string ("\n#<uint16-byte-table", printcharfun);
478 for (i = 0; i < 256; i++)
480 unsigned short n = bte->property[i];
482 write_c_string ("\n ", printcharfun);
483 write_c_string (" ", printcharfun);
484 if (n == BT_UINT16_unbound)
485 write_c_string ("void", printcharfun);
486 else if (n == BT_UINT16_nil)
487 write_c_string ("nil", printcharfun);
488 else if (n == BT_UINT16_t)
489 write_c_string ("t", printcharfun);
494 sprintf (buf, "%hd", n);
495 write_c_string (buf, printcharfun);
499 write_c_string (">", printcharfun);
503 uint16_byte_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
505 Lisp_Uint16_Byte_Table *te1 = XUINT16_BYTE_TABLE (obj1);
506 Lisp_Uint16_Byte_Table *te2 = XUINT16_BYTE_TABLE (obj2);
509 for (i = 0; i < 256; i++)
510 if (te1->property[i] != te2->property[i])
516 uint16_byte_table_hash (Lisp_Object obj, int depth)
518 Lisp_Uint16_Byte_Table *te = XUINT16_BYTE_TABLE (obj);
522 for (i = 0; i < 256; i++)
523 hash = HASH2 (hash, te->property[i]);
527 static const struct lrecord_description uint16_byte_table_description[] = {
531 DEFINE_LRECORD_IMPLEMENTATION ("uint16-byte-table", uint16_byte_table,
532 mark_uint16_byte_table,
533 print_uint16_byte_table,
534 0, uint16_byte_table_equal,
535 uint16_byte_table_hash,
536 uint16_byte_table_description,
537 Lisp_Uint16_Byte_Table);
540 make_uint16_byte_table (unsigned short initval)
544 Lisp_Uint16_Byte_Table *cte;
546 cte = alloc_lcrecord_type (Lisp_Uint16_Byte_Table,
547 &lrecord_uint16_byte_table);
549 for (i = 0; i < 256; i++)
550 cte->property[i] = initval;
552 XSETUINT16_BYTE_TABLE (obj, cte);
557 copy_uint16_byte_table (Lisp_Object entry)
559 Lisp_Uint16_Byte_Table *cte = XUINT16_BYTE_TABLE (entry);
562 Lisp_Uint16_Byte_Table *ctenew
563 = alloc_lcrecord_type (Lisp_Uint16_Byte_Table,
564 &lrecord_uint16_byte_table);
566 for (i = 0; i < 256; i++)
568 ctenew->property[i] = cte->property[i];
571 XSETUINT16_BYTE_TABLE (obj, ctenew);
576 expand_uint8_byte_table_to_uint16 (Lisp_Object table)
580 Lisp_Uint8_Byte_Table* bte = XUINT8_BYTE_TABLE(table);
581 Lisp_Uint16_Byte_Table* cte;
583 cte = alloc_lcrecord_type (Lisp_Uint16_Byte_Table,
584 &lrecord_uint16_byte_table);
585 for (i = 0; i < 256; i++)
587 cte->property[i] = UINT8_TO_UINT16 (bte->property[i]);
589 XSETUINT16_BYTE_TABLE (obj, cte);
594 uint16_byte_table_same_value_p (Lisp_Object obj)
596 Lisp_Uint16_Byte_Table *bte = XUINT16_BYTE_TABLE (obj);
597 unsigned short v0 = bte->property[0];
600 for (i = 1; i < 256; i++)
602 if (bte->property[i] != v0)
609 map_over_uint16_byte_table (Lisp_Uint16_Byte_Table *ct, Lisp_Char_Table* root,
610 Emchar ofs, int place,
611 int (*fn) (struct chartab_range *range,
612 Lisp_Object val, void *arg),
615 struct chartab_range rainj;
617 int unit = 1 << (8 * place);
621 rainj.type = CHARTAB_RANGE_CHAR;
623 for (i = 0, retval = 0; i < 256 && retval == 0; i++)
625 if (ct->property[i] == BT_UINT16_unloaded)
629 for (; c < c1 && retval == 0; c++)
631 Lisp_Object ret = get_char_id_table (root, c);
636 retval = (fn) (&rainj, ret, arg);
640 ct->property[i] = BT_UINT16_unbound;
644 else if (ct->property[i] != BT_UINT16_unbound)
647 for (; c < c1 && retval == 0; c++)
650 retval = (fn) (&rainj, UINT16_DECODE (ct->property[i]), arg);
661 save_uint16_byte_table (Lisp_Uint16_Byte_Table *ct, Lisp_Char_Table* root,
663 CHISE_Feature feature,
667 Emchar ofs, int place,
668 Lisp_Object (*filter)(Lisp_Object value))
670 struct chartab_range rainj;
672 int unit = 1 << (8 * place);
676 rainj.type = CHARTAB_RANGE_CHAR;
678 for (i = 0, retval = 0; i < 256 && retval == 0; i++)
680 if (ct->property[i] == BT_UINT16_unloaded)
684 else if (ct->property[i] != BT_UINT16_unbound)
687 for (; c < c1 && retval == 0; c++)
690 chise_char_set_feature_value
693 (Fprin1_to_string (UINT16_DECODE (ct->property[i]),
696 Fput_database (Fprin1_to_string (make_char (c), Qnil),
697 Fprin1_to_string (UINT16_DECODE (ct->property[i]),
711 mark_byte_table (Lisp_Object obj)
713 Lisp_Byte_Table *cte = XBYTE_TABLE (obj);
716 for (i = 0; i < 256; i++)
718 mark_object (cte->property[i]);
724 print_byte_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
726 Lisp_Byte_Table *bte = XBYTE_TABLE (obj);
728 struct gcpro gcpro1, gcpro2;
729 GCPRO2 (obj, printcharfun);
731 write_c_string ("\n#<byte-table", printcharfun);
732 for (i = 0; i < 256; i++)
734 Lisp_Object elt = bte->property[i];
736 write_c_string ("\n ", printcharfun);
737 write_c_string (" ", printcharfun);
738 if (EQ (elt, Qunbound))
739 write_c_string ("void", printcharfun);
741 print_internal (elt, printcharfun, escapeflag);
744 write_c_string (">", printcharfun);
748 byte_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
750 Lisp_Byte_Table *cte1 = XBYTE_TABLE (obj1);
751 Lisp_Byte_Table *cte2 = XBYTE_TABLE (obj2);
754 for (i = 0; i < 256; i++)
755 if (BYTE_TABLE_P (cte1->property[i]))
757 if (BYTE_TABLE_P (cte2->property[i]))
759 if (!byte_table_equal (cte1->property[i],
760 cte2->property[i], depth + 1))
767 if (!internal_equal (cte1->property[i], cte2->property[i], depth + 1))
773 byte_table_hash (Lisp_Object obj, int depth)
775 Lisp_Byte_Table *cte = XBYTE_TABLE (obj);
777 return internal_array_hash (cte->property, 256, depth);
780 static const struct lrecord_description byte_table_description[] = {
781 { XD_LISP_OBJECT_ARRAY, offsetof(Lisp_Byte_Table, property), 256 },
785 DEFINE_LRECORD_IMPLEMENTATION ("byte-table", byte_table,
790 byte_table_description,
794 make_byte_table (Lisp_Object initval)
798 Lisp_Byte_Table *cte;
800 cte = alloc_lcrecord_type (Lisp_Byte_Table, &lrecord_byte_table);
802 for (i = 0; i < 256; i++)
803 cte->property[i] = initval;
805 XSETBYTE_TABLE (obj, cte);
810 copy_byte_table (Lisp_Object entry)
812 Lisp_Byte_Table *cte = XBYTE_TABLE (entry);
815 Lisp_Byte_Table *ctnew
816 = alloc_lcrecord_type (Lisp_Byte_Table, &lrecord_byte_table);
818 for (i = 0; i < 256; i++)
820 if (UINT8_BYTE_TABLE_P (cte->property[i]))
822 ctnew->property[i] = copy_uint8_byte_table (cte->property[i]);
824 else if (UINT16_BYTE_TABLE_P (cte->property[i]))
826 ctnew->property[i] = copy_uint16_byte_table (cte->property[i]);
828 else if (BYTE_TABLE_P (cte->property[i]))
830 ctnew->property[i] = copy_byte_table (cte->property[i]);
833 ctnew->property[i] = cte->property[i];
836 XSETBYTE_TABLE (obj, ctnew);
841 byte_table_same_value_p (Lisp_Object obj)
843 Lisp_Byte_Table *bte = XBYTE_TABLE (obj);
844 Lisp_Object v0 = bte->property[0];
847 for (i = 1; i < 256; i++)
849 if (!internal_equal (bte->property[i], v0, 0))
856 map_over_byte_table (Lisp_Byte_Table *ct, Lisp_Char_Table* root,
857 Emchar ofs, int place,
858 int (*fn) (struct chartab_range *range,
859 Lisp_Object val, void *arg),
864 int unit = 1 << (8 * place);
867 for (i = 0, retval = 0; i < 256 && retval == 0; i++)
870 if (UINT8_BYTE_TABLE_P (v))
873 = map_over_uint8_byte_table (XUINT8_BYTE_TABLE(v), root,
874 c, place - 1, fn, arg);
877 else if (UINT16_BYTE_TABLE_P (v))
880 = map_over_uint16_byte_table (XUINT16_BYTE_TABLE(v), root,
881 c, place - 1, fn, arg);
884 else if (BYTE_TABLE_P (v))
886 retval = map_over_byte_table (XBYTE_TABLE(v), root,
887 c, place - 1, fn, arg);
890 else if (EQ (v, Qunloaded))
893 struct chartab_range rainj;
894 Emchar c1 = c + unit;
896 rainj.type = CHARTAB_RANGE_CHAR;
898 for (; c < c1 && retval == 0; c++)
900 Lisp_Object ret = get_char_id_table (root, c);
905 retval = (fn) (&rainj, ret, arg);
909 ct->property[i] = Qunbound;
913 else if (!UNBOUNDP (v))
915 struct chartab_range rainj;
916 Emchar c1 = c + unit;
918 rainj.type = CHARTAB_RANGE_CHAR;
920 for (; c < c1 && retval == 0; c++)
923 retval = (fn) (&rainj, v, arg);
934 save_byte_table (Lisp_Byte_Table *ct, Lisp_Char_Table* root,
936 CHISE_Feature feature,
940 Emchar ofs, int place,
941 Lisp_Object (*filter)(Lisp_Object value))
945 int unit = 1 << (8 * place);
948 for (i = 0, retval = 0; i < 256 && retval == 0; i++)
951 if (UINT8_BYTE_TABLE_P (v))
953 save_uint8_byte_table (XUINT8_BYTE_TABLE(v), root,
959 c, place - 1, filter);
962 else if (UINT16_BYTE_TABLE_P (v))
964 save_uint16_byte_table (XUINT16_BYTE_TABLE(v), root,
970 c, place - 1, filter);
973 else if (BYTE_TABLE_P (v))
975 save_byte_table (XBYTE_TABLE(v), root,
981 c, place - 1, filter);
984 else if (EQ (v, Qunloaded))
988 else if (!UNBOUNDP (v))
990 struct chartab_range rainj;
991 Emchar c1 = c + unit;
996 rainj.type = CHARTAB_RANGE_CHAR;
998 for (; c < c1 && retval == 0; c++)
1000 #ifdef HAVE_LIBCHISE
1001 chise_char_set_feature_value
1002 (c, feature, XSTRING_DATA (Fprin1_to_string (v, Qnil)));
1004 Fput_database (Fprin1_to_string (make_char (c), Qnil),
1005 Fprin1_to_string (v, Qnil),
1017 get_byte_table (Lisp_Object table, unsigned char idx)
1019 if (UINT8_BYTE_TABLE_P (table))
1020 return UINT8_DECODE (XUINT8_BYTE_TABLE(table)->property[idx]);
1021 else if (UINT16_BYTE_TABLE_P (table))
1022 return UINT16_DECODE (XUINT16_BYTE_TABLE(table)->property[idx]);
1023 else if (BYTE_TABLE_P (table))
1024 return XBYTE_TABLE(table)->property[idx];
1030 put_byte_table (Lisp_Object table, unsigned char idx, Lisp_Object value)
1032 if (UINT8_BYTE_TABLE_P (table))
1034 if (UINT8_VALUE_P (value))
1036 XUINT8_BYTE_TABLE(table)->property[idx] = UINT8_ENCODE (value);
1037 if (!UINT8_BYTE_TABLE_P (value) &&
1038 !UINT16_BYTE_TABLE_P (value) && !BYTE_TABLE_P (value)
1039 && uint8_byte_table_same_value_p (table))
1044 else if (UINT16_VALUE_P (value))
1046 Lisp_Object new = expand_uint8_byte_table_to_uint16 (table);
1048 XUINT16_BYTE_TABLE(new)->property[idx] = UINT16_ENCODE (value);
1053 Lisp_Object new = make_byte_table (Qnil);
1056 for (i = 0; i < 256; i++)
1058 XBYTE_TABLE(new)->property[i]
1059 = UINT8_DECODE (XUINT8_BYTE_TABLE(table)->property[i]);
1061 XBYTE_TABLE(new)->property[idx] = value;
1065 else if (UINT16_BYTE_TABLE_P (table))
1067 if (UINT16_VALUE_P (value))
1069 XUINT16_BYTE_TABLE(table)->property[idx] = UINT16_ENCODE (value);
1070 if (!UINT8_BYTE_TABLE_P (value) &&
1071 !UINT16_BYTE_TABLE_P (value) && !BYTE_TABLE_P (value)
1072 && uint16_byte_table_same_value_p (table))
1079 Lisp_Object new = make_byte_table (Qnil);
1082 for (i = 0; i < 256; i++)
1084 XBYTE_TABLE(new)->property[i]
1085 = UINT16_DECODE (XUINT16_BYTE_TABLE(table)->property[i]);
1087 XBYTE_TABLE(new)->property[idx] = value;
1091 else if (BYTE_TABLE_P (table))
1093 XBYTE_TABLE(table)->property[idx] = value;
1094 if (!UINT8_BYTE_TABLE_P (value) &&
1095 !UINT16_BYTE_TABLE_P (value) && !BYTE_TABLE_P (value)
1096 && byte_table_same_value_p (table))
1101 else if (!internal_equal (table, value, 0))
1103 if (UINT8_VALUE_P (table) && UINT8_VALUE_P (value))
1105 table = make_uint8_byte_table (UINT8_ENCODE (table));
1106 XUINT8_BYTE_TABLE(table)->property[idx] = UINT8_ENCODE (value);
1108 else if (UINT16_VALUE_P (table) && UINT16_VALUE_P (value))
1110 table = make_uint16_byte_table (UINT16_ENCODE (table));
1111 XUINT16_BYTE_TABLE(table)->property[idx] = UINT16_ENCODE (value);
1115 table = make_byte_table (table);
1116 XBYTE_TABLE(table)->property[idx] = value;
1124 make_char_id_table (Lisp_Object initval)
1127 obj = Fmake_char_table (Qgeneric);
1128 fill_char_table (XCHAR_TABLE (obj), initval);
1133 #if defined(HAVE_CHISE) && !defined(HAVE_LIBCHISE_LIBCHISE)
1134 Lisp_Object Qsystem_char_id;
1137 Lisp_Object Qcomposition;
1138 Lisp_Object Q_decomposition;
1139 Lisp_Object Q_identical;
1140 Lisp_Object Q_identical_from;
1141 Lisp_Object Q_denotational;
1142 Lisp_Object Q_denotational_from;
1143 Lisp_Object Q_subsumptive;
1144 Lisp_Object Q_subsumptive_from;
1145 Lisp_Object Q_component;
1146 Lisp_Object Q_component_of;
1147 Lisp_Object Qto_ucs;
1148 Lisp_Object Q_ucs_unified;
1149 Lisp_Object Qcompat;
1150 Lisp_Object Qisolated;
1151 Lisp_Object Qinitial;
1152 Lisp_Object Qmedial;
1154 Lisp_Object Qvertical;
1155 Lisp_Object QnoBreak;
1156 Lisp_Object Qfraction;
1159 Lisp_Object Qcircle;
1160 Lisp_Object Qsquare;
1162 Lisp_Object Qnarrow;
1166 Emchar to_char_id (Lisp_Object v, char* err_msg, Lisp_Object err_arg);
1169 to_char_id (Lisp_Object v, char* err_msg, Lisp_Object err_arg)
1175 else if (EQ (v, Qcompat))
1177 else if (EQ (v, Qisolated))
1179 else if (EQ (v, Qinitial))
1181 else if (EQ (v, Qmedial))
1183 else if (EQ (v, Qfinal))
1185 else if (EQ (v, Qvertical))
1187 else if (EQ (v, QnoBreak))
1189 else if (EQ (v, Qfraction))
1191 else if (EQ (v, Qsuper))
1193 else if (EQ (v, Qsub))
1195 else if (EQ (v, Qcircle))
1197 else if (EQ (v, Qsquare))
1199 else if (EQ (v, Qwide))
1201 else if (EQ (v, Qnarrow))
1203 else if (EQ (v, Qsmall))
1205 else if (EQ (v, Qfont))
1208 signal_simple_error (err_msg, err_arg);
1211 DEFUN ("get-composite-char", Fget_composite_char, 1, 1, 0, /*
1212 Return character corresponding with list.
1216 Lisp_Object base, modifier;
1220 signal_simple_error ("Invalid value for composition", list);
1223 while (!NILP (rest))
1228 signal_simple_error ("Invalid value for composition", list);
1229 modifier = Fcar (rest);
1231 base = Fcdr (Fassq (modifier,
1232 Fchar_feature (base, Qcomposition, Qnil,
1238 DEFUN ("char-variants", Fchar_variants, 1, 1, 0, /*
1239 Return variants of CHARACTER.
1245 CHECK_CHAR (character);
1246 ret = Fchar_feature (character, Q_ucs_unified, Qnil,
1249 return Fcopy_list (ret);
1257 /* A char table maps from ranges of characters to values.
1259 Implementing a general data structure that maps from arbitrary
1260 ranges of numbers to values is tricky to do efficiently. As it
1261 happens, it should suffice (and is usually more convenient, anyway)
1262 when dealing with characters to restrict the sorts of ranges that
1263 can be assigned values, as follows:
1266 2) All characters in a charset.
1267 3) All characters in a particular row of a charset, where a "row"
1268 means all characters with the same first byte.
1269 4) A particular character in a charset.
1271 We use char tables to generalize the 256-element vectors now
1272 littering the Emacs code.
1274 Possible uses (all should be converted at some point):
1280 5) keyboard-translate-table?
1283 abstract type to generalize the Emacs vectors and Mule
1284 vectors-of-vectors goo.
1287 /************************************************************************/
1288 /* Char Table object */
1289 /************************************************************************/
1291 #if defined(MULE)&&!defined(UTF2000)
1294 mark_char_table_entry (Lisp_Object obj)
1296 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj);
1299 for (i = 0; i < 96; i++)
1301 mark_object (cte->level2[i]);
1307 char_table_entry_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
1309 Lisp_Char_Table_Entry *cte1 = XCHAR_TABLE_ENTRY (obj1);
1310 Lisp_Char_Table_Entry *cte2 = XCHAR_TABLE_ENTRY (obj2);
1313 for (i = 0; i < 96; i++)
1314 if (!internal_equal (cte1->level2[i], cte2->level2[i], depth + 1))
1320 static unsigned long
1321 char_table_entry_hash (Lisp_Object obj, int depth)
1323 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj);
1325 return internal_array_hash (cte->level2, 96, depth);
1328 static const struct lrecord_description char_table_entry_description[] = {
1329 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table_Entry, level2), 96 },
1333 DEFINE_LRECORD_IMPLEMENTATION ("char-table-entry", char_table_entry,
1334 mark_char_table_entry, internal_object_printer,
1335 0, char_table_entry_equal,
1336 char_table_entry_hash,
1337 char_table_entry_description,
1338 Lisp_Char_Table_Entry);
1342 mark_char_table (Lisp_Object obj)
1344 Lisp_Char_Table *ct = XCHAR_TABLE (obj);
1347 mark_object (ct->table);
1348 mark_object (ct->name);
1349 #ifndef HAVE_LIBCHISE
1350 mark_object (ct->db);
1355 for (i = 0; i < NUM_ASCII_CHARS; i++)
1356 mark_object (ct->ascii[i]);
1358 for (i = 0; i < NUM_LEADING_BYTES; i++)
1359 mark_object (ct->level1[i]);
1363 return ct->default_value;
1365 return ct->mirror_table;
1369 /* WARNING: All functions of this nature need to be written extremely
1370 carefully to avoid crashes during GC. Cf. prune_specifiers()
1371 and prune_weak_hash_tables(). */
1374 prune_syntax_tables (void)
1376 Lisp_Object rest, prev = Qnil;
1378 for (rest = Vall_syntax_tables;
1380 rest = XCHAR_TABLE (rest)->next_table)
1382 if (! marked_p (rest))
1384 /* This table is garbage. Remove it from the list. */
1386 Vall_syntax_tables = XCHAR_TABLE (rest)->next_table;
1388 XCHAR_TABLE (prev)->next_table =
1389 XCHAR_TABLE (rest)->next_table;
1395 char_table_type_to_symbol (enum char_table_type type)
1400 case CHAR_TABLE_TYPE_GENERIC: return Qgeneric;
1401 case CHAR_TABLE_TYPE_SYNTAX: return Qsyntax;
1402 case CHAR_TABLE_TYPE_DISPLAY: return Qdisplay;
1403 case CHAR_TABLE_TYPE_CHAR: return Qchar;
1405 case CHAR_TABLE_TYPE_CATEGORY: return Qcategory;
1410 static enum char_table_type
1411 symbol_to_char_table_type (Lisp_Object symbol)
1413 CHECK_SYMBOL (symbol);
1415 if (EQ (symbol, Qgeneric)) return CHAR_TABLE_TYPE_GENERIC;
1416 if (EQ (symbol, Qsyntax)) return CHAR_TABLE_TYPE_SYNTAX;
1417 if (EQ (symbol, Qdisplay)) return CHAR_TABLE_TYPE_DISPLAY;
1418 if (EQ (symbol, Qchar)) return CHAR_TABLE_TYPE_CHAR;
1420 if (EQ (symbol, Qcategory)) return CHAR_TABLE_TYPE_CATEGORY;
1423 signal_simple_error ("Unrecognized char table type", symbol);
1424 return CHAR_TABLE_TYPE_GENERIC; /* not reached */
1429 print_chartab_range (Emchar first, Emchar last, Lisp_Object val,
1430 Lisp_Object printcharfun)
1434 write_c_string (" (", printcharfun);
1435 print_internal (make_char (first), printcharfun, 0);
1436 write_c_string (" ", printcharfun);
1437 print_internal (make_char (last), printcharfun, 0);
1438 write_c_string (") ", printcharfun);
1442 write_c_string (" ", printcharfun);
1443 print_internal (make_char (first), printcharfun, 0);
1444 write_c_string (" ", printcharfun);
1446 print_internal (val, printcharfun, 1);
1450 #if defined(MULE)&&!defined(UTF2000)
1453 print_chartab_charset_row (Lisp_Object charset,
1455 Lisp_Char_Table_Entry *cte,
1456 Lisp_Object printcharfun)
1459 Lisp_Object cat = Qunbound;
1462 for (i = 32; i < 128; i++)
1464 Lisp_Object pam = cte->level2[i - 32];
1476 print_chartab_range (MAKE_CHAR (charset, first, 0),
1477 MAKE_CHAR (charset, i - 1, 0),
1480 print_chartab_range (MAKE_CHAR (charset, row, first),
1481 MAKE_CHAR (charset, row, i - 1),
1491 print_chartab_range (MAKE_CHAR (charset, first, 0),
1492 MAKE_CHAR (charset, i - 1, 0),
1495 print_chartab_range (MAKE_CHAR (charset, row, first),
1496 MAKE_CHAR (charset, row, i - 1),
1502 print_chartab_two_byte_charset (Lisp_Object charset,
1503 Lisp_Char_Table_Entry *cte,
1504 Lisp_Object printcharfun)
1508 for (i = 32; i < 128; i++)
1510 Lisp_Object jen = cte->level2[i - 32];
1512 if (!CHAR_TABLE_ENTRYP (jen))
1516 write_c_string (" [", printcharfun);
1517 print_internal (XCHARSET_NAME (charset), printcharfun, 0);
1518 sprintf (buf, " %d] ", i);
1519 write_c_string (buf, printcharfun);
1520 print_internal (jen, printcharfun, 0);
1523 print_chartab_charset_row (charset, i, XCHAR_TABLE_ENTRY (jen),
1531 print_char_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1533 Lisp_Char_Table *ct = XCHAR_TABLE (obj);
1536 struct gcpro gcpro1, gcpro2;
1537 GCPRO2 (obj, printcharfun);
1539 write_c_string ("#s(char-table ", printcharfun);
1540 write_c_string (" ", printcharfun);
1541 write_c_string (string_data
1543 (XSYMBOL (char_table_type_to_symbol (ct->type)))),
1545 write_c_string ("\n ", printcharfun);
1546 print_internal (ct->default_value, printcharfun, escapeflag);
1547 for (i = 0; i < 256; i++)
1549 Lisp_Object elt = get_byte_table (ct->table, i);
1550 if (i != 0) write_c_string ("\n ", printcharfun);
1551 if (EQ (elt, Qunbound))
1552 write_c_string ("void", printcharfun);
1554 print_internal (elt, printcharfun, escapeflag);
1557 #else /* non UTF2000 */
1560 sprintf (buf, "#s(char-table type %s data (",
1561 string_data (symbol_name (XSYMBOL
1562 (char_table_type_to_symbol (ct->type)))));
1563 write_c_string (buf, printcharfun);
1565 /* Now write out the ASCII/Control-1 stuff. */
1569 Lisp_Object val = Qunbound;
1571 for (i = 0; i < NUM_ASCII_CHARS; i++)
1580 if (!EQ (ct->ascii[i], val))
1582 print_chartab_range (first, i - 1, val, printcharfun);
1589 print_chartab_range (first, i - 1, val, printcharfun);
1596 for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES;
1599 Lisp_Object ann = ct->level1[i - MIN_LEADING_BYTE];
1600 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (i);
1602 if (!CHARSETP (charset) || i == LEADING_BYTE_ASCII
1603 || i == LEADING_BYTE_CONTROL_1)
1605 if (!CHAR_TABLE_ENTRYP (ann))
1607 write_c_string (" ", printcharfun);
1608 print_internal (XCHARSET_NAME (charset),
1610 write_c_string (" ", printcharfun);
1611 print_internal (ann, printcharfun, 0);
1615 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (ann);
1616 if (XCHARSET_DIMENSION (charset) == 1)
1617 print_chartab_charset_row (charset, -1, cte, printcharfun);
1619 print_chartab_two_byte_charset (charset, cte, printcharfun);
1624 #endif /* non UTF2000 */
1626 write_c_string ("))", printcharfun);
1630 char_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
1632 Lisp_Char_Table *ct1 = XCHAR_TABLE (obj1);
1633 Lisp_Char_Table *ct2 = XCHAR_TABLE (obj2);
1636 if (CHAR_TABLE_TYPE (ct1) != CHAR_TABLE_TYPE (ct2))
1640 for (i = 0; i < 256; i++)
1642 if (!internal_equal (get_byte_table (ct1->table, i),
1643 get_byte_table (ct2->table, i), 0))
1647 for (i = 0; i < NUM_ASCII_CHARS; i++)
1648 if (!internal_equal (ct1->ascii[i], ct2->ascii[i], depth + 1))
1652 for (i = 0; i < NUM_LEADING_BYTES; i++)
1653 if (!internal_equal (ct1->level1[i], ct2->level1[i], depth + 1))
1656 #endif /* non UTF2000 */
1661 static unsigned long
1662 char_table_hash (Lisp_Object obj, int depth)
1664 Lisp_Char_Table *ct = XCHAR_TABLE (obj);
1666 return byte_table_hash (ct->table, depth + 1);
1668 unsigned long hashval = internal_array_hash (ct->ascii, NUM_ASCII_CHARS,
1671 hashval = HASH2 (hashval,
1672 internal_array_hash (ct->level1, NUM_LEADING_BYTES, depth));
1678 static const struct lrecord_description char_table_description[] = {
1680 { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, table) },
1681 { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, default_value) },
1682 { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, name) },
1683 #ifndef HAVE_LIBCHISE
1684 { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, db) },
1687 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, ascii), NUM_ASCII_CHARS },
1689 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, level1), NUM_LEADING_BYTES },
1693 { XD_LISP_OBJECT, offsetof (Lisp_Char_Table, mirror_table) },
1695 { XD_LO_LINK, offsetof (Lisp_Char_Table, next_table) },
1699 DEFINE_LRECORD_IMPLEMENTATION ("char-table", char_table,
1700 mark_char_table, print_char_table, 0,
1701 char_table_equal, char_table_hash,
1702 char_table_description,
1705 DEFUN ("char-table-p", Fchar_table_p, 1, 1, 0, /*
1706 Return non-nil if OBJECT is a char table.
1708 A char table is a table that maps characters (or ranges of characters)
1709 to values. Char tables are specialized for characters, only allowing
1710 particular sorts of ranges to be assigned values. Although this
1711 loses in generality, it makes for extremely fast (constant-time)
1712 lookups, and thus is feasible for applications that do an extremely
1713 large number of lookups (e.g. scanning a buffer for a character in
1714 a particular syntax, where a lookup in the syntax table must occur
1715 once per character).
1717 When Mule support exists, the types of ranges that can be assigned
1721 -- an entire charset
1722 -- a single row in a two-octet charset
1723 -- a single character
1725 When Mule support is not present, the types of ranges that can be
1729 -- a single character
1731 To create a char table, use `make-char-table'.
1732 To modify a char table, use `put-char-table' or `remove-char-table'.
1733 To retrieve the value for a particular character, use `get-char-table'.
1734 See also `map-char-table', `clear-char-table', `copy-char-table',
1735 `valid-char-table-type-p', `char-table-type-list',
1736 `valid-char-table-value-p', and `check-char-table-value'.
1740 return CHAR_TABLEP (object) ? Qt : Qnil;
1743 DEFUN ("char-table-type-list", Fchar_table_type_list, 0, 0, 0, /*
1744 Return a list of the recognized char table types.
1745 See `valid-char-table-type-p'.
1750 return list5 (Qchar, Qcategory, Qdisplay, Qgeneric, Qsyntax);
1752 return list4 (Qchar, Qdisplay, Qgeneric, Qsyntax);
1756 DEFUN ("valid-char-table-type-p", Fvalid_char_table_type_p, 1, 1, 0, /*
1757 Return t if TYPE if a recognized char table type.
1759 Each char table type is used for a different purpose and allows different
1760 sorts of values. The different char table types are
1763 Used for category tables, which specify the regexp categories
1764 that a character is in. The valid values are nil or a
1765 bit vector of 95 elements. Higher-level Lisp functions are
1766 provided for working with category tables. Currently categories
1767 and category tables only exist when Mule support is present.
1769 A generalized char table, for mapping from one character to
1770 another. Used for case tables, syntax matching tables,
1771 `keyboard-translate-table', etc. The valid values are characters.
1773 An even more generalized char table, for mapping from a
1774 character to anything.
1776 Used for display tables, which specify how a particular character
1777 is to appear when displayed. #### Not yet implemented.
1779 Used for syntax tables, which specify the syntax of a particular
1780 character. Higher-level Lisp functions are provided for
1781 working with syntax tables. The valid values are integers.
1786 return (EQ (type, Qchar) ||
1788 EQ (type, Qcategory) ||
1790 EQ (type, Qdisplay) ||
1791 EQ (type, Qgeneric) ||
1792 EQ (type, Qsyntax)) ? Qt : Qnil;
1795 DEFUN ("char-table-type", Fchar_table_type, 1, 1, 0, /*
1796 Return the type of CHAR-TABLE.
1797 See `valid-char-table-type-p'.
1801 CHECK_CHAR_TABLE (char_table);
1802 return char_table_type_to_symbol (XCHAR_TABLE (char_table)->type);
1806 fill_char_table (Lisp_Char_Table *ct, Lisp_Object value)
1809 ct->table = Qunbound;
1810 ct->default_value = value;
1815 for (i = 0; i < NUM_ASCII_CHARS; i++)
1816 ct->ascii[i] = value;
1818 for (i = 0; i < NUM_LEADING_BYTES; i++)
1819 ct->level1[i] = value;
1824 if (ct->type == CHAR_TABLE_TYPE_SYNTAX)
1825 update_syntax_table (ct);
1829 DEFUN ("reset-char-table", Freset_char_table, 1, 1, 0, /*
1830 Reset CHAR-TABLE to its default state.
1834 Lisp_Char_Table *ct;
1836 CHECK_CHAR_TABLE (char_table);
1837 ct = XCHAR_TABLE (char_table);
1841 case CHAR_TABLE_TYPE_CHAR:
1842 fill_char_table (ct, make_char (0));
1844 case CHAR_TABLE_TYPE_DISPLAY:
1845 case CHAR_TABLE_TYPE_GENERIC:
1847 case CHAR_TABLE_TYPE_CATEGORY:
1849 fill_char_table (ct, Qnil);
1852 case CHAR_TABLE_TYPE_SYNTAX:
1853 fill_char_table (ct, make_int (Sinherit));
1863 DEFUN ("make-char-table", Fmake_char_table, 1, 1, 0, /*
1864 Return a new, empty char table of type TYPE.
1865 Currently recognized types are 'char, 'category, 'display, 'generic,
1866 and 'syntax. See `valid-char-table-type-p'.
1870 Lisp_Char_Table *ct;
1872 enum char_table_type ty = symbol_to_char_table_type (type);
1874 ct = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table);
1877 if (ty == CHAR_TABLE_TYPE_SYNTAX)
1879 ct->mirror_table = Fmake_char_table (Qgeneric);
1880 fill_char_table (XCHAR_TABLE (ct->mirror_table),
1884 ct->mirror_table = Qnil;
1887 #ifndef HAVE_LIBCHISE
1891 ct->next_table = Qnil;
1892 XSETCHAR_TABLE (obj, ct);
1893 if (ty == CHAR_TABLE_TYPE_SYNTAX)
1895 ct->next_table = Vall_syntax_tables;
1896 Vall_syntax_tables = obj;
1898 Freset_char_table (obj);
1902 #if defined(MULE)&&!defined(UTF2000)
1905 make_char_table_entry (Lisp_Object initval)
1909 Lisp_Char_Table_Entry *cte =
1910 alloc_lcrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry);
1912 for (i = 0; i < 96; i++)
1913 cte->level2[i] = initval;
1915 XSETCHAR_TABLE_ENTRY (obj, cte);
1920 copy_char_table_entry (Lisp_Object entry)
1922 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (entry);
1925 Lisp_Char_Table_Entry *ctenew =
1926 alloc_lcrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry);
1928 for (i = 0; i < 96; i++)
1930 Lisp_Object new = cte->level2[i];
1931 if (CHAR_TABLE_ENTRYP (new))
1932 ctenew->level2[i] = copy_char_table_entry (new);
1934 ctenew->level2[i] = new;
1937 XSETCHAR_TABLE_ENTRY (obj, ctenew);
1943 DEFUN ("copy-char-table", Fcopy_char_table, 1, 1, 0, /*
1944 Return a new char table which is a copy of CHAR-TABLE.
1945 It will contain the same values for the same characters and ranges
1946 as CHAR-TABLE. The values will not themselves be copied.
1950 Lisp_Char_Table *ct, *ctnew;
1956 CHECK_CHAR_TABLE (char_table);
1957 ct = XCHAR_TABLE (char_table);
1958 ctnew = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table);
1959 ctnew->type = ct->type;
1961 ctnew->default_value = ct->default_value;
1962 /* [tomo:2002-01-21] Perhaps this code seems wrong */
1963 ctnew->name = ct->name;
1964 #ifndef HAVE_LIBCHISE
1968 if (UINT8_BYTE_TABLE_P (ct->table))
1970 ctnew->table = copy_uint8_byte_table (ct->table);
1972 else if (UINT16_BYTE_TABLE_P (ct->table))
1974 ctnew->table = copy_uint16_byte_table (ct->table);
1976 else if (BYTE_TABLE_P (ct->table))
1978 ctnew->table = copy_byte_table (ct->table);
1980 else if (!UNBOUNDP (ct->table))
1981 ctnew->table = ct->table;
1982 #else /* non UTF2000 */
1984 for (i = 0; i < NUM_ASCII_CHARS; i++)
1986 Lisp_Object new = ct->ascii[i];
1988 assert (! (CHAR_TABLE_ENTRYP (new)));
1990 ctnew->ascii[i] = new;
1995 for (i = 0; i < NUM_LEADING_BYTES; i++)
1997 Lisp_Object new = ct->level1[i];
1998 if (CHAR_TABLE_ENTRYP (new))
1999 ctnew->level1[i] = copy_char_table_entry (new);
2001 ctnew->level1[i] = new;
2005 #endif /* non UTF2000 */
2008 if (CHAR_TABLEP (ct->mirror_table))
2009 ctnew->mirror_table = Fcopy_char_table (ct->mirror_table);
2011 ctnew->mirror_table = ct->mirror_table;
2013 ctnew->next_table = Qnil;
2014 XSETCHAR_TABLE (obj, ctnew);
2015 if (ctnew->type == CHAR_TABLE_TYPE_SYNTAX)
2017 ctnew->next_table = Vall_syntax_tables;
2018 Vall_syntax_tables = obj;
2023 INLINE_HEADER int XCHARSET_CELL_RANGE (Lisp_Object ccs);
2025 XCHARSET_CELL_RANGE (Lisp_Object ccs)
2027 switch (XCHARSET_CHARS (ccs))
2030 return (33 << 8) | 126;
2032 return (32 << 8) | 127;
2035 return (0 << 8) | 127;
2037 return (0 << 8) | 255;
2049 decode_char_table_range (Lisp_Object range, struct chartab_range *outrange)
2052 outrange->type = CHARTAB_RANGE_ALL;
2054 else if (EQ (range, Qnil))
2055 outrange->type = CHARTAB_RANGE_DEFAULT;
2057 else if (CHAR_OR_CHAR_INTP (range))
2059 outrange->type = CHARTAB_RANGE_CHAR;
2060 outrange->ch = XCHAR_OR_CHAR_INT (range);
2064 signal_simple_error ("Range must be t or a character", range);
2066 else if (VECTORP (range))
2068 Lisp_Vector *vec = XVECTOR (range);
2069 Lisp_Object *elts = vector_data (vec);
2070 int cell_min, cell_max;
2072 outrange->type = CHARTAB_RANGE_ROW;
2073 outrange->charset = Fget_charset (elts[0]);
2074 CHECK_INT (elts[1]);
2075 outrange->row = XINT (elts[1]);
2076 if (XCHARSET_DIMENSION (outrange->charset) < 2)
2077 signal_simple_error ("Charset in row vector must be multi-byte",
2081 int ret = XCHARSET_CELL_RANGE (outrange->charset);
2083 cell_min = ret >> 8;
2084 cell_max = ret & 0xFF;
2086 if (XCHARSET_DIMENSION (outrange->charset) == 2)
2087 check_int_range (outrange->row, cell_min, cell_max);
2089 else if (XCHARSET_DIMENSION (outrange->charset) == 3)
2091 check_int_range (outrange->row >> 8 , cell_min, cell_max);
2092 check_int_range (outrange->row & 0xFF, cell_min, cell_max);
2094 else if (XCHARSET_DIMENSION (outrange->charset) == 4)
2096 check_int_range ( outrange->row >> 16 , cell_min, cell_max);
2097 check_int_range ((outrange->row >> 8) & 0xFF, cell_min, cell_max);
2098 check_int_range ( outrange->row & 0xFF, cell_min, cell_max);
2106 if (!CHARSETP (range) && !SYMBOLP (range))
2108 ("Char table range must be t, charset, char, or vector", range);
2109 outrange->type = CHARTAB_RANGE_CHARSET;
2110 outrange->charset = Fget_charset (range);
2115 #if defined(MULE)&&!defined(UTF2000)
2117 /* called from CHAR_TABLE_VALUE(). */
2119 get_non_ascii_char_table_value (Lisp_Char_Table *ct, Charset_ID leading_byte,
2124 Lisp_Object charset;
2126 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (leading_byte);
2131 BREAKUP_CHAR (c, charset, byte1, byte2);
2133 BREAKUP_CHAR_1_UNSAFE (c, charset, byte1, byte2);
2135 val = ct->level1[leading_byte - MIN_LEADING_BYTE];
2136 if (CHAR_TABLE_ENTRYP (val))
2138 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
2139 val = cte->level2[byte1 - 32];
2140 if (CHAR_TABLE_ENTRYP (val))
2142 cte = XCHAR_TABLE_ENTRY (val);
2143 assert (byte2 >= 32);
2144 val = cte->level2[byte2 - 32];
2145 assert (!CHAR_TABLE_ENTRYP (val));
2155 get_char_table (Emchar ch, Lisp_Char_Table *ct)
2159 Lisp_Object ret = get_char_id_table (ct, ch);
2164 if (EQ (CHAR_TABLE_NAME (ct), Qdowncase))
2165 ret = Fchar_feature (make_char (ch), Q_lowercase, Qnil,
2167 else if (EQ (CHAR_TABLE_NAME (ct), Qflippedcase))
2168 ret = Fchar_feature (make_char (ch), Q_uppercase, Qnil,
2174 ret = Ffind_char (ret);
2182 Lisp_Object charset;
2186 BREAKUP_CHAR (ch, charset, byte1, byte2);
2188 if (EQ (charset, Vcharset_ascii))
2189 val = ct->ascii[byte1];
2190 else if (EQ (charset, Vcharset_control_1))
2191 val = ct->ascii[byte1 + 128];
2194 int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE;
2195 val = ct->level1[lb];
2196 if (CHAR_TABLE_ENTRYP (val))
2198 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
2199 val = cte->level2[byte1 - 32];
2200 if (CHAR_TABLE_ENTRYP (val))
2202 cte = XCHAR_TABLE_ENTRY (val);
2203 assert (byte2 >= 32);
2204 val = cte->level2[byte2 - 32];
2205 assert (!CHAR_TABLE_ENTRYP (val));
2212 #else /* not MULE */
2213 return ct->ascii[(unsigned char)ch];
2214 #endif /* not MULE */
2218 DEFUN ("get-char-table", Fget_char_table, 2, 2, 0, /*
2219 Find value for CHARACTER in CHAR-TABLE.
2221 (character, char_table))
2223 CHECK_CHAR_TABLE (char_table);
2224 CHECK_CHAR_COERCE_INT (character);
2226 return get_char_table (XCHAR (character), XCHAR_TABLE (char_table));
2229 DEFUN ("get-range-char-table", Fget_range_char_table, 2, 3, 0, /*
2230 Find value for a range in CHAR-TABLE.
2231 If there is more than one value, return MULTI (defaults to nil).
2233 (range, char_table, multi))
2235 Lisp_Char_Table *ct;
2236 struct chartab_range rainj;
2238 if (CHAR_OR_CHAR_INTP (range))
2239 return Fget_char_table (range, char_table);
2240 CHECK_CHAR_TABLE (char_table);
2241 ct = XCHAR_TABLE (char_table);
2243 decode_char_table_range (range, &rainj);
2246 case CHARTAB_RANGE_ALL:
2249 if (UINT8_BYTE_TABLE_P (ct->table))
2251 else if (UINT16_BYTE_TABLE_P (ct->table))
2253 else if (BYTE_TABLE_P (ct->table))
2257 #else /* non UTF2000 */
2259 Lisp_Object first = ct->ascii[0];
2261 for (i = 1; i < NUM_ASCII_CHARS; i++)
2262 if (!EQ (first, ct->ascii[i]))
2266 for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES;
2269 if (!CHARSETP (CHARSET_BY_LEADING_BYTE (i))
2270 || i == LEADING_BYTE_ASCII
2271 || i == LEADING_BYTE_CONTROL_1)
2273 if (!EQ (first, ct->level1[i - MIN_LEADING_BYTE]))
2279 #endif /* non UTF2000 */
2283 case CHARTAB_RANGE_CHARSET:
2287 if (EQ (rainj.charset, Vcharset_ascii))
2290 Lisp_Object first = ct->ascii[0];
2292 for (i = 1; i < 128; i++)
2293 if (!EQ (first, ct->ascii[i]))
2298 if (EQ (rainj.charset, Vcharset_control_1))
2301 Lisp_Object first = ct->ascii[128];
2303 for (i = 129; i < 160; i++)
2304 if (!EQ (first, ct->ascii[i]))
2310 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (rainj.charset) -
2312 if (CHAR_TABLE_ENTRYP (val))
2318 case CHARTAB_RANGE_ROW:
2323 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (rainj.charset) -
2325 if (!CHAR_TABLE_ENTRYP (val))
2327 val = XCHAR_TABLE_ENTRY (val)->level2[rainj.row - 32];
2328 if (CHAR_TABLE_ENTRYP (val))
2332 #endif /* not UTF2000 */
2333 #endif /* not MULE */
2339 return Qnil; /* not reached */
2343 check_valid_char_table_value (Lisp_Object value, enum char_table_type type,
2344 Error_behavior errb)
2348 case CHAR_TABLE_TYPE_SYNTAX:
2349 if (!ERRB_EQ (errb, ERROR_ME))
2350 return INTP (value) || (CONSP (value) && INTP (XCAR (value))
2351 && CHAR_OR_CHAR_INTP (XCDR (value)));
2354 Lisp_Object cdr = XCDR (value);
2355 CHECK_INT (XCAR (value));
2356 CHECK_CHAR_COERCE_INT (cdr);
2363 case CHAR_TABLE_TYPE_CATEGORY:
2364 if (!ERRB_EQ (errb, ERROR_ME))
2365 return CATEGORY_TABLE_VALUEP (value);
2366 CHECK_CATEGORY_TABLE_VALUE (value);
2370 case CHAR_TABLE_TYPE_GENERIC:
2373 case CHAR_TABLE_TYPE_DISPLAY:
2375 maybe_signal_simple_error ("Display char tables not yet implemented",
2376 value, Qchar_table, errb);
2379 case CHAR_TABLE_TYPE_CHAR:
2380 if (!ERRB_EQ (errb, ERROR_ME))
2381 return CHAR_OR_CHAR_INTP (value);
2382 CHECK_CHAR_COERCE_INT (value);
2389 return 0; /* not reached */
2393 canonicalize_char_table_value (Lisp_Object value, enum char_table_type type)
2397 case CHAR_TABLE_TYPE_SYNTAX:
2400 Lisp_Object car = XCAR (value);
2401 Lisp_Object cdr = XCDR (value);
2402 CHECK_CHAR_COERCE_INT (cdr);
2403 return Fcons (car, cdr);
2406 case CHAR_TABLE_TYPE_CHAR:
2407 CHECK_CHAR_COERCE_INT (value);
2415 DEFUN ("valid-char-table-value-p", Fvalid_char_table_value_p, 2, 2, 0, /*
2416 Return non-nil if VALUE is a valid value for CHAR-TABLE-TYPE.
2418 (value, char_table_type))
2420 enum char_table_type type = symbol_to_char_table_type (char_table_type);
2422 return check_valid_char_table_value (value, type, ERROR_ME_NOT) ? Qt : Qnil;
2425 DEFUN ("check-valid-char-table-value", Fcheck_valid_char_table_value, 2, 2, 0, /*
2426 Signal an error if VALUE is not a valid value for CHAR-TABLE-TYPE.
2428 (value, char_table_type))
2430 enum char_table_type type = symbol_to_char_table_type (char_table_type);
2432 check_valid_char_table_value (value, type, ERROR_ME);
2437 Lisp_Char_Table* char_attribute_table_to_put;
2438 Lisp_Object Qput_char_table_map_function;
2439 Lisp_Object value_to_put;
2441 DEFUN ("put-char-table-map-function",
2442 Fput_char_table_map_function, 2, 2, 0, /*
2443 For internal use. Don't use it.
2447 put_char_id_table_0 (char_attribute_table_to_put,
2448 XCHAR (c), value_to_put);
2453 /* Assign VAL to all characters in RANGE in char table CT. */
2456 put_char_table (Lisp_Char_Table *ct, struct chartab_range *range,
2459 switch (range->type)
2461 case CHARTAB_RANGE_ALL:
2462 fill_char_table (ct, val);
2463 return; /* avoid the duplicate call to update_syntax_table() below,
2464 since fill_char_table() also did that. */
2467 case CHARTAB_RANGE_DEFAULT:
2468 ct->default_value = val;
2473 case CHARTAB_RANGE_CHARSET:
2476 Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (range->charset);
2478 if ( CHAR_TABLEP (encoding_table) )
2480 Lisp_Object mother = XCHARSET_MOTHER (range->charset);
2482 char_attribute_table_to_put = ct;
2484 Fmap_char_attribute (Qput_char_table_map_function,
2485 XCHAR_TABLE_NAME (encoding_table),
2487 if ( CHARSETP (mother) )
2489 struct chartab_range r;
2491 r.type = CHARTAB_RANGE_CHARSET;
2493 put_char_table (ct, &r, val);
2501 for (c = 0; c < 1 << 24; c++)
2503 if ( charset_code_point (range->charset, c) >= 0 )
2504 put_char_id_table_0 (ct, c, val);
2510 if (EQ (range->charset, Vcharset_ascii))
2513 for (i = 0; i < 128; i++)
2516 else if (EQ (range->charset, Vcharset_control_1))
2519 for (i = 128; i < 160; i++)
2524 int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE;
2525 ct->level1[lb] = val;
2530 case CHARTAB_RANGE_ROW:
2533 int cell_min, cell_max, i;
2535 i = XCHARSET_CELL_RANGE (range->charset);
2537 cell_max = i & 0xFF;
2538 for (i = cell_min; i <= cell_max; i++)
2541 = DECODE_CHAR (range->charset, (range->row << 8) | i, 0);
2543 if ( charset_code_point (range->charset, ch, 0) >= 0 )
2544 put_char_id_table_0 (ct, ch, val);
2549 Lisp_Char_Table_Entry *cte;
2550 int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE;
2551 /* make sure that there is a separate entry for the row. */
2552 if (!CHAR_TABLE_ENTRYP (ct->level1[lb]))
2553 ct->level1[lb] = make_char_table_entry (ct->level1[lb]);
2554 cte = XCHAR_TABLE_ENTRY (ct->level1[lb]);
2555 cte->level2[range->row - 32] = val;
2557 #endif /* not UTF2000 */
2561 case CHARTAB_RANGE_CHAR:
2563 put_char_id_table_0 (ct, range->ch, val);
2567 Lisp_Object charset;
2570 BREAKUP_CHAR (range->ch, charset, byte1, byte2);
2571 if (EQ (charset, Vcharset_ascii))
2572 ct->ascii[byte1] = val;
2573 else if (EQ (charset, Vcharset_control_1))
2574 ct->ascii[byte1 + 128] = val;
2577 Lisp_Char_Table_Entry *cte;
2578 int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE;
2579 /* make sure that there is a separate entry for the row. */
2580 if (!CHAR_TABLE_ENTRYP (ct->level1[lb]))
2581 ct->level1[lb] = make_char_table_entry (ct->level1[lb]);
2582 cte = XCHAR_TABLE_ENTRY (ct->level1[lb]);
2583 /* now CTE is a char table entry for the charset;
2584 each entry is for a single row (or character of
2585 a one-octet charset). */
2586 if (XCHARSET_DIMENSION (charset) == 1)
2587 cte->level2[byte1 - 32] = val;
2590 /* assigning to one character in a two-octet charset. */
2591 /* make sure that the charset row contains a separate
2592 entry for each character. */
2593 if (!CHAR_TABLE_ENTRYP (cte->level2[byte1 - 32]))
2594 cte->level2[byte1 - 32] =
2595 make_char_table_entry (cte->level2[byte1 - 32]);
2596 cte = XCHAR_TABLE_ENTRY (cte->level2[byte1 - 32]);
2597 cte->level2[byte2 - 32] = val;
2601 #else /* not MULE */
2602 ct->ascii[(unsigned char) (range->ch)] = val;
2604 #endif /* not MULE */
2608 if (ct->type == CHAR_TABLE_TYPE_SYNTAX)
2609 update_syntax_table (ct);
2613 DEFUN ("put-char-table", Fput_char_table, 3, 3, 0, /*
2614 Set the value for chars in RANGE to be VALUE in CHAR-TABLE.
2616 RANGE specifies one or more characters to be affected and should be
2617 one of the following:
2619 -- t (all characters are affected)
2620 -- A charset (only allowed when Mule support is present)
2621 -- A vector of two elements: a two-octet charset and a row number
2622 (only allowed when Mule support is present)
2623 -- A single character
2625 VALUE must be a value appropriate for the type of CHAR-TABLE.
2626 See `valid-char-table-type-p'.
2628 (range, value, char_table))
2630 Lisp_Char_Table *ct;
2631 struct chartab_range rainj;
2633 CHECK_CHAR_TABLE (char_table);
2634 ct = XCHAR_TABLE (char_table);
2635 check_valid_char_table_value (value, ct->type, ERROR_ME);
2636 decode_char_table_range (range, &rainj);
2637 value = canonicalize_char_table_value (value, ct->type);
2638 put_char_table (ct, &rainj, value);
2643 /* Map FN over the ASCII chars in CT. */
2646 map_over_charset_ascii (Lisp_Char_Table *ct,
2647 int (*fn) (struct chartab_range *range,
2648 Lisp_Object val, void *arg),
2651 struct chartab_range rainj;
2660 rainj.type = CHARTAB_RANGE_CHAR;
2662 for (i = start, retval = 0; i < stop && retval == 0; i++)
2664 rainj.ch = (Emchar) i;
2665 retval = (fn) (&rainj, ct->ascii[i], arg);
2673 /* Map FN over the Control-1 chars in CT. */
2676 map_over_charset_control_1 (Lisp_Char_Table *ct,
2677 int (*fn) (struct chartab_range *range,
2678 Lisp_Object val, void *arg),
2681 struct chartab_range rainj;
2684 int stop = start + 32;
2686 rainj.type = CHARTAB_RANGE_CHAR;
2688 for (i = start, retval = 0; i < stop && retval == 0; i++)
2690 rainj.ch = (Emchar) (i);
2691 retval = (fn) (&rainj, ct->ascii[i], arg);
2697 /* Map FN over the row ROW of two-byte charset CHARSET.
2698 There must be a separate value for that row in the char table.
2699 CTE specifies the char table entry for CHARSET. */
2702 map_over_charset_row (Lisp_Char_Table_Entry *cte,
2703 Lisp_Object charset, int row,
2704 int (*fn) (struct chartab_range *range,
2705 Lisp_Object val, void *arg),
2708 Lisp_Object val = cte->level2[row - 32];
2710 if (!CHAR_TABLE_ENTRYP (val))
2712 struct chartab_range rainj;
2714 rainj.type = CHARTAB_RANGE_ROW;
2715 rainj.charset = charset;
2717 return (fn) (&rainj, val, arg);
2721 struct chartab_range rainj;
2723 int charset94_p = (XCHARSET_CHARS (charset) == 94);
2724 int start = charset94_p ? 33 : 32;
2725 int stop = charset94_p ? 127 : 128;
2727 cte = XCHAR_TABLE_ENTRY (val);
2729 rainj.type = CHARTAB_RANGE_CHAR;
2731 for (i = start, retval = 0; i < stop && retval == 0; i++)
2733 rainj.ch = MAKE_CHAR (charset, row, i);
2734 retval = (fn) (&rainj, cte->level2[i - 32], arg);
2742 map_over_other_charset (Lisp_Char_Table *ct, Charset_ID lb,
2743 int (*fn) (struct chartab_range *range,
2744 Lisp_Object val, void *arg),
2747 Lisp_Object val = ct->level1[lb - MIN_LEADING_BYTE];
2748 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (lb);
2750 if (!CHARSETP (charset)
2751 || lb == LEADING_BYTE_ASCII
2752 || lb == LEADING_BYTE_CONTROL_1)
2755 if (!CHAR_TABLE_ENTRYP (val))
2757 struct chartab_range rainj;
2759 rainj.type = CHARTAB_RANGE_CHARSET;
2760 rainj.charset = charset;
2761 return (fn) (&rainj, val, arg);
2765 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
2766 int charset94_p = (XCHARSET_CHARS (charset) == 94);
2767 int start = charset94_p ? 33 : 32;
2768 int stop = charset94_p ? 127 : 128;
2771 if (XCHARSET_DIMENSION (charset) == 1)
2773 struct chartab_range rainj;
2774 rainj.type = CHARTAB_RANGE_CHAR;
2776 for (i = start, retval = 0; i < stop && retval == 0; i++)
2778 rainj.ch = MAKE_CHAR (charset, i, 0);
2779 retval = (fn) (&rainj, cte->level2[i - 32], arg);
2784 for (i = start, retval = 0; i < stop && retval == 0; i++)
2785 retval = map_over_charset_row (cte, charset, i, fn, arg);
2793 #endif /* not UTF2000 */
2796 struct map_char_table_for_charset_arg
2798 int (*fn) (struct chartab_range *range, Lisp_Object val, void *arg);
2799 Lisp_Char_Table *ct;
2804 map_char_table_for_charset_fun (struct chartab_range *range,
2805 Lisp_Object val, void *arg)
2807 struct map_char_table_for_charset_arg *closure =
2808 (struct map_char_table_for_charset_arg *) arg;
2811 switch (range->type)
2813 case CHARTAB_RANGE_ALL:
2816 case CHARTAB_RANGE_DEFAULT:
2819 case CHARTAB_RANGE_CHARSET:
2822 case CHARTAB_RANGE_ROW:
2825 case CHARTAB_RANGE_CHAR:
2826 ret = get_char_table (range->ch, closure->ct);
2827 if (!UNBOUNDP (ret))
2828 return (closure->fn) (range, ret, closure->arg);
2840 /* Map FN (with client data ARG) over range RANGE in char table CT.
2841 Mapping stops the first time FN returns non-zero, and that value
2842 becomes the return value of map_char_table(). */
2845 map_char_table (Lisp_Char_Table *ct,
2846 struct chartab_range *range,
2847 int (*fn) (struct chartab_range *range,
2848 Lisp_Object val, void *arg),
2851 switch (range->type)
2853 case CHARTAB_RANGE_ALL:
2855 if (!UNBOUNDP (ct->default_value))
2857 struct chartab_range rainj;
2860 rainj.type = CHARTAB_RANGE_DEFAULT;
2861 retval = (fn) (&rainj, ct->default_value, arg);
2865 if (UINT8_BYTE_TABLE_P (ct->table))
2866 return map_over_uint8_byte_table (XUINT8_BYTE_TABLE(ct->table), ct,
2868 else if (UINT16_BYTE_TABLE_P (ct->table))
2869 return map_over_uint16_byte_table (XUINT16_BYTE_TABLE(ct->table), ct,
2871 else if (BYTE_TABLE_P (ct->table))
2872 return map_over_byte_table (XBYTE_TABLE(ct->table), ct,
2874 else if (EQ (ct->table, Qunloaded))
2877 struct chartab_range rainj;
2880 Emchar c1 = c + unit;
2883 rainj.type = CHARTAB_RANGE_CHAR;
2885 for (retval = 0; c < c1 && retval == 0; c++)
2887 Lisp_Object ret = get_char_id_table (ct, c);
2889 if (!UNBOUNDP (ret))
2892 retval = (fn) (&rainj, ct->table, arg);
2897 ct->table = Qunbound;
2900 else if (!UNBOUNDP (ct->table))
2901 return (fn) (range, ct->table, arg);
2907 retval = map_over_charset_ascii (ct, fn, arg);
2911 retval = map_over_charset_control_1 (ct, fn, arg);
2916 Charset_ID start = MIN_LEADING_BYTE;
2917 Charset_ID stop = start + NUM_LEADING_BYTES;
2919 for (i = start, retval = 0; i < stop && retval == 0; i++)
2921 retval = map_over_other_charset (ct, i, fn, arg);
2930 case CHARTAB_RANGE_DEFAULT:
2931 if (!UNBOUNDP (ct->default_value))
2932 return (fn) (range, ct->default_value, arg);
2937 case CHARTAB_RANGE_CHARSET:
2940 Lisp_Object encoding_table
2941 = XCHARSET_ENCODING_TABLE (range->charset);
2943 if (!NILP (encoding_table))
2945 struct chartab_range rainj;
2946 struct map_char_table_for_charset_arg mcarg;
2949 if (XCHAR_TABLE_UNLOADED(encoding_table))
2950 Fload_char_attribute_table (XCHAR_TABLE_NAME (encoding_table));
2955 rainj.type = CHARTAB_RANGE_ALL;
2956 return map_char_table (XCHAR_TABLE(encoding_table),
2958 &map_char_table_for_charset_fun,
2964 return map_over_other_charset (ct,
2965 XCHARSET_LEADING_BYTE (range->charset),
2969 case CHARTAB_RANGE_ROW:
2972 int cell_min, cell_max, i;
2974 struct chartab_range rainj;
2976 i = XCHARSET_CELL_RANGE (range->charset);
2978 cell_max = i & 0xFF;
2979 rainj.type = CHARTAB_RANGE_CHAR;
2980 for (retval =0, i = cell_min; i <= cell_max && retval == 0; i++)
2983 = DECODE_CHAR (range->charset, (range->row << 8) | i, 0);
2985 if ( charset_code_point (range->charset, ch, 0) >= 0 )
2988 = get_byte_table (get_byte_table
2992 (unsigned char)(ch >> 24)),
2993 (unsigned char) (ch >> 16)),
2994 (unsigned char) (ch >> 8)),
2995 (unsigned char) ch);
2998 val = ct->default_value;
3000 retval = (fn) (&rainj, val, arg);
3007 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (range->charset)
3008 - MIN_LEADING_BYTE];
3009 if (!CHAR_TABLE_ENTRYP (val))
3011 struct chartab_range rainj;
3013 rainj.type = CHARTAB_RANGE_ROW;
3014 rainj.charset = range->charset;
3015 rainj.row = range->row;
3016 return (fn) (&rainj, val, arg);
3019 return map_over_charset_row (XCHAR_TABLE_ENTRY (val),
3020 range->charset, range->row,
3023 #endif /* not UTF2000 */
3026 case CHARTAB_RANGE_CHAR:
3028 Emchar ch = range->ch;
3029 Lisp_Object val = CHAR_TABLE_VALUE_UNSAFE (ct, ch);
3031 if (!UNBOUNDP (val))
3033 struct chartab_range rainj;
3035 rainj.type = CHARTAB_RANGE_CHAR;
3037 return (fn) (&rainj, val, arg);
3049 struct slow_map_char_table_arg
3051 Lisp_Object function;
3056 slow_map_char_table_fun (struct chartab_range *range,
3057 Lisp_Object val, void *arg)
3059 Lisp_Object ranjarg = Qnil;
3060 struct slow_map_char_table_arg *closure =
3061 (struct slow_map_char_table_arg *) arg;
3063 switch (range->type)
3065 case CHARTAB_RANGE_ALL:
3070 case CHARTAB_RANGE_DEFAULT:
3076 case CHARTAB_RANGE_CHARSET:
3077 ranjarg = XCHARSET_NAME (range->charset);
3080 case CHARTAB_RANGE_ROW:
3081 ranjarg = vector2 (XCHARSET_NAME (range->charset),
3082 make_int (range->row));
3085 case CHARTAB_RANGE_CHAR:
3086 ranjarg = make_char (range->ch);
3092 closure->retval = call2 (closure->function, ranjarg, val);
3093 return !NILP (closure->retval);
3096 DEFUN ("map-char-table", Fmap_char_table, 2, 3, 0, /*
3097 Map FUNCTION over entries in CHAR-TABLE, calling it with two args,
3098 each key and value in the table.
3100 RANGE specifies a subrange to map over and is in the same format as
3101 the RANGE argument to `put-range-table'. If omitted or t, it defaults to
3104 (function, char_table, range))
3106 Lisp_Char_Table *ct;
3107 struct slow_map_char_table_arg slarg;
3108 struct gcpro gcpro1, gcpro2;
3109 struct chartab_range rainj;
3111 CHECK_CHAR_TABLE (char_table);
3112 ct = XCHAR_TABLE (char_table);
3115 decode_char_table_range (range, &rainj);
3116 slarg.function = function;
3117 slarg.retval = Qnil;
3118 GCPRO2 (slarg.function, slarg.retval);
3119 map_char_table (ct, &rainj, slow_map_char_table_fun, &slarg);
3122 return slarg.retval;
3126 /************************************************************************/
3127 /* Character Attributes */
3128 /************************************************************************/
3132 Lisp_Object Vchar_attribute_hash_table;
3134 /* We store the char-attributes in hash tables with the names as the
3135 key and the actual char-id-table object as the value. Occasionally
3136 we need to use them in a list format. These routines provide us
3138 struct char_attribute_list_closure
3140 Lisp_Object *char_attribute_list;
3144 add_char_attribute_to_list_mapper (Lisp_Object key, Lisp_Object value,
3145 void *char_attribute_list_closure)
3147 /* This function can GC */
3148 struct char_attribute_list_closure *calcl
3149 = (struct char_attribute_list_closure*) char_attribute_list_closure;
3150 Lisp_Object *char_attribute_list = calcl->char_attribute_list;
3152 *char_attribute_list = Fcons (key, *char_attribute_list);
3156 #ifdef HAVE_LIBCHISE
3158 char_attribute_list_reset_map_func (CHISE_DS *ds, unsigned char *name)
3160 Fmount_char_attribute_table (intern (name));
3164 DEFUN ("char-attribute-list", Fchar_attribute_list, 0, 1, 0, /*
3165 Return the list of all existing character attributes except coded-charsets.
3169 DEFUN ("char-attribute-list", Fchar_attribute_list, 0, 0, 0, /*
3170 Return the list of all existing character attributes except coded-charsets.
3175 Lisp_Object char_attribute_list = Qnil;
3176 struct gcpro gcpro1;
3177 struct char_attribute_list_closure char_attribute_list_closure;
3179 #ifdef HAVE_LIBCHISE
3182 open_chise_data_source_maybe ();
3183 chise_ds_foreach_char_feature_name
3184 (default_chise_data_source, &char_attribute_list_reset_map_func);
3187 GCPRO1 (char_attribute_list);
3188 char_attribute_list_closure.char_attribute_list = &char_attribute_list;
3189 elisp_maphash (add_char_attribute_to_list_mapper,
3190 Vchar_attribute_hash_table,
3191 &char_attribute_list_closure);
3193 return char_attribute_list;
3196 DEFUN ("find-char-attribute-table", Ffind_char_attribute_table, 1, 1, 0, /*
3197 Return char-id-table corresponding to ATTRIBUTE.
3201 return Fgethash (attribute, Vchar_attribute_hash_table, Qnil);
3205 /* We store the char-id-tables in hash tables with the attributes as
3206 the key and the actual char-id-table object as the value. Each
3207 char-id-table stores values of an attribute corresponding with
3208 characters. Occasionally we need to get attributes of a character
3209 in a association-list format. These routines provide us with
3211 struct char_attribute_alist_closure
3214 Lisp_Object *char_attribute_alist;
3218 add_char_attribute_alist_mapper (Lisp_Object key, Lisp_Object value,
3219 void *char_attribute_alist_closure)
3221 /* This function can GC */
3222 struct char_attribute_alist_closure *caacl =
3223 (struct char_attribute_alist_closure*) char_attribute_alist_closure;
3225 = get_char_id_table (XCHAR_TABLE(value), caacl->char_id);
3226 if (!UNBOUNDP (ret))
3228 Lisp_Object *char_attribute_alist = caacl->char_attribute_alist;
3229 *char_attribute_alist
3230 = Fcons (Fcons (key, ret), *char_attribute_alist);
3235 DEFUN ("char-attribute-alist", Fchar_attribute_alist, 1, 1, 0, /*
3236 Return the alist of attributes of CHARACTER.
3240 struct gcpro gcpro1;
3241 struct char_attribute_alist_closure char_attribute_alist_closure;
3242 Lisp_Object alist = Qnil;
3244 CHECK_CHAR (character);
3247 char_attribute_alist_closure.char_id = XCHAR (character);
3248 char_attribute_alist_closure.char_attribute_alist = &alist;
3249 elisp_maphash (add_char_attribute_alist_mapper,
3250 Vchar_attribute_hash_table,
3251 &char_attribute_alist_closure);
3257 DEFUN ("get-char-attribute", Fget_char_attribute, 2, 3, 0, /*
3258 Return the value of CHARACTER's ATTRIBUTE.
3259 Return DEFAULT-VALUE if the value is not exist.
3261 (character, attribute, default_value))
3265 CHECK_CHAR (character);
3267 if (CHARSETP (attribute))
3268 attribute = XCHARSET_NAME (attribute);
3270 table = Fgethash (attribute, Vchar_attribute_hash_table,
3272 if (!UNBOUNDP (table))
3274 Lisp_Object ret = get_char_id_table (XCHAR_TABLE(table),
3276 if (!UNBOUNDP (ret))
3279 return default_value;
3283 find_char_feature_in_family (Lisp_Object character,
3284 Lisp_Object con_feature,
3285 Lisp_Object feature,
3286 Lisp_Object feature_rel_max)
3288 Lisp_Object ancestors
3289 = Fget_char_attribute (character, con_feature, Qnil);
3291 while (!NILP (ancestors))
3293 Lisp_Object ancestor = XCAR (ancestors);
3296 if (EQ (ancestor, character))
3299 ret = Fchar_feature (ancestor, feature, Qunbound,
3300 Qnil, make_int (0));
3301 if (!UNBOUNDP (ret))
3304 ancestors = XCDR (ancestors);
3306 ret = Fget_char_attribute (ancestor, Q_subsumptive_from, Qnil);
3308 ancestors = nconc2 (Fcopy_sequence (ancestors), ret);
3310 ret = Fget_char_attribute (ancestor, Q_denotational_from, Qnil);
3312 ancestors = nconc2 (Fcopy_sequence (ancestors), ret);
3317 DEFUN ("char-feature", Fchar_feature, 2, 5, 0, /*
3318 Return the value of CHARACTER's FEATURE.
3319 Return DEFAULT-VALUE if the value is not exist.
3321 (character, attribute, default_value,
3322 feature_rel_max, char_rel_max))
3325 = Fget_char_attribute (character, attribute, Qunbound);
3327 if (!UNBOUNDP (ret))
3330 if (NILP (feature_rel_max)
3331 || (INTP (feature_rel_max) &&
3332 XINT (feature_rel_max) > 0))
3334 Lisp_String* name = symbol_name (XSYMBOL (attribute));
3335 Bufbyte *name_str = string_data (name);
3337 if (name_str[0] == '=' && name_str[1] == '>')
3339 Bytecount length = string_length (name) - 1;
3340 Lisp_Object map_to = make_uninit_string (length);
3342 memcpy (XSTRING_DATA (map_to) + 1, name_str + 2, length - 1);
3343 XSTRING_DATA(map_to)[0] = '=';
3344 ret = Fchar_feature (character, Fintern (map_to, Qnil),
3346 NILP (feature_rel_max)
3348 : make_int (XINT (feature_rel_max) - 1),
3350 if (!UNBOUNDP (ret))
3355 if ( !(EQ (attribute, Q_identical)) &&
3356 !(EQ (attribute, Q_subsumptive_from)) &&
3357 !(EQ (attribute, Q_denotational_from)) &&
3358 ( (NILP (char_rel_max)
3359 || (INTP (char_rel_max) &&
3360 XINT (char_rel_max) > 0)) ) )
3362 Lisp_String* name = symbol_name (XSYMBOL (attribute));
3363 Bufbyte *name_str = string_data (name);
3365 if ( (name_str[0] != '=') || (name_str[1] == '>') )
3367 ret = find_char_feature_in_family (character, Q_identical,
3368 attribute, feature_rel_max);
3369 if (!UNBOUNDP (ret))
3372 ret = find_char_feature_in_family (character, Q_subsumptive_from,
3373 attribute, feature_rel_max);
3374 if (!UNBOUNDP (ret))
3377 ret = find_char_feature_in_family (character, Q_denotational_from,
3378 attribute, feature_rel_max);
3379 if (!UNBOUNDP (ret))
3383 return default_value;
3386 void put_char_composition (Lisp_Object character, Lisp_Object value);
3388 put_char_composition (Lisp_Object character, Lisp_Object value)
3391 signal_simple_error ("Invalid value for ->decomposition",
3394 if (CONSP (Fcdr (value)))
3396 if (NILP (Fcdr (Fcdr (value))))
3398 Lisp_Object base = Fcar (value);
3399 Lisp_Object modifier = Fcar (Fcdr (value));
3403 base = make_char (XINT (base));
3404 Fsetcar (value, base);
3406 if (INTP (modifier))
3408 modifier = make_char (XINT (modifier));
3409 Fsetcar (Fcdr (value), modifier);
3414 = Fchar_feature (base, Qcomposition, Qnil,
3416 Lisp_Object ret = Fassq (modifier, alist);
3419 Fput_char_attribute (base, Qcomposition,
3420 Fcons (Fcons (modifier, character),
3423 Fsetcdr (ret, character);
3429 Lisp_Object v = Fcar (value);
3433 Emchar c = XINT (v);
3435 = Fchar_feature (make_char (c), Q_ucs_unified, Qnil,
3440 Fput_char_attribute (make_char (c), Q_ucs_unified,
3441 Fcons (character, Qnil));
3443 else if (NILP (Fmemq (character, ret)))
3445 Fput_char_attribute (make_char (c), Q_ucs_unified,
3446 Fcons (character, ret));
3453 put_char_attribute (Lisp_Object character, Lisp_Object attribute,
3456 Lisp_Object table = Fgethash (attribute,
3457 Vchar_attribute_hash_table,
3462 table = make_char_id_table (Qunbound);
3463 Fputhash (attribute, table, Vchar_attribute_hash_table);
3465 XCHAR_TABLE_NAME (table) = attribute;
3468 put_char_id_table (XCHAR_TABLE(table), character, value);
3472 DEFUN ("put-char-attribute", Fput_char_attribute, 3, 3, 0, /*
3473 Store CHARACTER's ATTRIBUTE with VALUE.
3475 (character, attribute, value))
3477 Lisp_Object ccs = Ffind_charset (attribute);
3479 CHECK_CHAR (character);
3483 value = put_char_ccs_code_point (character, ccs, value);
3484 attribute = XCHARSET_NAME (ccs);
3486 else if (EQ (attribute, Q_decomposition))
3487 put_char_composition (character, value);
3488 else if (EQ (attribute, Qto_ucs))
3494 signal_simple_error ("Invalid value for =>ucs", value);
3498 ret = Fchar_feature (make_char (c), Q_ucs_unified, Qnil,
3501 put_char_attribute (make_char (c), Q_ucs_unified,
3503 else if (NILP (Fmemq (character, ret)))
3504 Fput_char_attribute (make_char (c), Q_ucs_unified,
3505 Fcons (character, ret));
3507 else if ( EQ (attribute, Q_subsumptive) ||
3508 EQ (attribute, Q_subsumptive_from) ||
3509 EQ (attribute, Q_denotational) ||
3510 EQ (attribute, Q_denotational_from) ||
3511 EQ (attribute, Q_identical) ||
3512 EQ (attribute, Q_identical_from) ||
3513 EQ (attribute, Q_component) ||
3514 EQ (attribute, Q_component_of) ||
3515 !NILP (Fstring_match
3516 (build_string ("^\\(<-\\|->\\)\\(simplified"
3517 "\\|same\\|vulgar\\|wrong"
3519 Fsymbol_name (attribute),
3522 Lisp_Object rest = value;
3524 Lisp_Object rev_feature = Qnil;
3525 struct gcpro gcpro1;
3526 GCPRO1 (rev_feature);
3528 if (EQ (attribute, Q_identical))
3529 rev_feature = Q_identical_from;
3530 else if (EQ (attribute, Q_identical_from))
3531 rev_feature = Q_identical;
3532 else if (EQ (attribute, Q_subsumptive))
3533 rev_feature = Q_subsumptive_from;
3534 else if (EQ (attribute, Q_subsumptive_from))
3535 rev_feature = Q_subsumptive;
3536 else if (EQ (attribute, Q_denotational))
3537 rev_feature = Q_denotational_from;
3538 else if (EQ (attribute, Q_denotational_from))
3539 rev_feature = Q_denotational;
3540 else if (EQ (attribute, Q_component))
3541 rev_feature = Q_component_of;
3542 else if (EQ (attribute, Q_component_of))
3543 rev_feature = Q_component;
3546 Lisp_String* name = symbol_name (XSYMBOL (attribute));
3547 Bufbyte *name_str = string_data (name);
3549 if ( (name_str[0] == '<' && name_str[1] == '-') ||
3550 (name_str[0] == '-' && name_str[1] == '>') )
3552 Bytecount length = string_length (name);
3553 Bufbyte *rev_name_str = alloca (length + 1);
3555 memcpy (rev_name_str + 2, name_str + 2, length - 2);
3556 if (name_str[0] == '<')
3558 rev_name_str[0] = '-';
3559 rev_name_str[1] = '>';
3563 rev_name_str[0] = '<';
3564 rev_name_str[1] = '-';
3566 rev_name_str[length] = 0;
3567 rev_feature = intern (rev_name_str);
3571 while (CONSP (rest))
3576 ret = Fdefine_char (ret);
3578 if ( !NILP (ret) && !EQ (ret, character) )
3582 ffv = Fget_char_attribute (ret, rev_feature, Qnil);
3584 put_char_attribute (ret, rev_feature, list1 (character));
3585 else if (NILP (Fmemq (character, ffv)))
3586 put_char_attribute (ret, rev_feature,
3587 Fcons (character, ffv));
3588 Fsetcar (rest, ret);
3595 else if (EQ (attribute, Qideographic_structure))
3596 value = Fcopy_sequence (Fchar_refs_simplify_char_specs (value));
3598 return put_char_attribute (character, attribute, value);
3601 DEFUN ("remove-char-attribute", Fremove_char_attribute, 2, 2, 0, /*
3602 Remove CHARACTER's ATTRIBUTE.
3604 (character, attribute))
3608 CHECK_CHAR (character);
3609 ccs = Ffind_charset (attribute);
3612 return remove_char_ccs (character, ccs);
3616 Lisp_Object table = Fgethash (attribute,
3617 Vchar_attribute_hash_table,
3619 if (!UNBOUNDP (table))
3621 put_char_id_table (XCHAR_TABLE(table), character, Qunbound);
3630 int char_table_open_db_maybe (Lisp_Char_Table* cit);
3631 void char_table_close_db_maybe (Lisp_Char_Table* cit);
3632 Lisp_Object char_table_get_db (Lisp_Char_Table* cit, Emchar ch);
3634 #ifdef HAVE_LIBCHISE
3636 open_chise_data_source_maybe ()
3638 if (default_chise_data_source == NULL)
3640 Lisp_Object db_dir = Vexec_directory;
3641 int modemask = 0755; /* rwxr-xr-x */
3644 db_dir = build_string ("../lib-src");
3645 db_dir = Fexpand_file_name (build_string ("chise-db"), db_dir);
3647 default_chise_data_source
3648 = CHISE_DS_open (CHISE_DS_Berkeley_DB, XSTRING_DATA (db_dir),
3649 0 /* DB_HASH */, modemask);
3650 if (default_chise_data_source == NULL)
3655 #endif /* HAVE_LIBCHISE */
3657 DEFUN ("close-char-data-source", Fclose_char_data_source, 0, 0, 0, /*
3658 Close data-source of CHISE.
3662 #ifdef HAVE_LIBCHISE
3663 int status = CHISE_DS_close (default_chise_data_source);
3665 default_chise_data_source = NULL;
3668 #endif /* HAVE_LIBCHISE */
3673 char_table_open_db_maybe (Lisp_Char_Table* cit)
3675 Lisp_Object attribute = CHAR_TABLE_NAME (cit);
3677 if (!NILP (attribute))
3679 #ifdef HAVE_LIBCHISE
3680 if ( open_chise_data_source_maybe () )
3682 #else /* HAVE_LIBCHISE */
3683 if (NILP (Fdatabase_live_p (cit->db)))
3686 = char_attribute_system_db_file (Qsystem_char_id, attribute, 0);
3688 cit->db = Fopen_database (db_file, Qnil, Qnil,
3689 build_string ("r"), Qnil);
3693 #endif /* not HAVE_LIBCHISE */
3701 char_table_close_db_maybe (Lisp_Char_Table* cit)
3703 #ifndef HAVE_LIBCHISE
3704 if (!NILP (cit->db))
3706 if (!NILP (Fdatabase_live_p (cit->db)))
3707 Fclose_database (cit->db);
3710 #endif /* not HAVE_LIBCHISE */
3714 char_table_get_db (Lisp_Char_Table* cit, Emchar ch)
3717 #ifdef HAVE_LIBCHISE
3720 = chise_ds_load_char_feature_value (default_chise_data_source, ch,
3721 XSTRING_DATA(Fsymbol_name
3727 val = Fread (make_string (chise_value_data (&value),
3728 chise_value_size (&value) ));
3732 #else /* HAVE_LIBCHISE */
3733 val = Fget_database (Fprin1_to_string (make_char (ch), Qnil),
3735 if (!UNBOUNDP (val))
3739 #endif /* not HAVE_LIBCHISE */
3743 #ifndef HAVE_LIBCHISE
3745 char_attribute_system_db_file (Lisp_Object key_type, Lisp_Object attribute,
3748 Lisp_Object db_dir = Vexec_directory;
3751 db_dir = build_string ("../lib-src");
3753 db_dir = Fexpand_file_name (build_string ("chise-db"), db_dir);
3754 if (writing_mode && NILP (Ffile_exists_p (db_dir)))
3755 Fmake_directory_internal (db_dir);
3757 db_dir = Fexpand_file_name (Fsymbol_name (key_type), db_dir);
3758 if (writing_mode && NILP (Ffile_exists_p (db_dir)))
3759 Fmake_directory_internal (db_dir);
3762 Lisp_Object attribute_name = Fsymbol_name (attribute);
3763 Lisp_Object dest = Qnil, ret;
3765 struct gcpro gcpro1, gcpro2;
3766 int len = XSTRING_CHAR_LENGTH (attribute_name);
3770 for (i = 0; i < len; i++)
3772 Emchar c = string_char (XSTRING (attribute_name), i);
3774 if ( (c == '/') || (c == '%') )
3778 sprintf (str, "%%%02X", c);
3779 dest = concat3 (dest,
3780 Fsubstring (attribute_name,
3781 make_int (base), make_int (i)),
3782 build_string (str));
3786 ret = Fsubstring (attribute_name, make_int (base), make_int (len));
3787 dest = concat2 (dest, ret);
3789 return Fexpand_file_name (dest, db_dir);
3792 #endif /* not HAVE_LIBCHISE */
3794 DEFUN ("save-char-attribute-table", Fsave_char_attribute_table, 1, 1, 0, /*
3795 Save values of ATTRIBUTE into database file.
3799 Lisp_Object table = Fgethash (attribute,
3800 Vchar_attribute_hash_table, Qunbound);
3801 Lisp_Char_Table *ct;
3802 #ifdef HAVE_LIBCHISE
3803 CHISE_Feature feature;
3804 #else /* HAVE_LIBCHISE */
3805 Lisp_Object db_file;
3807 #endif /* not HAVE_LIBCHISE */
3809 if (CHAR_TABLEP (table))
3810 ct = XCHAR_TABLE (table);
3814 #ifdef HAVE_LIBCHISE
3815 if ( open_chise_data_source_maybe () )
3818 = chise_ds_get_feature (default_chise_data_source,
3819 XSTRING_DATA (Fsymbol_name (attribute)));
3820 #else /* HAVE_LIBCHISE */
3821 db_file = char_attribute_system_db_file (Qsystem_char_id, attribute, 1);
3822 db = Fopen_database (db_file, Qnil, Qnil, build_string ("w+"), Qnil);
3823 #endif /* not HAVE_LIBCHISE */
3825 #ifdef HAVE_LIBCHISE
3827 #else /* HAVE_LIBCHISE */
3829 #endif /* not HAVE_LIBCHISE */
3832 Lisp_Object (*filter)(Lisp_Object value);
3834 if ( EQ (attribute, Qideographic_structure)
3835 || EQ (attribute, Q_identical)
3836 || EQ (attribute, Q_identical_from)
3837 || !NILP (Fstring_match
3838 (build_string ("^\\(<-\\|->\\)\\(simplified"
3839 "\\|same\\|vulgar\\|wrong"
3841 Fsymbol_name (attribute),
3843 filter = &Fchar_refs_simplify_char_specs;
3847 if (UINT8_BYTE_TABLE_P (ct->table))
3848 save_uint8_byte_table (XUINT8_BYTE_TABLE(ct->table), ct,
3849 #ifdef HAVE_LIBCHISE
3851 #else /* HAVE_LIBCHISE */
3853 #endif /* not HAVE_LIBCHISE */
3855 else if (UINT16_BYTE_TABLE_P (ct->table))
3856 save_uint16_byte_table (XUINT16_BYTE_TABLE(ct->table), ct,
3857 #ifdef HAVE_LIBCHISE
3859 #else /* HAVE_LIBCHISE */
3861 #endif /* not HAVE_LIBCHISE */
3863 else if (BYTE_TABLE_P (ct->table))
3864 save_byte_table (XBYTE_TABLE(ct->table), ct,
3865 #ifdef HAVE_LIBCHISE
3867 #else /* HAVE_LIBCHISE */
3869 #endif /* not HAVE_LIBCHISE */
3871 #ifdef HAVE_LIBCHISE
3872 chise_feature_sync (feature);
3873 #else /* HAVE_LIBCHISE */
3874 Fclose_database (db);
3875 #endif /* not HAVE_LIBCHISE */
3882 DEFUN ("mount-char-attribute-table", Fmount_char_attribute_table, 1, 1, 0, /*
3883 Mount database file on char-attribute-table ATTRIBUTE.
3887 Lisp_Object table = Fgethash (attribute,
3888 Vchar_attribute_hash_table, Qunbound);
3890 if (UNBOUNDP (table))
3892 Lisp_Char_Table *ct;
3894 table = make_char_id_table (Qunbound);
3895 Fputhash (attribute, table, Vchar_attribute_hash_table);
3896 XCHAR_TABLE_NAME(table) = attribute;
3897 ct = XCHAR_TABLE (table);
3898 ct->table = Qunloaded;
3899 XCHAR_TABLE_UNLOADED(table) = 1;
3900 #ifndef HAVE_LIBCHISE
3902 #endif /* not HAVE_LIBCHISE */
3908 DEFUN ("close-char-attribute-table", Fclose_char_attribute_table, 1, 1, 0, /*
3909 Close database of ATTRIBUTE.
3913 Lisp_Object table = Fgethash (attribute,
3914 Vchar_attribute_hash_table, Qunbound);
3915 Lisp_Char_Table *ct;
3917 if (CHAR_TABLEP (table))
3918 ct = XCHAR_TABLE (table);
3921 char_table_close_db_maybe (ct);
3925 DEFUN ("reset-char-attribute-table", Freset_char_attribute_table, 1, 1, 0, /*
3926 Reset values of ATTRIBUTE with database file.
3930 #ifdef HAVE_LIBCHISE
3931 CHISE_Feature feature
3932 = chise_ds_get_feature (default_chise_data_source,
3933 XSTRING_DATA (Fsymbol_name
3936 if (feature == NULL)
3939 if (chise_feature_setup_db (feature, 0) == 0)
3941 Lisp_Object table = Fgethash (attribute,
3942 Vchar_attribute_hash_table, Qunbound);
3943 Lisp_Char_Table *ct;
3945 chise_feature_sync (feature);
3946 if (UNBOUNDP (table))
3948 table = make_char_id_table (Qunbound);
3949 Fputhash (attribute, table, Vchar_attribute_hash_table);
3950 XCHAR_TABLE_NAME(table) = attribute;
3952 ct = XCHAR_TABLE (table);
3953 ct->table = Qunloaded;
3954 char_table_close_db_maybe (ct);
3955 XCHAR_TABLE_UNLOADED(table) = 1;
3959 Lisp_Object table = Fgethash (attribute,
3960 Vchar_attribute_hash_table, Qunbound);
3961 Lisp_Char_Table *ct;
3963 = char_attribute_system_db_file (Qsystem_char_id, attribute, 0);
3965 if (!NILP (Ffile_exists_p (db_file)))
3967 if (UNBOUNDP (table))
3969 table = make_char_id_table (Qunbound);
3970 Fputhash (attribute, table, Vchar_attribute_hash_table);
3971 XCHAR_TABLE_NAME(table) = attribute;
3973 ct = XCHAR_TABLE (table);
3974 ct->table = Qunloaded;
3975 char_table_close_db_maybe (ct);
3976 XCHAR_TABLE_UNLOADED(table) = 1;
3984 load_char_attribute_maybe (Lisp_Char_Table* cit, Emchar ch)
3986 Lisp_Object attribute = CHAR_TABLE_NAME (cit);
3988 if (!NILP (attribute))
3992 if (char_table_open_db_maybe (cit))
3995 val = char_table_get_db (cit, ch);
3997 if (!NILP (Vchar_db_stingy_mode))
3998 char_table_close_db_maybe (cit);
4005 Lisp_Char_Table* char_attribute_table_to_load;
4007 #ifdef HAVE_LIBCHISE
4009 load_char_attribute_table_map_func (CHISE_Char_ID cid,
4010 CHISE_Feature feature,
4011 CHISE_Value *value);
4013 load_char_attribute_table_map_func (CHISE_Char_ID cid,
4014 CHISE_Feature feature,
4018 Lisp_Object ret = get_char_id_table_0 (char_attribute_table_to_load, code);
4020 if (EQ (ret, Qunloaded))
4021 put_char_id_table_0 (char_attribute_table_to_load, code,
4022 Fread (make_string ((Bufbyte *) value->data,
4026 #else /* HAVE_LIBCHISE */
4027 Lisp_Object Qload_char_attribute_table_map_function;
4029 DEFUN ("load-char-attribute-table-map-function",
4030 Fload_char_attribute_table_map_function, 2, 2, 0, /*
4031 For internal use. Don't use it.
4035 Lisp_Object c = Fread (key);
4036 Emchar code = XCHAR (c);
4037 Lisp_Object ret = get_char_id_table_0 (char_attribute_table_to_load, code);
4039 if (EQ (ret, Qunloaded))
4040 put_char_id_table_0 (char_attribute_table_to_load, code, Fread (value));
4043 #endif /* not HAVE_LIBCHISE */
4045 DEFUN ("load-char-attribute-table", Fload_char_attribute_table, 1, 1, 0, /*
4046 Load values of ATTRIBUTE into database file.
4050 Lisp_Object table = Fgethash (attribute,
4051 Vchar_attribute_hash_table,
4053 if (CHAR_TABLEP (table))
4055 Lisp_Char_Table *cit = XCHAR_TABLE (table);
4057 if (char_table_open_db_maybe (cit))
4060 char_attribute_table_to_load = XCHAR_TABLE (table);
4062 struct gcpro gcpro1;
4065 #ifdef HAVE_LIBCHISE
4066 chise_feature_foreach_char_with_value
4067 (chise_ds_get_feature (default_chise_data_source,
4068 XSTRING_DATA (Fsymbol_name (cit->name))),
4069 &load_char_attribute_table_map_func);
4070 #else /* HAVE_LIBCHISE */
4071 Fmap_database (Qload_char_attribute_table_map_function, cit->db);
4072 #endif /* not HAVE_LIBCHISE */
4075 char_table_close_db_maybe (cit);
4076 XCHAR_TABLE_UNLOADED(table) = 0;
4081 #endif /* HAVE_CHISE */
4083 DEFUN ("map-char-attribute", Fmap_char_attribute, 2, 3, 0, /*
4084 Map FUNCTION over entries in ATTRIBUTE, calling it with two args,
4085 each key and value in the table.
4087 RANGE specifies a subrange to map over and is in the same format as
4088 the RANGE argument to `put-range-table'. If omitted or t, it defaults to
4091 (function, attribute, range))
4094 Lisp_Char_Table *ct;
4095 struct slow_map_char_table_arg slarg;
4096 struct gcpro gcpro1, gcpro2;
4097 struct chartab_range rainj;
4099 if (!NILP (ccs = Ffind_charset (attribute)))
4101 Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (ccs);
4103 if (CHAR_TABLEP (encoding_table))
4104 ct = XCHAR_TABLE (encoding_table);
4110 Lisp_Object table = Fgethash (attribute,
4111 Vchar_attribute_hash_table,
4113 if (CHAR_TABLEP (table))
4114 ct = XCHAR_TABLE (table);
4120 decode_char_table_range (range, &rainj);
4122 if (CHAR_TABLE_UNLOADED(ct))
4123 Fload_char_attribute_table (attribute);
4125 slarg.function = function;
4126 slarg.retval = Qnil;
4127 GCPRO2 (slarg.function, slarg.retval);
4128 map_char_table (ct, &rainj, slow_map_char_table_fun, &slarg);
4131 return slarg.retval;
4134 DEFUN ("define-char", Fdefine_char, 1, 1, 0, /*
4135 Store character's ATTRIBUTES.
4140 Lisp_Object code = Fcdr (Fassq (Qmap_ucs, attributes));
4141 Lisp_Object character;
4144 code = Fcdr (Fassq (Qucs, attributes));
4149 while (CONSP (rest))
4151 Lisp_Object cell = Fcar (rest);
4154 if ( !LISTP (cell) )
4155 signal_simple_error ("Invalid argument", attributes);
4157 ccs = Ffind_charset (Fcar (cell));
4163 character = Fdecode_char (ccs, cell, Qt, Qt);
4164 if (!NILP (character))
4165 goto setup_attributes;
4167 if ( (XCHARSET_FINAL (ccs) != 0) ||
4168 (XCHARSET_MAX_CODE (ccs) > 0) ||
4169 (EQ (ccs, Vcharset_chinese_big5)) )
4173 = Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
4175 character = Fdecode_char (ccs, cell, Qnil, Qt);
4176 if (!NILP (character))
4177 goto setup_attributes;
4184 int cid = XINT (Vnext_defined_char_id);
4186 if (cid <= 0xE00000)
4188 character = make_char (cid);
4189 Vnext_defined_char_id = make_int (cid + 1);
4190 goto setup_attributes;
4194 if ( (!NILP (code = Fcdr (Fassq (Qto_ucs, attributes)))) )
4197 signal_simple_error ("Invalid argument", attributes);
4199 character = make_char (XINT (code) + 0x100000);
4200 goto setup_attributes;
4205 else if (!INTP (code))
4206 signal_simple_error ("Invalid argument", attributes);
4208 character = make_char (XINT (code));
4212 while (CONSP (rest))
4214 Lisp_Object cell = Fcar (rest);
4217 signal_simple_error ("Invalid argument", attributes);
4219 Fput_char_attribute (character, Fcar (cell), Fcdr (cell));
4225 DEFUN ("find-char", Ffind_char, 1, 1, 0, /*
4226 Retrieve the character of the given ATTRIBUTES.
4230 Lisp_Object rest = attributes;
4233 while (CONSP (rest))
4235 Lisp_Object cell = Fcar (rest);
4239 signal_simple_error ("Invalid argument", attributes);
4240 if (!NILP (ccs = Ffind_charset (Fcar (cell))))
4244 return Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
4246 return Fdecode_char (ccs, cell, Qnil, Qnil);
4250 if ( (!NILP (code = Fcdr (Fassq (Qto_ucs, attributes)))) )
4253 signal_simple_error ("Invalid argument", attributes);
4255 return make_char (XINT (code) + 0x100000);
4263 /************************************************************************/
4264 /* Char table read syntax */
4265 /************************************************************************/
4268 chartab_type_validate (Lisp_Object keyword, Lisp_Object value,
4269 Error_behavior errb)
4271 /* #### should deal with ERRB */
4272 symbol_to_char_table_type (value);
4277 chartab_data_validate (Lisp_Object keyword, Lisp_Object value,
4278 Error_behavior errb)
4282 /* #### should deal with ERRB */
4283 EXTERNAL_LIST_LOOP (rest, value)
4285 Lisp_Object range = XCAR (rest);
4286 struct chartab_range dummy;
4290 signal_simple_error ("Invalid list format", value);
4293 if (!CONSP (XCDR (range))
4294 || !NILP (XCDR (XCDR (range))))
4295 signal_simple_error ("Invalid range format", range);
4296 decode_char_table_range (XCAR (range), &dummy);
4297 decode_char_table_range (XCAR (XCDR (range)), &dummy);
4300 decode_char_table_range (range, &dummy);
4307 chartab_instantiate (Lisp_Object data)
4309 Lisp_Object chartab;
4310 Lisp_Object type = Qgeneric;
4311 Lisp_Object dataval = Qnil;
4313 while (!NILP (data))
4315 Lisp_Object keyw = Fcar (data);
4321 if (EQ (keyw, Qtype))
4323 else if (EQ (keyw, Qdata))
4327 chartab = Fmake_char_table (type);
4330 while (!NILP (data))
4332 Lisp_Object range = Fcar (data);
4333 Lisp_Object val = Fcar (Fcdr (data));
4335 data = Fcdr (Fcdr (data));
4338 if (CHAR_OR_CHAR_INTP (XCAR (range)))
4340 Emchar first = XCHAR_OR_CHAR_INT (Fcar (range));
4341 Emchar last = XCHAR_OR_CHAR_INT (Fcar (Fcdr (range)));
4344 for (i = first; i <= last; i++)
4345 Fput_char_table (make_char (i), val, chartab);
4351 Fput_char_table (range, val, chartab);
4360 /************************************************************************/
4361 /* Category Tables, specifically */
4362 /************************************************************************/
4364 DEFUN ("category-table-p", Fcategory_table_p, 1, 1, 0, /*
4365 Return t if OBJECT is a category table.
4366 A category table is a type of char table used for keeping track of
4367 categories. Categories are used for classifying characters for use
4368 in regexps -- you can refer to a category rather than having to use
4369 a complicated [] expression (and category lookups are significantly
4372 There are 95 different categories available, one for each printable
4373 character (including space) in the ASCII charset. Each category
4374 is designated by one such character, called a "category designator".
4375 They are specified in a regexp using the syntax "\\cX", where X is
4376 a category designator.
4378 A category table specifies, for each character, the categories that
4379 the character is in. Note that a character can be in more than one
4380 category. More specifically, a category table maps from a character
4381 to either the value nil (meaning the character is in no categories)
4382 or a 95-element bit vector, specifying for each of the 95 categories
4383 whether the character is in that category.
4385 Special Lisp functions are provided that abstract this, so you do not
4386 have to directly manipulate bit vectors.
4390 return (CHAR_TABLEP (object) &&
4391 XCHAR_TABLE_TYPE (object) == CHAR_TABLE_TYPE_CATEGORY) ?
4396 check_category_table (Lisp_Object object, Lisp_Object default_)
4400 while (NILP (Fcategory_table_p (object)))
4401 object = wrong_type_argument (Qcategory_table_p, object);
4406 check_category_char (Emchar ch, Lisp_Object table,
4407 unsigned int designator, unsigned int not_p)
4409 REGISTER Lisp_Object temp;
4410 Lisp_Char_Table *ctbl;
4411 #ifdef ERROR_CHECK_TYPECHECK
4412 if (NILP (Fcategory_table_p (table)))
4413 signal_simple_error ("Expected category table", table);
4415 ctbl = XCHAR_TABLE (table);
4416 temp = get_char_table (ch, ctbl);
4421 return bit_vector_bit (XBIT_VECTOR (temp), designator) ? !not_p : not_p;
4424 DEFUN ("check-category-at", Fcheck_category_at, 2, 4, 0, /*
4425 Return t if category of the character at POSITION includes DESIGNATOR.
4426 Optional third arg BUFFER specifies which buffer to use, and defaults
4427 to the current buffer.
4428 Optional fourth arg CATEGORY-TABLE specifies the category table to
4429 use, and defaults to BUFFER's category table.
4431 (position, designator, buffer, category_table))
4436 struct buffer *buf = decode_buffer (buffer, 0);
4438 CHECK_INT (position);
4439 CHECK_CATEGORY_DESIGNATOR (designator);
4440 des = XCHAR (designator);
4441 ctbl = check_category_table (category_table, Vstandard_category_table);
4442 ch = BUF_FETCH_CHAR (buf, XINT (position));
4443 return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil;
4446 DEFUN ("char-in-category-p", Fchar_in_category_p, 2, 3, 0, /*
4447 Return t if category of CHARACTER includes DESIGNATOR, else nil.
4448 Optional third arg CATEGORY-TABLE specifies the category table to use,
4449 and defaults to the standard category table.
4451 (character, designator, category_table))
4457 CHECK_CATEGORY_DESIGNATOR (designator);
4458 des = XCHAR (designator);
4459 CHECK_CHAR (character);
4460 ch = XCHAR (character);
4461 ctbl = check_category_table (category_table, Vstandard_category_table);
4462 return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil;
4465 DEFUN ("category-table", Fcategory_table, 0, 1, 0, /*
4466 Return BUFFER's current category table.
4467 BUFFER defaults to the current buffer.
4471 return decode_buffer (buffer, 0)->category_table;
4474 DEFUN ("standard-category-table", Fstandard_category_table, 0, 0, 0, /*
4475 Return the standard category table.
4476 This is the one used for new buffers.
4480 return Vstandard_category_table;
4483 DEFUN ("copy-category-table", Fcopy_category_table, 0, 1, 0, /*
4484 Return a new category table which is a copy of CATEGORY-TABLE.
4485 CATEGORY-TABLE defaults to the standard category table.
4489 if (NILP (Vstandard_category_table))
4490 return Fmake_char_table (Qcategory);
4493 check_category_table (category_table, Vstandard_category_table);
4494 return Fcopy_char_table (category_table);
4497 DEFUN ("set-category-table", Fset_category_table, 1, 2, 0, /*
4498 Select CATEGORY-TABLE as the new category table for BUFFER.
4499 BUFFER defaults to the current buffer if omitted.
4501 (category_table, buffer))
4503 struct buffer *buf = decode_buffer (buffer, 0);
4504 category_table = check_category_table (category_table, Qnil);
4505 buf->category_table = category_table;
4506 /* Indicate that this buffer now has a specified category table. */
4507 buf->local_var_flags |= XINT (buffer_local_flags.category_table);
4508 return category_table;
4511 DEFUN ("category-designator-p", Fcategory_designator_p, 1, 1, 0, /*
4512 Return t if OBJECT is a category designator (a char in the range ' ' to '~').
4516 return CATEGORY_DESIGNATORP (object) ? Qt : Qnil;
4519 DEFUN ("category-table-value-p", Fcategory_table_value_p, 1, 1, 0, /*
4520 Return t if OBJECT is a category table value.
4521 Valid values are nil or a bit vector of size 95.
4525 return CATEGORY_TABLE_VALUEP (object) ? Qt : Qnil;
4529 #define CATEGORYP(x) \
4530 (CHARP (x) && XCHAR (x) >= 0x20 && XCHAR (x) <= 0x7E)
4532 #define CATEGORY_SET(c) \
4533 (get_char_table(c, XCHAR_TABLE(current_buffer->category_table)))
4535 /* Return 1 if CATEGORY_SET contains CATEGORY, else return 0.
4536 The faster version of `!NILP (Faref (category_set, category))'. */
4537 #define CATEGORY_MEMBER(category, category_set) \
4538 (bit_vector_bit(XBIT_VECTOR (category_set), category - 32))
4540 /* Return 1 if there is a word boundary between two word-constituent
4541 characters C1 and C2 if they appear in this order, else return 0.
4542 Use the macro WORD_BOUNDARY_P instead of calling this function
4545 int word_boundary_p (Emchar c1, Emchar c2);
4547 word_boundary_p (Emchar c1, Emchar c2)
4549 Lisp_Object category_set1, category_set2;
4554 if (COMPOSITE_CHAR_P (c1))
4555 c1 = cmpchar_component (c1, 0, 1);
4556 if (COMPOSITE_CHAR_P (c2))
4557 c2 = cmpchar_component (c2, 0, 1);
4561 if (EQ (CHAR_CHARSET (c1), CHAR_CHARSET (c2)))
4564 tail = Vword_separating_categories;
4570 tail = Vword_combining_categories;
4575 category_set1 = CATEGORY_SET (c1);
4576 if (NILP (category_set1))
4577 return default_result;
4578 category_set2 = CATEGORY_SET (c2);
4579 if (NILP (category_set2))
4580 return default_result;
4582 for (; CONSP (tail); tail = XCONS (tail)->cdr)
4584 Lisp_Object elt = XCONS(tail)->car;
4587 && CATEGORYP (XCONS (elt)->car)
4588 && CATEGORYP (XCONS (elt)->cdr)
4589 && CATEGORY_MEMBER (XCHAR (XCONS (elt)->car), category_set1)
4590 && CATEGORY_MEMBER (XCHAR (XCONS (elt)->cdr), category_set2))
4591 return !default_result;
4593 return default_result;
4599 syms_of_chartab (void)
4602 INIT_LRECORD_IMPLEMENTATION (uint8_byte_table);
4603 INIT_LRECORD_IMPLEMENTATION (uint16_byte_table);
4604 INIT_LRECORD_IMPLEMENTATION (byte_table);
4606 defsymbol (&Qto_ucs, "=>ucs");
4607 defsymbol (&Q_ucs_unified, "->ucs-unified");
4608 defsymbol (&Q_subsumptive, "->subsumptive");
4609 defsymbol (&Q_subsumptive_from, "<-subsumptive");
4610 defsymbol (&Q_denotational, "->denotational");
4611 defsymbol (&Q_denotational_from, "<-denotational");
4612 defsymbol (&Q_identical, "->identical");
4613 defsymbol (&Q_identical_from, "<-identical");
4614 defsymbol (&Q_component, "->ideographic-component-forms");
4615 defsymbol (&Q_component_of, "<-ideographic-component-forms");
4616 defsymbol (&Qcomposition, "composition");
4617 defsymbol (&Q_decomposition, "->decomposition");
4618 defsymbol (&Qcompat, "compat");
4619 defsymbol (&Qisolated, "isolated");
4620 defsymbol (&Qinitial, "initial");
4621 defsymbol (&Qmedial, "medial");
4622 defsymbol (&Qfinal, "final");
4623 defsymbol (&Qvertical, "vertical");
4624 defsymbol (&QnoBreak, "noBreak");
4625 defsymbol (&Qfraction, "fraction");
4626 defsymbol (&Qsuper, "super");
4627 defsymbol (&Qsub, "sub");
4628 defsymbol (&Qcircle, "circle");
4629 defsymbol (&Qsquare, "square");
4630 defsymbol (&Qwide, "wide");
4631 defsymbol (&Qnarrow, "narrow");
4632 defsymbol (&Qsmall, "small");
4633 defsymbol (&Qfont, "font");
4635 DEFSUBR (Fchar_attribute_list);
4636 DEFSUBR (Ffind_char_attribute_table);
4637 defsymbol (&Qput_char_table_map_function, "put-char-table-map-function");
4638 DEFSUBR (Fput_char_table_map_function);
4640 DEFSUBR (Fsave_char_attribute_table);
4641 DEFSUBR (Fmount_char_attribute_table);
4642 DEFSUBR (Freset_char_attribute_table);
4643 DEFSUBR (Fclose_char_attribute_table);
4644 DEFSUBR (Fclose_char_data_source);
4645 #ifndef HAVE_LIBCHISE
4646 defsymbol (&Qload_char_attribute_table_map_function,
4647 "load-char-attribute-table-map-function");
4648 DEFSUBR (Fload_char_attribute_table_map_function);
4650 DEFSUBR (Fload_char_attribute_table);
4652 DEFSUBR (Fchar_feature);
4653 DEFSUBR (Fchar_attribute_alist);
4654 DEFSUBR (Fget_char_attribute);
4655 DEFSUBR (Fput_char_attribute);
4656 DEFSUBR (Fremove_char_attribute);
4657 DEFSUBR (Fmap_char_attribute);
4658 DEFSUBR (Fdefine_char);
4659 DEFSUBR (Ffind_char);
4660 DEFSUBR (Fchar_variants);
4662 DEFSUBR (Fget_composite_char);
4665 INIT_LRECORD_IMPLEMENTATION (char_table);
4669 INIT_LRECORD_IMPLEMENTATION (char_table_entry);
4672 defsymbol (&Qcategory_table_p, "category-table-p");
4673 defsymbol (&Qcategory_designator_p, "category-designator-p");
4674 defsymbol (&Qcategory_table_value_p, "category-table-value-p");
4677 defsymbol (&Qchar_table, "char-table");
4678 defsymbol (&Qchar_tablep, "char-table-p");
4680 DEFSUBR (Fchar_table_p);
4681 DEFSUBR (Fchar_table_type_list);
4682 DEFSUBR (Fvalid_char_table_type_p);
4683 DEFSUBR (Fchar_table_type);
4684 DEFSUBR (Freset_char_table);
4685 DEFSUBR (Fmake_char_table);
4686 DEFSUBR (Fcopy_char_table);
4687 DEFSUBR (Fget_char_table);
4688 DEFSUBR (Fget_range_char_table);
4689 DEFSUBR (Fvalid_char_table_value_p);
4690 DEFSUBR (Fcheck_valid_char_table_value);
4691 DEFSUBR (Fput_char_table);
4692 DEFSUBR (Fmap_char_table);
4695 DEFSUBR (Fcategory_table_p);
4696 DEFSUBR (Fcategory_table);
4697 DEFSUBR (Fstandard_category_table);
4698 DEFSUBR (Fcopy_category_table);
4699 DEFSUBR (Fset_category_table);
4700 DEFSUBR (Fcheck_category_at);
4701 DEFSUBR (Fchar_in_category_p);
4702 DEFSUBR (Fcategory_designator_p);
4703 DEFSUBR (Fcategory_table_value_p);
4709 vars_of_chartab (void)
4712 DEFVAR_LISP ("next-defined-char-id", &Vnext_defined_char_id /*
4714 Vnext_defined_char_id = make_int (0x0F0000);
4718 DEFVAR_LISP ("char-db-stingy-mode", &Vchar_db_stingy_mode /*
4720 Vchar_db_stingy_mode = Qt;
4722 #ifdef HAVE_LIBCHISE
4723 Vchise_db_directory = build_string(chise_db_dir);
4724 DEFVAR_LISP ("chise-db-directory", &Vchise_db_directory /*
4725 Directory of CHISE character databases.
4728 Vchise_system_db_directory = build_string(chise_system_db_dir);
4729 DEFVAR_LISP ("chise-system-db-directory", &Vchise_system_db_directory /*
4730 Directory of system character database of CHISE.
4734 #endif /* HAVE_CHISE */
4735 /* DO NOT staticpro this. It works just like Vweak_hash_tables. */
4736 Vall_syntax_tables = Qnil;
4737 dump_add_weak_object_chain (&Vall_syntax_tables);
4741 structure_type_create_chartab (void)
4743 struct structure_type *st;
4745 st = define_structure_type (Qchar_table, 0, chartab_instantiate);
4747 define_structure_type_keyword (st, Qtype, chartab_type_validate);
4748 define_structure_type_keyword (st, Qdata, chartab_data_validate);
4752 complex_vars_of_chartab (void)
4755 staticpro (&Vchar_attribute_hash_table);
4756 Vchar_attribute_hash_table
4757 = make_lisp_hash_table (16, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
4758 #endif /* UTF2000 */
4760 /* Set this now, so first buffer creation can refer to it. */
4761 /* Make it nil before calling copy-category-table
4762 so that copy-category-table will know not to try to copy from garbage */
4763 Vstandard_category_table = Qnil;
4764 Vstandard_category_table = Fcopy_category_table (Qnil);
4765 staticpro (&Vstandard_category_table);
4767 DEFVAR_LISP ("word-combining-categories", &Vword_combining_categories /*
4768 List of pair (cons) of categories to determine word boundary.
4770 Emacs treats a sequence of word constituent characters as a single
4771 word (i.e. finds no word boundary between them) iff they belongs to
4772 the same charset. But, exceptions are allowed in the following cases.
4774 \(1) The case that characters are in different charsets is controlled
4775 by the variable `word-combining-categories'.
4777 Emacs finds no word boundary between characters of different charsets
4778 if they have categories matching some element of this list.
4780 More precisely, if an element of this list is a cons of category CAT1
4781 and CAT2, and a multibyte character C1 which has CAT1 is followed by
4782 C2 which has CAT2, there's no word boundary between C1 and C2.
4784 For instance, to tell that ASCII characters and Latin-1 characters can
4785 form a single word, the element `(?l . ?l)' should be in this list
4786 because both characters have the category `l' (Latin characters).
4788 \(2) The case that character are in the same charset is controlled by
4789 the variable `word-separating-categories'.
4791 Emacs find a word boundary between characters of the same charset
4792 if they have categories matching some element of this list.
4794 More precisely, if an element of this list is a cons of category CAT1
4795 and CAT2, and a multibyte character C1 which has CAT1 is followed by
4796 C2 which has CAT2, there's a word boundary between C1 and C2.
4798 For instance, to tell that there's a word boundary between Japanese
4799 Hiragana and Japanese Kanji (both are in the same charset), the
4800 element `(?H . ?C) should be in this list.
4803 Vword_combining_categories = Qnil;
4805 DEFVAR_LISP ("word-separating-categories", &Vword_separating_categories /*
4806 List of pair (cons) of categories to determine word boundary.
4807 See the documentation of the variable `word-combining-categories'.
4810 Vword_separating_categories = Qnil;