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 Lisp_Object Qcomposition;
1134 Lisp_Object Q_decomposition;
1135 Lisp_Object Q_identical;
1136 Lisp_Object Q_identical_from;
1137 Lisp_Object Q_denotational;
1138 Lisp_Object Q_denotational_from;
1139 Lisp_Object Q_subsumptive;
1140 Lisp_Object Q_subsumptive_from;
1141 Lisp_Object Q_component;
1142 Lisp_Object Q_component_of;
1143 Lisp_Object Qto_ucs;
1144 Lisp_Object Q_ucs_unified;
1145 Lisp_Object Qcompat;
1146 Lisp_Object Qisolated;
1147 Lisp_Object Qinitial;
1148 Lisp_Object Qmedial;
1150 Lisp_Object Qvertical;
1151 Lisp_Object QnoBreak;
1152 Lisp_Object Qfraction;
1155 Lisp_Object Qcircle;
1156 Lisp_Object Qsquare;
1158 Lisp_Object Qnarrow;
1162 Emchar to_char_id (Lisp_Object v, char* err_msg, Lisp_Object err_arg);
1165 to_char_id (Lisp_Object v, char* err_msg, Lisp_Object err_arg)
1171 else if (EQ (v, Qcompat))
1173 else if (EQ (v, Qisolated))
1175 else if (EQ (v, Qinitial))
1177 else if (EQ (v, Qmedial))
1179 else if (EQ (v, Qfinal))
1181 else if (EQ (v, Qvertical))
1183 else if (EQ (v, QnoBreak))
1185 else if (EQ (v, Qfraction))
1187 else if (EQ (v, Qsuper))
1189 else if (EQ (v, Qsub))
1191 else if (EQ (v, Qcircle))
1193 else if (EQ (v, Qsquare))
1195 else if (EQ (v, Qwide))
1197 else if (EQ (v, Qnarrow))
1199 else if (EQ (v, Qsmall))
1201 else if (EQ (v, Qfont))
1204 signal_simple_error (err_msg, err_arg);
1207 DEFUN ("get-composite-char", Fget_composite_char, 1, 1, 0, /*
1208 Return character corresponding with list.
1212 Lisp_Object base, modifier;
1216 signal_simple_error ("Invalid value for composition", list);
1219 while (!NILP (rest))
1224 signal_simple_error ("Invalid value for composition", list);
1225 modifier = Fcar (rest);
1227 base = Fcdr (Fassq (modifier,
1228 Fchar_feature (base, Qcomposition, Qnil,
1234 DEFUN ("char-variants", Fchar_variants, 1, 1, 0, /*
1235 Return variants of CHARACTER.
1241 CHECK_CHAR (character);
1242 ret = Fchar_feature (character, Q_ucs_unified, Qnil,
1245 return Fcopy_list (ret);
1253 /* A char table maps from ranges of characters to values.
1255 Implementing a general data structure that maps from arbitrary
1256 ranges of numbers to values is tricky to do efficiently. As it
1257 happens, it should suffice (and is usually more convenient, anyway)
1258 when dealing with characters to restrict the sorts of ranges that
1259 can be assigned values, as follows:
1262 2) All characters in a charset.
1263 3) All characters in a particular row of a charset, where a "row"
1264 means all characters with the same first byte.
1265 4) A particular character in a charset.
1267 We use char tables to generalize the 256-element vectors now
1268 littering the Emacs code.
1270 Possible uses (all should be converted at some point):
1276 5) keyboard-translate-table?
1279 abstract type to generalize the Emacs vectors and Mule
1280 vectors-of-vectors goo.
1283 /************************************************************************/
1284 /* Char Table object */
1285 /************************************************************************/
1287 #if defined(MULE)&&!defined(UTF2000)
1290 mark_char_table_entry (Lisp_Object obj)
1292 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj);
1295 for (i = 0; i < 96; i++)
1297 mark_object (cte->level2[i]);
1303 char_table_entry_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
1305 Lisp_Char_Table_Entry *cte1 = XCHAR_TABLE_ENTRY (obj1);
1306 Lisp_Char_Table_Entry *cte2 = XCHAR_TABLE_ENTRY (obj2);
1309 for (i = 0; i < 96; i++)
1310 if (!internal_equal (cte1->level2[i], cte2->level2[i], depth + 1))
1316 static unsigned long
1317 char_table_entry_hash (Lisp_Object obj, int depth)
1319 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj);
1321 return internal_array_hash (cte->level2, 96, depth);
1324 static const struct lrecord_description char_table_entry_description[] = {
1325 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table_Entry, level2), 96 },
1329 DEFINE_LRECORD_IMPLEMENTATION ("char-table-entry", char_table_entry,
1330 mark_char_table_entry, internal_object_printer,
1331 0, char_table_entry_equal,
1332 char_table_entry_hash,
1333 char_table_entry_description,
1334 Lisp_Char_Table_Entry);
1338 mark_char_table (Lisp_Object obj)
1340 Lisp_Char_Table *ct = XCHAR_TABLE (obj);
1343 mark_object (ct->table);
1344 mark_object (ct->name);
1345 #ifndef HAVE_LIBCHISE
1346 mark_object (ct->db);
1351 for (i = 0; i < NUM_ASCII_CHARS; i++)
1352 mark_object (ct->ascii[i]);
1354 for (i = 0; i < NUM_LEADING_BYTES; i++)
1355 mark_object (ct->level1[i]);
1359 return ct->default_value;
1361 return ct->mirror_table;
1365 /* WARNING: All functions of this nature need to be written extremely
1366 carefully to avoid crashes during GC. Cf. prune_specifiers()
1367 and prune_weak_hash_tables(). */
1370 prune_syntax_tables (void)
1372 Lisp_Object rest, prev = Qnil;
1374 for (rest = Vall_syntax_tables;
1376 rest = XCHAR_TABLE (rest)->next_table)
1378 if (! marked_p (rest))
1380 /* This table is garbage. Remove it from the list. */
1382 Vall_syntax_tables = XCHAR_TABLE (rest)->next_table;
1384 XCHAR_TABLE (prev)->next_table =
1385 XCHAR_TABLE (rest)->next_table;
1391 char_table_type_to_symbol (enum char_table_type type)
1396 case CHAR_TABLE_TYPE_GENERIC: return Qgeneric;
1397 case CHAR_TABLE_TYPE_SYNTAX: return Qsyntax;
1398 case CHAR_TABLE_TYPE_DISPLAY: return Qdisplay;
1399 case CHAR_TABLE_TYPE_CHAR: return Qchar;
1401 case CHAR_TABLE_TYPE_CATEGORY: return Qcategory;
1406 static enum char_table_type
1407 symbol_to_char_table_type (Lisp_Object symbol)
1409 CHECK_SYMBOL (symbol);
1411 if (EQ (symbol, Qgeneric)) return CHAR_TABLE_TYPE_GENERIC;
1412 if (EQ (symbol, Qsyntax)) return CHAR_TABLE_TYPE_SYNTAX;
1413 if (EQ (symbol, Qdisplay)) return CHAR_TABLE_TYPE_DISPLAY;
1414 if (EQ (symbol, Qchar)) return CHAR_TABLE_TYPE_CHAR;
1416 if (EQ (symbol, Qcategory)) return CHAR_TABLE_TYPE_CATEGORY;
1419 signal_simple_error ("Unrecognized char table type", symbol);
1420 return CHAR_TABLE_TYPE_GENERIC; /* not reached */
1425 print_chartab_range (Emchar first, Emchar last, Lisp_Object val,
1426 Lisp_Object printcharfun)
1430 write_c_string (" (", printcharfun);
1431 print_internal (make_char (first), printcharfun, 0);
1432 write_c_string (" ", printcharfun);
1433 print_internal (make_char (last), printcharfun, 0);
1434 write_c_string (") ", printcharfun);
1438 write_c_string (" ", printcharfun);
1439 print_internal (make_char (first), printcharfun, 0);
1440 write_c_string (" ", printcharfun);
1442 print_internal (val, printcharfun, 1);
1446 #if defined(MULE)&&!defined(UTF2000)
1449 print_chartab_charset_row (Lisp_Object charset,
1451 Lisp_Char_Table_Entry *cte,
1452 Lisp_Object printcharfun)
1455 Lisp_Object cat = Qunbound;
1458 for (i = 32; i < 128; i++)
1460 Lisp_Object pam = cte->level2[i - 32];
1472 print_chartab_range (MAKE_CHAR (charset, first, 0),
1473 MAKE_CHAR (charset, i - 1, 0),
1476 print_chartab_range (MAKE_CHAR (charset, row, first),
1477 MAKE_CHAR (charset, row, i - 1),
1487 print_chartab_range (MAKE_CHAR (charset, first, 0),
1488 MAKE_CHAR (charset, i - 1, 0),
1491 print_chartab_range (MAKE_CHAR (charset, row, first),
1492 MAKE_CHAR (charset, row, i - 1),
1498 print_chartab_two_byte_charset (Lisp_Object charset,
1499 Lisp_Char_Table_Entry *cte,
1500 Lisp_Object printcharfun)
1504 for (i = 32; i < 128; i++)
1506 Lisp_Object jen = cte->level2[i - 32];
1508 if (!CHAR_TABLE_ENTRYP (jen))
1512 write_c_string (" [", printcharfun);
1513 print_internal (XCHARSET_NAME (charset), printcharfun, 0);
1514 sprintf (buf, " %d] ", i);
1515 write_c_string (buf, printcharfun);
1516 print_internal (jen, printcharfun, 0);
1519 print_chartab_charset_row (charset, i, XCHAR_TABLE_ENTRY (jen),
1527 print_char_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1529 Lisp_Char_Table *ct = XCHAR_TABLE (obj);
1532 struct gcpro gcpro1, gcpro2;
1533 GCPRO2 (obj, printcharfun);
1535 write_c_string ("#s(char-table ", printcharfun);
1536 write_c_string (" ", printcharfun);
1537 write_c_string (string_data
1539 (XSYMBOL (char_table_type_to_symbol (ct->type)))),
1541 write_c_string ("\n ", printcharfun);
1542 print_internal (ct->default_value, printcharfun, escapeflag);
1543 for (i = 0; i < 256; i++)
1545 Lisp_Object elt = get_byte_table (ct->table, i);
1546 if (i != 0) write_c_string ("\n ", printcharfun);
1547 if (EQ (elt, Qunbound))
1548 write_c_string ("void", printcharfun);
1550 print_internal (elt, printcharfun, escapeflag);
1553 #else /* non UTF2000 */
1556 sprintf (buf, "#s(char-table type %s data (",
1557 string_data (symbol_name (XSYMBOL
1558 (char_table_type_to_symbol (ct->type)))));
1559 write_c_string (buf, printcharfun);
1561 /* Now write out the ASCII/Control-1 stuff. */
1565 Lisp_Object val = Qunbound;
1567 for (i = 0; i < NUM_ASCII_CHARS; i++)
1576 if (!EQ (ct->ascii[i], val))
1578 print_chartab_range (first, i - 1, val, printcharfun);
1585 print_chartab_range (first, i - 1, val, printcharfun);
1592 for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES;
1595 Lisp_Object ann = ct->level1[i - MIN_LEADING_BYTE];
1596 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (i);
1598 if (!CHARSETP (charset) || i == LEADING_BYTE_ASCII
1599 || i == LEADING_BYTE_CONTROL_1)
1601 if (!CHAR_TABLE_ENTRYP (ann))
1603 write_c_string (" ", printcharfun);
1604 print_internal (XCHARSET_NAME (charset),
1606 write_c_string (" ", printcharfun);
1607 print_internal (ann, printcharfun, 0);
1611 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (ann);
1612 if (XCHARSET_DIMENSION (charset) == 1)
1613 print_chartab_charset_row (charset, -1, cte, printcharfun);
1615 print_chartab_two_byte_charset (charset, cte, printcharfun);
1620 #endif /* non UTF2000 */
1622 write_c_string ("))", printcharfun);
1626 char_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
1628 Lisp_Char_Table *ct1 = XCHAR_TABLE (obj1);
1629 Lisp_Char_Table *ct2 = XCHAR_TABLE (obj2);
1632 if (CHAR_TABLE_TYPE (ct1) != CHAR_TABLE_TYPE (ct2))
1636 for (i = 0; i < 256; i++)
1638 if (!internal_equal (get_byte_table (ct1->table, i),
1639 get_byte_table (ct2->table, i), 0))
1643 for (i = 0; i < NUM_ASCII_CHARS; i++)
1644 if (!internal_equal (ct1->ascii[i], ct2->ascii[i], depth + 1))
1648 for (i = 0; i < NUM_LEADING_BYTES; i++)
1649 if (!internal_equal (ct1->level1[i], ct2->level1[i], depth + 1))
1652 #endif /* non UTF2000 */
1657 static unsigned long
1658 char_table_hash (Lisp_Object obj, int depth)
1660 Lisp_Char_Table *ct = XCHAR_TABLE (obj);
1662 return byte_table_hash (ct->table, depth + 1);
1664 unsigned long hashval = internal_array_hash (ct->ascii, NUM_ASCII_CHARS,
1667 hashval = HASH2 (hashval,
1668 internal_array_hash (ct->level1, NUM_LEADING_BYTES, depth));
1674 static const struct lrecord_description char_table_description[] = {
1676 { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, table) },
1677 { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, default_value) },
1678 { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, name) },
1679 #ifndef HAVE_LIBCHISE
1680 { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, db) },
1683 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, ascii), NUM_ASCII_CHARS },
1685 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, level1), NUM_LEADING_BYTES },
1689 { XD_LISP_OBJECT, offsetof (Lisp_Char_Table, mirror_table) },
1691 { XD_LO_LINK, offsetof (Lisp_Char_Table, next_table) },
1695 DEFINE_LRECORD_IMPLEMENTATION ("char-table", char_table,
1696 mark_char_table, print_char_table, 0,
1697 char_table_equal, char_table_hash,
1698 char_table_description,
1701 DEFUN ("char-table-p", Fchar_table_p, 1, 1, 0, /*
1702 Return non-nil if OBJECT is a char table.
1704 A char table is a table that maps characters (or ranges of characters)
1705 to values. Char tables are specialized for characters, only allowing
1706 particular sorts of ranges to be assigned values. Although this
1707 loses in generality, it makes for extremely fast (constant-time)
1708 lookups, and thus is feasible for applications that do an extremely
1709 large number of lookups (e.g. scanning a buffer for a character in
1710 a particular syntax, where a lookup in the syntax table must occur
1711 once per character).
1713 When Mule support exists, the types of ranges that can be assigned
1717 -- an entire charset
1718 -- a single row in a two-octet charset
1719 -- a single character
1721 When Mule support is not present, the types of ranges that can be
1725 -- a single character
1727 To create a char table, use `make-char-table'.
1728 To modify a char table, use `put-char-table' or `remove-char-table'.
1729 To retrieve the value for a particular character, use `get-char-table'.
1730 See also `map-char-table', `clear-char-table', `copy-char-table',
1731 `valid-char-table-type-p', `char-table-type-list',
1732 `valid-char-table-value-p', and `check-char-table-value'.
1736 return CHAR_TABLEP (object) ? Qt : Qnil;
1739 DEFUN ("char-table-type-list", Fchar_table_type_list, 0, 0, 0, /*
1740 Return a list of the recognized char table types.
1741 See `valid-char-table-type-p'.
1746 return list5 (Qchar, Qcategory, Qdisplay, Qgeneric, Qsyntax);
1748 return list4 (Qchar, Qdisplay, Qgeneric, Qsyntax);
1752 DEFUN ("valid-char-table-type-p", Fvalid_char_table_type_p, 1, 1, 0, /*
1753 Return t if TYPE if a recognized char table type.
1755 Each char table type is used for a different purpose and allows different
1756 sorts of values. The different char table types are
1759 Used for category tables, which specify the regexp categories
1760 that a character is in. The valid values are nil or a
1761 bit vector of 95 elements. Higher-level Lisp functions are
1762 provided for working with category tables. Currently categories
1763 and category tables only exist when Mule support is present.
1765 A generalized char table, for mapping from one character to
1766 another. Used for case tables, syntax matching tables,
1767 `keyboard-translate-table', etc. The valid values are characters.
1769 An even more generalized char table, for mapping from a
1770 character to anything.
1772 Used for display tables, which specify how a particular character
1773 is to appear when displayed. #### Not yet implemented.
1775 Used for syntax tables, which specify the syntax of a particular
1776 character. Higher-level Lisp functions are provided for
1777 working with syntax tables. The valid values are integers.
1782 return (EQ (type, Qchar) ||
1784 EQ (type, Qcategory) ||
1786 EQ (type, Qdisplay) ||
1787 EQ (type, Qgeneric) ||
1788 EQ (type, Qsyntax)) ? Qt : Qnil;
1791 DEFUN ("char-table-type", Fchar_table_type, 1, 1, 0, /*
1792 Return the type of CHAR-TABLE.
1793 See `valid-char-table-type-p'.
1797 CHECK_CHAR_TABLE (char_table);
1798 return char_table_type_to_symbol (XCHAR_TABLE (char_table)->type);
1802 fill_char_table (Lisp_Char_Table *ct, Lisp_Object value)
1805 ct->table = Qunbound;
1806 ct->default_value = value;
1811 for (i = 0; i < NUM_ASCII_CHARS; i++)
1812 ct->ascii[i] = value;
1814 for (i = 0; i < NUM_LEADING_BYTES; i++)
1815 ct->level1[i] = value;
1820 if (ct->type == CHAR_TABLE_TYPE_SYNTAX)
1821 update_syntax_table (ct);
1825 DEFUN ("reset-char-table", Freset_char_table, 1, 1, 0, /*
1826 Reset CHAR-TABLE to its default state.
1830 Lisp_Char_Table *ct;
1832 CHECK_CHAR_TABLE (char_table);
1833 ct = XCHAR_TABLE (char_table);
1837 case CHAR_TABLE_TYPE_CHAR:
1838 fill_char_table (ct, make_char (0));
1840 case CHAR_TABLE_TYPE_DISPLAY:
1841 case CHAR_TABLE_TYPE_GENERIC:
1843 case CHAR_TABLE_TYPE_CATEGORY:
1845 fill_char_table (ct, Qnil);
1848 case CHAR_TABLE_TYPE_SYNTAX:
1849 fill_char_table (ct, make_int (Sinherit));
1859 DEFUN ("make-char-table", Fmake_char_table, 1, 1, 0, /*
1860 Return a new, empty char table of type TYPE.
1861 Currently recognized types are 'char, 'category, 'display, 'generic,
1862 and 'syntax. See `valid-char-table-type-p'.
1866 Lisp_Char_Table *ct;
1868 enum char_table_type ty = symbol_to_char_table_type (type);
1870 ct = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table);
1873 if (ty == CHAR_TABLE_TYPE_SYNTAX)
1875 ct->mirror_table = Fmake_char_table (Qgeneric);
1876 fill_char_table (XCHAR_TABLE (ct->mirror_table),
1880 ct->mirror_table = Qnil;
1883 #ifndef HAVE_LIBCHISE
1887 ct->next_table = Qnil;
1888 XSETCHAR_TABLE (obj, ct);
1889 if (ty == CHAR_TABLE_TYPE_SYNTAX)
1891 ct->next_table = Vall_syntax_tables;
1892 Vall_syntax_tables = obj;
1894 Freset_char_table (obj);
1898 #if defined(MULE)&&!defined(UTF2000)
1901 make_char_table_entry (Lisp_Object initval)
1905 Lisp_Char_Table_Entry *cte =
1906 alloc_lcrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry);
1908 for (i = 0; i < 96; i++)
1909 cte->level2[i] = initval;
1911 XSETCHAR_TABLE_ENTRY (obj, cte);
1916 copy_char_table_entry (Lisp_Object entry)
1918 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (entry);
1921 Lisp_Char_Table_Entry *ctenew =
1922 alloc_lcrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry);
1924 for (i = 0; i < 96; i++)
1926 Lisp_Object new = cte->level2[i];
1927 if (CHAR_TABLE_ENTRYP (new))
1928 ctenew->level2[i] = copy_char_table_entry (new);
1930 ctenew->level2[i] = new;
1933 XSETCHAR_TABLE_ENTRY (obj, ctenew);
1939 DEFUN ("copy-char-table", Fcopy_char_table, 1, 1, 0, /*
1940 Return a new char table which is a copy of CHAR-TABLE.
1941 It will contain the same values for the same characters and ranges
1942 as CHAR-TABLE. The values will not themselves be copied.
1946 Lisp_Char_Table *ct, *ctnew;
1952 CHECK_CHAR_TABLE (char_table);
1953 ct = XCHAR_TABLE (char_table);
1954 ctnew = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table);
1955 ctnew->type = ct->type;
1957 ctnew->default_value = ct->default_value;
1958 /* [tomo:2002-01-21] Perhaps this code seems wrong */
1959 ctnew->name = ct->name;
1960 #ifndef HAVE_LIBCHISE
1964 if (UINT8_BYTE_TABLE_P (ct->table))
1966 ctnew->table = copy_uint8_byte_table (ct->table);
1968 else if (UINT16_BYTE_TABLE_P (ct->table))
1970 ctnew->table = copy_uint16_byte_table (ct->table);
1972 else if (BYTE_TABLE_P (ct->table))
1974 ctnew->table = copy_byte_table (ct->table);
1976 else if (!UNBOUNDP (ct->table))
1977 ctnew->table = ct->table;
1978 #else /* non UTF2000 */
1980 for (i = 0; i < NUM_ASCII_CHARS; i++)
1982 Lisp_Object new = ct->ascii[i];
1984 assert (! (CHAR_TABLE_ENTRYP (new)));
1986 ctnew->ascii[i] = new;
1991 for (i = 0; i < NUM_LEADING_BYTES; i++)
1993 Lisp_Object new = ct->level1[i];
1994 if (CHAR_TABLE_ENTRYP (new))
1995 ctnew->level1[i] = copy_char_table_entry (new);
1997 ctnew->level1[i] = new;
2001 #endif /* non UTF2000 */
2004 if (CHAR_TABLEP (ct->mirror_table))
2005 ctnew->mirror_table = Fcopy_char_table (ct->mirror_table);
2007 ctnew->mirror_table = ct->mirror_table;
2009 ctnew->next_table = Qnil;
2010 XSETCHAR_TABLE (obj, ctnew);
2011 if (ctnew->type == CHAR_TABLE_TYPE_SYNTAX)
2013 ctnew->next_table = Vall_syntax_tables;
2014 Vall_syntax_tables = obj;
2019 INLINE_HEADER int XCHARSET_CELL_RANGE (Lisp_Object ccs);
2021 XCHARSET_CELL_RANGE (Lisp_Object ccs)
2023 switch (XCHARSET_CHARS (ccs))
2026 return (33 << 8) | 126;
2028 return (32 << 8) | 127;
2031 return (0 << 8) | 127;
2033 return (0 << 8) | 255;
2045 decode_char_table_range (Lisp_Object range, struct chartab_range *outrange)
2048 outrange->type = CHARTAB_RANGE_ALL;
2050 else if (EQ (range, Qnil))
2051 outrange->type = CHARTAB_RANGE_DEFAULT;
2053 else if (CHAR_OR_CHAR_INTP (range))
2055 outrange->type = CHARTAB_RANGE_CHAR;
2056 outrange->ch = XCHAR_OR_CHAR_INT (range);
2060 signal_simple_error ("Range must be t or a character", range);
2062 else if (VECTORP (range))
2064 Lisp_Vector *vec = XVECTOR (range);
2065 Lisp_Object *elts = vector_data (vec);
2066 int cell_min, cell_max;
2068 outrange->type = CHARTAB_RANGE_ROW;
2069 outrange->charset = Fget_charset (elts[0]);
2070 CHECK_INT (elts[1]);
2071 outrange->row = XINT (elts[1]);
2072 if (XCHARSET_DIMENSION (outrange->charset) < 2)
2073 signal_simple_error ("Charset in row vector must be multi-byte",
2077 int ret = XCHARSET_CELL_RANGE (outrange->charset);
2079 cell_min = ret >> 8;
2080 cell_max = ret & 0xFF;
2082 if (XCHARSET_DIMENSION (outrange->charset) == 2)
2083 check_int_range (outrange->row, cell_min, cell_max);
2085 else if (XCHARSET_DIMENSION (outrange->charset) == 3)
2087 check_int_range (outrange->row >> 8 , cell_min, cell_max);
2088 check_int_range (outrange->row & 0xFF, cell_min, cell_max);
2090 else if (XCHARSET_DIMENSION (outrange->charset) == 4)
2092 check_int_range ( outrange->row >> 16 , cell_min, cell_max);
2093 check_int_range ((outrange->row >> 8) & 0xFF, cell_min, cell_max);
2094 check_int_range ( outrange->row & 0xFF, cell_min, cell_max);
2102 if (!CHARSETP (range) && !SYMBOLP (range))
2104 ("Char table range must be t, charset, char, or vector", range);
2105 outrange->type = CHARTAB_RANGE_CHARSET;
2106 outrange->charset = Fget_charset (range);
2111 #if defined(MULE)&&!defined(UTF2000)
2113 /* called from CHAR_TABLE_VALUE(). */
2115 get_non_ascii_char_table_value (Lisp_Char_Table *ct, Charset_ID leading_byte,
2120 Lisp_Object charset;
2122 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (leading_byte);
2127 BREAKUP_CHAR (c, charset, byte1, byte2);
2129 BREAKUP_CHAR_1_UNSAFE (c, charset, byte1, byte2);
2131 val = ct->level1[leading_byte - MIN_LEADING_BYTE];
2132 if (CHAR_TABLE_ENTRYP (val))
2134 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
2135 val = cte->level2[byte1 - 32];
2136 if (CHAR_TABLE_ENTRYP (val))
2138 cte = XCHAR_TABLE_ENTRY (val);
2139 assert (byte2 >= 32);
2140 val = cte->level2[byte2 - 32];
2141 assert (!CHAR_TABLE_ENTRYP (val));
2151 get_char_table (Emchar ch, Lisp_Char_Table *ct)
2155 Lisp_Object ret = get_char_id_table (ct, ch);
2160 if (EQ (CHAR_TABLE_NAME (ct), Qdowncase))
2161 ret = Fchar_feature (make_char (ch), Q_lowercase, Qnil,
2163 else if (EQ (CHAR_TABLE_NAME (ct), Qflippedcase))
2164 ret = Fchar_feature (make_char (ch), Q_uppercase, Qnil,
2170 ret = Ffind_char (ret);
2178 Lisp_Object charset;
2182 BREAKUP_CHAR (ch, charset, byte1, byte2);
2184 if (EQ (charset, Vcharset_ascii))
2185 val = ct->ascii[byte1];
2186 else if (EQ (charset, Vcharset_control_1))
2187 val = ct->ascii[byte1 + 128];
2190 int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE;
2191 val = ct->level1[lb];
2192 if (CHAR_TABLE_ENTRYP (val))
2194 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
2195 val = cte->level2[byte1 - 32];
2196 if (CHAR_TABLE_ENTRYP (val))
2198 cte = XCHAR_TABLE_ENTRY (val);
2199 assert (byte2 >= 32);
2200 val = cte->level2[byte2 - 32];
2201 assert (!CHAR_TABLE_ENTRYP (val));
2208 #else /* not MULE */
2209 return ct->ascii[(unsigned char)ch];
2210 #endif /* not MULE */
2214 DEFUN ("get-char-table", Fget_char_table, 2, 2, 0, /*
2215 Find value for CHARACTER in CHAR-TABLE.
2217 (character, char_table))
2219 CHECK_CHAR_TABLE (char_table);
2220 CHECK_CHAR_COERCE_INT (character);
2222 return get_char_table (XCHAR (character), XCHAR_TABLE (char_table));
2225 DEFUN ("get-range-char-table", Fget_range_char_table, 2, 3, 0, /*
2226 Find value for a range in CHAR-TABLE.
2227 If there is more than one value, return MULTI (defaults to nil).
2229 (range, char_table, multi))
2231 Lisp_Char_Table *ct;
2232 struct chartab_range rainj;
2234 if (CHAR_OR_CHAR_INTP (range))
2235 return Fget_char_table (range, char_table);
2236 CHECK_CHAR_TABLE (char_table);
2237 ct = XCHAR_TABLE (char_table);
2239 decode_char_table_range (range, &rainj);
2242 case CHARTAB_RANGE_ALL:
2245 if (UINT8_BYTE_TABLE_P (ct->table))
2247 else if (UINT16_BYTE_TABLE_P (ct->table))
2249 else if (BYTE_TABLE_P (ct->table))
2253 #else /* non UTF2000 */
2255 Lisp_Object first = ct->ascii[0];
2257 for (i = 1; i < NUM_ASCII_CHARS; i++)
2258 if (!EQ (first, ct->ascii[i]))
2262 for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES;
2265 if (!CHARSETP (CHARSET_BY_LEADING_BYTE (i))
2266 || i == LEADING_BYTE_ASCII
2267 || i == LEADING_BYTE_CONTROL_1)
2269 if (!EQ (first, ct->level1[i - MIN_LEADING_BYTE]))
2275 #endif /* non UTF2000 */
2279 case CHARTAB_RANGE_CHARSET:
2283 if (EQ (rainj.charset, Vcharset_ascii))
2286 Lisp_Object first = ct->ascii[0];
2288 for (i = 1; i < 128; i++)
2289 if (!EQ (first, ct->ascii[i]))
2294 if (EQ (rainj.charset, Vcharset_control_1))
2297 Lisp_Object first = ct->ascii[128];
2299 for (i = 129; i < 160; i++)
2300 if (!EQ (first, ct->ascii[i]))
2306 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (rainj.charset) -
2308 if (CHAR_TABLE_ENTRYP (val))
2314 case CHARTAB_RANGE_ROW:
2319 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (rainj.charset) -
2321 if (!CHAR_TABLE_ENTRYP (val))
2323 val = XCHAR_TABLE_ENTRY (val)->level2[rainj.row - 32];
2324 if (CHAR_TABLE_ENTRYP (val))
2328 #endif /* not UTF2000 */
2329 #endif /* not MULE */
2335 return Qnil; /* not reached */
2339 check_valid_char_table_value (Lisp_Object value, enum char_table_type type,
2340 Error_behavior errb)
2344 case CHAR_TABLE_TYPE_SYNTAX:
2345 if (!ERRB_EQ (errb, ERROR_ME))
2346 return INTP (value) || (CONSP (value) && INTP (XCAR (value))
2347 && CHAR_OR_CHAR_INTP (XCDR (value)));
2350 Lisp_Object cdr = XCDR (value);
2351 CHECK_INT (XCAR (value));
2352 CHECK_CHAR_COERCE_INT (cdr);
2359 case CHAR_TABLE_TYPE_CATEGORY:
2360 if (!ERRB_EQ (errb, ERROR_ME))
2361 return CATEGORY_TABLE_VALUEP (value);
2362 CHECK_CATEGORY_TABLE_VALUE (value);
2366 case CHAR_TABLE_TYPE_GENERIC:
2369 case CHAR_TABLE_TYPE_DISPLAY:
2371 maybe_signal_simple_error ("Display char tables not yet implemented",
2372 value, Qchar_table, errb);
2375 case CHAR_TABLE_TYPE_CHAR:
2376 if (!ERRB_EQ (errb, ERROR_ME))
2377 return CHAR_OR_CHAR_INTP (value);
2378 CHECK_CHAR_COERCE_INT (value);
2385 return 0; /* not reached */
2389 canonicalize_char_table_value (Lisp_Object value, enum char_table_type type)
2393 case CHAR_TABLE_TYPE_SYNTAX:
2396 Lisp_Object car = XCAR (value);
2397 Lisp_Object cdr = XCDR (value);
2398 CHECK_CHAR_COERCE_INT (cdr);
2399 return Fcons (car, cdr);
2402 case CHAR_TABLE_TYPE_CHAR:
2403 CHECK_CHAR_COERCE_INT (value);
2411 DEFUN ("valid-char-table-value-p", Fvalid_char_table_value_p, 2, 2, 0, /*
2412 Return non-nil if VALUE is a valid value for CHAR-TABLE-TYPE.
2414 (value, char_table_type))
2416 enum char_table_type type = symbol_to_char_table_type (char_table_type);
2418 return check_valid_char_table_value (value, type, ERROR_ME_NOT) ? Qt : Qnil;
2421 DEFUN ("check-valid-char-table-value", Fcheck_valid_char_table_value, 2, 2, 0, /*
2422 Signal an error if VALUE is not a valid value for CHAR-TABLE-TYPE.
2424 (value, char_table_type))
2426 enum char_table_type type = symbol_to_char_table_type (char_table_type);
2428 check_valid_char_table_value (value, type, ERROR_ME);
2433 Lisp_Char_Table* char_attribute_table_to_put;
2434 Lisp_Object Qput_char_table_map_function;
2435 Lisp_Object value_to_put;
2437 DEFUN ("put-char-table-map-function",
2438 Fput_char_table_map_function, 2, 2, 0, /*
2439 For internal use. Don't use it.
2443 put_char_id_table_0 (char_attribute_table_to_put,
2444 XCHAR (c), value_to_put);
2449 /* Assign VAL to all characters in RANGE in char table CT. */
2452 put_char_table (Lisp_Char_Table *ct, struct chartab_range *range,
2455 switch (range->type)
2457 case CHARTAB_RANGE_ALL:
2458 fill_char_table (ct, val);
2459 return; /* avoid the duplicate call to update_syntax_table() below,
2460 since fill_char_table() also did that. */
2463 case CHARTAB_RANGE_DEFAULT:
2464 ct->default_value = val;
2469 case CHARTAB_RANGE_CHARSET:
2472 Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (range->charset);
2474 if ( CHAR_TABLEP (encoding_table) )
2476 Lisp_Object mother = XCHARSET_MOTHER (range->charset);
2478 char_attribute_table_to_put = ct;
2480 Fmap_char_attribute (Qput_char_table_map_function,
2481 XCHAR_TABLE_NAME (encoding_table),
2483 if ( CHARSETP (mother) )
2485 struct chartab_range r;
2487 r.type = CHARTAB_RANGE_CHARSET;
2489 put_char_table (ct, &r, val);
2497 for (c = 0; c < 1 << 24; c++)
2499 if ( charset_code_point (range->charset, c) >= 0 )
2500 put_char_id_table_0 (ct, c, val);
2506 if (EQ (range->charset, Vcharset_ascii))
2509 for (i = 0; i < 128; i++)
2512 else if (EQ (range->charset, Vcharset_control_1))
2515 for (i = 128; i < 160; i++)
2520 int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE;
2521 ct->level1[lb] = val;
2526 case CHARTAB_RANGE_ROW:
2529 int cell_min, cell_max, i;
2531 i = XCHARSET_CELL_RANGE (range->charset);
2533 cell_max = i & 0xFF;
2534 for (i = cell_min; i <= cell_max; i++)
2537 = DECODE_CHAR (range->charset, (range->row << 8) | i, 0);
2539 if ( charset_code_point (range->charset, ch, 0) >= 0 )
2540 put_char_id_table_0 (ct, ch, val);
2545 Lisp_Char_Table_Entry *cte;
2546 int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE;
2547 /* make sure that there is a separate entry for the row. */
2548 if (!CHAR_TABLE_ENTRYP (ct->level1[lb]))
2549 ct->level1[lb] = make_char_table_entry (ct->level1[lb]);
2550 cte = XCHAR_TABLE_ENTRY (ct->level1[lb]);
2551 cte->level2[range->row - 32] = val;
2553 #endif /* not UTF2000 */
2557 case CHARTAB_RANGE_CHAR:
2559 put_char_id_table_0 (ct, range->ch, val);
2563 Lisp_Object charset;
2566 BREAKUP_CHAR (range->ch, charset, byte1, byte2);
2567 if (EQ (charset, Vcharset_ascii))
2568 ct->ascii[byte1] = val;
2569 else if (EQ (charset, Vcharset_control_1))
2570 ct->ascii[byte1 + 128] = val;
2573 Lisp_Char_Table_Entry *cte;
2574 int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE;
2575 /* make sure that there is a separate entry for the row. */
2576 if (!CHAR_TABLE_ENTRYP (ct->level1[lb]))
2577 ct->level1[lb] = make_char_table_entry (ct->level1[lb]);
2578 cte = XCHAR_TABLE_ENTRY (ct->level1[lb]);
2579 /* now CTE is a char table entry for the charset;
2580 each entry is for a single row (or character of
2581 a one-octet charset). */
2582 if (XCHARSET_DIMENSION (charset) == 1)
2583 cte->level2[byte1 - 32] = val;
2586 /* assigning to one character in a two-octet charset. */
2587 /* make sure that the charset row contains a separate
2588 entry for each character. */
2589 if (!CHAR_TABLE_ENTRYP (cte->level2[byte1 - 32]))
2590 cte->level2[byte1 - 32] =
2591 make_char_table_entry (cte->level2[byte1 - 32]);
2592 cte = XCHAR_TABLE_ENTRY (cte->level2[byte1 - 32]);
2593 cte->level2[byte2 - 32] = val;
2597 #else /* not MULE */
2598 ct->ascii[(unsigned char) (range->ch)] = val;
2600 #endif /* not MULE */
2604 if (ct->type == CHAR_TABLE_TYPE_SYNTAX)
2605 update_syntax_table (ct);
2609 DEFUN ("put-char-table", Fput_char_table, 3, 3, 0, /*
2610 Set the value for chars in RANGE to be VALUE in CHAR-TABLE.
2612 RANGE specifies one or more characters to be affected and should be
2613 one of the following:
2615 -- t (all characters are affected)
2616 -- A charset (only allowed when Mule support is present)
2617 -- A vector of two elements: a two-octet charset and a row number
2618 (only allowed when Mule support is present)
2619 -- A single character
2621 VALUE must be a value appropriate for the type of CHAR-TABLE.
2622 See `valid-char-table-type-p'.
2624 (range, value, char_table))
2626 Lisp_Char_Table *ct;
2627 struct chartab_range rainj;
2629 CHECK_CHAR_TABLE (char_table);
2630 ct = XCHAR_TABLE (char_table);
2631 check_valid_char_table_value (value, ct->type, ERROR_ME);
2632 decode_char_table_range (range, &rainj);
2633 value = canonicalize_char_table_value (value, ct->type);
2634 put_char_table (ct, &rainj, value);
2639 /* Map FN over the ASCII chars in CT. */
2642 map_over_charset_ascii (Lisp_Char_Table *ct,
2643 int (*fn) (struct chartab_range *range,
2644 Lisp_Object val, void *arg),
2647 struct chartab_range rainj;
2656 rainj.type = CHARTAB_RANGE_CHAR;
2658 for (i = start, retval = 0; i < stop && retval == 0; i++)
2660 rainj.ch = (Emchar) i;
2661 retval = (fn) (&rainj, ct->ascii[i], arg);
2669 /* Map FN over the Control-1 chars in CT. */
2672 map_over_charset_control_1 (Lisp_Char_Table *ct,
2673 int (*fn) (struct chartab_range *range,
2674 Lisp_Object val, void *arg),
2677 struct chartab_range rainj;
2680 int stop = start + 32;
2682 rainj.type = CHARTAB_RANGE_CHAR;
2684 for (i = start, retval = 0; i < stop && retval == 0; i++)
2686 rainj.ch = (Emchar) (i);
2687 retval = (fn) (&rainj, ct->ascii[i], arg);
2693 /* Map FN over the row ROW of two-byte charset CHARSET.
2694 There must be a separate value for that row in the char table.
2695 CTE specifies the char table entry for CHARSET. */
2698 map_over_charset_row (Lisp_Char_Table_Entry *cte,
2699 Lisp_Object charset, int row,
2700 int (*fn) (struct chartab_range *range,
2701 Lisp_Object val, void *arg),
2704 Lisp_Object val = cte->level2[row - 32];
2706 if (!CHAR_TABLE_ENTRYP (val))
2708 struct chartab_range rainj;
2710 rainj.type = CHARTAB_RANGE_ROW;
2711 rainj.charset = charset;
2713 return (fn) (&rainj, val, arg);
2717 struct chartab_range rainj;
2719 int charset94_p = (XCHARSET_CHARS (charset) == 94);
2720 int start = charset94_p ? 33 : 32;
2721 int stop = charset94_p ? 127 : 128;
2723 cte = XCHAR_TABLE_ENTRY (val);
2725 rainj.type = CHARTAB_RANGE_CHAR;
2727 for (i = start, retval = 0; i < stop && retval == 0; i++)
2729 rainj.ch = MAKE_CHAR (charset, row, i);
2730 retval = (fn) (&rainj, cte->level2[i - 32], arg);
2738 map_over_other_charset (Lisp_Char_Table *ct, Charset_ID lb,
2739 int (*fn) (struct chartab_range *range,
2740 Lisp_Object val, void *arg),
2743 Lisp_Object val = ct->level1[lb - MIN_LEADING_BYTE];
2744 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (lb);
2746 if (!CHARSETP (charset)
2747 || lb == LEADING_BYTE_ASCII
2748 || lb == LEADING_BYTE_CONTROL_1)
2751 if (!CHAR_TABLE_ENTRYP (val))
2753 struct chartab_range rainj;
2755 rainj.type = CHARTAB_RANGE_CHARSET;
2756 rainj.charset = charset;
2757 return (fn) (&rainj, val, arg);
2761 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
2762 int charset94_p = (XCHARSET_CHARS (charset) == 94);
2763 int start = charset94_p ? 33 : 32;
2764 int stop = charset94_p ? 127 : 128;
2767 if (XCHARSET_DIMENSION (charset) == 1)
2769 struct chartab_range rainj;
2770 rainj.type = CHARTAB_RANGE_CHAR;
2772 for (i = start, retval = 0; i < stop && retval == 0; i++)
2774 rainj.ch = MAKE_CHAR (charset, i, 0);
2775 retval = (fn) (&rainj, cte->level2[i - 32], arg);
2780 for (i = start, retval = 0; i < stop && retval == 0; i++)
2781 retval = map_over_charset_row (cte, charset, i, fn, arg);
2789 #endif /* not UTF2000 */
2792 struct map_char_table_for_charset_arg
2794 int (*fn) (struct chartab_range *range, Lisp_Object val, void *arg);
2795 Lisp_Char_Table *ct;
2800 map_char_table_for_charset_fun (struct chartab_range *range,
2801 Lisp_Object val, void *arg)
2803 struct map_char_table_for_charset_arg *closure =
2804 (struct map_char_table_for_charset_arg *) arg;
2807 switch (range->type)
2809 case CHARTAB_RANGE_ALL:
2812 case CHARTAB_RANGE_DEFAULT:
2815 case CHARTAB_RANGE_CHARSET:
2818 case CHARTAB_RANGE_ROW:
2821 case CHARTAB_RANGE_CHAR:
2822 ret = get_char_table (range->ch, closure->ct);
2823 if (!UNBOUNDP (ret))
2824 return (closure->fn) (range, ret, closure->arg);
2836 /* Map FN (with client data ARG) over range RANGE in char table CT.
2837 Mapping stops the first time FN returns non-zero, and that value
2838 becomes the return value of map_char_table(). */
2841 map_char_table (Lisp_Char_Table *ct,
2842 struct chartab_range *range,
2843 int (*fn) (struct chartab_range *range,
2844 Lisp_Object val, void *arg),
2847 switch (range->type)
2849 case CHARTAB_RANGE_ALL:
2851 if (!UNBOUNDP (ct->default_value))
2853 struct chartab_range rainj;
2856 rainj.type = CHARTAB_RANGE_DEFAULT;
2857 retval = (fn) (&rainj, ct->default_value, arg);
2861 if (UINT8_BYTE_TABLE_P (ct->table))
2862 return map_over_uint8_byte_table (XUINT8_BYTE_TABLE(ct->table), ct,
2864 else if (UINT16_BYTE_TABLE_P (ct->table))
2865 return map_over_uint16_byte_table (XUINT16_BYTE_TABLE(ct->table), ct,
2867 else if (BYTE_TABLE_P (ct->table))
2868 return map_over_byte_table (XBYTE_TABLE(ct->table), ct,
2870 else if (EQ (ct->table, Qunloaded))
2873 struct chartab_range rainj;
2876 Emchar c1 = c + unit;
2879 rainj.type = CHARTAB_RANGE_CHAR;
2881 for (retval = 0; c < c1 && retval == 0; c++)
2883 Lisp_Object ret = get_char_id_table (ct, c);
2885 if (!UNBOUNDP (ret))
2888 retval = (fn) (&rainj, ct->table, arg);
2893 ct->table = Qunbound;
2896 else if (!UNBOUNDP (ct->table))
2897 return (fn) (range, ct->table, arg);
2903 retval = map_over_charset_ascii (ct, fn, arg);
2907 retval = map_over_charset_control_1 (ct, fn, arg);
2912 Charset_ID start = MIN_LEADING_BYTE;
2913 Charset_ID stop = start + NUM_LEADING_BYTES;
2915 for (i = start, retval = 0; i < stop && retval == 0; i++)
2917 retval = map_over_other_charset (ct, i, fn, arg);
2926 case CHARTAB_RANGE_DEFAULT:
2927 if (!UNBOUNDP (ct->default_value))
2928 return (fn) (range, ct->default_value, arg);
2933 case CHARTAB_RANGE_CHARSET:
2936 Lisp_Object encoding_table
2937 = XCHARSET_ENCODING_TABLE (range->charset);
2939 if (!NILP (encoding_table))
2941 struct chartab_range rainj;
2942 struct map_char_table_for_charset_arg mcarg;
2945 if (XCHAR_TABLE_UNLOADED(encoding_table))
2946 Fload_char_attribute_table (XCHAR_TABLE_NAME (encoding_table));
2951 rainj.type = CHARTAB_RANGE_ALL;
2952 return map_char_table (XCHAR_TABLE(encoding_table),
2954 &map_char_table_for_charset_fun,
2960 return map_over_other_charset (ct,
2961 XCHARSET_LEADING_BYTE (range->charset),
2965 case CHARTAB_RANGE_ROW:
2968 int cell_min, cell_max, i;
2970 struct chartab_range rainj;
2972 i = XCHARSET_CELL_RANGE (range->charset);
2974 cell_max = i & 0xFF;
2975 rainj.type = CHARTAB_RANGE_CHAR;
2976 for (retval =0, i = cell_min; i <= cell_max && retval == 0; i++)
2979 = DECODE_CHAR (range->charset, (range->row << 8) | i, 0);
2981 if ( charset_code_point (range->charset, ch, 0) >= 0 )
2984 = get_byte_table (get_byte_table
2988 (unsigned char)(ch >> 24)),
2989 (unsigned char) (ch >> 16)),
2990 (unsigned char) (ch >> 8)),
2991 (unsigned char) ch);
2994 val = ct->default_value;
2996 retval = (fn) (&rainj, val, arg);
3003 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (range->charset)
3004 - MIN_LEADING_BYTE];
3005 if (!CHAR_TABLE_ENTRYP (val))
3007 struct chartab_range rainj;
3009 rainj.type = CHARTAB_RANGE_ROW;
3010 rainj.charset = range->charset;
3011 rainj.row = range->row;
3012 return (fn) (&rainj, val, arg);
3015 return map_over_charset_row (XCHAR_TABLE_ENTRY (val),
3016 range->charset, range->row,
3019 #endif /* not UTF2000 */
3022 case CHARTAB_RANGE_CHAR:
3024 Emchar ch = range->ch;
3025 Lisp_Object val = CHAR_TABLE_VALUE_UNSAFE (ct, ch);
3027 if (!UNBOUNDP (val))
3029 struct chartab_range rainj;
3031 rainj.type = CHARTAB_RANGE_CHAR;
3033 return (fn) (&rainj, val, arg);
3045 struct slow_map_char_table_arg
3047 Lisp_Object function;
3052 slow_map_char_table_fun (struct chartab_range *range,
3053 Lisp_Object val, void *arg)
3055 Lisp_Object ranjarg = Qnil;
3056 struct slow_map_char_table_arg *closure =
3057 (struct slow_map_char_table_arg *) arg;
3059 switch (range->type)
3061 case CHARTAB_RANGE_ALL:
3066 case CHARTAB_RANGE_DEFAULT:
3072 case CHARTAB_RANGE_CHARSET:
3073 ranjarg = XCHARSET_NAME (range->charset);
3076 case CHARTAB_RANGE_ROW:
3077 ranjarg = vector2 (XCHARSET_NAME (range->charset),
3078 make_int (range->row));
3081 case CHARTAB_RANGE_CHAR:
3082 ranjarg = make_char (range->ch);
3088 closure->retval = call2 (closure->function, ranjarg, val);
3089 return !NILP (closure->retval);
3092 DEFUN ("map-char-table", Fmap_char_table, 2, 3, 0, /*
3093 Map FUNCTION over entries in CHAR-TABLE, calling it with two args,
3094 each key and value in the table.
3096 RANGE specifies a subrange to map over and is in the same format as
3097 the RANGE argument to `put-range-table'. If omitted or t, it defaults to
3100 (function, char_table, range))
3102 Lisp_Char_Table *ct;
3103 struct slow_map_char_table_arg slarg;
3104 struct gcpro gcpro1, gcpro2;
3105 struct chartab_range rainj;
3107 CHECK_CHAR_TABLE (char_table);
3108 ct = XCHAR_TABLE (char_table);
3111 decode_char_table_range (range, &rainj);
3112 slarg.function = function;
3113 slarg.retval = Qnil;
3114 GCPRO2 (slarg.function, slarg.retval);
3115 map_char_table (ct, &rainj, slow_map_char_table_fun, &slarg);
3118 return slarg.retval;
3122 /************************************************************************/
3123 /* Character Attributes */
3124 /************************************************************************/
3128 Lisp_Object Vchar_attribute_hash_table;
3130 /* We store the char-attributes in hash tables with the names as the
3131 key and the actual char-id-table object as the value. Occasionally
3132 we need to use them in a list format. These routines provide us
3134 struct char_attribute_list_closure
3136 Lisp_Object *char_attribute_list;
3140 add_char_attribute_to_list_mapper (Lisp_Object key, Lisp_Object value,
3141 void *char_attribute_list_closure)
3143 /* This function can GC */
3144 struct char_attribute_list_closure *calcl
3145 = (struct char_attribute_list_closure*) char_attribute_list_closure;
3146 Lisp_Object *char_attribute_list = calcl->char_attribute_list;
3148 *char_attribute_list = Fcons (key, *char_attribute_list);
3152 #ifdef HAVE_LIBCHISE
3154 char_attribute_list_reset_map_func (CHISE_DS *ds, unsigned char *name)
3156 Fmount_char_attribute_table (intern (name));
3160 DEFUN ("char-attribute-list", Fchar_attribute_list, 0, 1, 0, /*
3161 Return the list of all existing character attributes except coded-charsets.
3165 DEFUN ("char-attribute-list", Fchar_attribute_list, 0, 0, 0, /*
3166 Return the list of all existing character attributes except coded-charsets.
3171 Lisp_Object char_attribute_list = Qnil;
3172 struct gcpro gcpro1;
3173 struct char_attribute_list_closure char_attribute_list_closure;
3175 #ifdef HAVE_LIBCHISE
3178 open_chise_data_source_maybe ();
3179 chise_ds_foreach_char_feature_name
3180 (default_chise_data_source, &char_attribute_list_reset_map_func);
3183 GCPRO1 (char_attribute_list);
3184 char_attribute_list_closure.char_attribute_list = &char_attribute_list;
3185 elisp_maphash (add_char_attribute_to_list_mapper,
3186 Vchar_attribute_hash_table,
3187 &char_attribute_list_closure);
3189 return char_attribute_list;
3192 DEFUN ("find-char-attribute-table", Ffind_char_attribute_table, 1, 1, 0, /*
3193 Return char-id-table corresponding to ATTRIBUTE.
3197 return Fgethash (attribute, Vchar_attribute_hash_table, Qnil);
3201 /* We store the char-id-tables in hash tables with the attributes as
3202 the key and the actual char-id-table object as the value. Each
3203 char-id-table stores values of an attribute corresponding with
3204 characters. Occasionally we need to get attributes of a character
3205 in a association-list format. These routines provide us with
3207 struct char_attribute_alist_closure
3210 Lisp_Object *char_attribute_alist;
3214 add_char_attribute_alist_mapper (Lisp_Object key, Lisp_Object value,
3215 void *char_attribute_alist_closure)
3217 /* This function can GC */
3218 struct char_attribute_alist_closure *caacl =
3219 (struct char_attribute_alist_closure*) char_attribute_alist_closure;
3221 = get_char_id_table (XCHAR_TABLE(value), caacl->char_id);
3222 if (!UNBOUNDP (ret))
3224 Lisp_Object *char_attribute_alist = caacl->char_attribute_alist;
3225 *char_attribute_alist
3226 = Fcons (Fcons (key, ret), *char_attribute_alist);
3231 DEFUN ("char-attribute-alist", Fchar_attribute_alist, 1, 1, 0, /*
3232 Return the alist of attributes of CHARACTER.
3236 struct gcpro gcpro1;
3237 struct char_attribute_alist_closure char_attribute_alist_closure;
3238 Lisp_Object alist = Qnil;
3240 CHECK_CHAR (character);
3243 char_attribute_alist_closure.char_id = XCHAR (character);
3244 char_attribute_alist_closure.char_attribute_alist = &alist;
3245 elisp_maphash (add_char_attribute_alist_mapper,
3246 Vchar_attribute_hash_table,
3247 &char_attribute_alist_closure);
3253 DEFUN ("get-char-attribute", Fget_char_attribute, 2, 3, 0, /*
3254 Return the value of CHARACTER's ATTRIBUTE.
3255 Return DEFAULT-VALUE if the value is not exist.
3257 (character, attribute, default_value))
3261 CHECK_CHAR (character);
3263 if (CHARSETP (attribute))
3264 attribute = XCHARSET_NAME (attribute);
3266 table = Fgethash (attribute, Vchar_attribute_hash_table,
3268 if (!UNBOUNDP (table))
3270 Lisp_Object ret = get_char_id_table (XCHAR_TABLE(table),
3272 if (!UNBOUNDP (ret))
3275 return default_value;
3279 find_char_feature_in_family (Lisp_Object character,
3280 Lisp_Object con_feature,
3281 Lisp_Object feature,
3282 Lisp_Object feature_rel_max)
3284 Lisp_Object ancestors
3285 = Fget_char_attribute (character, con_feature, Qnil);
3287 while (!NILP (ancestors))
3289 Lisp_Object ancestor = XCAR (ancestors);
3292 if (EQ (ancestor, character))
3295 ret = Fchar_feature (ancestor, feature, Qunbound,
3296 Qnil, make_int (0));
3297 if (!UNBOUNDP (ret))
3300 ancestors = XCDR (ancestors);
3302 ret = Fget_char_attribute (ancestor, Q_subsumptive_from, Qnil);
3304 ancestors = nconc2 (Fcopy_sequence (ancestors), ret);
3306 ret = Fget_char_attribute (ancestor, Q_denotational_from, Qnil);
3308 ancestors = nconc2 (Fcopy_sequence (ancestors), ret);
3313 DEFUN ("char-feature", Fchar_feature, 2, 5, 0, /*
3314 Return the value of CHARACTER's FEATURE.
3315 Return DEFAULT-VALUE if the value is not exist.
3317 (character, attribute, default_value,
3318 feature_rel_max, char_rel_max))
3321 = Fget_char_attribute (character, attribute, Qunbound);
3323 if (!UNBOUNDP (ret))
3326 if (NILP (feature_rel_max)
3327 || (INTP (feature_rel_max) &&
3328 XINT (feature_rel_max) > 0))
3330 Lisp_String* name = symbol_name (XSYMBOL (attribute));
3331 Bufbyte *name_str = string_data (name);
3333 if (name_str[0] == '=' && name_str[1] == '>')
3335 Bytecount length = string_length (name) - 1;
3336 Lisp_Object map_to = make_uninit_string (length);
3338 memcpy (XSTRING_DATA (map_to) + 1, name_str + 2, length - 1);
3339 XSTRING_DATA(map_to)[0] = '=';
3340 ret = Fchar_feature (character, Fintern (map_to, Qnil),
3342 NILP (feature_rel_max)
3344 : make_int (XINT (feature_rel_max) - 1),
3346 if (!UNBOUNDP (ret))
3351 if ( !(EQ (attribute, Q_identical)) &&
3352 !(EQ (attribute, Q_subsumptive_from)) &&
3353 !(EQ (attribute, Q_denotational_from)) &&
3354 ( (NILP (char_rel_max)
3355 || (INTP (char_rel_max) &&
3356 XINT (char_rel_max) > 0)) ) )
3358 Lisp_String* name = symbol_name (XSYMBOL (attribute));
3359 Bufbyte *name_str = string_data (name);
3361 if ( (name_str[0] != '=') || (name_str[1] == '>') )
3363 ret = find_char_feature_in_family (character, Q_identical,
3364 attribute, feature_rel_max);
3365 if (!UNBOUNDP (ret))
3368 ret = find_char_feature_in_family (character, Q_subsumptive_from,
3369 attribute, feature_rel_max);
3370 if (!UNBOUNDP (ret))
3373 ret = find_char_feature_in_family (character, Q_denotational_from,
3374 attribute, feature_rel_max);
3375 if (!UNBOUNDP (ret))
3379 return default_value;
3382 void put_char_composition (Lisp_Object character, Lisp_Object value);
3384 put_char_composition (Lisp_Object character, Lisp_Object value)
3387 signal_simple_error ("Invalid value for ->decomposition",
3390 if (CONSP (Fcdr (value)))
3392 if (NILP (Fcdr (Fcdr (value))))
3394 Lisp_Object base = Fcar (value);
3395 Lisp_Object modifier = Fcar (Fcdr (value));
3399 base = make_char (XINT (base));
3400 Fsetcar (value, base);
3402 if (INTP (modifier))
3404 modifier = make_char (XINT (modifier));
3405 Fsetcar (Fcdr (value), modifier);
3410 = Fchar_feature (base, Qcomposition, Qnil,
3412 Lisp_Object ret = Fassq (modifier, alist);
3415 Fput_char_attribute (base, Qcomposition,
3416 Fcons (Fcons (modifier, character),
3419 Fsetcdr (ret, character);
3425 Lisp_Object v = Fcar (value);
3429 Emchar c = XINT (v);
3431 = Fchar_feature (make_char (c), Q_ucs_unified, Qnil,
3436 Fput_char_attribute (make_char (c), Q_ucs_unified,
3437 Fcons (character, Qnil));
3439 else if (NILP (Fmemq (character, ret)))
3441 Fput_char_attribute (make_char (c), Q_ucs_unified,
3442 Fcons (character, ret));
3449 put_char_attribute (Lisp_Object character, Lisp_Object attribute,
3452 Lisp_Object table = Fgethash (attribute,
3453 Vchar_attribute_hash_table,
3458 table = make_char_id_table (Qunbound);
3459 Fputhash (attribute, table, Vchar_attribute_hash_table);
3461 XCHAR_TABLE_NAME (table) = attribute;
3464 put_char_id_table (XCHAR_TABLE(table), character, value);
3468 DEFUN ("put-char-attribute", Fput_char_attribute, 3, 3, 0, /*
3469 Store CHARACTER's ATTRIBUTE with VALUE.
3471 (character, attribute, value))
3473 Lisp_Object ccs = Ffind_charset (attribute);
3475 CHECK_CHAR (character);
3479 value = put_char_ccs_code_point (character, ccs, value);
3480 attribute = XCHARSET_NAME (ccs);
3482 else if (EQ (attribute, Q_decomposition))
3483 put_char_composition (character, value);
3484 else if (EQ (attribute, Qto_ucs))
3490 signal_simple_error ("Invalid value for =>ucs", value);
3494 ret = Fchar_feature (make_char (c), Q_ucs_unified, Qnil,
3497 put_char_attribute (make_char (c), Q_ucs_unified,
3499 else if (NILP (Fmemq (character, ret)))
3500 Fput_char_attribute (make_char (c), Q_ucs_unified,
3501 Fcons (character, ret));
3503 else if ( EQ (attribute, Q_subsumptive) ||
3504 EQ (attribute, Q_subsumptive_from) ||
3505 EQ (attribute, Q_denotational) ||
3506 EQ (attribute, Q_denotational_from) ||
3507 EQ (attribute, Q_identical) ||
3508 EQ (attribute, Q_identical_from) ||
3509 EQ (attribute, Q_component) ||
3510 EQ (attribute, Q_component_of) ||
3511 !NILP (Fstring_match
3512 (build_string ("^\\(<-\\|->\\)\\(simplified"
3513 "\\|same\\|vulgar\\|wrong"
3516 Fsymbol_name (attribute),
3519 Lisp_Object rest = value;
3521 Lisp_Object rev_feature = Qnil;
3522 struct gcpro gcpro1;
3523 GCPRO1 (rev_feature);
3525 if (EQ (attribute, Q_identical))
3526 rev_feature = Q_identical_from;
3527 else if (EQ (attribute, Q_identical_from))
3528 rev_feature = Q_identical;
3529 else if (EQ (attribute, Q_subsumptive))
3530 rev_feature = Q_subsumptive_from;
3531 else if (EQ (attribute, Q_subsumptive_from))
3532 rev_feature = Q_subsumptive;
3533 else if (EQ (attribute, Q_denotational))
3534 rev_feature = Q_denotational_from;
3535 else if (EQ (attribute, Q_denotational_from))
3536 rev_feature = Q_denotational;
3537 else if (EQ (attribute, Q_component))
3538 rev_feature = Q_component_of;
3539 else if (EQ (attribute, Q_component_of))
3540 rev_feature = Q_component;
3543 Lisp_String* name = symbol_name (XSYMBOL (attribute));
3544 Bufbyte *name_str = string_data (name);
3546 if ( (name_str[0] == '<' && name_str[1] == '-') ||
3547 (name_str[0] == '-' && name_str[1] == '>') )
3549 Bytecount length = string_length (name);
3550 Bufbyte *rev_name_str = alloca (length + 1);
3552 memcpy (rev_name_str + 2, name_str + 2, length - 2);
3553 if (name_str[0] == '<')
3555 rev_name_str[0] = '-';
3556 rev_name_str[1] = '>';
3560 rev_name_str[0] = '<';
3561 rev_name_str[1] = '-';
3563 rev_name_str[length] = 0;
3564 rev_feature = intern (rev_name_str);
3568 while (CONSP (rest))
3573 ret = Fdefine_char (ret);
3575 if ( !NILP (ret) && !EQ (ret, character) )
3579 ffv = Fget_char_attribute (ret, rev_feature, Qnil);
3581 put_char_attribute (ret, rev_feature, list1 (character));
3582 else if (NILP (Fmemq (character, ffv)))
3585 nconc2 (Fcopy_sequence (ffv), list1 (character)));
3586 Fsetcar (rest, ret);
3593 else if (EQ (attribute, Qideographic_structure))
3594 value = Fcopy_sequence (Fchar_refs_simplify_char_specs (value));
3596 return put_char_attribute (character, attribute, value);
3599 DEFUN ("remove-char-attribute", Fremove_char_attribute, 2, 2, 0, /*
3600 Remove CHARACTER's ATTRIBUTE.
3602 (character, attribute))
3606 CHECK_CHAR (character);
3607 ccs = Ffind_charset (attribute);
3610 return remove_char_ccs (character, ccs);
3614 Lisp_Object table = Fgethash (attribute,
3615 Vchar_attribute_hash_table,
3617 if (!UNBOUNDP (table))
3619 put_char_id_table (XCHAR_TABLE(table), character, Qunbound);
3628 int char_table_open_db_maybe (Lisp_Char_Table* cit);
3629 void char_table_close_db_maybe (Lisp_Char_Table* cit);
3630 Lisp_Object char_table_get_db (Lisp_Char_Table* cit, Emchar ch);
3632 #ifdef HAVE_LIBCHISE
3634 open_chise_data_source_maybe ()
3636 if (default_chise_data_source == NULL)
3638 Lisp_Object db_dir = Vexec_directory;
3639 int modemask = 0755; /* rwxr-xr-x */
3642 db_dir = build_string ("../lib-src");
3643 db_dir = Fexpand_file_name (build_string ("chise-db"), db_dir);
3645 default_chise_data_source
3646 = CHISE_DS_open (CHISE_DS_Berkeley_DB, XSTRING_DATA (db_dir),
3647 0 /* DB_HASH */, modemask);
3648 if (default_chise_data_source == NULL)
3653 #endif /* HAVE_LIBCHISE */
3655 DEFUN ("close-char-data-source", Fclose_char_data_source, 0, 0, 0, /*
3656 Close data-source of CHISE.
3660 #ifdef HAVE_LIBCHISE
3661 int status = CHISE_DS_close (default_chise_data_source);
3663 default_chise_data_source = NULL;
3666 #endif /* HAVE_LIBCHISE */
3671 char_table_open_db_maybe (Lisp_Char_Table* cit)
3673 Lisp_Object attribute = CHAR_TABLE_NAME (cit);
3675 if (!NILP (attribute))
3677 #ifdef HAVE_LIBCHISE
3678 if ( open_chise_data_source_maybe () )
3680 #else /* HAVE_LIBCHISE */
3681 if (NILP (Fdatabase_live_p (cit->db)))
3684 = char_attribute_system_db_file (Qsystem_char_id, attribute, 0);
3686 cit->db = Fopen_database (db_file, Qnil, Qnil,
3687 build_string ("r"), Qnil);
3691 #endif /* not HAVE_LIBCHISE */
3699 char_table_close_db_maybe (Lisp_Char_Table* cit)
3701 #ifndef HAVE_LIBCHISE
3702 if (!NILP (cit->db))
3704 if (!NILP (Fdatabase_live_p (cit->db)))
3705 Fclose_database (cit->db);
3708 #endif /* not HAVE_LIBCHISE */
3712 char_table_get_db (Lisp_Char_Table* cit, Emchar ch)
3715 #ifdef HAVE_LIBCHISE
3718 = chise_ds_load_char_feature_value (default_chise_data_source, ch,
3719 XSTRING_DATA(Fsymbol_name
3725 val = Fread (make_string (chise_value_data (&value),
3726 chise_value_size (&value) ));
3730 #else /* HAVE_LIBCHISE */
3731 val = Fget_database (Fprin1_to_string (make_char (ch), Qnil),
3733 if (!UNBOUNDP (val))
3737 #endif /* not HAVE_LIBCHISE */
3741 #ifndef HAVE_LIBCHISE
3743 char_attribute_system_db_file (Lisp_Object key_type, Lisp_Object attribute,
3746 Lisp_Object db_dir = Vexec_directory;
3749 db_dir = build_string ("../lib-src");
3751 db_dir = Fexpand_file_name (build_string ("chise-db"), db_dir);
3752 if (writing_mode && NILP (Ffile_exists_p (db_dir)))
3753 Fmake_directory_internal (db_dir);
3755 db_dir = Fexpand_file_name (Fsymbol_name (key_type), db_dir);
3756 if (writing_mode && NILP (Ffile_exists_p (db_dir)))
3757 Fmake_directory_internal (db_dir);
3760 Lisp_Object attribute_name = Fsymbol_name (attribute);
3761 Lisp_Object dest = Qnil, ret;
3763 struct gcpro gcpro1, gcpro2;
3764 int len = XSTRING_CHAR_LENGTH (attribute_name);
3768 for (i = 0; i < len; i++)
3770 Emchar c = string_char (XSTRING (attribute_name), i);
3772 if ( (c == '/') || (c == '%') )
3776 sprintf (str, "%%%02X", c);
3777 dest = concat3 (dest,
3778 Fsubstring (attribute_name,
3779 make_int (base), make_int (i)),
3780 build_string (str));
3784 ret = Fsubstring (attribute_name, make_int (base), make_int (len));
3785 dest = concat2 (dest, ret);
3787 return Fexpand_file_name (dest, db_dir);
3790 #endif /* not HAVE_LIBCHISE */
3792 DEFUN ("save-char-attribute-table", Fsave_char_attribute_table, 1, 1, 0, /*
3793 Save values of ATTRIBUTE into database file.
3797 Lisp_Object table = Fgethash (attribute,
3798 Vchar_attribute_hash_table, Qunbound);
3799 Lisp_Char_Table *ct;
3800 #ifdef HAVE_LIBCHISE
3801 CHISE_Feature feature;
3802 #else /* HAVE_LIBCHISE */
3803 Lisp_Object db_file;
3805 #endif /* not HAVE_LIBCHISE */
3807 if (CHAR_TABLEP (table))
3808 ct = XCHAR_TABLE (table);
3812 #ifdef HAVE_LIBCHISE
3813 if ( open_chise_data_source_maybe () )
3816 = chise_ds_get_feature (default_chise_data_source,
3817 XSTRING_DATA (Fsymbol_name (attribute)));
3818 #else /* HAVE_LIBCHISE */
3819 db_file = char_attribute_system_db_file (Qsystem_char_id, attribute, 1);
3820 db = Fopen_database (db_file, Qnil, Qnil, build_string ("w+"), Qnil);
3821 #endif /* not HAVE_LIBCHISE */
3823 #ifdef HAVE_LIBCHISE
3825 #else /* HAVE_LIBCHISE */
3827 #endif /* not HAVE_LIBCHISE */
3830 Lisp_Object (*filter)(Lisp_Object value);
3832 if ( EQ (attribute, Qideographic_structure)
3833 || EQ (attribute, Q_identical)
3834 || EQ (attribute, Q_identical_from)
3835 || !NILP (Fstring_match
3836 (build_string ("^\\(<-\\|->\\)\\(simplified"
3837 "\\|same\\|vulgar\\|wrong"
3840 Fsymbol_name (attribute),
3842 filter = &Fchar_refs_simplify_char_specs;
3846 if (UINT8_BYTE_TABLE_P (ct->table))
3847 save_uint8_byte_table (XUINT8_BYTE_TABLE(ct->table), ct,
3848 #ifdef HAVE_LIBCHISE
3850 #else /* HAVE_LIBCHISE */
3852 #endif /* not HAVE_LIBCHISE */
3854 else if (UINT16_BYTE_TABLE_P (ct->table))
3855 save_uint16_byte_table (XUINT16_BYTE_TABLE(ct->table), ct,
3856 #ifdef HAVE_LIBCHISE
3858 #else /* HAVE_LIBCHISE */
3860 #endif /* not HAVE_LIBCHISE */
3862 else if (BYTE_TABLE_P (ct->table))
3863 save_byte_table (XBYTE_TABLE(ct->table), ct,
3864 #ifdef HAVE_LIBCHISE
3866 #else /* HAVE_LIBCHISE */
3868 #endif /* not HAVE_LIBCHISE */
3870 #ifdef HAVE_LIBCHISE
3871 chise_feature_sync (feature);
3872 #else /* HAVE_LIBCHISE */
3873 Fclose_database (db);
3874 #endif /* not HAVE_LIBCHISE */
3881 DEFUN ("mount-char-attribute-table", Fmount_char_attribute_table, 1, 1, 0, /*
3882 Mount database file on char-attribute-table ATTRIBUTE.
3886 Lisp_Object table = Fgethash (attribute,
3887 Vchar_attribute_hash_table, Qunbound);
3889 if (UNBOUNDP (table))
3891 Lisp_Char_Table *ct;
3893 table = make_char_id_table (Qunbound);
3894 Fputhash (attribute, table, Vchar_attribute_hash_table);
3895 XCHAR_TABLE_NAME(table) = attribute;
3896 ct = XCHAR_TABLE (table);
3897 ct->table = Qunloaded;
3898 XCHAR_TABLE_UNLOADED(table) = 1;
3899 #ifndef HAVE_LIBCHISE
3901 #endif /* not HAVE_LIBCHISE */
3907 DEFUN ("close-char-attribute-table", Fclose_char_attribute_table, 1, 1, 0, /*
3908 Close database of ATTRIBUTE.
3912 Lisp_Object table = Fgethash (attribute,
3913 Vchar_attribute_hash_table, Qunbound);
3914 Lisp_Char_Table *ct;
3916 if (CHAR_TABLEP (table))
3917 ct = XCHAR_TABLE (table);
3920 char_table_close_db_maybe (ct);
3924 DEFUN ("reset-char-attribute-table", Freset_char_attribute_table, 1, 1, 0, /*
3925 Reset values of ATTRIBUTE with database file.
3929 #ifdef HAVE_LIBCHISE
3930 CHISE_Feature feature
3931 = chise_ds_get_feature (default_chise_data_source,
3932 XSTRING_DATA (Fsymbol_name
3935 if (feature == NULL)
3938 if (chise_feature_setup_db (feature, 0) == 0)
3940 Lisp_Object table = Fgethash (attribute,
3941 Vchar_attribute_hash_table, Qunbound);
3942 Lisp_Char_Table *ct;
3944 chise_feature_sync (feature);
3945 if (UNBOUNDP (table))
3947 table = make_char_id_table (Qunbound);
3948 Fputhash (attribute, table, Vchar_attribute_hash_table);
3949 XCHAR_TABLE_NAME(table) = attribute;
3951 ct = XCHAR_TABLE (table);
3952 ct->table = Qunloaded;
3953 char_table_close_db_maybe (ct);
3954 XCHAR_TABLE_UNLOADED(table) = 1;
3958 Lisp_Object table = Fgethash (attribute,
3959 Vchar_attribute_hash_table, Qunbound);
3960 Lisp_Char_Table *ct;
3962 = char_attribute_system_db_file (Qsystem_char_id, attribute, 0);
3964 if (!NILP (Ffile_exists_p (db_file)))
3966 if (UNBOUNDP (table))
3968 table = make_char_id_table (Qunbound);
3969 Fputhash (attribute, table, Vchar_attribute_hash_table);
3970 XCHAR_TABLE_NAME(table) = attribute;
3972 ct = XCHAR_TABLE (table);
3973 ct->table = Qunloaded;
3974 char_table_close_db_maybe (ct);
3975 XCHAR_TABLE_UNLOADED(table) = 1;
3983 load_char_attribute_maybe (Lisp_Char_Table* cit, Emchar ch)
3985 Lisp_Object attribute = CHAR_TABLE_NAME (cit);
3987 if (!NILP (attribute))
3991 if (char_table_open_db_maybe (cit))
3994 val = char_table_get_db (cit, ch);
3996 if (!NILP (Vchar_db_stingy_mode))
3997 char_table_close_db_maybe (cit);
4004 Lisp_Char_Table* char_attribute_table_to_load;
4006 #ifdef HAVE_LIBCHISE
4008 load_char_attribute_table_map_func (CHISE_Char_ID cid,
4009 CHISE_Feature feature,
4010 CHISE_Value *value);
4012 load_char_attribute_table_map_func (CHISE_Char_ID cid,
4013 CHISE_Feature feature,
4017 Lisp_Object ret = get_char_id_table_0 (char_attribute_table_to_load, code);
4019 if (EQ (ret, Qunloaded))
4020 put_char_id_table_0 (char_attribute_table_to_load, code,
4021 Fread (make_string ((Bufbyte *) value->data,
4025 #else /* HAVE_LIBCHISE */
4026 Lisp_Object Qload_char_attribute_table_map_function;
4028 DEFUN ("load-char-attribute-table-map-function",
4029 Fload_char_attribute_table_map_function, 2, 2, 0, /*
4030 For internal use. Don't use it.
4034 Lisp_Object c = Fread (key);
4035 Emchar code = XCHAR (c);
4036 Lisp_Object ret = get_char_id_table_0 (char_attribute_table_to_load, code);
4038 if (EQ (ret, Qunloaded))
4039 put_char_id_table_0 (char_attribute_table_to_load, code, Fread (value));
4042 #endif /* not HAVE_LIBCHISE */
4044 DEFUN ("load-char-attribute-table", Fload_char_attribute_table, 1, 1, 0, /*
4045 Load values of ATTRIBUTE into database file.
4049 Lisp_Object table = Fgethash (attribute,
4050 Vchar_attribute_hash_table,
4052 if (CHAR_TABLEP (table))
4054 Lisp_Char_Table *cit = XCHAR_TABLE (table);
4056 if (char_table_open_db_maybe (cit))
4059 char_attribute_table_to_load = XCHAR_TABLE (table);
4061 struct gcpro gcpro1;
4064 #ifdef HAVE_LIBCHISE
4065 chise_feature_foreach_char_with_value
4066 (chise_ds_get_feature (default_chise_data_source,
4067 XSTRING_DATA (Fsymbol_name (cit->name))),
4068 &load_char_attribute_table_map_func);
4069 #else /* HAVE_LIBCHISE */
4070 Fmap_database (Qload_char_attribute_table_map_function, cit->db);
4071 #endif /* not HAVE_LIBCHISE */
4074 char_table_close_db_maybe (cit);
4075 XCHAR_TABLE_UNLOADED(table) = 0;
4080 #endif /* HAVE_CHISE */
4082 DEFUN ("map-char-attribute", Fmap_char_attribute, 2, 3, 0, /*
4083 Map FUNCTION over entries in ATTRIBUTE, calling it with two args,
4084 each key and value in the table.
4086 RANGE specifies a subrange to map over and is in the same format as
4087 the RANGE argument to `put-range-table'. If omitted or t, it defaults to
4090 (function, attribute, range))
4093 Lisp_Char_Table *ct;
4094 struct slow_map_char_table_arg slarg;
4095 struct gcpro gcpro1, gcpro2;
4096 struct chartab_range rainj;
4098 if (!NILP (ccs = Ffind_charset (attribute)))
4100 Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (ccs);
4102 if (CHAR_TABLEP (encoding_table))
4103 ct = XCHAR_TABLE (encoding_table);
4109 Lisp_Object table = Fgethash (attribute,
4110 Vchar_attribute_hash_table,
4112 if (CHAR_TABLEP (table))
4113 ct = XCHAR_TABLE (table);
4119 decode_char_table_range (range, &rainj);
4121 if (CHAR_TABLE_UNLOADED(ct))
4122 Fload_char_attribute_table (attribute);
4124 slarg.function = function;
4125 slarg.retval = Qnil;
4126 GCPRO2 (slarg.function, slarg.retval);
4127 map_char_table (ct, &rainj, slow_map_char_table_fun, &slarg);
4130 return slarg.retval;
4133 DEFUN ("define-char", Fdefine_char, 1, 1, 0, /*
4134 Store character's ATTRIBUTES.
4139 Lisp_Object code = Fcdr (Fassq (Qmap_ucs, attributes));
4140 Lisp_Object character;
4143 code = Fcdr (Fassq (Qucs, attributes));
4148 while (CONSP (rest))
4150 Lisp_Object cell = Fcar (rest);
4153 if ( !LISTP (cell) )
4154 signal_simple_error ("Invalid argument", attributes);
4156 ccs = Ffind_charset (Fcar (cell));
4162 character = Fdecode_char (ccs, cell, Qt, Qt);
4163 if (!NILP (character))
4164 goto setup_attributes;
4166 if ( (XCHARSET_FINAL (ccs) != 0) ||
4167 (XCHARSET_MAX_CODE (ccs) > 0) ||
4168 (EQ (ccs, Vcharset_chinese_big5)) )
4172 = Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
4174 character = Fdecode_char (ccs, cell, Qnil, Qt);
4175 if (!NILP (character))
4176 goto setup_attributes;
4183 int cid = XINT (Vnext_defined_char_id);
4185 if (cid <= 0xE00000)
4187 character = make_char (cid);
4188 Vnext_defined_char_id = make_int (cid + 1);
4189 goto setup_attributes;
4193 if ( (!NILP (code = Fcdr (Fassq (Qto_ucs, attributes)))) )
4196 signal_simple_error ("Invalid argument", attributes);
4198 character = make_char (XINT (code) + 0x100000);
4199 goto setup_attributes;
4204 else if (!INTP (code))
4205 signal_simple_error ("Invalid argument", attributes);
4207 character = make_char (XINT (code));
4211 while (CONSP (rest))
4213 Lisp_Object cell = Fcar (rest);
4216 signal_simple_error ("Invalid argument", attributes);
4218 Fput_char_attribute (character, Fcar (cell), Fcdr (cell));
4224 DEFUN ("find-char", Ffind_char, 1, 1, 0, /*
4225 Retrieve the character of the given ATTRIBUTES.
4229 Lisp_Object rest = attributes;
4232 while (CONSP (rest))
4234 Lisp_Object cell = Fcar (rest);
4238 signal_simple_error ("Invalid argument", attributes);
4239 if (!NILP (ccs = Ffind_charset (Fcar (cell))))
4243 return Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
4245 return Fdecode_char (ccs, cell, Qnil, Qnil);
4249 if ( (!NILP (code = Fcdr (Fassq (Qto_ucs, attributes)))) )
4252 signal_simple_error ("Invalid argument", attributes);
4254 return make_char (XINT (code) + 0x100000);
4262 /************************************************************************/
4263 /* Char table read syntax */
4264 /************************************************************************/
4267 chartab_type_validate (Lisp_Object keyword, Lisp_Object value,
4268 Error_behavior errb)
4270 /* #### should deal with ERRB */
4271 symbol_to_char_table_type (value);
4276 chartab_data_validate (Lisp_Object keyword, Lisp_Object value,
4277 Error_behavior errb)
4281 /* #### should deal with ERRB */
4282 EXTERNAL_LIST_LOOP (rest, value)
4284 Lisp_Object range = XCAR (rest);
4285 struct chartab_range dummy;
4289 signal_simple_error ("Invalid list format", value);
4292 if (!CONSP (XCDR (range))
4293 || !NILP (XCDR (XCDR (range))))
4294 signal_simple_error ("Invalid range format", range);
4295 decode_char_table_range (XCAR (range), &dummy);
4296 decode_char_table_range (XCAR (XCDR (range)), &dummy);
4299 decode_char_table_range (range, &dummy);
4306 chartab_instantiate (Lisp_Object data)
4308 Lisp_Object chartab;
4309 Lisp_Object type = Qgeneric;
4310 Lisp_Object dataval = Qnil;
4312 while (!NILP (data))
4314 Lisp_Object keyw = Fcar (data);
4320 if (EQ (keyw, Qtype))
4322 else if (EQ (keyw, Qdata))
4326 chartab = Fmake_char_table (type);
4329 while (!NILP (data))
4331 Lisp_Object range = Fcar (data);
4332 Lisp_Object val = Fcar (Fcdr (data));
4334 data = Fcdr (Fcdr (data));
4337 if (CHAR_OR_CHAR_INTP (XCAR (range)))
4339 Emchar first = XCHAR_OR_CHAR_INT (Fcar (range));
4340 Emchar last = XCHAR_OR_CHAR_INT (Fcar (Fcdr (range)));
4343 for (i = first; i <= last; i++)
4344 Fput_char_table (make_char (i), val, chartab);
4350 Fput_char_table (range, val, chartab);
4359 /************************************************************************/
4360 /* Category Tables, specifically */
4361 /************************************************************************/
4363 DEFUN ("category-table-p", Fcategory_table_p, 1, 1, 0, /*
4364 Return t if OBJECT is a category table.
4365 A category table is a type of char table used for keeping track of
4366 categories. Categories are used for classifying characters for use
4367 in regexps -- you can refer to a category rather than having to use
4368 a complicated [] expression (and category lookups are significantly
4371 There are 95 different categories available, one for each printable
4372 character (including space) in the ASCII charset. Each category
4373 is designated by one such character, called a "category designator".
4374 They are specified in a regexp using the syntax "\\cX", where X is
4375 a category designator.
4377 A category table specifies, for each character, the categories that
4378 the character is in. Note that a character can be in more than one
4379 category. More specifically, a category table maps from a character
4380 to either the value nil (meaning the character is in no categories)
4381 or a 95-element bit vector, specifying for each of the 95 categories
4382 whether the character is in that category.
4384 Special Lisp functions are provided that abstract this, so you do not
4385 have to directly manipulate bit vectors.
4389 return (CHAR_TABLEP (object) &&
4390 XCHAR_TABLE_TYPE (object) == CHAR_TABLE_TYPE_CATEGORY) ?
4395 check_category_table (Lisp_Object object, Lisp_Object default_)
4399 while (NILP (Fcategory_table_p (object)))
4400 object = wrong_type_argument (Qcategory_table_p, object);
4405 check_category_char (Emchar ch, Lisp_Object table,
4406 unsigned int designator, unsigned int not_p)
4408 REGISTER Lisp_Object temp;
4409 Lisp_Char_Table *ctbl;
4410 #ifdef ERROR_CHECK_TYPECHECK
4411 if (NILP (Fcategory_table_p (table)))
4412 signal_simple_error ("Expected category table", table);
4414 ctbl = XCHAR_TABLE (table);
4415 temp = get_char_table (ch, ctbl);
4420 return bit_vector_bit (XBIT_VECTOR (temp), designator) ? !not_p : not_p;
4423 DEFUN ("check-category-at", Fcheck_category_at, 2, 4, 0, /*
4424 Return t if category of the character at POSITION includes DESIGNATOR.
4425 Optional third arg BUFFER specifies which buffer to use, and defaults
4426 to the current buffer.
4427 Optional fourth arg CATEGORY-TABLE specifies the category table to
4428 use, and defaults to BUFFER's category table.
4430 (position, designator, buffer, category_table))
4435 struct buffer *buf = decode_buffer (buffer, 0);
4437 CHECK_INT (position);
4438 CHECK_CATEGORY_DESIGNATOR (designator);
4439 des = XCHAR (designator);
4440 ctbl = check_category_table (category_table, Vstandard_category_table);
4441 ch = BUF_FETCH_CHAR (buf, XINT (position));
4442 return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil;
4445 DEFUN ("char-in-category-p", Fchar_in_category_p, 2, 3, 0, /*
4446 Return t if category of CHARACTER includes DESIGNATOR, else nil.
4447 Optional third arg CATEGORY-TABLE specifies the category table to use,
4448 and defaults to the standard category table.
4450 (character, designator, category_table))
4456 CHECK_CATEGORY_DESIGNATOR (designator);
4457 des = XCHAR (designator);
4458 CHECK_CHAR (character);
4459 ch = XCHAR (character);
4460 ctbl = check_category_table (category_table, Vstandard_category_table);
4461 return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil;
4464 DEFUN ("category-table", Fcategory_table, 0, 1, 0, /*
4465 Return BUFFER's current category table.
4466 BUFFER defaults to the current buffer.
4470 return decode_buffer (buffer, 0)->category_table;
4473 DEFUN ("standard-category-table", Fstandard_category_table, 0, 0, 0, /*
4474 Return the standard category table.
4475 This is the one used for new buffers.
4479 return Vstandard_category_table;
4482 DEFUN ("copy-category-table", Fcopy_category_table, 0, 1, 0, /*
4483 Return a new category table which is a copy of CATEGORY-TABLE.
4484 CATEGORY-TABLE defaults to the standard category table.
4488 if (NILP (Vstandard_category_table))
4489 return Fmake_char_table (Qcategory);
4492 check_category_table (category_table, Vstandard_category_table);
4493 return Fcopy_char_table (category_table);
4496 DEFUN ("set-category-table", Fset_category_table, 1, 2, 0, /*
4497 Select CATEGORY-TABLE as the new category table for BUFFER.
4498 BUFFER defaults to the current buffer if omitted.
4500 (category_table, buffer))
4502 struct buffer *buf = decode_buffer (buffer, 0);
4503 category_table = check_category_table (category_table, Qnil);
4504 buf->category_table = category_table;
4505 /* Indicate that this buffer now has a specified category table. */
4506 buf->local_var_flags |= XINT (buffer_local_flags.category_table);
4507 return category_table;
4510 DEFUN ("category-designator-p", Fcategory_designator_p, 1, 1, 0, /*
4511 Return t if OBJECT is a category designator (a char in the range ' ' to '~').
4515 return CATEGORY_DESIGNATORP (object) ? Qt : Qnil;
4518 DEFUN ("category-table-value-p", Fcategory_table_value_p, 1, 1, 0, /*
4519 Return t if OBJECT is a category table value.
4520 Valid values are nil or a bit vector of size 95.
4524 return CATEGORY_TABLE_VALUEP (object) ? Qt : Qnil;
4528 #define CATEGORYP(x) \
4529 (CHARP (x) && XCHAR (x) >= 0x20 && XCHAR (x) <= 0x7E)
4531 #define CATEGORY_SET(c) \
4532 (get_char_table(c, XCHAR_TABLE(current_buffer->category_table)))
4534 /* Return 1 if CATEGORY_SET contains CATEGORY, else return 0.
4535 The faster version of `!NILP (Faref (category_set, category))'. */
4536 #define CATEGORY_MEMBER(category, category_set) \
4537 (bit_vector_bit(XBIT_VECTOR (category_set), category - 32))
4539 /* Return 1 if there is a word boundary between two word-constituent
4540 characters C1 and C2 if they appear in this order, else return 0.
4541 Use the macro WORD_BOUNDARY_P instead of calling this function
4544 int word_boundary_p (Emchar c1, Emchar c2);
4546 word_boundary_p (Emchar c1, Emchar c2)
4548 Lisp_Object category_set1, category_set2;
4553 if (COMPOSITE_CHAR_P (c1))
4554 c1 = cmpchar_component (c1, 0, 1);
4555 if (COMPOSITE_CHAR_P (c2))
4556 c2 = cmpchar_component (c2, 0, 1);
4560 if (EQ (CHAR_CHARSET (c1), CHAR_CHARSET (c2)))
4563 tail = Vword_separating_categories;
4569 tail = Vword_combining_categories;
4574 category_set1 = CATEGORY_SET (c1);
4575 if (NILP (category_set1))
4576 return default_result;
4577 category_set2 = CATEGORY_SET (c2);
4578 if (NILP (category_set2))
4579 return default_result;
4581 for (; CONSP (tail); tail = XCONS (tail)->cdr)
4583 Lisp_Object elt = XCONS(tail)->car;
4586 && CATEGORYP (XCONS (elt)->car)
4587 && CATEGORYP (XCONS (elt)->cdr)
4588 && CATEGORY_MEMBER (XCHAR (XCONS (elt)->car), category_set1)
4589 && CATEGORY_MEMBER (XCHAR (XCONS (elt)->cdr), category_set2))
4590 return !default_result;
4592 return default_result;
4598 syms_of_chartab (void)
4601 INIT_LRECORD_IMPLEMENTATION (uint8_byte_table);
4602 INIT_LRECORD_IMPLEMENTATION (uint16_byte_table);
4603 INIT_LRECORD_IMPLEMENTATION (byte_table);
4605 defsymbol (&Qto_ucs, "=>ucs");
4606 defsymbol (&Q_ucs_unified, "->ucs-unified");
4607 defsymbol (&Q_subsumptive, "->subsumptive");
4608 defsymbol (&Q_subsumptive_from, "<-subsumptive");
4609 defsymbol (&Q_denotational, "->denotational");
4610 defsymbol (&Q_denotational_from, "<-denotational");
4611 defsymbol (&Q_identical, "->identical");
4612 defsymbol (&Q_identical_from, "<-identical");
4613 defsymbol (&Q_component, "->ideographic-component-forms");
4614 defsymbol (&Q_component_of, "<-ideographic-component-forms");
4615 defsymbol (&Qcomposition, "composition");
4616 defsymbol (&Q_decomposition, "->decomposition");
4617 defsymbol (&Qcompat, "compat");
4618 defsymbol (&Qisolated, "isolated");
4619 defsymbol (&Qinitial, "initial");
4620 defsymbol (&Qmedial, "medial");
4621 defsymbol (&Qfinal, "final");
4622 defsymbol (&Qvertical, "vertical");
4623 defsymbol (&QnoBreak, "noBreak");
4624 defsymbol (&Qfraction, "fraction");
4625 defsymbol (&Qsuper, "super");
4626 defsymbol (&Qsub, "sub");
4627 defsymbol (&Qcircle, "circle");
4628 defsymbol (&Qsquare, "square");
4629 defsymbol (&Qwide, "wide");
4630 defsymbol (&Qnarrow, "narrow");
4631 defsymbol (&Qsmall, "small");
4632 defsymbol (&Qfont, "font");
4634 DEFSUBR (Fchar_attribute_list);
4635 DEFSUBR (Ffind_char_attribute_table);
4636 defsymbol (&Qput_char_table_map_function, "put-char-table-map-function");
4637 DEFSUBR (Fput_char_table_map_function);
4639 DEFSUBR (Fsave_char_attribute_table);
4640 DEFSUBR (Fmount_char_attribute_table);
4641 DEFSUBR (Freset_char_attribute_table);
4642 DEFSUBR (Fclose_char_attribute_table);
4643 DEFSUBR (Fclose_char_data_source);
4644 #ifndef HAVE_LIBCHISE
4645 defsymbol (&Qload_char_attribute_table_map_function,
4646 "load-char-attribute-table-map-function");
4647 DEFSUBR (Fload_char_attribute_table_map_function);
4649 DEFSUBR (Fload_char_attribute_table);
4651 DEFSUBR (Fchar_feature);
4652 DEFSUBR (Fchar_attribute_alist);
4653 DEFSUBR (Fget_char_attribute);
4654 DEFSUBR (Fput_char_attribute);
4655 DEFSUBR (Fremove_char_attribute);
4656 DEFSUBR (Fmap_char_attribute);
4657 DEFSUBR (Fdefine_char);
4658 DEFSUBR (Ffind_char);
4659 DEFSUBR (Fchar_variants);
4661 DEFSUBR (Fget_composite_char);
4664 INIT_LRECORD_IMPLEMENTATION (char_table);
4668 INIT_LRECORD_IMPLEMENTATION (char_table_entry);
4671 defsymbol (&Qcategory_table_p, "category-table-p");
4672 defsymbol (&Qcategory_designator_p, "category-designator-p");
4673 defsymbol (&Qcategory_table_value_p, "category-table-value-p");
4676 defsymbol (&Qchar_table, "char-table");
4677 defsymbol (&Qchar_tablep, "char-table-p");
4679 DEFSUBR (Fchar_table_p);
4680 DEFSUBR (Fchar_table_type_list);
4681 DEFSUBR (Fvalid_char_table_type_p);
4682 DEFSUBR (Fchar_table_type);
4683 DEFSUBR (Freset_char_table);
4684 DEFSUBR (Fmake_char_table);
4685 DEFSUBR (Fcopy_char_table);
4686 DEFSUBR (Fget_char_table);
4687 DEFSUBR (Fget_range_char_table);
4688 DEFSUBR (Fvalid_char_table_value_p);
4689 DEFSUBR (Fcheck_valid_char_table_value);
4690 DEFSUBR (Fput_char_table);
4691 DEFSUBR (Fmap_char_table);
4694 DEFSUBR (Fcategory_table_p);
4695 DEFSUBR (Fcategory_table);
4696 DEFSUBR (Fstandard_category_table);
4697 DEFSUBR (Fcopy_category_table);
4698 DEFSUBR (Fset_category_table);
4699 DEFSUBR (Fcheck_category_at);
4700 DEFSUBR (Fchar_in_category_p);
4701 DEFSUBR (Fcategory_designator_p);
4702 DEFSUBR (Fcategory_table_value_p);
4708 vars_of_chartab (void)
4711 DEFVAR_LISP ("next-defined-char-id", &Vnext_defined_char_id /*
4713 Vnext_defined_char_id = make_int (0x0F0000);
4717 DEFVAR_LISP ("char-db-stingy-mode", &Vchar_db_stingy_mode /*
4719 Vchar_db_stingy_mode = Qt;
4721 #ifdef HAVE_LIBCHISE
4722 Vchise_db_directory = build_string(chise_db_dir);
4723 DEFVAR_LISP ("chise-db-directory", &Vchise_db_directory /*
4724 Directory of CHISE character databases.
4727 Vchise_system_db_directory = build_string(chise_system_db_dir);
4728 DEFVAR_LISP ("chise-system-db-directory", &Vchise_system_db_directory /*
4729 Directory of system character database of CHISE.
4733 #endif /* HAVE_CHISE */
4734 /* DO NOT staticpro this. It works just like Vweak_hash_tables. */
4735 Vall_syntax_tables = Qnil;
4736 dump_add_weak_object_chain (&Vall_syntax_tables);
4740 structure_type_create_chartab (void)
4742 struct structure_type *st;
4744 st = define_structure_type (Qchar_table, 0, chartab_instantiate);
4746 define_structure_type_keyword (st, Qtype, chartab_type_validate);
4747 define_structure_type_keyword (st, Qdata, chartab_data_validate);
4751 complex_vars_of_chartab (void)
4754 staticpro (&Vchar_attribute_hash_table);
4755 Vchar_attribute_hash_table
4756 = make_lisp_hash_table (16, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
4757 #endif /* UTF2000 */
4759 /* Set this now, so first buffer creation can refer to it. */
4760 /* Make it nil before calling copy-category-table
4761 so that copy-category-table will know not to try to copy from garbage */
4762 Vstandard_category_table = Qnil;
4763 Vstandard_category_table = Fcopy_category_table (Qnil);
4764 staticpro (&Vstandard_category_table);
4766 DEFVAR_LISP ("word-combining-categories", &Vword_combining_categories /*
4767 List of pair (cons) of categories to determine word boundary.
4769 Emacs treats a sequence of word constituent characters as a single
4770 word (i.e. finds no word boundary between them) iff they belongs to
4771 the same charset. But, exceptions are allowed in the following cases.
4773 \(1) The case that characters are in different charsets is controlled
4774 by the variable `word-combining-categories'.
4776 Emacs finds no word boundary between characters of different charsets
4777 if they have categories matching some element of this list.
4779 More precisely, if an element of this list is a cons of category CAT1
4780 and CAT2, and a multibyte character C1 which has CAT1 is followed by
4781 C2 which has CAT2, there's no word boundary between C1 and C2.
4783 For instance, to tell that ASCII characters and Latin-1 characters can
4784 form a single word, the element `(?l . ?l)' should be in this list
4785 because both characters have the category `l' (Latin characters).
4787 \(2) The case that character are in the same charset is controlled by
4788 the variable `word-separating-categories'.
4790 Emacs find a word boundary between characters of the same charset
4791 if they have categories matching some element of this list.
4793 More precisely, if an element of this list is a cons of category CAT1
4794 and CAT2, and a multibyte character C1 which has CAT1 is followed by
4795 C2 which has CAT2, there's a word boundary between C1 and C2.
4797 For instance, to tell that there's a word boundary between Japanese
4798 Hiragana and Japanese Kanji (both are in the same charset), the
4799 element `(?H . ?C) should be in this list.
4802 Vword_combining_categories = Qnil;
4804 DEFVAR_LISP ("word-separating-categories", &Vword_separating_categories /*
4805 List of pair (cons) of categories to determine word boundary.
4806 See the documentation of the variable `word-combining-categories'.
4809 Vword_separating_categories = Qnil;