1 /* XEmacs routines to deal with char tables.
2 Copyright (C) 1992, 1995 Free Software Foundation, Inc.
3 Copyright (C) 1995 Sun Microsystems, Inc.
4 Copyright (C) 1995, 1996 Ben Wing.
5 Copyright (C) 1995, 1997, 1999 Electrotechnical Laboratory, JAPAN.
6 Licensed to the Free Software Foundation.
7 Copyright (C) 1999,2000,2001,2002,2003,2004 MORIOKA Tomohiko
9 This file is part of XEmacs.
11 XEmacs is free software; you can redistribute it and/or modify it
12 under the terms of the GNU General Public License as published by the
13 Free Software Foundation; either version 2, or (at your option) any
16 XEmacs is distributed in the hope that it will be useful, but WITHOUT
17 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
18 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
21 You should have received a copy of the GNU General Public License
22 along with XEmacs; see the file COPYING. If not, write to
23 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 Boston, MA 02111-1307, USA. */
26 /* Synched up with: Mule 2.3. Not synched with FSF.
28 This file was written independently of the FSF implementation,
29 and is not compatible. */
33 Ben Wing: wrote, for 19.13 (Mule). Some category table stuff
34 loosely based on the original Mule.
35 Jareth Hein: fixed a couple of bugs in the implementation, and
36 added regex support for categories with check_category_at
37 MORIOKA Tomohiko: Rewritten for XEmacs CHISE
50 Lisp_Object Qchar_tablep, Qchar_table;
52 Lisp_Object Vall_syntax_tables;
55 Lisp_Object Qcategory_table_p;
56 Lisp_Object Qcategory_designator_p;
57 Lisp_Object Qcategory_table_value_p;
59 Lisp_Object Vstandard_category_table;
61 /* Variables to determine word boundary. */
62 Lisp_Object Vword_combining_categories, Vword_separating_categories;
67 Lisp_Object Vchise_db_directory;
68 Lisp_Object Vchise_system_db_directory;
70 CHISE_DS *default_chise_data_source = NULL;
75 EXFUN (Fchar_refs_simplify_char_specs, 1);
76 extern Lisp_Object Qideographic_structure;
78 Lisp_Object Vnext_defined_char_id;
79 EXFUN (Fdefine_char, 1);
81 EXFUN (Fmap_char_attribute, 3);
84 EXFUN (Fmount_char_attribute_table, 1);
88 EXFUN (Fload_char_attribute_table, 1);
90 Lisp_Object Vchar_db_stingy_mode;
93 #define BT_UINT8_MIN 0
94 #define BT_UINT8_MAX (UCHAR_MAX - 4)
95 #define BT_UINT8_t (UCHAR_MAX - 3)
96 #define BT_UINT8_nil (UCHAR_MAX - 2)
97 #define BT_UINT8_unbound (UCHAR_MAX - 1)
98 #define BT_UINT8_unloaded UCHAR_MAX
100 INLINE_HEADER int INT_UINT8_P (Lisp_Object obj);
101 INLINE_HEADER int UINT8_VALUE_P (Lisp_Object obj);
102 INLINE_HEADER unsigned char UINT8_ENCODE (Lisp_Object obj);
103 INLINE_HEADER Lisp_Object UINT8_DECODE (unsigned char n);
104 INLINE_HEADER unsigned short UINT8_TO_UINT16 (unsigned char n);
107 INT_UINT8_P (Lisp_Object obj)
111 int num = XINT (obj);
113 return (BT_UINT8_MIN <= num) && (num <= BT_UINT8_MAX);
120 UINT8_VALUE_P (Lisp_Object obj)
122 return EQ (obj, Qunloaded) || EQ (obj, Qunbound)
123 || EQ (obj, Qnil) || EQ (obj, Qt) || INT_UINT8_P (obj);
126 INLINE_HEADER unsigned char
127 UINT8_ENCODE (Lisp_Object obj)
129 if (EQ (obj, Qunloaded))
130 return BT_UINT8_unloaded;
131 else if (EQ (obj, Qunbound))
132 return BT_UINT8_unbound;
133 else if (EQ (obj, Qnil))
135 else if (EQ (obj, Qt))
141 INLINE_HEADER Lisp_Object
142 UINT8_DECODE (unsigned char n)
144 if (n == BT_UINT8_unloaded)
146 else if (n == BT_UINT8_unbound)
148 else if (n == BT_UINT8_nil)
150 else if (n == BT_UINT8_t)
157 mark_uint8_byte_table (Lisp_Object obj)
163 print_uint8_byte_table (Lisp_Object obj,
164 Lisp_Object printcharfun, int escapeflag)
166 Lisp_Uint8_Byte_Table *bte = XUINT8_BYTE_TABLE (obj);
168 struct gcpro gcpro1, gcpro2;
169 GCPRO2 (obj, printcharfun);
171 write_c_string ("\n#<uint8-byte-table", printcharfun);
172 for (i = 0; i < 256; i++)
174 unsigned char n = bte->property[i];
176 write_c_string ("\n ", printcharfun);
177 write_c_string (" ", printcharfun);
178 if (n == BT_UINT8_unbound)
179 write_c_string ("void", printcharfun);
180 else if (n == BT_UINT8_nil)
181 write_c_string ("nil", printcharfun);
182 else if (n == BT_UINT8_t)
183 write_c_string ("t", printcharfun);
188 sprintf (buf, "%hd", n);
189 write_c_string (buf, printcharfun);
193 write_c_string (">", printcharfun);
197 uint8_byte_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
199 Lisp_Uint8_Byte_Table *te1 = XUINT8_BYTE_TABLE (obj1);
200 Lisp_Uint8_Byte_Table *te2 = XUINT8_BYTE_TABLE (obj2);
203 for (i = 0; i < 256; i++)
204 if (te1->property[i] != te2->property[i])
210 uint8_byte_table_hash (Lisp_Object obj, int depth)
212 Lisp_Uint8_Byte_Table *te = XUINT8_BYTE_TABLE (obj);
216 for (i = 0; i < 256; i++)
217 hash = HASH2 (hash, te->property[i]);
221 static const struct lrecord_description uint8_byte_table_description[] = {
225 DEFINE_LRECORD_IMPLEMENTATION ("uint8-byte-table", uint8_byte_table,
226 mark_uint8_byte_table,
227 print_uint8_byte_table,
228 0, uint8_byte_table_equal,
229 uint8_byte_table_hash,
230 uint8_byte_table_description,
231 Lisp_Uint8_Byte_Table);
234 make_uint8_byte_table (unsigned char initval)
238 Lisp_Uint8_Byte_Table *cte;
240 cte = alloc_lcrecord_type (Lisp_Uint8_Byte_Table,
241 &lrecord_uint8_byte_table);
243 for (i = 0; i < 256; i++)
244 cte->property[i] = initval;
246 XSETUINT8_BYTE_TABLE (obj, cte);
251 copy_uint8_byte_table (Lisp_Object entry)
253 Lisp_Uint8_Byte_Table *cte = XUINT8_BYTE_TABLE (entry);
256 Lisp_Uint8_Byte_Table *ctenew
257 = alloc_lcrecord_type (Lisp_Uint8_Byte_Table,
258 &lrecord_uint8_byte_table);
260 for (i = 0; i < 256; i++)
262 ctenew->property[i] = cte->property[i];
265 XSETUINT8_BYTE_TABLE (obj, ctenew);
270 uint8_byte_table_same_value_p (Lisp_Object obj)
272 Lisp_Uint8_Byte_Table *bte = XUINT8_BYTE_TABLE (obj);
273 unsigned char v0 = bte->property[0];
276 for (i = 1; i < 256; i++)
278 if (bte->property[i] != v0)
285 map_over_uint8_byte_table (Lisp_Uint8_Byte_Table *ct, Lisp_Char_Table* root,
286 Emchar ofs, int place,
287 int (*fn) (struct chartab_range *range,
288 Lisp_Object val, void *arg),
291 struct chartab_range rainj;
293 int unit = 1 << (8 * place);
297 rainj.type = CHARTAB_RANGE_CHAR;
299 for (i = 0, retval = 0; i < 256 && retval == 0; i++)
301 if (ct->property[i] == BT_UINT8_unloaded)
305 for (; c < c1 && retval == 0; c++)
307 Lisp_Object ret = get_char_id_table (root, c);
312 retval = (fn) (&rainj, ret, arg);
316 ct->property[i] = BT_UINT8_unbound;
320 else if (ct->property[i] != BT_UINT8_unbound)
323 for (; c < c1 && retval == 0; c++)
326 retval = (fn) (&rainj, UINT8_DECODE (ct->property[i]), arg);
337 save_uint8_byte_table (Lisp_Uint8_Byte_Table *ct, Lisp_Char_Table* root,
339 CHISE_Feature feature,
343 Emchar ofs, int place,
344 Lisp_Object (*filter)(Lisp_Object value))
346 struct chartab_range rainj;
348 int unit = 1 << (8 * place);
352 rainj.type = CHARTAB_RANGE_CHAR;
354 for (i = 0, retval = 0; i < 256 && retval == 0; i++)
356 if (ct->property[i] == BT_UINT8_unloaded)
360 else if (ct->property[i] != BT_UINT8_unbound)
363 for (; c < c1 && retval == 0; c++)
366 chise_char_set_feature_value
369 (Fprin1_to_string (UINT8_DECODE (ct->property[i]),
372 Fput_database (Fprin1_to_string (make_char (c), Qnil),
373 Fprin1_to_string (UINT8_DECODE (ct->property[i]),
385 #define BT_UINT16_MIN 0
386 #define BT_UINT16_MAX (USHRT_MAX - 4)
387 #define BT_UINT16_t (USHRT_MAX - 3)
388 #define BT_UINT16_nil (USHRT_MAX - 2)
389 #define BT_UINT16_unbound (USHRT_MAX - 1)
390 #define BT_UINT16_unloaded USHRT_MAX
392 INLINE_HEADER int INT_UINT16_P (Lisp_Object obj);
393 INLINE_HEADER int UINT16_VALUE_P (Lisp_Object obj);
394 INLINE_HEADER unsigned short UINT16_ENCODE (Lisp_Object obj);
395 INLINE_HEADER Lisp_Object UINT16_DECODE (unsigned short us);
398 INT_UINT16_P (Lisp_Object obj)
402 int num = XINT (obj);
404 return (BT_UINT16_MIN <= num) && (num <= BT_UINT16_MAX);
411 UINT16_VALUE_P (Lisp_Object obj)
413 return EQ (obj, Qunloaded) || EQ (obj, Qunbound)
414 || EQ (obj, Qnil) || EQ (obj, Qt) || INT_UINT16_P (obj);
417 INLINE_HEADER unsigned short
418 UINT16_ENCODE (Lisp_Object obj)
420 if (EQ (obj, Qunloaded))
421 return BT_UINT16_unloaded;
422 else if (EQ (obj, Qunbound))
423 return BT_UINT16_unbound;
424 else if (EQ (obj, Qnil))
425 return BT_UINT16_nil;
426 else if (EQ (obj, Qt))
432 INLINE_HEADER Lisp_Object
433 UINT16_DECODE (unsigned short n)
435 if (n == BT_UINT16_unloaded)
437 else if (n == BT_UINT16_unbound)
439 else if (n == BT_UINT16_nil)
441 else if (n == BT_UINT16_t)
447 INLINE_HEADER unsigned short
448 UINT8_TO_UINT16 (unsigned char n)
450 if (n == BT_UINT8_unloaded)
451 return BT_UINT16_unloaded;
452 else if (n == BT_UINT8_unbound)
453 return BT_UINT16_unbound;
454 else if (n == BT_UINT8_nil)
455 return BT_UINT16_nil;
456 else if (n == BT_UINT8_t)
463 mark_uint16_byte_table (Lisp_Object obj)
469 print_uint16_byte_table (Lisp_Object obj,
470 Lisp_Object printcharfun, int escapeflag)
472 Lisp_Uint16_Byte_Table *bte = XUINT16_BYTE_TABLE (obj);
474 struct gcpro gcpro1, gcpro2;
475 GCPRO2 (obj, printcharfun);
477 write_c_string ("\n#<uint16-byte-table", printcharfun);
478 for (i = 0; i < 256; i++)
480 unsigned short n = bte->property[i];
482 write_c_string ("\n ", printcharfun);
483 write_c_string (" ", printcharfun);
484 if (n == BT_UINT16_unbound)
485 write_c_string ("void", printcharfun);
486 else if (n == BT_UINT16_nil)
487 write_c_string ("nil", printcharfun);
488 else if (n == BT_UINT16_t)
489 write_c_string ("t", printcharfun);
494 sprintf (buf, "%hd", n);
495 write_c_string (buf, printcharfun);
499 write_c_string (">", printcharfun);
503 uint16_byte_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
505 Lisp_Uint16_Byte_Table *te1 = XUINT16_BYTE_TABLE (obj1);
506 Lisp_Uint16_Byte_Table *te2 = XUINT16_BYTE_TABLE (obj2);
509 for (i = 0; i < 256; i++)
510 if (te1->property[i] != te2->property[i])
516 uint16_byte_table_hash (Lisp_Object obj, int depth)
518 Lisp_Uint16_Byte_Table *te = XUINT16_BYTE_TABLE (obj);
522 for (i = 0; i < 256; i++)
523 hash = HASH2 (hash, te->property[i]);
527 static const struct lrecord_description uint16_byte_table_description[] = {
531 DEFINE_LRECORD_IMPLEMENTATION ("uint16-byte-table", uint16_byte_table,
532 mark_uint16_byte_table,
533 print_uint16_byte_table,
534 0, uint16_byte_table_equal,
535 uint16_byte_table_hash,
536 uint16_byte_table_description,
537 Lisp_Uint16_Byte_Table);
540 make_uint16_byte_table (unsigned short initval)
544 Lisp_Uint16_Byte_Table *cte;
546 cte = alloc_lcrecord_type (Lisp_Uint16_Byte_Table,
547 &lrecord_uint16_byte_table);
549 for (i = 0; i < 256; i++)
550 cte->property[i] = initval;
552 XSETUINT16_BYTE_TABLE (obj, cte);
557 copy_uint16_byte_table (Lisp_Object entry)
559 Lisp_Uint16_Byte_Table *cte = XUINT16_BYTE_TABLE (entry);
562 Lisp_Uint16_Byte_Table *ctenew
563 = alloc_lcrecord_type (Lisp_Uint16_Byte_Table,
564 &lrecord_uint16_byte_table);
566 for (i = 0; i < 256; i++)
568 ctenew->property[i] = cte->property[i];
571 XSETUINT16_BYTE_TABLE (obj, ctenew);
576 expand_uint8_byte_table_to_uint16 (Lisp_Object table)
580 Lisp_Uint8_Byte_Table* bte = XUINT8_BYTE_TABLE(table);
581 Lisp_Uint16_Byte_Table* cte;
583 cte = alloc_lcrecord_type (Lisp_Uint16_Byte_Table,
584 &lrecord_uint16_byte_table);
585 for (i = 0; i < 256; i++)
587 cte->property[i] = UINT8_TO_UINT16 (bte->property[i]);
589 XSETUINT16_BYTE_TABLE (obj, cte);
594 uint16_byte_table_same_value_p (Lisp_Object obj)
596 Lisp_Uint16_Byte_Table *bte = XUINT16_BYTE_TABLE (obj);
597 unsigned short v0 = bte->property[0];
600 for (i = 1; i < 256; i++)
602 if (bte->property[i] != v0)
609 map_over_uint16_byte_table (Lisp_Uint16_Byte_Table *ct, Lisp_Char_Table* root,
610 Emchar ofs, int place,
611 int (*fn) (struct chartab_range *range,
612 Lisp_Object val, void *arg),
615 struct chartab_range rainj;
617 int unit = 1 << (8 * place);
621 rainj.type = CHARTAB_RANGE_CHAR;
623 for (i = 0, retval = 0; i < 256 && retval == 0; i++)
625 if (ct->property[i] == BT_UINT16_unloaded)
629 for (; c < c1 && retval == 0; c++)
631 Lisp_Object ret = get_char_id_table (root, c);
636 retval = (fn) (&rainj, ret, arg);
640 ct->property[i] = BT_UINT16_unbound;
644 else if (ct->property[i] != BT_UINT16_unbound)
647 for (; c < c1 && retval == 0; c++)
650 retval = (fn) (&rainj, UINT16_DECODE (ct->property[i]), arg);
661 save_uint16_byte_table (Lisp_Uint16_Byte_Table *ct, Lisp_Char_Table* root,
663 CHISE_Feature feature,
667 Emchar ofs, int place,
668 Lisp_Object (*filter)(Lisp_Object value))
670 struct chartab_range rainj;
672 int unit = 1 << (8 * place);
676 rainj.type = CHARTAB_RANGE_CHAR;
678 for (i = 0, retval = 0; i < 256 && retval == 0; i++)
680 if (ct->property[i] == BT_UINT16_unloaded)
684 else if (ct->property[i] != BT_UINT16_unbound)
687 for (; c < c1 && retval == 0; c++)
690 chise_char_set_feature_value
693 (Fprin1_to_string (UINT16_DECODE (ct->property[i]),
696 Fput_database (Fprin1_to_string (make_char (c), Qnil),
697 Fprin1_to_string (UINT16_DECODE (ct->property[i]),
711 mark_byte_table (Lisp_Object obj)
713 Lisp_Byte_Table *cte = XBYTE_TABLE (obj);
716 for (i = 0; i < 256; i++)
718 mark_object (cte->property[i]);
724 print_byte_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
726 Lisp_Byte_Table *bte = XBYTE_TABLE (obj);
728 struct gcpro gcpro1, gcpro2;
729 GCPRO2 (obj, printcharfun);
731 write_c_string ("\n#<byte-table", printcharfun);
732 for (i = 0; i < 256; i++)
734 Lisp_Object elt = bte->property[i];
736 write_c_string ("\n ", printcharfun);
737 write_c_string (" ", printcharfun);
738 if (EQ (elt, Qunbound))
739 write_c_string ("void", printcharfun);
741 print_internal (elt, printcharfun, escapeflag);
744 write_c_string (">", printcharfun);
748 byte_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
750 Lisp_Byte_Table *cte1 = XBYTE_TABLE (obj1);
751 Lisp_Byte_Table *cte2 = XBYTE_TABLE (obj2);
754 for (i = 0; i < 256; i++)
755 if (BYTE_TABLE_P (cte1->property[i]))
757 if (BYTE_TABLE_P (cte2->property[i]))
759 if (!byte_table_equal (cte1->property[i],
760 cte2->property[i], depth + 1))
767 if (!internal_equal (cte1->property[i], cte2->property[i], depth + 1))
773 byte_table_hash (Lisp_Object obj, int depth)
775 Lisp_Byte_Table *cte = XBYTE_TABLE (obj);
777 return internal_array_hash (cte->property, 256, depth);
780 static const struct lrecord_description byte_table_description[] = {
781 { XD_LISP_OBJECT_ARRAY, offsetof(Lisp_Byte_Table, property), 256 },
785 DEFINE_LRECORD_IMPLEMENTATION ("byte-table", byte_table,
790 byte_table_description,
794 make_byte_table (Lisp_Object initval)
798 Lisp_Byte_Table *cte;
800 cte = alloc_lcrecord_type (Lisp_Byte_Table, &lrecord_byte_table);
802 for (i = 0; i < 256; i++)
803 cte->property[i] = initval;
805 XSETBYTE_TABLE (obj, cte);
810 copy_byte_table (Lisp_Object entry)
812 Lisp_Byte_Table *cte = XBYTE_TABLE (entry);
815 Lisp_Byte_Table *ctnew
816 = alloc_lcrecord_type (Lisp_Byte_Table, &lrecord_byte_table);
818 for (i = 0; i < 256; i++)
820 if (UINT8_BYTE_TABLE_P (cte->property[i]))
822 ctnew->property[i] = copy_uint8_byte_table (cte->property[i]);
824 else if (UINT16_BYTE_TABLE_P (cte->property[i]))
826 ctnew->property[i] = copy_uint16_byte_table (cte->property[i]);
828 else if (BYTE_TABLE_P (cte->property[i]))
830 ctnew->property[i] = copy_byte_table (cte->property[i]);
833 ctnew->property[i] = cte->property[i];
836 XSETBYTE_TABLE (obj, ctnew);
841 byte_table_same_value_p (Lisp_Object obj)
843 Lisp_Byte_Table *bte = XBYTE_TABLE (obj);
844 Lisp_Object v0 = bte->property[0];
847 for (i = 1; i < 256; i++)
849 if (!internal_equal (bte->property[i], v0, 0))
856 map_over_byte_table (Lisp_Byte_Table *ct, Lisp_Char_Table* root,
857 Emchar ofs, int place,
858 int (*fn) (struct chartab_range *range,
859 Lisp_Object val, void *arg),
864 int unit = 1 << (8 * place);
867 for (i = 0, retval = 0; i < 256 && retval == 0; i++)
870 if (UINT8_BYTE_TABLE_P (v))
873 = map_over_uint8_byte_table (XUINT8_BYTE_TABLE(v), root,
874 c, place - 1, fn, arg);
877 else if (UINT16_BYTE_TABLE_P (v))
880 = map_over_uint16_byte_table (XUINT16_BYTE_TABLE(v), root,
881 c, place - 1, fn, arg);
884 else if (BYTE_TABLE_P (v))
886 retval = map_over_byte_table (XBYTE_TABLE(v), root,
887 c, place - 1, fn, arg);
890 else if (EQ (v, Qunloaded))
893 struct chartab_range rainj;
894 Emchar c1 = c + unit;
896 rainj.type = CHARTAB_RANGE_CHAR;
898 for (; c < c1 && retval == 0; c++)
900 Lisp_Object ret = get_char_id_table (root, c);
905 retval = (fn) (&rainj, ret, arg);
909 ct->property[i] = Qunbound;
913 else if (!UNBOUNDP (v))
915 struct chartab_range rainj;
916 Emchar c1 = c + unit;
918 rainj.type = CHARTAB_RANGE_CHAR;
920 for (; c < c1 && retval == 0; c++)
923 retval = (fn) (&rainj, v, arg);
934 save_byte_table (Lisp_Byte_Table *ct, Lisp_Char_Table* root,
936 CHISE_Feature feature,
940 Emchar ofs, int place,
941 Lisp_Object (*filter)(Lisp_Object value))
945 int unit = 1 << (8 * place);
948 for (i = 0, retval = 0; i < 256 && retval == 0; i++)
951 if (UINT8_BYTE_TABLE_P (v))
953 save_uint8_byte_table (XUINT8_BYTE_TABLE(v), root,
959 c, place - 1, filter);
962 else if (UINT16_BYTE_TABLE_P (v))
964 save_uint16_byte_table (XUINT16_BYTE_TABLE(v), root,
970 c, place - 1, filter);
973 else if (BYTE_TABLE_P (v))
975 save_byte_table (XBYTE_TABLE(v), root,
981 c, place - 1, filter);
984 else if (EQ (v, Qunloaded))
988 else if (!UNBOUNDP (v))
990 struct chartab_range rainj;
991 Emchar c1 = c + unit;
996 rainj.type = CHARTAB_RANGE_CHAR;
998 for (; c < c1 && retval == 0; c++)
1000 #ifdef HAVE_LIBCHISE
1001 chise_char_set_feature_value
1002 (c, feature, XSTRING_DATA (Fprin1_to_string (v, Qnil)));
1004 Fput_database (Fprin1_to_string (make_char (c), Qnil),
1005 Fprin1_to_string (v, Qnil),
1017 get_byte_table (Lisp_Object table, unsigned char idx)
1019 if (UINT8_BYTE_TABLE_P (table))
1020 return UINT8_DECODE (XUINT8_BYTE_TABLE(table)->property[idx]);
1021 else if (UINT16_BYTE_TABLE_P (table))
1022 return UINT16_DECODE (XUINT16_BYTE_TABLE(table)->property[idx]);
1023 else if (BYTE_TABLE_P (table))
1024 return XBYTE_TABLE(table)->property[idx];
1030 put_byte_table (Lisp_Object table, unsigned char idx, Lisp_Object value)
1032 if (UINT8_BYTE_TABLE_P (table))
1034 if (UINT8_VALUE_P (value))
1036 XUINT8_BYTE_TABLE(table)->property[idx] = UINT8_ENCODE (value);
1037 if (!UINT8_BYTE_TABLE_P (value) &&
1038 !UINT16_BYTE_TABLE_P (value) && !BYTE_TABLE_P (value)
1039 && uint8_byte_table_same_value_p (table))
1044 else if (UINT16_VALUE_P (value))
1046 Lisp_Object new = expand_uint8_byte_table_to_uint16 (table);
1048 XUINT16_BYTE_TABLE(new)->property[idx] = UINT16_ENCODE (value);
1053 Lisp_Object new = make_byte_table (Qnil);
1056 for (i = 0; i < 256; i++)
1058 XBYTE_TABLE(new)->property[i]
1059 = UINT8_DECODE (XUINT8_BYTE_TABLE(table)->property[i]);
1061 XBYTE_TABLE(new)->property[idx] = value;
1065 else if (UINT16_BYTE_TABLE_P (table))
1067 if (UINT16_VALUE_P (value))
1069 XUINT16_BYTE_TABLE(table)->property[idx] = UINT16_ENCODE (value);
1070 if (!UINT8_BYTE_TABLE_P (value) &&
1071 !UINT16_BYTE_TABLE_P (value) && !BYTE_TABLE_P (value)
1072 && uint16_byte_table_same_value_p (table))
1079 Lisp_Object new = make_byte_table (Qnil);
1082 for (i = 0; i < 256; i++)
1084 XBYTE_TABLE(new)->property[i]
1085 = UINT16_DECODE (XUINT16_BYTE_TABLE(table)->property[i]);
1087 XBYTE_TABLE(new)->property[idx] = value;
1091 else if (BYTE_TABLE_P (table))
1093 XBYTE_TABLE(table)->property[idx] = value;
1094 if (!UINT8_BYTE_TABLE_P (value) &&
1095 !UINT16_BYTE_TABLE_P (value) && !BYTE_TABLE_P (value)
1096 && byte_table_same_value_p (table))
1101 else if (!internal_equal (table, value, 0))
1103 if (UINT8_VALUE_P (table) && UINT8_VALUE_P (value))
1105 table = make_uint8_byte_table (UINT8_ENCODE (table));
1106 XUINT8_BYTE_TABLE(table)->property[idx] = UINT8_ENCODE (value);
1108 else if (UINT16_VALUE_P (table) && UINT16_VALUE_P (value))
1110 table = make_uint16_byte_table (UINT16_ENCODE (table));
1111 XUINT16_BYTE_TABLE(table)->property[idx] = UINT16_ENCODE (value);
1115 table = make_byte_table (table);
1116 XBYTE_TABLE(table)->property[idx] = value;
1124 make_char_id_table (Lisp_Object initval)
1127 obj = Fmake_char_table (Qgeneric);
1128 fill_char_table (XCHAR_TABLE (obj), initval);
1133 #if defined(HAVE_CHISE) && !defined(HAVE_LIBCHISE_LIBCHISE)
1134 Lisp_Object Qsystem_char_id;
1137 Lisp_Object Qcomposition;
1138 Lisp_Object Q_decomposition;
1139 Lisp_Object Q_identical;
1140 Lisp_Object Q_identical_from;
1141 Lisp_Object Q_denotational;
1142 Lisp_Object Q_denotational_from;
1143 Lisp_Object Q_subsumptive;
1144 Lisp_Object Q_subsumptive_from;
1145 Lisp_Object Q_component;
1146 Lisp_Object Q_component_of;
1148 Lisp_Object Q_same_of;
1149 Lisp_Object Qto_ucs;
1150 Lisp_Object Q_ucs_unified;
1151 Lisp_Object Qcompat;
1152 Lisp_Object Qisolated;
1153 Lisp_Object Qinitial;
1154 Lisp_Object Qmedial;
1156 Lisp_Object Qvertical;
1157 Lisp_Object QnoBreak;
1158 Lisp_Object Qfraction;
1161 Lisp_Object Qcircle;
1162 Lisp_Object Qsquare;
1164 Lisp_Object Qnarrow;
1168 Emchar to_char_id (Lisp_Object v, char* err_msg, Lisp_Object err_arg);
1171 to_char_id (Lisp_Object v, char* err_msg, Lisp_Object err_arg)
1177 else if (EQ (v, Qcompat))
1179 else if (EQ (v, Qisolated))
1181 else if (EQ (v, Qinitial))
1183 else if (EQ (v, Qmedial))
1185 else if (EQ (v, Qfinal))
1187 else if (EQ (v, Qvertical))
1189 else if (EQ (v, QnoBreak))
1191 else if (EQ (v, Qfraction))
1193 else if (EQ (v, Qsuper))
1195 else if (EQ (v, Qsub))
1197 else if (EQ (v, Qcircle))
1199 else if (EQ (v, Qsquare))
1201 else if (EQ (v, Qwide))
1203 else if (EQ (v, Qnarrow))
1205 else if (EQ (v, Qsmall))
1207 else if (EQ (v, Qfont))
1210 signal_simple_error (err_msg, err_arg);
1213 DEFUN ("get-composite-char", Fget_composite_char, 1, 1, 0, /*
1214 Return character corresponding with list.
1218 Lisp_Object base, modifier;
1222 signal_simple_error ("Invalid value for composition", list);
1225 while (!NILP (rest))
1230 signal_simple_error ("Invalid value for composition", list);
1231 modifier = Fcar (rest);
1233 base = Fcdr (Fassq (modifier,
1234 Fchar_feature (base, Qcomposition, Qnil,
1240 DEFUN ("char-variants", Fchar_variants, 1, 1, 0, /*
1241 Return variants of CHARACTER.
1247 CHECK_CHAR (character);
1248 ret = Fchar_feature (character, Q_ucs_unified, Qnil,
1251 return Fcopy_list (ret);
1259 /* A char table maps from ranges of characters to values.
1261 Implementing a general data structure that maps from arbitrary
1262 ranges of numbers to values is tricky to do efficiently. As it
1263 happens, it should suffice (and is usually more convenient, anyway)
1264 when dealing with characters to restrict the sorts of ranges that
1265 can be assigned values, as follows:
1268 2) All characters in a charset.
1269 3) All characters in a particular row of a charset, where a "row"
1270 means all characters with the same first byte.
1271 4) A particular character in a charset.
1273 We use char tables to generalize the 256-element vectors now
1274 littering the Emacs code.
1276 Possible uses (all should be converted at some point):
1282 5) keyboard-translate-table?
1285 abstract type to generalize the Emacs vectors and Mule
1286 vectors-of-vectors goo.
1289 /************************************************************************/
1290 /* Char Table object */
1291 /************************************************************************/
1293 #if defined(MULE)&&!defined(UTF2000)
1296 mark_char_table_entry (Lisp_Object obj)
1298 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj);
1301 for (i = 0; i < 96; i++)
1303 mark_object (cte->level2[i]);
1309 char_table_entry_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
1311 Lisp_Char_Table_Entry *cte1 = XCHAR_TABLE_ENTRY (obj1);
1312 Lisp_Char_Table_Entry *cte2 = XCHAR_TABLE_ENTRY (obj2);
1315 for (i = 0; i < 96; i++)
1316 if (!internal_equal (cte1->level2[i], cte2->level2[i], depth + 1))
1322 static unsigned long
1323 char_table_entry_hash (Lisp_Object obj, int depth)
1325 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj);
1327 return internal_array_hash (cte->level2, 96, depth);
1330 static const struct lrecord_description char_table_entry_description[] = {
1331 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table_Entry, level2), 96 },
1335 DEFINE_LRECORD_IMPLEMENTATION ("char-table-entry", char_table_entry,
1336 mark_char_table_entry, internal_object_printer,
1337 0, char_table_entry_equal,
1338 char_table_entry_hash,
1339 char_table_entry_description,
1340 Lisp_Char_Table_Entry);
1344 mark_char_table (Lisp_Object obj)
1346 Lisp_Char_Table *ct = XCHAR_TABLE (obj);
1349 mark_object (ct->table);
1350 mark_object (ct->name);
1351 #ifndef HAVE_LIBCHISE
1352 mark_object (ct->db);
1357 for (i = 0; i < NUM_ASCII_CHARS; i++)
1358 mark_object (ct->ascii[i]);
1360 for (i = 0; i < NUM_LEADING_BYTES; i++)
1361 mark_object (ct->level1[i]);
1365 return ct->default_value;
1367 return ct->mirror_table;
1371 /* WARNING: All functions of this nature need to be written extremely
1372 carefully to avoid crashes during GC. Cf. prune_specifiers()
1373 and prune_weak_hash_tables(). */
1376 prune_syntax_tables (void)
1378 Lisp_Object rest, prev = Qnil;
1380 for (rest = Vall_syntax_tables;
1382 rest = XCHAR_TABLE (rest)->next_table)
1384 if (! marked_p (rest))
1386 /* This table is garbage. Remove it from the list. */
1388 Vall_syntax_tables = XCHAR_TABLE (rest)->next_table;
1390 XCHAR_TABLE (prev)->next_table =
1391 XCHAR_TABLE (rest)->next_table;
1397 char_table_type_to_symbol (enum char_table_type type)
1402 case CHAR_TABLE_TYPE_GENERIC: return Qgeneric;
1403 case CHAR_TABLE_TYPE_SYNTAX: return Qsyntax;
1404 case CHAR_TABLE_TYPE_DISPLAY: return Qdisplay;
1405 case CHAR_TABLE_TYPE_CHAR: return Qchar;
1407 case CHAR_TABLE_TYPE_CATEGORY: return Qcategory;
1412 static enum char_table_type
1413 symbol_to_char_table_type (Lisp_Object symbol)
1415 CHECK_SYMBOL (symbol);
1417 if (EQ (symbol, Qgeneric)) return CHAR_TABLE_TYPE_GENERIC;
1418 if (EQ (symbol, Qsyntax)) return CHAR_TABLE_TYPE_SYNTAX;
1419 if (EQ (symbol, Qdisplay)) return CHAR_TABLE_TYPE_DISPLAY;
1420 if (EQ (symbol, Qchar)) return CHAR_TABLE_TYPE_CHAR;
1422 if (EQ (symbol, Qcategory)) return CHAR_TABLE_TYPE_CATEGORY;
1425 signal_simple_error ("Unrecognized char table type", symbol);
1426 return CHAR_TABLE_TYPE_GENERIC; /* not reached */
1431 print_chartab_range (Emchar first, Emchar last, Lisp_Object val,
1432 Lisp_Object printcharfun)
1436 write_c_string (" (", printcharfun);
1437 print_internal (make_char (first), printcharfun, 0);
1438 write_c_string (" ", printcharfun);
1439 print_internal (make_char (last), printcharfun, 0);
1440 write_c_string (") ", printcharfun);
1444 write_c_string (" ", printcharfun);
1445 print_internal (make_char (first), printcharfun, 0);
1446 write_c_string (" ", printcharfun);
1448 print_internal (val, printcharfun, 1);
1452 #if defined(MULE)&&!defined(UTF2000)
1455 print_chartab_charset_row (Lisp_Object charset,
1457 Lisp_Char_Table_Entry *cte,
1458 Lisp_Object printcharfun)
1461 Lisp_Object cat = Qunbound;
1464 for (i = 32; i < 128; i++)
1466 Lisp_Object pam = cte->level2[i - 32];
1478 print_chartab_range (MAKE_CHAR (charset, first, 0),
1479 MAKE_CHAR (charset, i - 1, 0),
1482 print_chartab_range (MAKE_CHAR (charset, row, first),
1483 MAKE_CHAR (charset, row, i - 1),
1493 print_chartab_range (MAKE_CHAR (charset, first, 0),
1494 MAKE_CHAR (charset, i - 1, 0),
1497 print_chartab_range (MAKE_CHAR (charset, row, first),
1498 MAKE_CHAR (charset, row, i - 1),
1504 print_chartab_two_byte_charset (Lisp_Object charset,
1505 Lisp_Char_Table_Entry *cte,
1506 Lisp_Object printcharfun)
1510 for (i = 32; i < 128; i++)
1512 Lisp_Object jen = cte->level2[i - 32];
1514 if (!CHAR_TABLE_ENTRYP (jen))
1518 write_c_string (" [", printcharfun);
1519 print_internal (XCHARSET_NAME (charset), printcharfun, 0);
1520 sprintf (buf, " %d] ", i);
1521 write_c_string (buf, printcharfun);
1522 print_internal (jen, printcharfun, 0);
1525 print_chartab_charset_row (charset, i, XCHAR_TABLE_ENTRY (jen),
1533 print_char_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1535 Lisp_Char_Table *ct = XCHAR_TABLE (obj);
1538 struct gcpro gcpro1, gcpro2;
1539 GCPRO2 (obj, printcharfun);
1541 write_c_string ("#s(char-table ", printcharfun);
1542 write_c_string (" ", printcharfun);
1543 write_c_string (string_data
1545 (XSYMBOL (char_table_type_to_symbol (ct->type)))),
1547 write_c_string ("\n ", printcharfun);
1548 print_internal (ct->default_value, printcharfun, escapeflag);
1549 for (i = 0; i < 256; i++)
1551 Lisp_Object elt = get_byte_table (ct->table, i);
1552 if (i != 0) write_c_string ("\n ", printcharfun);
1553 if (EQ (elt, Qunbound))
1554 write_c_string ("void", printcharfun);
1556 print_internal (elt, printcharfun, escapeflag);
1559 #else /* non UTF2000 */
1562 sprintf (buf, "#s(char-table type %s data (",
1563 string_data (symbol_name (XSYMBOL
1564 (char_table_type_to_symbol (ct->type)))));
1565 write_c_string (buf, printcharfun);
1567 /* Now write out the ASCII/Control-1 stuff. */
1571 Lisp_Object val = Qunbound;
1573 for (i = 0; i < NUM_ASCII_CHARS; i++)
1582 if (!EQ (ct->ascii[i], val))
1584 print_chartab_range (first, i - 1, val, printcharfun);
1591 print_chartab_range (first, i - 1, val, printcharfun);
1598 for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES;
1601 Lisp_Object ann = ct->level1[i - MIN_LEADING_BYTE];
1602 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (i);
1604 if (!CHARSETP (charset) || i == LEADING_BYTE_ASCII
1605 || i == LEADING_BYTE_CONTROL_1)
1607 if (!CHAR_TABLE_ENTRYP (ann))
1609 write_c_string (" ", printcharfun);
1610 print_internal (XCHARSET_NAME (charset),
1612 write_c_string (" ", printcharfun);
1613 print_internal (ann, printcharfun, 0);
1617 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (ann);
1618 if (XCHARSET_DIMENSION (charset) == 1)
1619 print_chartab_charset_row (charset, -1, cte, printcharfun);
1621 print_chartab_two_byte_charset (charset, cte, printcharfun);
1626 #endif /* non UTF2000 */
1628 write_c_string ("))", printcharfun);
1632 char_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
1634 Lisp_Char_Table *ct1 = XCHAR_TABLE (obj1);
1635 Lisp_Char_Table *ct2 = XCHAR_TABLE (obj2);
1638 if (CHAR_TABLE_TYPE (ct1) != CHAR_TABLE_TYPE (ct2))
1642 for (i = 0; i < 256; i++)
1644 if (!internal_equal (get_byte_table (ct1->table, i),
1645 get_byte_table (ct2->table, i), 0))
1649 for (i = 0; i < NUM_ASCII_CHARS; i++)
1650 if (!internal_equal (ct1->ascii[i], ct2->ascii[i], depth + 1))
1654 for (i = 0; i < NUM_LEADING_BYTES; i++)
1655 if (!internal_equal (ct1->level1[i], ct2->level1[i], depth + 1))
1658 #endif /* non UTF2000 */
1663 static unsigned long
1664 char_table_hash (Lisp_Object obj, int depth)
1666 Lisp_Char_Table *ct = XCHAR_TABLE (obj);
1668 return byte_table_hash (ct->table, depth + 1);
1670 unsigned long hashval = internal_array_hash (ct->ascii, NUM_ASCII_CHARS,
1673 hashval = HASH2 (hashval,
1674 internal_array_hash (ct->level1, NUM_LEADING_BYTES, depth));
1680 static const struct lrecord_description char_table_description[] = {
1682 { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, table) },
1683 { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, default_value) },
1684 { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, name) },
1685 #ifndef HAVE_LIBCHISE
1686 { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, db) },
1689 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, ascii), NUM_ASCII_CHARS },
1691 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, level1), NUM_LEADING_BYTES },
1695 { XD_LISP_OBJECT, offsetof (Lisp_Char_Table, mirror_table) },
1697 { XD_LO_LINK, offsetof (Lisp_Char_Table, next_table) },
1701 DEFINE_LRECORD_IMPLEMENTATION ("char-table", char_table,
1702 mark_char_table, print_char_table, 0,
1703 char_table_equal, char_table_hash,
1704 char_table_description,
1707 DEFUN ("char-table-p", Fchar_table_p, 1, 1, 0, /*
1708 Return non-nil if OBJECT is a char table.
1710 A char table is a table that maps characters (or ranges of characters)
1711 to values. Char tables are specialized for characters, only allowing
1712 particular sorts of ranges to be assigned values. Although this
1713 loses in generality, it makes for extremely fast (constant-time)
1714 lookups, and thus is feasible for applications that do an extremely
1715 large number of lookups (e.g. scanning a buffer for a character in
1716 a particular syntax, where a lookup in the syntax table must occur
1717 once per character).
1719 When Mule support exists, the types of ranges that can be assigned
1723 -- an entire charset
1724 -- a single row in a two-octet charset
1725 -- a single character
1727 When Mule support is not present, the types of ranges that can be
1731 -- a single character
1733 To create a char table, use `make-char-table'.
1734 To modify a char table, use `put-char-table' or `remove-char-table'.
1735 To retrieve the value for a particular character, use `get-char-table'.
1736 See also `map-char-table', `clear-char-table', `copy-char-table',
1737 `valid-char-table-type-p', `char-table-type-list',
1738 `valid-char-table-value-p', and `check-char-table-value'.
1742 return CHAR_TABLEP (object) ? Qt : Qnil;
1745 DEFUN ("char-table-type-list", Fchar_table_type_list, 0, 0, 0, /*
1746 Return a list of the recognized char table types.
1747 See `valid-char-table-type-p'.
1752 return list5 (Qchar, Qcategory, Qdisplay, Qgeneric, Qsyntax);
1754 return list4 (Qchar, Qdisplay, Qgeneric, Qsyntax);
1758 DEFUN ("valid-char-table-type-p", Fvalid_char_table_type_p, 1, 1, 0, /*
1759 Return t if TYPE if a recognized char table type.
1761 Each char table type is used for a different purpose and allows different
1762 sorts of values. The different char table types are
1765 Used for category tables, which specify the regexp categories
1766 that a character is in. The valid values are nil or a
1767 bit vector of 95 elements. Higher-level Lisp functions are
1768 provided for working with category tables. Currently categories
1769 and category tables only exist when Mule support is present.
1771 A generalized char table, for mapping from one character to
1772 another. Used for case tables, syntax matching tables,
1773 `keyboard-translate-table', etc. The valid values are characters.
1775 An even more generalized char table, for mapping from a
1776 character to anything.
1778 Used for display tables, which specify how a particular character
1779 is to appear when displayed. #### Not yet implemented.
1781 Used for syntax tables, which specify the syntax of a particular
1782 character. Higher-level Lisp functions are provided for
1783 working with syntax tables. The valid values are integers.
1788 return (EQ (type, Qchar) ||
1790 EQ (type, Qcategory) ||
1792 EQ (type, Qdisplay) ||
1793 EQ (type, Qgeneric) ||
1794 EQ (type, Qsyntax)) ? Qt : Qnil;
1797 DEFUN ("char-table-type", Fchar_table_type, 1, 1, 0, /*
1798 Return the type of CHAR-TABLE.
1799 See `valid-char-table-type-p'.
1803 CHECK_CHAR_TABLE (char_table);
1804 return char_table_type_to_symbol (XCHAR_TABLE (char_table)->type);
1808 fill_char_table (Lisp_Char_Table *ct, Lisp_Object value)
1811 ct->table = Qunbound;
1812 ct->default_value = value;
1817 for (i = 0; i < NUM_ASCII_CHARS; i++)
1818 ct->ascii[i] = value;
1820 for (i = 0; i < NUM_LEADING_BYTES; i++)
1821 ct->level1[i] = value;
1826 if (ct->type == CHAR_TABLE_TYPE_SYNTAX)
1827 update_syntax_table (ct);
1831 DEFUN ("reset-char-table", Freset_char_table, 1, 1, 0, /*
1832 Reset CHAR-TABLE to its default state.
1836 Lisp_Char_Table *ct;
1838 CHECK_CHAR_TABLE (char_table);
1839 ct = XCHAR_TABLE (char_table);
1843 case CHAR_TABLE_TYPE_CHAR:
1844 fill_char_table (ct, make_char (0));
1846 case CHAR_TABLE_TYPE_DISPLAY:
1847 case CHAR_TABLE_TYPE_GENERIC:
1849 case CHAR_TABLE_TYPE_CATEGORY:
1851 fill_char_table (ct, Qnil);
1854 case CHAR_TABLE_TYPE_SYNTAX:
1855 fill_char_table (ct, make_int (Sinherit));
1865 DEFUN ("make-char-table", Fmake_char_table, 1, 1, 0, /*
1866 Return a new, empty char table of type TYPE.
1867 Currently recognized types are 'char, 'category, 'display, 'generic,
1868 and 'syntax. See `valid-char-table-type-p'.
1872 Lisp_Char_Table *ct;
1874 enum char_table_type ty = symbol_to_char_table_type (type);
1876 ct = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table);
1879 if (ty == CHAR_TABLE_TYPE_SYNTAX)
1881 ct->mirror_table = Fmake_char_table (Qgeneric);
1882 fill_char_table (XCHAR_TABLE (ct->mirror_table),
1886 ct->mirror_table = Qnil;
1889 #ifndef HAVE_LIBCHISE
1893 ct->next_table = Qnil;
1894 XSETCHAR_TABLE (obj, ct);
1895 if (ty == CHAR_TABLE_TYPE_SYNTAX)
1897 ct->next_table = Vall_syntax_tables;
1898 Vall_syntax_tables = obj;
1900 Freset_char_table (obj);
1904 #if defined(MULE)&&!defined(UTF2000)
1907 make_char_table_entry (Lisp_Object initval)
1911 Lisp_Char_Table_Entry *cte =
1912 alloc_lcrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry);
1914 for (i = 0; i < 96; i++)
1915 cte->level2[i] = initval;
1917 XSETCHAR_TABLE_ENTRY (obj, cte);
1922 copy_char_table_entry (Lisp_Object entry)
1924 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (entry);
1927 Lisp_Char_Table_Entry *ctenew =
1928 alloc_lcrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry);
1930 for (i = 0; i < 96; i++)
1932 Lisp_Object new = cte->level2[i];
1933 if (CHAR_TABLE_ENTRYP (new))
1934 ctenew->level2[i] = copy_char_table_entry (new);
1936 ctenew->level2[i] = new;
1939 XSETCHAR_TABLE_ENTRY (obj, ctenew);
1945 DEFUN ("copy-char-table", Fcopy_char_table, 1, 1, 0, /*
1946 Return a new char table which is a copy of CHAR-TABLE.
1947 It will contain the same values for the same characters and ranges
1948 as CHAR-TABLE. The values will not themselves be copied.
1952 Lisp_Char_Table *ct, *ctnew;
1958 CHECK_CHAR_TABLE (char_table);
1959 ct = XCHAR_TABLE (char_table);
1960 ctnew = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table);
1961 ctnew->type = ct->type;
1963 ctnew->default_value = ct->default_value;
1964 /* [tomo:2002-01-21] Perhaps this code seems wrong */
1965 ctnew->name = ct->name;
1966 #ifndef HAVE_LIBCHISE
1970 if (UINT8_BYTE_TABLE_P (ct->table))
1972 ctnew->table = copy_uint8_byte_table (ct->table);
1974 else if (UINT16_BYTE_TABLE_P (ct->table))
1976 ctnew->table = copy_uint16_byte_table (ct->table);
1978 else if (BYTE_TABLE_P (ct->table))
1980 ctnew->table = copy_byte_table (ct->table);
1982 else if (!UNBOUNDP (ct->table))
1983 ctnew->table = ct->table;
1984 #else /* non UTF2000 */
1986 for (i = 0; i < NUM_ASCII_CHARS; i++)
1988 Lisp_Object new = ct->ascii[i];
1990 assert (! (CHAR_TABLE_ENTRYP (new)));
1992 ctnew->ascii[i] = new;
1997 for (i = 0; i < NUM_LEADING_BYTES; i++)
1999 Lisp_Object new = ct->level1[i];
2000 if (CHAR_TABLE_ENTRYP (new))
2001 ctnew->level1[i] = copy_char_table_entry (new);
2003 ctnew->level1[i] = new;
2007 #endif /* non UTF2000 */
2010 if (CHAR_TABLEP (ct->mirror_table))
2011 ctnew->mirror_table = Fcopy_char_table (ct->mirror_table);
2013 ctnew->mirror_table = ct->mirror_table;
2015 ctnew->next_table = Qnil;
2016 XSETCHAR_TABLE (obj, ctnew);
2017 if (ctnew->type == CHAR_TABLE_TYPE_SYNTAX)
2019 ctnew->next_table = Vall_syntax_tables;
2020 Vall_syntax_tables = obj;
2025 INLINE_HEADER int XCHARSET_CELL_RANGE (Lisp_Object ccs);
2027 XCHARSET_CELL_RANGE (Lisp_Object ccs)
2029 switch (XCHARSET_CHARS (ccs))
2032 return (33 << 8) | 126;
2034 return (32 << 8) | 127;
2037 return (0 << 8) | 127;
2039 return (0 << 8) | 255;
2051 decode_char_table_range (Lisp_Object range, struct chartab_range *outrange)
2054 outrange->type = CHARTAB_RANGE_ALL;
2056 else if (EQ (range, Qnil))
2057 outrange->type = CHARTAB_RANGE_DEFAULT;
2059 else if (CHAR_OR_CHAR_INTP (range))
2061 outrange->type = CHARTAB_RANGE_CHAR;
2062 outrange->ch = XCHAR_OR_CHAR_INT (range);
2066 signal_simple_error ("Range must be t or a character", range);
2068 else if (VECTORP (range))
2070 Lisp_Vector *vec = XVECTOR (range);
2071 Lisp_Object *elts = vector_data (vec);
2072 int cell_min, cell_max;
2074 outrange->type = CHARTAB_RANGE_ROW;
2075 outrange->charset = Fget_charset (elts[0]);
2076 CHECK_INT (elts[1]);
2077 outrange->row = XINT (elts[1]);
2078 if (XCHARSET_DIMENSION (outrange->charset) < 2)
2079 signal_simple_error ("Charset in row vector must be multi-byte",
2083 int ret = XCHARSET_CELL_RANGE (outrange->charset);
2085 cell_min = ret >> 8;
2086 cell_max = ret & 0xFF;
2088 if (XCHARSET_DIMENSION (outrange->charset) == 2)
2089 check_int_range (outrange->row, cell_min, cell_max);
2091 else if (XCHARSET_DIMENSION (outrange->charset) == 3)
2093 check_int_range (outrange->row >> 8 , cell_min, cell_max);
2094 check_int_range (outrange->row & 0xFF, cell_min, cell_max);
2096 else if (XCHARSET_DIMENSION (outrange->charset) == 4)
2098 check_int_range ( outrange->row >> 16 , cell_min, cell_max);
2099 check_int_range ((outrange->row >> 8) & 0xFF, cell_min, cell_max);
2100 check_int_range ( outrange->row & 0xFF, cell_min, cell_max);
2108 if (!CHARSETP (range) && !SYMBOLP (range))
2110 ("Char table range must be t, charset, char, or vector", range);
2111 outrange->type = CHARTAB_RANGE_CHARSET;
2112 outrange->charset = Fget_charset (range);
2117 #if defined(MULE)&&!defined(UTF2000)
2119 /* called from CHAR_TABLE_VALUE(). */
2121 get_non_ascii_char_table_value (Lisp_Char_Table *ct, Charset_ID leading_byte,
2126 Lisp_Object charset;
2128 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (leading_byte);
2133 BREAKUP_CHAR (c, charset, byte1, byte2);
2135 BREAKUP_CHAR_1_UNSAFE (c, charset, byte1, byte2);
2137 val = ct->level1[leading_byte - MIN_LEADING_BYTE];
2138 if (CHAR_TABLE_ENTRYP (val))
2140 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
2141 val = cte->level2[byte1 - 32];
2142 if (CHAR_TABLE_ENTRYP (val))
2144 cte = XCHAR_TABLE_ENTRY (val);
2145 assert (byte2 >= 32);
2146 val = cte->level2[byte2 - 32];
2147 assert (!CHAR_TABLE_ENTRYP (val));
2157 get_char_table (Emchar ch, Lisp_Char_Table *ct)
2161 Lisp_Object ret = get_char_id_table (ct, ch);
2166 if (EQ (CHAR_TABLE_NAME (ct), Qdowncase))
2167 ret = Fchar_feature (make_char (ch), Q_lowercase, Qnil,
2169 else if (EQ (CHAR_TABLE_NAME (ct), Qflippedcase))
2170 ret = Fchar_feature (make_char (ch), Q_uppercase, Qnil,
2176 ret = Ffind_char (ret);
2184 Lisp_Object charset;
2188 BREAKUP_CHAR (ch, charset, byte1, byte2);
2190 if (EQ (charset, Vcharset_ascii))
2191 val = ct->ascii[byte1];
2192 else if (EQ (charset, Vcharset_control_1))
2193 val = ct->ascii[byte1 + 128];
2196 int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE;
2197 val = ct->level1[lb];
2198 if (CHAR_TABLE_ENTRYP (val))
2200 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
2201 val = cte->level2[byte1 - 32];
2202 if (CHAR_TABLE_ENTRYP (val))
2204 cte = XCHAR_TABLE_ENTRY (val);
2205 assert (byte2 >= 32);
2206 val = cte->level2[byte2 - 32];
2207 assert (!CHAR_TABLE_ENTRYP (val));
2214 #else /* not MULE */
2215 return ct->ascii[(unsigned char)ch];
2216 #endif /* not MULE */
2220 DEFUN ("get-char-table", Fget_char_table, 2, 2, 0, /*
2221 Find value for CHARACTER in CHAR-TABLE.
2223 (character, char_table))
2225 CHECK_CHAR_TABLE (char_table);
2226 CHECK_CHAR_COERCE_INT (character);
2228 return get_char_table (XCHAR (character), XCHAR_TABLE (char_table));
2231 DEFUN ("get-range-char-table", Fget_range_char_table, 2, 3, 0, /*
2232 Find value for a range in CHAR-TABLE.
2233 If there is more than one value, return MULTI (defaults to nil).
2235 (range, char_table, multi))
2237 Lisp_Char_Table *ct;
2238 struct chartab_range rainj;
2240 if (CHAR_OR_CHAR_INTP (range))
2241 return Fget_char_table (range, char_table);
2242 CHECK_CHAR_TABLE (char_table);
2243 ct = XCHAR_TABLE (char_table);
2245 decode_char_table_range (range, &rainj);
2248 case CHARTAB_RANGE_ALL:
2251 if (UINT8_BYTE_TABLE_P (ct->table))
2253 else if (UINT16_BYTE_TABLE_P (ct->table))
2255 else if (BYTE_TABLE_P (ct->table))
2259 #else /* non UTF2000 */
2261 Lisp_Object first = ct->ascii[0];
2263 for (i = 1; i < NUM_ASCII_CHARS; i++)
2264 if (!EQ (first, ct->ascii[i]))
2268 for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES;
2271 if (!CHARSETP (CHARSET_BY_LEADING_BYTE (i))
2272 || i == LEADING_BYTE_ASCII
2273 || i == LEADING_BYTE_CONTROL_1)
2275 if (!EQ (first, ct->level1[i - MIN_LEADING_BYTE]))
2281 #endif /* non UTF2000 */
2285 case CHARTAB_RANGE_CHARSET:
2289 if (EQ (rainj.charset, Vcharset_ascii))
2292 Lisp_Object first = ct->ascii[0];
2294 for (i = 1; i < 128; i++)
2295 if (!EQ (first, ct->ascii[i]))
2300 if (EQ (rainj.charset, Vcharset_control_1))
2303 Lisp_Object first = ct->ascii[128];
2305 for (i = 129; i < 160; i++)
2306 if (!EQ (first, ct->ascii[i]))
2312 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (rainj.charset) -
2314 if (CHAR_TABLE_ENTRYP (val))
2320 case CHARTAB_RANGE_ROW:
2325 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (rainj.charset) -
2327 if (!CHAR_TABLE_ENTRYP (val))
2329 val = XCHAR_TABLE_ENTRY (val)->level2[rainj.row - 32];
2330 if (CHAR_TABLE_ENTRYP (val))
2334 #endif /* not UTF2000 */
2335 #endif /* not MULE */
2341 return Qnil; /* not reached */
2345 check_valid_char_table_value (Lisp_Object value, enum char_table_type type,
2346 Error_behavior errb)
2350 case CHAR_TABLE_TYPE_SYNTAX:
2351 if (!ERRB_EQ (errb, ERROR_ME))
2352 return INTP (value) || (CONSP (value) && INTP (XCAR (value))
2353 && CHAR_OR_CHAR_INTP (XCDR (value)));
2356 Lisp_Object cdr = XCDR (value);
2357 CHECK_INT (XCAR (value));
2358 CHECK_CHAR_COERCE_INT (cdr);
2365 case CHAR_TABLE_TYPE_CATEGORY:
2366 if (!ERRB_EQ (errb, ERROR_ME))
2367 return CATEGORY_TABLE_VALUEP (value);
2368 CHECK_CATEGORY_TABLE_VALUE (value);
2372 case CHAR_TABLE_TYPE_GENERIC:
2375 case CHAR_TABLE_TYPE_DISPLAY:
2377 maybe_signal_simple_error ("Display char tables not yet implemented",
2378 value, Qchar_table, errb);
2381 case CHAR_TABLE_TYPE_CHAR:
2382 if (!ERRB_EQ (errb, ERROR_ME))
2383 return CHAR_OR_CHAR_INTP (value);
2384 CHECK_CHAR_COERCE_INT (value);
2391 return 0; /* not reached */
2395 canonicalize_char_table_value (Lisp_Object value, enum char_table_type type)
2399 case CHAR_TABLE_TYPE_SYNTAX:
2402 Lisp_Object car = XCAR (value);
2403 Lisp_Object cdr = XCDR (value);
2404 CHECK_CHAR_COERCE_INT (cdr);
2405 return Fcons (car, cdr);
2408 case CHAR_TABLE_TYPE_CHAR:
2409 CHECK_CHAR_COERCE_INT (value);
2417 DEFUN ("valid-char-table-value-p", Fvalid_char_table_value_p, 2, 2, 0, /*
2418 Return non-nil if VALUE is a valid value for CHAR-TABLE-TYPE.
2420 (value, char_table_type))
2422 enum char_table_type type = symbol_to_char_table_type (char_table_type);
2424 return check_valid_char_table_value (value, type, ERROR_ME_NOT) ? Qt : Qnil;
2427 DEFUN ("check-valid-char-table-value", Fcheck_valid_char_table_value, 2, 2, 0, /*
2428 Signal an error if VALUE is not a valid value for CHAR-TABLE-TYPE.
2430 (value, char_table_type))
2432 enum char_table_type type = symbol_to_char_table_type (char_table_type);
2434 check_valid_char_table_value (value, type, ERROR_ME);
2439 Lisp_Char_Table* char_attribute_table_to_put;
2440 Lisp_Object Qput_char_table_map_function;
2441 Lisp_Object value_to_put;
2443 DEFUN ("put-char-table-map-function",
2444 Fput_char_table_map_function, 2, 2, 0, /*
2445 For internal use. Don't use it.
2449 put_char_id_table_0 (char_attribute_table_to_put,
2450 XCHAR (c), value_to_put);
2455 /* Assign VAL to all characters in RANGE in char table CT. */
2458 put_char_table (Lisp_Char_Table *ct, struct chartab_range *range,
2461 switch (range->type)
2463 case CHARTAB_RANGE_ALL:
2464 fill_char_table (ct, val);
2465 return; /* avoid the duplicate call to update_syntax_table() below,
2466 since fill_char_table() also did that. */
2469 case CHARTAB_RANGE_DEFAULT:
2470 ct->default_value = val;
2475 case CHARTAB_RANGE_CHARSET:
2478 Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (range->charset);
2480 if ( CHAR_TABLEP (encoding_table) )
2482 Lisp_Object mother = XCHARSET_MOTHER (range->charset);
2484 char_attribute_table_to_put = ct;
2486 Fmap_char_attribute (Qput_char_table_map_function,
2487 XCHAR_TABLE_NAME (encoding_table),
2489 if ( CHARSETP (mother) )
2491 struct chartab_range r;
2493 r.type = CHARTAB_RANGE_CHARSET;
2495 put_char_table (ct, &r, val);
2503 for (c = 0; c < 1 << 24; c++)
2505 if ( charset_code_point (range->charset, c) >= 0 )
2506 put_char_id_table_0 (ct, c, val);
2512 if (EQ (range->charset, Vcharset_ascii))
2515 for (i = 0; i < 128; i++)
2518 else if (EQ (range->charset, Vcharset_control_1))
2521 for (i = 128; i < 160; i++)
2526 int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE;
2527 ct->level1[lb] = val;
2532 case CHARTAB_RANGE_ROW:
2535 int cell_min, cell_max, i;
2537 i = XCHARSET_CELL_RANGE (range->charset);
2539 cell_max = i & 0xFF;
2540 for (i = cell_min; i <= cell_max; i++)
2543 = DECODE_CHAR (range->charset, (range->row << 8) | i, 0);
2545 if ( charset_code_point (range->charset, ch, 0) >= 0 )
2546 put_char_id_table_0 (ct, ch, val);
2551 Lisp_Char_Table_Entry *cte;
2552 int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE;
2553 /* make sure that there is a separate entry for the row. */
2554 if (!CHAR_TABLE_ENTRYP (ct->level1[lb]))
2555 ct->level1[lb] = make_char_table_entry (ct->level1[lb]);
2556 cte = XCHAR_TABLE_ENTRY (ct->level1[lb]);
2557 cte->level2[range->row - 32] = val;
2559 #endif /* not UTF2000 */
2563 case CHARTAB_RANGE_CHAR:
2565 put_char_id_table_0 (ct, range->ch, val);
2569 Lisp_Object charset;
2572 BREAKUP_CHAR (range->ch, charset, byte1, byte2);
2573 if (EQ (charset, Vcharset_ascii))
2574 ct->ascii[byte1] = val;
2575 else if (EQ (charset, Vcharset_control_1))
2576 ct->ascii[byte1 + 128] = val;
2579 Lisp_Char_Table_Entry *cte;
2580 int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE;
2581 /* make sure that there is a separate entry for the row. */
2582 if (!CHAR_TABLE_ENTRYP (ct->level1[lb]))
2583 ct->level1[lb] = make_char_table_entry (ct->level1[lb]);
2584 cte = XCHAR_TABLE_ENTRY (ct->level1[lb]);
2585 /* now CTE is a char table entry for the charset;
2586 each entry is for a single row (or character of
2587 a one-octet charset). */
2588 if (XCHARSET_DIMENSION (charset) == 1)
2589 cte->level2[byte1 - 32] = val;
2592 /* assigning to one character in a two-octet charset. */
2593 /* make sure that the charset row contains a separate
2594 entry for each character. */
2595 if (!CHAR_TABLE_ENTRYP (cte->level2[byte1 - 32]))
2596 cte->level2[byte1 - 32] =
2597 make_char_table_entry (cte->level2[byte1 - 32]);
2598 cte = XCHAR_TABLE_ENTRY (cte->level2[byte1 - 32]);
2599 cte->level2[byte2 - 32] = val;
2603 #else /* not MULE */
2604 ct->ascii[(unsigned char) (range->ch)] = val;
2606 #endif /* not MULE */
2610 if (ct->type == CHAR_TABLE_TYPE_SYNTAX)
2611 update_syntax_table (ct);
2615 DEFUN ("put-char-table", Fput_char_table, 3, 3, 0, /*
2616 Set the value for chars in RANGE to be VALUE in CHAR-TABLE.
2618 RANGE specifies one or more characters to be affected and should be
2619 one of the following:
2621 -- t (all characters are affected)
2622 -- A charset (only allowed when Mule support is present)
2623 -- A vector of two elements: a two-octet charset and a row number
2624 (only allowed when Mule support is present)
2625 -- A single character
2627 VALUE must be a value appropriate for the type of CHAR-TABLE.
2628 See `valid-char-table-type-p'.
2630 (range, value, char_table))
2632 Lisp_Char_Table *ct;
2633 struct chartab_range rainj;
2635 CHECK_CHAR_TABLE (char_table);
2636 ct = XCHAR_TABLE (char_table);
2637 check_valid_char_table_value (value, ct->type, ERROR_ME);
2638 decode_char_table_range (range, &rainj);
2639 value = canonicalize_char_table_value (value, ct->type);
2640 put_char_table (ct, &rainj, value);
2645 /* Map FN over the ASCII chars in CT. */
2648 map_over_charset_ascii (Lisp_Char_Table *ct,
2649 int (*fn) (struct chartab_range *range,
2650 Lisp_Object val, void *arg),
2653 struct chartab_range rainj;
2662 rainj.type = CHARTAB_RANGE_CHAR;
2664 for (i = start, retval = 0; i < stop && retval == 0; i++)
2666 rainj.ch = (Emchar) i;
2667 retval = (fn) (&rainj, ct->ascii[i], arg);
2675 /* Map FN over the Control-1 chars in CT. */
2678 map_over_charset_control_1 (Lisp_Char_Table *ct,
2679 int (*fn) (struct chartab_range *range,
2680 Lisp_Object val, void *arg),
2683 struct chartab_range rainj;
2686 int stop = start + 32;
2688 rainj.type = CHARTAB_RANGE_CHAR;
2690 for (i = start, retval = 0; i < stop && retval == 0; i++)
2692 rainj.ch = (Emchar) (i);
2693 retval = (fn) (&rainj, ct->ascii[i], arg);
2699 /* Map FN over the row ROW of two-byte charset CHARSET.
2700 There must be a separate value for that row in the char table.
2701 CTE specifies the char table entry for CHARSET. */
2704 map_over_charset_row (Lisp_Char_Table_Entry *cte,
2705 Lisp_Object charset, int row,
2706 int (*fn) (struct chartab_range *range,
2707 Lisp_Object val, void *arg),
2710 Lisp_Object val = cte->level2[row - 32];
2712 if (!CHAR_TABLE_ENTRYP (val))
2714 struct chartab_range rainj;
2716 rainj.type = CHARTAB_RANGE_ROW;
2717 rainj.charset = charset;
2719 return (fn) (&rainj, val, arg);
2723 struct chartab_range rainj;
2725 int charset94_p = (XCHARSET_CHARS (charset) == 94);
2726 int start = charset94_p ? 33 : 32;
2727 int stop = charset94_p ? 127 : 128;
2729 cte = XCHAR_TABLE_ENTRY (val);
2731 rainj.type = CHARTAB_RANGE_CHAR;
2733 for (i = start, retval = 0; i < stop && retval == 0; i++)
2735 rainj.ch = MAKE_CHAR (charset, row, i);
2736 retval = (fn) (&rainj, cte->level2[i - 32], arg);
2744 map_over_other_charset (Lisp_Char_Table *ct, Charset_ID lb,
2745 int (*fn) (struct chartab_range *range,
2746 Lisp_Object val, void *arg),
2749 Lisp_Object val = ct->level1[lb - MIN_LEADING_BYTE];
2750 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (lb);
2752 if (!CHARSETP (charset)
2753 || lb == LEADING_BYTE_ASCII
2754 || lb == LEADING_BYTE_CONTROL_1)
2757 if (!CHAR_TABLE_ENTRYP (val))
2759 struct chartab_range rainj;
2761 rainj.type = CHARTAB_RANGE_CHARSET;
2762 rainj.charset = charset;
2763 return (fn) (&rainj, val, arg);
2767 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
2768 int charset94_p = (XCHARSET_CHARS (charset) == 94);
2769 int start = charset94_p ? 33 : 32;
2770 int stop = charset94_p ? 127 : 128;
2773 if (XCHARSET_DIMENSION (charset) == 1)
2775 struct chartab_range rainj;
2776 rainj.type = CHARTAB_RANGE_CHAR;
2778 for (i = start, retval = 0; i < stop && retval == 0; i++)
2780 rainj.ch = MAKE_CHAR (charset, i, 0);
2781 retval = (fn) (&rainj, cte->level2[i - 32], arg);
2786 for (i = start, retval = 0; i < stop && retval == 0; i++)
2787 retval = map_over_charset_row (cte, charset, i, fn, arg);
2795 #endif /* not UTF2000 */
2798 struct map_char_table_for_charset_arg
2800 int (*fn) (struct chartab_range *range, Lisp_Object val, void *arg);
2801 Lisp_Char_Table *ct;
2806 map_char_table_for_charset_fun (struct chartab_range *range,
2807 Lisp_Object val, void *arg)
2809 struct map_char_table_for_charset_arg *closure =
2810 (struct map_char_table_for_charset_arg *) arg;
2813 switch (range->type)
2815 case CHARTAB_RANGE_ALL:
2818 case CHARTAB_RANGE_DEFAULT:
2821 case CHARTAB_RANGE_CHARSET:
2824 case CHARTAB_RANGE_ROW:
2827 case CHARTAB_RANGE_CHAR:
2828 ret = get_char_table (range->ch, closure->ct);
2829 if (!UNBOUNDP (ret))
2830 return (closure->fn) (range, ret, closure->arg);
2842 /* Map FN (with client data ARG) over range RANGE in char table CT.
2843 Mapping stops the first time FN returns non-zero, and that value
2844 becomes the return value of map_char_table(). */
2847 map_char_table (Lisp_Char_Table *ct,
2848 struct chartab_range *range,
2849 int (*fn) (struct chartab_range *range,
2850 Lisp_Object val, void *arg),
2853 switch (range->type)
2855 case CHARTAB_RANGE_ALL:
2857 if (!UNBOUNDP (ct->default_value))
2859 struct chartab_range rainj;
2862 rainj.type = CHARTAB_RANGE_DEFAULT;
2863 retval = (fn) (&rainj, ct->default_value, arg);
2867 if (UINT8_BYTE_TABLE_P (ct->table))
2868 return map_over_uint8_byte_table (XUINT8_BYTE_TABLE(ct->table), ct,
2870 else if (UINT16_BYTE_TABLE_P (ct->table))
2871 return map_over_uint16_byte_table (XUINT16_BYTE_TABLE(ct->table), ct,
2873 else if (BYTE_TABLE_P (ct->table))
2874 return map_over_byte_table (XBYTE_TABLE(ct->table), ct,
2876 else if (EQ (ct->table, Qunloaded))
2879 struct chartab_range rainj;
2882 Emchar c1 = c + unit;
2885 rainj.type = CHARTAB_RANGE_CHAR;
2887 for (retval = 0; c < c1 && retval == 0; c++)
2889 Lisp_Object ret = get_char_id_table (ct, c);
2891 if (!UNBOUNDP (ret))
2894 retval = (fn) (&rainj, ct->table, arg);
2899 ct->table = Qunbound;
2902 else if (!UNBOUNDP (ct->table))
2903 return (fn) (range, ct->table, arg);
2909 retval = map_over_charset_ascii (ct, fn, arg);
2913 retval = map_over_charset_control_1 (ct, fn, arg);
2918 Charset_ID start = MIN_LEADING_BYTE;
2919 Charset_ID stop = start + NUM_LEADING_BYTES;
2921 for (i = start, retval = 0; i < stop && retval == 0; i++)
2923 retval = map_over_other_charset (ct, i, fn, arg);
2932 case CHARTAB_RANGE_DEFAULT:
2933 if (!UNBOUNDP (ct->default_value))
2934 return (fn) (range, ct->default_value, arg);
2939 case CHARTAB_RANGE_CHARSET:
2942 Lisp_Object encoding_table
2943 = XCHARSET_ENCODING_TABLE (range->charset);
2945 if (!NILP (encoding_table))
2947 struct chartab_range rainj;
2948 struct map_char_table_for_charset_arg mcarg;
2951 if (XCHAR_TABLE_UNLOADED(encoding_table))
2952 Fload_char_attribute_table (XCHAR_TABLE_NAME (encoding_table));
2957 rainj.type = CHARTAB_RANGE_ALL;
2958 return map_char_table (XCHAR_TABLE(encoding_table),
2960 &map_char_table_for_charset_fun,
2966 return map_over_other_charset (ct,
2967 XCHARSET_LEADING_BYTE (range->charset),
2971 case CHARTAB_RANGE_ROW:
2974 int cell_min, cell_max, i;
2976 struct chartab_range rainj;
2978 i = XCHARSET_CELL_RANGE (range->charset);
2980 cell_max = i & 0xFF;
2981 rainj.type = CHARTAB_RANGE_CHAR;
2982 for (retval =0, i = cell_min; i <= cell_max && retval == 0; i++)
2985 = DECODE_CHAR (range->charset, (range->row << 8) | i, 0);
2987 if ( charset_code_point (range->charset, ch, 0) >= 0 )
2990 = get_byte_table (get_byte_table
2994 (unsigned char)(ch >> 24)),
2995 (unsigned char) (ch >> 16)),
2996 (unsigned char) (ch >> 8)),
2997 (unsigned char) ch);
3000 val = ct->default_value;
3002 retval = (fn) (&rainj, val, arg);
3009 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (range->charset)
3010 - MIN_LEADING_BYTE];
3011 if (!CHAR_TABLE_ENTRYP (val))
3013 struct chartab_range rainj;
3015 rainj.type = CHARTAB_RANGE_ROW;
3016 rainj.charset = range->charset;
3017 rainj.row = range->row;
3018 return (fn) (&rainj, val, arg);
3021 return map_over_charset_row (XCHAR_TABLE_ENTRY (val),
3022 range->charset, range->row,
3025 #endif /* not UTF2000 */
3028 case CHARTAB_RANGE_CHAR:
3030 Emchar ch = range->ch;
3031 Lisp_Object val = CHAR_TABLE_VALUE_UNSAFE (ct, ch);
3033 if (!UNBOUNDP (val))
3035 struct chartab_range rainj;
3037 rainj.type = CHARTAB_RANGE_CHAR;
3039 return (fn) (&rainj, val, arg);
3051 struct slow_map_char_table_arg
3053 Lisp_Object function;
3058 slow_map_char_table_fun (struct chartab_range *range,
3059 Lisp_Object val, void *arg)
3061 Lisp_Object ranjarg = Qnil;
3062 struct slow_map_char_table_arg *closure =
3063 (struct slow_map_char_table_arg *) arg;
3065 switch (range->type)
3067 case CHARTAB_RANGE_ALL:
3072 case CHARTAB_RANGE_DEFAULT:
3078 case CHARTAB_RANGE_CHARSET:
3079 ranjarg = XCHARSET_NAME (range->charset);
3082 case CHARTAB_RANGE_ROW:
3083 ranjarg = vector2 (XCHARSET_NAME (range->charset),
3084 make_int (range->row));
3087 case CHARTAB_RANGE_CHAR:
3088 ranjarg = make_char (range->ch);
3094 closure->retval = call2 (closure->function, ranjarg, val);
3095 return !NILP (closure->retval);
3098 DEFUN ("map-char-table", Fmap_char_table, 2, 3, 0, /*
3099 Map FUNCTION over entries in CHAR-TABLE, calling it with two args,
3100 each key and value in the table.
3102 RANGE specifies a subrange to map over and is in the same format as
3103 the RANGE argument to `put-range-table'. If omitted or t, it defaults to
3106 (function, char_table, range))
3108 Lisp_Char_Table *ct;
3109 struct slow_map_char_table_arg slarg;
3110 struct gcpro gcpro1, gcpro2;
3111 struct chartab_range rainj;
3113 CHECK_CHAR_TABLE (char_table);
3114 ct = XCHAR_TABLE (char_table);
3117 decode_char_table_range (range, &rainj);
3118 slarg.function = function;
3119 slarg.retval = Qnil;
3120 GCPRO2 (slarg.function, slarg.retval);
3121 map_char_table (ct, &rainj, slow_map_char_table_fun, &slarg);
3124 return slarg.retval;
3128 /************************************************************************/
3129 /* Character Attributes */
3130 /************************************************************************/
3134 Lisp_Object Vchar_attribute_hash_table;
3136 /* We store the char-attributes in hash tables with the names as the
3137 key and the actual char-id-table object as the value. Occasionally
3138 we need to use them in a list format. These routines provide us
3140 struct char_attribute_list_closure
3142 Lisp_Object *char_attribute_list;
3146 add_char_attribute_to_list_mapper (Lisp_Object key, Lisp_Object value,
3147 void *char_attribute_list_closure)
3149 /* This function can GC */
3150 struct char_attribute_list_closure *calcl
3151 = (struct char_attribute_list_closure*) char_attribute_list_closure;
3152 Lisp_Object *char_attribute_list = calcl->char_attribute_list;
3154 *char_attribute_list = Fcons (key, *char_attribute_list);
3158 #ifdef HAVE_LIBCHISE
3160 char_attribute_list_reset_map_func (CHISE_DS *ds, unsigned char *name)
3162 Fmount_char_attribute_table (intern (name));
3166 DEFUN ("char-attribute-list", Fchar_attribute_list, 0, 1, 0, /*
3167 Return the list of all existing character attributes except coded-charsets.
3171 DEFUN ("char-attribute-list", Fchar_attribute_list, 0, 0, 0, /*
3172 Return the list of all existing character attributes except coded-charsets.
3177 Lisp_Object char_attribute_list = Qnil;
3178 struct gcpro gcpro1;
3179 struct char_attribute_list_closure char_attribute_list_closure;
3181 #ifdef HAVE_LIBCHISE
3184 open_chise_data_source_maybe ();
3185 chise_ds_foreach_char_feature_name
3186 (default_chise_data_source, &char_attribute_list_reset_map_func);
3189 GCPRO1 (char_attribute_list);
3190 char_attribute_list_closure.char_attribute_list = &char_attribute_list;
3191 elisp_maphash (add_char_attribute_to_list_mapper,
3192 Vchar_attribute_hash_table,
3193 &char_attribute_list_closure);
3195 return char_attribute_list;
3198 DEFUN ("find-char-attribute-table", Ffind_char_attribute_table, 1, 1, 0, /*
3199 Return char-id-table corresponding to ATTRIBUTE.
3203 return Fgethash (attribute, Vchar_attribute_hash_table, Qnil);
3207 /* We store the char-id-tables in hash tables with the attributes as
3208 the key and the actual char-id-table object as the value. Each
3209 char-id-table stores values of an attribute corresponding with
3210 characters. Occasionally we need to get attributes of a character
3211 in a association-list format. These routines provide us with
3213 struct char_attribute_alist_closure
3216 Lisp_Object *char_attribute_alist;
3220 add_char_attribute_alist_mapper (Lisp_Object key, Lisp_Object value,
3221 void *char_attribute_alist_closure)
3223 /* This function can GC */
3224 struct char_attribute_alist_closure *caacl =
3225 (struct char_attribute_alist_closure*) char_attribute_alist_closure;
3227 = get_char_id_table (XCHAR_TABLE(value), caacl->char_id);
3228 if (!UNBOUNDP (ret))
3230 Lisp_Object *char_attribute_alist = caacl->char_attribute_alist;
3231 *char_attribute_alist
3232 = Fcons (Fcons (key, ret), *char_attribute_alist);
3237 DEFUN ("char-attribute-alist", Fchar_attribute_alist, 1, 1, 0, /*
3238 Return the alist of attributes of CHARACTER.
3242 struct gcpro gcpro1;
3243 struct char_attribute_alist_closure char_attribute_alist_closure;
3244 Lisp_Object alist = Qnil;
3246 CHECK_CHAR (character);
3249 char_attribute_alist_closure.char_id = XCHAR (character);
3250 char_attribute_alist_closure.char_attribute_alist = &alist;
3251 elisp_maphash (add_char_attribute_alist_mapper,
3252 Vchar_attribute_hash_table,
3253 &char_attribute_alist_closure);
3259 DEFUN ("get-char-attribute", Fget_char_attribute, 2, 3, 0, /*
3260 Return the value of CHARACTER's ATTRIBUTE.
3261 Return DEFAULT-VALUE if the value is not exist.
3263 (character, attribute, default_value))
3267 CHECK_CHAR (character);
3269 if (CHARSETP (attribute))
3270 attribute = XCHARSET_NAME (attribute);
3272 table = Fgethash (attribute, Vchar_attribute_hash_table,
3274 if (!UNBOUNDP (table))
3276 Lisp_Object ret = get_char_id_table (XCHAR_TABLE(table),
3278 if (!UNBOUNDP (ret))
3281 return default_value;
3285 find_char_feature_in_family (Lisp_Object character,
3286 Lisp_Object con_feature,
3287 Lisp_Object feature,
3288 Lisp_Object feature_rel_max)
3290 Lisp_Object ancestors
3291 = Fget_char_attribute (character, con_feature, Qnil);
3293 while (!NILP (ancestors))
3295 Lisp_Object ancestor = XCAR (ancestors);
3298 if (EQ (ancestor, character))
3301 ret = Fchar_feature (ancestor, feature, Qunbound,
3302 Qnil, make_int (0));
3303 if (!UNBOUNDP (ret))
3306 ancestors = XCDR (ancestors);
3308 ret = Fget_char_attribute (ancestor, Q_subsumptive_from, Qnil);
3310 ancestors = nconc2 (Fcopy_sequence (ancestors), ret);
3312 ret = Fget_char_attribute (ancestor, Q_denotational_from, Qnil);
3314 ancestors = nconc2 (Fcopy_sequence (ancestors), ret);
3319 DEFUN ("char-feature", Fchar_feature, 2, 5, 0, /*
3320 Return the value of CHARACTER's FEATURE.
3321 Return DEFAULT-VALUE if the value is not exist.
3323 (character, attribute, default_value,
3324 feature_rel_max, char_rel_max))
3327 = Fget_char_attribute (character, attribute, Qunbound);
3329 if (!UNBOUNDP (ret))
3332 if (NILP (feature_rel_max)
3333 || (INTP (feature_rel_max) &&
3334 XINT (feature_rel_max) > 0))
3336 Lisp_String* name = symbol_name (XSYMBOL (attribute));
3337 Bufbyte *name_str = string_data (name);
3339 if (name_str[0] == '=' && name_str[1] == '>')
3341 Bytecount length = string_length (name) - 1;
3342 Lisp_Object map_to = make_uninit_string (length);
3344 memcpy (XSTRING_DATA (map_to) + 1, name_str + 2, length - 1);
3345 XSTRING_DATA(map_to)[0] = '=';
3346 ret = Fchar_feature (character, Fintern (map_to, Qnil),
3348 NILP (feature_rel_max)
3350 : make_int (XINT (feature_rel_max) - 1),
3352 if (!UNBOUNDP (ret))
3357 if ( !(EQ (attribute, Q_identical)) &&
3358 !(EQ (attribute, Q_subsumptive_from)) &&
3359 !(EQ (attribute, Q_denotational_from)) &&
3360 ( (NILP (char_rel_max)
3361 || (INTP (char_rel_max) &&
3362 XINT (char_rel_max) > 0)) ) )
3364 Lisp_String* name = symbol_name (XSYMBOL (attribute));
3365 Bufbyte *name_str = string_data (name);
3367 if ( (name_str[0] != '=') || (name_str[1] == '>') )
3369 ret = find_char_feature_in_family (character, Q_identical,
3370 attribute, feature_rel_max);
3371 if (!UNBOUNDP (ret))
3374 ret = find_char_feature_in_family (character, Q_subsumptive_from,
3375 attribute, feature_rel_max);
3376 if (!UNBOUNDP (ret))
3379 ret = find_char_feature_in_family (character, Q_denotational_from,
3380 attribute, feature_rel_max);
3381 if (!UNBOUNDP (ret))
3385 return default_value;
3388 void put_char_composition (Lisp_Object character, Lisp_Object value);
3390 put_char_composition (Lisp_Object character, Lisp_Object value)
3393 signal_simple_error ("Invalid value for ->decomposition",
3396 if (CONSP (Fcdr (value)))
3398 if (NILP (Fcdr (Fcdr (value))))
3400 Lisp_Object base = Fcar (value);
3401 Lisp_Object modifier = Fcar (Fcdr (value));
3405 base = make_char (XINT (base));
3406 Fsetcar (value, base);
3408 if (INTP (modifier))
3410 modifier = make_char (XINT (modifier));
3411 Fsetcar (Fcdr (value), modifier);
3416 = Fchar_feature (base, Qcomposition, Qnil,
3418 Lisp_Object ret = Fassq (modifier, alist);
3421 Fput_char_attribute (base, Qcomposition,
3422 Fcons (Fcons (modifier, character),
3425 Fsetcdr (ret, character);
3431 Lisp_Object v = Fcar (value);
3435 Emchar c = XINT (v);
3437 = Fchar_feature (make_char (c), Q_ucs_unified, Qnil,
3442 Fput_char_attribute (make_char (c), Q_ucs_unified,
3443 Fcons (character, Qnil));
3445 else if (NILP (Fmemq (character, ret)))
3447 Fput_char_attribute (make_char (c), Q_ucs_unified,
3448 Fcons (character, ret));
3455 put_char_attribute (Lisp_Object character, Lisp_Object attribute,
3458 Lisp_Object table = Fgethash (attribute,
3459 Vchar_attribute_hash_table,
3464 table = make_char_id_table (Qunbound);
3465 Fputhash (attribute, table, Vchar_attribute_hash_table);
3467 XCHAR_TABLE_NAME (table) = attribute;
3470 put_char_id_table (XCHAR_TABLE(table), character, value);
3474 DEFUN ("put-char-attribute", Fput_char_attribute, 3, 3, 0, /*
3475 Store CHARACTER's ATTRIBUTE with VALUE.
3477 (character, attribute, value))
3479 Lisp_Object ccs = Ffind_charset (attribute);
3481 CHECK_CHAR (character);
3485 value = put_char_ccs_code_point (character, ccs, value);
3486 attribute = XCHARSET_NAME (ccs);
3488 else if (EQ (attribute, Q_decomposition))
3489 put_char_composition (character, value);
3490 else if (EQ (attribute, Qto_ucs))
3496 signal_simple_error ("Invalid value for =>ucs", value);
3500 ret = Fchar_feature (make_char (c), Q_ucs_unified, Qnil,
3503 put_char_attribute (make_char (c), Q_ucs_unified,
3505 else if (NILP (Fmemq (character, ret)))
3506 Fput_char_attribute (make_char (c), Q_ucs_unified,
3507 Fcons (character, ret));
3509 else if ( EQ (attribute, Q_subsumptive) ||
3510 EQ (attribute, Q_subsumptive_from) ||
3511 EQ (attribute, Q_denotational) ||
3512 EQ (attribute, Q_denotational_from) ||
3513 EQ (attribute, Q_identical) ||
3514 EQ (attribute, Q_identical_from) ||
3515 EQ (attribute, Q_component) ||
3516 EQ (attribute, Q_component_of) ||
3517 EQ (attribute, Q_same) ||
3518 EQ (attribute, Q_same_of) ||
3519 !NILP (Fstring_match (build_string ("^<-simplified[^*]*$"),
3520 Fsymbol_name (attribute),
3523 Lisp_Object rest = value;
3525 Lisp_Object rev_feature = Qnil;
3526 struct gcpro gcpro1;
3527 GCPRO1 (rev_feature);
3529 if (EQ (attribute, Q_identical))
3530 rev_feature = Q_identical_from;
3531 else if (EQ (attribute, Q_identical_from))
3532 rev_feature = Q_identical;
3533 else if (EQ (attribute, Q_subsumptive))
3534 rev_feature = Q_subsumptive_from;
3535 else if (EQ (attribute, Q_subsumptive_from))
3536 rev_feature = Q_subsumptive;
3537 else if (EQ (attribute, Q_denotational))
3538 rev_feature = Q_denotational_from;
3539 else if (EQ (attribute, Q_denotational_from))
3540 rev_feature = Q_denotational;
3541 else if (EQ (attribute, Q_component))
3542 rev_feature = Q_component_of;
3543 else if (EQ (attribute, Q_component_of))
3544 rev_feature = Q_component;
3545 else if (EQ (attribute, Q_same))
3546 rev_feature = Q_same_of;
3547 else if (EQ (attribute, Q_same_of))
3548 rev_feature = Q_same;
3551 Lisp_String* name = symbol_name (XSYMBOL (attribute));
3552 Bufbyte *name_str = string_data (name);
3554 if (name_str[0] == '<' && name_str[1] == '-')
3556 Bytecount length = string_length (name);
3557 Bufbyte *rev_name_str = alloca (length + 1);
3559 memcpy (rev_name_str + 2, name_str + 2, length - 2);
3560 rev_name_str[0] = '-';
3561 rev_name_str[1] = '>';
3562 rev_name_str[length] = 0;
3563 rev_feature = intern (rev_name_str);
3567 while (CONSP (rest))
3572 ret = Fdefine_char (ret);
3574 if ( !NILP (ret) && !EQ (ret, character) )
3578 ffv = Fget_char_attribute (ret, rev_feature, Qnil);
3580 put_char_attribute (ret, rev_feature, list1 (character));
3581 else if (NILP (Fmemq (character, ffv)))
3582 put_char_attribute (ret, rev_feature,
3583 Fcons (character, ffv));
3584 Fsetcar (rest, ret);
3591 else if (EQ (attribute, Qideographic_structure))
3592 value = Fcopy_sequence (Fchar_refs_simplify_char_specs (value));
3594 return put_char_attribute (character, attribute, value);
3597 DEFUN ("remove-char-attribute", Fremove_char_attribute, 2, 2, 0, /*
3598 Remove CHARACTER's ATTRIBUTE.
3600 (character, attribute))
3604 CHECK_CHAR (character);
3605 ccs = Ffind_charset (attribute);
3608 return remove_char_ccs (character, ccs);
3612 Lisp_Object table = Fgethash (attribute,
3613 Vchar_attribute_hash_table,
3615 if (!UNBOUNDP (table))
3617 put_char_id_table (XCHAR_TABLE(table), character, Qunbound);
3626 int char_table_open_db_maybe (Lisp_Char_Table* cit);
3627 void char_table_close_db_maybe (Lisp_Char_Table* cit);
3628 Lisp_Object char_table_get_db (Lisp_Char_Table* cit, Emchar ch);
3630 #ifdef HAVE_LIBCHISE
3632 open_chise_data_source_maybe ()
3634 if (default_chise_data_source == NULL)
3636 Lisp_Object db_dir = Vexec_directory;
3637 int modemask = 0755; /* rwxr-xr-x */
3640 db_dir = build_string ("../lib-src");
3641 db_dir = Fexpand_file_name (build_string ("chise-db"), db_dir);
3643 default_chise_data_source
3644 = CHISE_DS_open (CHISE_DS_Berkeley_DB, XSTRING_DATA (db_dir),
3645 0 /* DB_HASH */, modemask);
3646 if (default_chise_data_source == NULL)
3651 #endif /* HAVE_LIBCHISE */
3653 DEFUN ("close-char-data-source", Fclose_char_data_source, 0, 0, 0, /*
3654 Close data-source of CHISE.
3658 #ifdef HAVE_LIBCHISE
3659 int status = CHISE_DS_close (default_chise_data_source);
3661 default_chise_data_source = NULL;
3664 #endif /* HAVE_LIBCHISE */
3669 char_table_open_db_maybe (Lisp_Char_Table* cit)
3671 Lisp_Object attribute = CHAR_TABLE_NAME (cit);
3673 if (!NILP (attribute))
3675 #ifdef HAVE_LIBCHISE
3676 if ( open_chise_data_source_maybe () )
3678 #else /* HAVE_LIBCHISE */
3679 if (NILP (Fdatabase_live_p (cit->db)))
3682 = char_attribute_system_db_file (Qsystem_char_id, attribute, 0);
3684 cit->db = Fopen_database (db_file, Qnil, Qnil,
3685 build_string ("r"), Qnil);
3689 #endif /* not HAVE_LIBCHISE */
3697 char_table_close_db_maybe (Lisp_Char_Table* cit)
3699 #ifndef HAVE_LIBCHISE
3700 if (!NILP (cit->db))
3702 if (!NILP (Fdatabase_live_p (cit->db)))
3703 Fclose_database (cit->db);
3706 #endif /* not HAVE_LIBCHISE */
3710 char_table_get_db (Lisp_Char_Table* cit, Emchar ch)
3713 #ifdef HAVE_LIBCHISE
3716 = chise_ds_load_char_feature_value (default_chise_data_source, ch,
3717 XSTRING_DATA(Fsymbol_name
3723 val = Fread (make_string (chise_value_data (&value),
3724 chise_value_size (&value) ));
3728 #else /* HAVE_LIBCHISE */
3729 val = Fget_database (Fprin1_to_string (make_char (ch), Qnil),
3731 if (!UNBOUNDP (val))
3735 #endif /* not HAVE_LIBCHISE */
3739 #ifndef HAVE_LIBCHISE
3741 char_attribute_system_db_file (Lisp_Object key_type, Lisp_Object attribute,
3744 Lisp_Object db_dir = Vexec_directory;
3747 db_dir = build_string ("../lib-src");
3749 db_dir = Fexpand_file_name (build_string ("chise-db"), db_dir);
3750 if (writing_mode && NILP (Ffile_exists_p (db_dir)))
3751 Fmake_directory_internal (db_dir);
3753 db_dir = Fexpand_file_name (Fsymbol_name (key_type), db_dir);
3754 if (writing_mode && NILP (Ffile_exists_p (db_dir)))
3755 Fmake_directory_internal (db_dir);
3758 Lisp_Object attribute_name = Fsymbol_name (attribute);
3759 Lisp_Object dest = Qnil, ret;
3761 struct gcpro gcpro1, gcpro2;
3762 int len = XSTRING_CHAR_LENGTH (attribute_name);
3766 for (i = 0; i < len; i++)
3768 Emchar c = string_char (XSTRING (attribute_name), i);
3770 if ( (c == '/') || (c == '%') )
3774 sprintf (str, "%%%02X", c);
3775 dest = concat3 (dest,
3776 Fsubstring (attribute_name,
3777 make_int (base), make_int (i)),
3778 build_string (str));
3782 ret = Fsubstring (attribute_name, make_int (base), make_int (len));
3783 dest = concat2 (dest, ret);
3785 return Fexpand_file_name (dest, db_dir);
3788 #endif /* not HAVE_LIBCHISE */
3790 DEFUN ("save-char-attribute-table", Fsave_char_attribute_table, 1, 1, 0, /*
3791 Save values of ATTRIBUTE into database file.
3795 Lisp_Object table = Fgethash (attribute,
3796 Vchar_attribute_hash_table, Qunbound);
3797 Lisp_Char_Table *ct;
3798 #ifdef HAVE_LIBCHISE
3799 CHISE_Feature feature;
3800 #else /* HAVE_LIBCHISE */
3801 Lisp_Object db_file;
3803 #endif /* not HAVE_LIBCHISE */
3805 if (CHAR_TABLEP (table))
3806 ct = XCHAR_TABLE (table);
3810 #ifdef HAVE_LIBCHISE
3811 if ( open_chise_data_source_maybe () )
3814 = chise_ds_get_feature (default_chise_data_source,
3815 XSTRING_DATA (Fsymbol_name (attribute)));
3816 #else /* HAVE_LIBCHISE */
3817 db_file = char_attribute_system_db_file (Qsystem_char_id, attribute, 1);
3818 db = Fopen_database (db_file, Qnil, Qnil, build_string ("w+"), Qnil);
3819 #endif /* not HAVE_LIBCHISE */
3821 #ifdef HAVE_LIBCHISE
3823 #else /* HAVE_LIBCHISE */
3825 #endif /* not HAVE_LIBCHISE */
3828 Lisp_Object (*filter)(Lisp_Object value);
3830 if ( EQ (attribute, Qideographic_structure)
3831 || EQ (attribute, Q_identical)
3832 || EQ (attribute, Q_identical_from)
3833 || EQ (attribute, Q_same)
3834 || EQ (attribute, Q_same_of)
3835 || !NILP (Fstring_match
3836 (build_string ("^\\(<-\\|->\\)simplified[^*]*$"),
3837 Fsymbol_name (attribute),
3839 filter = &Fchar_refs_simplify_char_specs;
3843 if (UINT8_BYTE_TABLE_P (ct->table))
3844 save_uint8_byte_table (XUINT8_BYTE_TABLE(ct->table), ct,
3845 #ifdef HAVE_LIBCHISE
3847 #else /* HAVE_LIBCHISE */
3849 #endif /* not HAVE_LIBCHISE */
3851 else if (UINT16_BYTE_TABLE_P (ct->table))
3852 save_uint16_byte_table (XUINT16_BYTE_TABLE(ct->table), ct,
3853 #ifdef HAVE_LIBCHISE
3855 #else /* HAVE_LIBCHISE */
3857 #endif /* not HAVE_LIBCHISE */
3859 else if (BYTE_TABLE_P (ct->table))
3860 save_byte_table (XBYTE_TABLE(ct->table), ct,
3861 #ifdef HAVE_LIBCHISE
3863 #else /* HAVE_LIBCHISE */
3865 #endif /* not HAVE_LIBCHISE */
3867 #ifdef HAVE_LIBCHISE
3868 chise_feature_sync (feature);
3869 #else /* HAVE_LIBCHISE */
3870 Fclose_database (db);
3871 #endif /* not HAVE_LIBCHISE */
3878 DEFUN ("mount-char-attribute-table", Fmount_char_attribute_table, 1, 1, 0, /*
3879 Mount database file on char-attribute-table ATTRIBUTE.
3883 Lisp_Object table = Fgethash (attribute,
3884 Vchar_attribute_hash_table, Qunbound);
3886 if (UNBOUNDP (table))
3888 Lisp_Char_Table *ct;
3890 table = make_char_id_table (Qunbound);
3891 Fputhash (attribute, table, Vchar_attribute_hash_table);
3892 XCHAR_TABLE_NAME(table) = attribute;
3893 ct = XCHAR_TABLE (table);
3894 ct->table = Qunloaded;
3895 XCHAR_TABLE_UNLOADED(table) = 1;
3896 #ifndef HAVE_LIBCHISE
3898 #endif /* not HAVE_LIBCHISE */
3904 DEFUN ("close-char-attribute-table", Fclose_char_attribute_table, 1, 1, 0, /*
3905 Close database of ATTRIBUTE.
3909 Lisp_Object table = Fgethash (attribute,
3910 Vchar_attribute_hash_table, Qunbound);
3911 Lisp_Char_Table *ct;
3913 if (CHAR_TABLEP (table))
3914 ct = XCHAR_TABLE (table);
3917 char_table_close_db_maybe (ct);
3921 DEFUN ("reset-char-attribute-table", Freset_char_attribute_table, 1, 1, 0, /*
3922 Reset values of ATTRIBUTE with database file.
3926 #ifdef HAVE_LIBCHISE
3927 CHISE_Feature feature
3928 = chise_ds_get_feature (default_chise_data_source,
3929 XSTRING_DATA (Fsymbol_name
3932 if (feature == NULL)
3935 if (chise_feature_setup_db (feature, 0) == 0)
3937 Lisp_Object table = Fgethash (attribute,
3938 Vchar_attribute_hash_table, Qunbound);
3939 Lisp_Char_Table *ct;
3941 chise_feature_sync (feature);
3942 if (UNBOUNDP (table))
3944 table = make_char_id_table (Qunbound);
3945 Fputhash (attribute, table, Vchar_attribute_hash_table);
3946 XCHAR_TABLE_NAME(table) = attribute;
3948 ct = XCHAR_TABLE (table);
3949 ct->table = Qunloaded;
3950 char_table_close_db_maybe (ct);
3951 XCHAR_TABLE_UNLOADED(table) = 1;
3955 Lisp_Object table = Fgethash (attribute,
3956 Vchar_attribute_hash_table, Qunbound);
3957 Lisp_Char_Table *ct;
3959 = char_attribute_system_db_file (Qsystem_char_id, attribute, 0);
3961 if (!NILP (Ffile_exists_p (db_file)))
3963 if (UNBOUNDP (table))
3965 table = make_char_id_table (Qunbound);
3966 Fputhash (attribute, table, Vchar_attribute_hash_table);
3967 XCHAR_TABLE_NAME(table) = attribute;
3969 ct = XCHAR_TABLE (table);
3970 ct->table = Qunloaded;
3971 char_table_close_db_maybe (ct);
3972 XCHAR_TABLE_UNLOADED(table) = 1;
3980 load_char_attribute_maybe (Lisp_Char_Table* cit, Emchar ch)
3982 Lisp_Object attribute = CHAR_TABLE_NAME (cit);
3984 if (!NILP (attribute))
3988 if (char_table_open_db_maybe (cit))
3991 val = char_table_get_db (cit, ch);
3993 if (!NILP (Vchar_db_stingy_mode))
3994 char_table_close_db_maybe (cit);
4001 Lisp_Char_Table* char_attribute_table_to_load;
4003 #ifdef HAVE_LIBCHISE
4005 load_char_attribute_table_map_func (CHISE_Char_ID cid,
4006 CHISE_Feature feature,
4007 CHISE_Value *value);
4009 load_char_attribute_table_map_func (CHISE_Char_ID cid,
4010 CHISE_Feature feature,
4014 Lisp_Object ret = get_char_id_table_0 (char_attribute_table_to_load, code);
4016 if (EQ (ret, Qunloaded))
4017 put_char_id_table_0 (char_attribute_table_to_load, code,
4018 Fread (make_string ((Bufbyte *) value->data,
4022 #else /* HAVE_LIBCHISE */
4023 Lisp_Object Qload_char_attribute_table_map_function;
4025 DEFUN ("load-char-attribute-table-map-function",
4026 Fload_char_attribute_table_map_function, 2, 2, 0, /*
4027 For internal use. Don't use it.
4031 Lisp_Object c = Fread (key);
4032 Emchar code = XCHAR (c);
4033 Lisp_Object ret = get_char_id_table_0 (char_attribute_table_to_load, code);
4035 if (EQ (ret, Qunloaded))
4036 put_char_id_table_0 (char_attribute_table_to_load, code, Fread (value));
4039 #endif /* not HAVE_LIBCHISE */
4041 DEFUN ("load-char-attribute-table", Fload_char_attribute_table, 1, 1, 0, /*
4042 Load values of ATTRIBUTE into database file.
4046 Lisp_Object table = Fgethash (attribute,
4047 Vchar_attribute_hash_table,
4049 if (CHAR_TABLEP (table))
4051 Lisp_Char_Table *cit = XCHAR_TABLE (table);
4053 if (char_table_open_db_maybe (cit))
4056 char_attribute_table_to_load = XCHAR_TABLE (table);
4058 struct gcpro gcpro1;
4061 #ifdef HAVE_LIBCHISE
4062 chise_feature_foreach_char_with_value
4063 (chise_ds_get_feature (default_chise_data_source,
4064 XSTRING_DATA (Fsymbol_name (cit->name))),
4065 &load_char_attribute_table_map_func);
4066 #else /* HAVE_LIBCHISE */
4067 Fmap_database (Qload_char_attribute_table_map_function, cit->db);
4068 #endif /* not HAVE_LIBCHISE */
4071 char_table_close_db_maybe (cit);
4072 XCHAR_TABLE_UNLOADED(table) = 0;
4077 #endif /* HAVE_CHISE */
4079 DEFUN ("map-char-attribute", Fmap_char_attribute, 2, 3, 0, /*
4080 Map FUNCTION over entries in ATTRIBUTE, calling it with two args,
4081 each key and value in the table.
4083 RANGE specifies a subrange to map over and is in the same format as
4084 the RANGE argument to `put-range-table'. If omitted or t, it defaults to
4087 (function, attribute, range))
4090 Lisp_Char_Table *ct;
4091 struct slow_map_char_table_arg slarg;
4092 struct gcpro gcpro1, gcpro2;
4093 struct chartab_range rainj;
4095 if (!NILP (ccs = Ffind_charset (attribute)))
4097 Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (ccs);
4099 if (CHAR_TABLEP (encoding_table))
4100 ct = XCHAR_TABLE (encoding_table);
4106 Lisp_Object table = Fgethash (attribute,
4107 Vchar_attribute_hash_table,
4109 if (CHAR_TABLEP (table))
4110 ct = XCHAR_TABLE (table);
4116 decode_char_table_range (range, &rainj);
4118 if (CHAR_TABLE_UNLOADED(ct))
4119 Fload_char_attribute_table (attribute);
4121 slarg.function = function;
4122 slarg.retval = Qnil;
4123 GCPRO2 (slarg.function, slarg.retval);
4124 map_char_table (ct, &rainj, slow_map_char_table_fun, &slarg);
4127 return slarg.retval;
4130 DEFUN ("define-char", Fdefine_char, 1, 1, 0, /*
4131 Store character's ATTRIBUTES.
4136 Lisp_Object code = Fcdr (Fassq (Qmap_ucs, attributes));
4137 Lisp_Object character;
4140 code = Fcdr (Fassq (Qucs, attributes));
4145 while (CONSP (rest))
4147 Lisp_Object cell = Fcar (rest);
4150 if ( !LISTP (cell) )
4151 signal_simple_error ("Invalid argument", attributes);
4153 ccs = Ffind_charset (Fcar (cell));
4159 character = Fdecode_char (ccs, cell, Qt, Qt);
4160 if (!NILP (character))
4161 goto setup_attributes;
4163 if ( (XCHARSET_FINAL (ccs) != 0) ||
4164 (XCHARSET_MAX_CODE (ccs) > 0) ||
4165 (EQ (ccs, Vcharset_chinese_big5)) )
4169 = Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
4171 character = Fdecode_char (ccs, cell, Qnil, Qt);
4172 if (!NILP (character))
4173 goto setup_attributes;
4180 int cid = XINT (Vnext_defined_char_id);
4182 if (cid <= 0xE00000)
4184 character = make_char (cid);
4185 Vnext_defined_char_id = make_int (cid + 1);
4186 goto setup_attributes;
4190 if ( (!NILP (code = Fcdr (Fassq (Qto_ucs, attributes)))) )
4193 signal_simple_error ("Invalid argument", attributes);
4195 character = make_char (XINT (code) + 0x100000);
4196 goto setup_attributes;
4201 else if (!INTP (code))
4202 signal_simple_error ("Invalid argument", attributes);
4204 character = make_char (XINT (code));
4208 while (CONSP (rest))
4210 Lisp_Object cell = Fcar (rest);
4213 signal_simple_error ("Invalid argument", attributes);
4215 Fput_char_attribute (character, Fcar (cell), Fcdr (cell));
4221 DEFUN ("find-char", Ffind_char, 1, 1, 0, /*
4222 Retrieve the character of the given ATTRIBUTES.
4226 Lisp_Object rest = attributes;
4229 while (CONSP (rest))
4231 Lisp_Object cell = Fcar (rest);
4235 signal_simple_error ("Invalid argument", attributes);
4236 if (!NILP (ccs = Ffind_charset (Fcar (cell))))
4240 return Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
4242 return Fdecode_char (ccs, cell, Qnil, Qnil);
4246 if ( (!NILP (code = Fcdr (Fassq (Qto_ucs, attributes)))) )
4249 signal_simple_error ("Invalid argument", attributes);
4251 return make_char (XINT (code) + 0x100000);
4259 /************************************************************************/
4260 /* Char table read syntax */
4261 /************************************************************************/
4264 chartab_type_validate (Lisp_Object keyword, Lisp_Object value,
4265 Error_behavior errb)
4267 /* #### should deal with ERRB */
4268 symbol_to_char_table_type (value);
4273 chartab_data_validate (Lisp_Object keyword, Lisp_Object value,
4274 Error_behavior errb)
4278 /* #### should deal with ERRB */
4279 EXTERNAL_LIST_LOOP (rest, value)
4281 Lisp_Object range = XCAR (rest);
4282 struct chartab_range dummy;
4286 signal_simple_error ("Invalid list format", value);
4289 if (!CONSP (XCDR (range))
4290 || !NILP (XCDR (XCDR (range))))
4291 signal_simple_error ("Invalid range format", range);
4292 decode_char_table_range (XCAR (range), &dummy);
4293 decode_char_table_range (XCAR (XCDR (range)), &dummy);
4296 decode_char_table_range (range, &dummy);
4303 chartab_instantiate (Lisp_Object data)
4305 Lisp_Object chartab;
4306 Lisp_Object type = Qgeneric;
4307 Lisp_Object dataval = Qnil;
4309 while (!NILP (data))
4311 Lisp_Object keyw = Fcar (data);
4317 if (EQ (keyw, Qtype))
4319 else if (EQ (keyw, Qdata))
4323 chartab = Fmake_char_table (type);
4326 while (!NILP (data))
4328 Lisp_Object range = Fcar (data);
4329 Lisp_Object val = Fcar (Fcdr (data));
4331 data = Fcdr (Fcdr (data));
4334 if (CHAR_OR_CHAR_INTP (XCAR (range)))
4336 Emchar first = XCHAR_OR_CHAR_INT (Fcar (range));
4337 Emchar last = XCHAR_OR_CHAR_INT (Fcar (Fcdr (range)));
4340 for (i = first; i <= last; i++)
4341 Fput_char_table (make_char (i), val, chartab);
4347 Fput_char_table (range, val, chartab);
4356 /************************************************************************/
4357 /* Category Tables, specifically */
4358 /************************************************************************/
4360 DEFUN ("category-table-p", Fcategory_table_p, 1, 1, 0, /*
4361 Return t if OBJECT is a category table.
4362 A category table is a type of char table used for keeping track of
4363 categories. Categories are used for classifying characters for use
4364 in regexps -- you can refer to a category rather than having to use
4365 a complicated [] expression (and category lookups are significantly
4368 There are 95 different categories available, one for each printable
4369 character (including space) in the ASCII charset. Each category
4370 is designated by one such character, called a "category designator".
4371 They are specified in a regexp using the syntax "\\cX", where X is
4372 a category designator.
4374 A category table specifies, for each character, the categories that
4375 the character is in. Note that a character can be in more than one
4376 category. More specifically, a category table maps from a character
4377 to either the value nil (meaning the character is in no categories)
4378 or a 95-element bit vector, specifying for each of the 95 categories
4379 whether the character is in that category.
4381 Special Lisp functions are provided that abstract this, so you do not
4382 have to directly manipulate bit vectors.
4386 return (CHAR_TABLEP (object) &&
4387 XCHAR_TABLE_TYPE (object) == CHAR_TABLE_TYPE_CATEGORY) ?
4392 check_category_table (Lisp_Object object, Lisp_Object default_)
4396 while (NILP (Fcategory_table_p (object)))
4397 object = wrong_type_argument (Qcategory_table_p, object);
4402 check_category_char (Emchar ch, Lisp_Object table,
4403 unsigned int designator, unsigned int not_p)
4405 REGISTER Lisp_Object temp;
4406 Lisp_Char_Table *ctbl;
4407 #ifdef ERROR_CHECK_TYPECHECK
4408 if (NILP (Fcategory_table_p (table)))
4409 signal_simple_error ("Expected category table", table);
4411 ctbl = XCHAR_TABLE (table);
4412 temp = get_char_table (ch, ctbl);
4417 return bit_vector_bit (XBIT_VECTOR (temp), designator) ? !not_p : not_p;
4420 DEFUN ("check-category-at", Fcheck_category_at, 2, 4, 0, /*
4421 Return t if category of the character at POSITION includes DESIGNATOR.
4422 Optional third arg BUFFER specifies which buffer to use, and defaults
4423 to the current buffer.
4424 Optional fourth arg CATEGORY-TABLE specifies the category table to
4425 use, and defaults to BUFFER's category table.
4427 (position, designator, buffer, category_table))
4432 struct buffer *buf = decode_buffer (buffer, 0);
4434 CHECK_INT (position);
4435 CHECK_CATEGORY_DESIGNATOR (designator);
4436 des = XCHAR (designator);
4437 ctbl = check_category_table (category_table, Vstandard_category_table);
4438 ch = BUF_FETCH_CHAR (buf, XINT (position));
4439 return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil;
4442 DEFUN ("char-in-category-p", Fchar_in_category_p, 2, 3, 0, /*
4443 Return t if category of CHARACTER includes DESIGNATOR, else nil.
4444 Optional third arg CATEGORY-TABLE specifies the category table to use,
4445 and defaults to the standard category table.
4447 (character, designator, category_table))
4453 CHECK_CATEGORY_DESIGNATOR (designator);
4454 des = XCHAR (designator);
4455 CHECK_CHAR (character);
4456 ch = XCHAR (character);
4457 ctbl = check_category_table (category_table, Vstandard_category_table);
4458 return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil;
4461 DEFUN ("category-table", Fcategory_table, 0, 1, 0, /*
4462 Return BUFFER's current category table.
4463 BUFFER defaults to the current buffer.
4467 return decode_buffer (buffer, 0)->category_table;
4470 DEFUN ("standard-category-table", Fstandard_category_table, 0, 0, 0, /*
4471 Return the standard category table.
4472 This is the one used for new buffers.
4476 return Vstandard_category_table;
4479 DEFUN ("copy-category-table", Fcopy_category_table, 0, 1, 0, /*
4480 Return a new category table which is a copy of CATEGORY-TABLE.
4481 CATEGORY-TABLE defaults to the standard category table.
4485 if (NILP (Vstandard_category_table))
4486 return Fmake_char_table (Qcategory);
4489 check_category_table (category_table, Vstandard_category_table);
4490 return Fcopy_char_table (category_table);
4493 DEFUN ("set-category-table", Fset_category_table, 1, 2, 0, /*
4494 Select CATEGORY-TABLE as the new category table for BUFFER.
4495 BUFFER defaults to the current buffer if omitted.
4497 (category_table, buffer))
4499 struct buffer *buf = decode_buffer (buffer, 0);
4500 category_table = check_category_table (category_table, Qnil);
4501 buf->category_table = category_table;
4502 /* Indicate that this buffer now has a specified category table. */
4503 buf->local_var_flags |= XINT (buffer_local_flags.category_table);
4504 return category_table;
4507 DEFUN ("category-designator-p", Fcategory_designator_p, 1, 1, 0, /*
4508 Return t if OBJECT is a category designator (a char in the range ' ' to '~').
4512 return CATEGORY_DESIGNATORP (object) ? Qt : Qnil;
4515 DEFUN ("category-table-value-p", Fcategory_table_value_p, 1, 1, 0, /*
4516 Return t if OBJECT is a category table value.
4517 Valid values are nil or a bit vector of size 95.
4521 return CATEGORY_TABLE_VALUEP (object) ? Qt : Qnil;
4525 #define CATEGORYP(x) \
4526 (CHARP (x) && XCHAR (x) >= 0x20 && XCHAR (x) <= 0x7E)
4528 #define CATEGORY_SET(c) \
4529 (get_char_table(c, XCHAR_TABLE(current_buffer->category_table)))
4531 /* Return 1 if CATEGORY_SET contains CATEGORY, else return 0.
4532 The faster version of `!NILP (Faref (category_set, category))'. */
4533 #define CATEGORY_MEMBER(category, category_set) \
4534 (bit_vector_bit(XBIT_VECTOR (category_set), category - 32))
4536 /* Return 1 if there is a word boundary between two word-constituent
4537 characters C1 and C2 if they appear in this order, else return 0.
4538 Use the macro WORD_BOUNDARY_P instead of calling this function
4541 int word_boundary_p (Emchar c1, Emchar c2);
4543 word_boundary_p (Emchar c1, Emchar c2)
4545 Lisp_Object category_set1, category_set2;
4550 if (COMPOSITE_CHAR_P (c1))
4551 c1 = cmpchar_component (c1, 0, 1);
4552 if (COMPOSITE_CHAR_P (c2))
4553 c2 = cmpchar_component (c2, 0, 1);
4557 if (EQ (CHAR_CHARSET (c1), CHAR_CHARSET (c2)))
4560 tail = Vword_separating_categories;
4566 tail = Vword_combining_categories;
4571 category_set1 = CATEGORY_SET (c1);
4572 if (NILP (category_set1))
4573 return default_result;
4574 category_set2 = CATEGORY_SET (c2);
4575 if (NILP (category_set2))
4576 return default_result;
4578 for (; CONSP (tail); tail = XCONS (tail)->cdr)
4580 Lisp_Object elt = XCONS(tail)->car;
4583 && CATEGORYP (XCONS (elt)->car)
4584 && CATEGORYP (XCONS (elt)->cdr)
4585 && CATEGORY_MEMBER (XCHAR (XCONS (elt)->car), category_set1)
4586 && CATEGORY_MEMBER (XCHAR (XCONS (elt)->cdr), category_set2))
4587 return !default_result;
4589 return default_result;
4595 syms_of_chartab (void)
4598 INIT_LRECORD_IMPLEMENTATION (uint8_byte_table);
4599 INIT_LRECORD_IMPLEMENTATION (uint16_byte_table);
4600 INIT_LRECORD_IMPLEMENTATION (byte_table);
4602 defsymbol (&Qto_ucs, "=>ucs");
4603 defsymbol (&Q_ucs_unified, "->ucs-unified");
4604 defsymbol (&Q_subsumptive, "->subsumptive");
4605 defsymbol (&Q_subsumptive_from, "<-subsumptive");
4606 defsymbol (&Q_denotational, "->denotational");
4607 defsymbol (&Q_denotational_from, "<-denotational");
4608 defsymbol (&Q_identical, "->identical");
4609 defsymbol (&Q_identical_from, "<-identical");
4610 defsymbol (&Q_component, "->ideographic-component-forms");
4611 defsymbol (&Q_component_of, "<-ideographic-component-forms");
4612 defsymbol (&Q_same, "->same");
4613 defsymbol (&Q_same_of, "<-same");
4614 defsymbol (&Qcomposition, "composition");
4615 defsymbol (&Q_decomposition, "->decomposition");
4616 defsymbol (&Qcompat, "compat");
4617 defsymbol (&Qisolated, "isolated");
4618 defsymbol (&Qinitial, "initial");
4619 defsymbol (&Qmedial, "medial");
4620 defsymbol (&Qfinal, "final");
4621 defsymbol (&Qvertical, "vertical");
4622 defsymbol (&QnoBreak, "noBreak");
4623 defsymbol (&Qfraction, "fraction");
4624 defsymbol (&Qsuper, "super");
4625 defsymbol (&Qsub, "sub");
4626 defsymbol (&Qcircle, "circle");
4627 defsymbol (&Qsquare, "square");
4628 defsymbol (&Qwide, "wide");
4629 defsymbol (&Qnarrow, "narrow");
4630 defsymbol (&Qsmall, "small");
4631 defsymbol (&Qfont, "font");
4633 DEFSUBR (Fchar_attribute_list);
4634 DEFSUBR (Ffind_char_attribute_table);
4635 defsymbol (&Qput_char_table_map_function, "put-char-table-map-function");
4636 DEFSUBR (Fput_char_table_map_function);
4638 DEFSUBR (Fsave_char_attribute_table);
4639 DEFSUBR (Fmount_char_attribute_table);
4640 DEFSUBR (Freset_char_attribute_table);
4641 DEFSUBR (Fclose_char_attribute_table);
4642 DEFSUBR (Fclose_char_data_source);
4643 #ifndef HAVE_LIBCHISE
4644 defsymbol (&Qload_char_attribute_table_map_function,
4645 "load-char-attribute-table-map-function");
4646 DEFSUBR (Fload_char_attribute_table_map_function);
4648 DEFSUBR (Fload_char_attribute_table);
4650 DEFSUBR (Fchar_feature);
4651 DEFSUBR (Fchar_attribute_alist);
4652 DEFSUBR (Fget_char_attribute);
4653 DEFSUBR (Fput_char_attribute);
4654 DEFSUBR (Fremove_char_attribute);
4655 DEFSUBR (Fmap_char_attribute);
4656 DEFSUBR (Fdefine_char);
4657 DEFSUBR (Ffind_char);
4658 DEFSUBR (Fchar_variants);
4660 DEFSUBR (Fget_composite_char);
4663 INIT_LRECORD_IMPLEMENTATION (char_table);
4667 INIT_LRECORD_IMPLEMENTATION (char_table_entry);
4670 defsymbol (&Qcategory_table_p, "category-table-p");
4671 defsymbol (&Qcategory_designator_p, "category-designator-p");
4672 defsymbol (&Qcategory_table_value_p, "category-table-value-p");
4675 defsymbol (&Qchar_table, "char-table");
4676 defsymbol (&Qchar_tablep, "char-table-p");
4678 DEFSUBR (Fchar_table_p);
4679 DEFSUBR (Fchar_table_type_list);
4680 DEFSUBR (Fvalid_char_table_type_p);
4681 DEFSUBR (Fchar_table_type);
4682 DEFSUBR (Freset_char_table);
4683 DEFSUBR (Fmake_char_table);
4684 DEFSUBR (Fcopy_char_table);
4685 DEFSUBR (Fget_char_table);
4686 DEFSUBR (Fget_range_char_table);
4687 DEFSUBR (Fvalid_char_table_value_p);
4688 DEFSUBR (Fcheck_valid_char_table_value);
4689 DEFSUBR (Fput_char_table);
4690 DEFSUBR (Fmap_char_table);
4693 DEFSUBR (Fcategory_table_p);
4694 DEFSUBR (Fcategory_table);
4695 DEFSUBR (Fstandard_category_table);
4696 DEFSUBR (Fcopy_category_table);
4697 DEFSUBR (Fset_category_table);
4698 DEFSUBR (Fcheck_category_at);
4699 DEFSUBR (Fchar_in_category_p);
4700 DEFSUBR (Fcategory_designator_p);
4701 DEFSUBR (Fcategory_table_value_p);
4707 vars_of_chartab (void)
4710 DEFVAR_LISP ("next-defined-char-id", &Vnext_defined_char_id /*
4712 Vnext_defined_char_id = make_int (0x0F0000);
4716 DEFVAR_LISP ("char-db-stingy-mode", &Vchar_db_stingy_mode /*
4718 Vchar_db_stingy_mode = Qt;
4720 #ifdef HAVE_LIBCHISE
4721 Vchise_db_directory = build_string(chise_db_dir);
4722 DEFVAR_LISP ("chise-db-directory", &Vchise_db_directory /*
4723 Directory of CHISE character databases.
4726 Vchise_system_db_directory = build_string(chise_system_db_dir);
4727 DEFVAR_LISP ("chise-system-db-directory", &Vchise_system_db_directory /*
4728 Directory of system character database of CHISE.
4732 #endif /* HAVE_CHISE */
4733 /* DO NOT staticpro this. It works just like Vweak_hash_tables. */
4734 Vall_syntax_tables = Qnil;
4735 dump_add_weak_object_chain (&Vall_syntax_tables);
4739 structure_type_create_chartab (void)
4741 struct structure_type *st;
4743 st = define_structure_type (Qchar_table, 0, chartab_instantiate);
4745 define_structure_type_keyword (st, Qtype, chartab_type_validate);
4746 define_structure_type_keyword (st, Qdata, chartab_data_validate);
4750 complex_vars_of_chartab (void)
4753 staticpro (&Vchar_attribute_hash_table);
4754 Vchar_attribute_hash_table
4755 = make_lisp_hash_table (16, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
4756 #endif /* UTF2000 */
4758 /* Set this now, so first buffer creation can refer to it. */
4759 /* Make it nil before calling copy-category-table
4760 so that copy-category-table will know not to try to copy from garbage */
4761 Vstandard_category_table = Qnil;
4762 Vstandard_category_table = Fcopy_category_table (Qnil);
4763 staticpro (&Vstandard_category_table);
4765 DEFVAR_LISP ("word-combining-categories", &Vword_combining_categories /*
4766 List of pair (cons) of categories to determine word boundary.
4768 Emacs treats a sequence of word constituent characters as a single
4769 word (i.e. finds no word boundary between them) iff they belongs to
4770 the same charset. But, exceptions are allowed in the following cases.
4772 \(1) The case that characters are in different charsets is controlled
4773 by the variable `word-combining-categories'.
4775 Emacs finds no word boundary between characters of different charsets
4776 if they have categories matching some element of this list.
4778 More precisely, if an element of this list is a cons of category CAT1
4779 and CAT2, and a multibyte character C1 which has CAT1 is followed by
4780 C2 which has CAT2, there's no word boundary between C1 and C2.
4782 For instance, to tell that ASCII characters and Latin-1 characters can
4783 form a single word, the element `(?l . ?l)' should be in this list
4784 because both characters have the category `l' (Latin characters).
4786 \(2) The case that character are in the same charset is controlled by
4787 the variable `word-separating-categories'.
4789 Emacs find a word boundary between characters of the same charset
4790 if they have categories matching some element of this list.
4792 More precisely, if an element of this list is a cons of category CAT1
4793 and CAT2, and a multibyte character C1 which has CAT1 is followed by
4794 C2 which has CAT2, there's a word boundary between C1 and C2.
4796 For instance, to tell that there's a word boundary between Japanese
4797 Hiragana and Japanese Kanji (both are in the same charset), the
4798 element `(?H . ?C) should be in this list.
4801 Vword_combining_categories = Qnil;
4803 DEFVAR_LISP ("word-separating-categories", &Vword_separating_categories /*
4804 List of pair (cons) of categories to determine word boundary.
4805 See the documentation of the variable `word-combining-categories'.
4808 Vword_separating_categories = Qnil;