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,2005 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;
80 EXFUN (Fmap_char_attribute, 3);
83 EXFUN (Fmount_char_attribute_table, 1);
87 EXFUN (Fload_char_attribute_table, 1);
89 Lisp_Object Vchar_db_stingy_mode;
92 #define BT_UINT8_MIN 0
93 #define BT_UINT8_MAX (UCHAR_MAX - 4)
94 #define BT_UINT8_t (UCHAR_MAX - 3)
95 #define BT_UINT8_nil (UCHAR_MAX - 2)
96 #define BT_UINT8_unbound (UCHAR_MAX - 1)
97 #define BT_UINT8_unloaded UCHAR_MAX
99 INLINE_HEADER int INT_UINT8_P (Lisp_Object obj);
100 INLINE_HEADER int UINT8_VALUE_P (Lisp_Object obj);
101 INLINE_HEADER unsigned char UINT8_ENCODE (Lisp_Object obj);
102 INLINE_HEADER Lisp_Object UINT8_DECODE (unsigned char n);
103 INLINE_HEADER unsigned short UINT8_TO_UINT16 (unsigned char n);
106 INT_UINT8_P (Lisp_Object obj)
110 int num = XINT (obj);
112 return (BT_UINT8_MIN <= num) && (num <= BT_UINT8_MAX);
119 UINT8_VALUE_P (Lisp_Object obj)
121 return EQ (obj, Qunloaded) || EQ (obj, Qunbound)
122 || EQ (obj, Qnil) || EQ (obj, Qt) || INT_UINT8_P (obj);
125 INLINE_HEADER unsigned char
126 UINT8_ENCODE (Lisp_Object obj)
128 if (EQ (obj, Qunloaded))
129 return BT_UINT8_unloaded;
130 else if (EQ (obj, Qunbound))
131 return BT_UINT8_unbound;
132 else if (EQ (obj, Qnil))
134 else if (EQ (obj, Qt))
140 INLINE_HEADER Lisp_Object
141 UINT8_DECODE (unsigned char n)
143 if (n == BT_UINT8_unloaded)
145 else if (n == BT_UINT8_unbound)
147 else if (n == BT_UINT8_nil)
149 else if (n == BT_UINT8_t)
156 mark_uint8_byte_table (Lisp_Object obj)
162 print_uint8_byte_table (Lisp_Object obj,
163 Lisp_Object printcharfun, int escapeflag)
165 Lisp_Uint8_Byte_Table *bte = XUINT8_BYTE_TABLE (obj);
167 struct gcpro gcpro1, gcpro2;
168 GCPRO2 (obj, printcharfun);
170 write_c_string ("\n#<uint8-byte-table", printcharfun);
171 for (i = 0; i < 256; i++)
173 unsigned char n = bte->property[i];
175 write_c_string ("\n ", printcharfun);
176 write_c_string (" ", printcharfun);
177 if (n == BT_UINT8_unbound)
178 write_c_string ("void", printcharfun);
179 else if (n == BT_UINT8_nil)
180 write_c_string ("nil", printcharfun);
181 else if (n == BT_UINT8_t)
182 write_c_string ("t", printcharfun);
187 sprintf (buf, "%hd", n);
188 write_c_string (buf, printcharfun);
192 write_c_string (">", printcharfun);
196 uint8_byte_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
198 Lisp_Uint8_Byte_Table *te1 = XUINT8_BYTE_TABLE (obj1);
199 Lisp_Uint8_Byte_Table *te2 = XUINT8_BYTE_TABLE (obj2);
202 for (i = 0; i < 256; i++)
203 if (te1->property[i] != te2->property[i])
209 uint8_byte_table_hash (Lisp_Object obj, int depth)
211 Lisp_Uint8_Byte_Table *te = XUINT8_BYTE_TABLE (obj);
215 for (i = 0; i < 256; i++)
216 hash = HASH2 (hash, te->property[i]);
220 static const struct lrecord_description uint8_byte_table_description[] = {
224 DEFINE_LRECORD_IMPLEMENTATION ("uint8-byte-table", uint8_byte_table,
225 mark_uint8_byte_table,
226 print_uint8_byte_table,
227 0, uint8_byte_table_equal,
228 uint8_byte_table_hash,
229 uint8_byte_table_description,
230 Lisp_Uint8_Byte_Table);
233 make_uint8_byte_table (unsigned char initval)
237 Lisp_Uint8_Byte_Table *cte;
239 cte = alloc_lcrecord_type (Lisp_Uint8_Byte_Table,
240 &lrecord_uint8_byte_table);
242 for (i = 0; i < 256; i++)
243 cte->property[i] = initval;
245 XSETUINT8_BYTE_TABLE (obj, cte);
250 copy_uint8_byte_table (Lisp_Object entry)
252 Lisp_Uint8_Byte_Table *cte = XUINT8_BYTE_TABLE (entry);
255 Lisp_Uint8_Byte_Table *ctenew
256 = alloc_lcrecord_type (Lisp_Uint8_Byte_Table,
257 &lrecord_uint8_byte_table);
259 for (i = 0; i < 256; i++)
261 ctenew->property[i] = cte->property[i];
264 XSETUINT8_BYTE_TABLE (obj, ctenew);
269 uint8_byte_table_same_value_p (Lisp_Object obj)
271 Lisp_Uint8_Byte_Table *bte = XUINT8_BYTE_TABLE (obj);
272 unsigned char v0 = bte->property[0];
275 for (i = 1; i < 256; i++)
277 if (bte->property[i] != v0)
284 map_over_uint8_byte_table (Lisp_Uint8_Byte_Table *ct, Lisp_Char_Table* root,
285 Emchar ofs, int place,
286 int (*fn) (struct chartab_range *range,
287 Lisp_Object val, void *arg),
290 struct chartab_range rainj;
292 int unit = 1 << (8 * place);
296 rainj.type = CHARTAB_RANGE_CHAR;
298 for (i = 0, retval = 0; i < 256 && retval == 0; i++)
300 if (ct->property[i] == BT_UINT8_unloaded)
304 for (; c < c1 && retval == 0; c++)
306 Lisp_Object ret = get_char_id_table (root, c);
311 retval = (fn) (&rainj, ret, arg);
315 ct->property[i] = BT_UINT8_unbound;
319 else if (ct->property[i] != BT_UINT8_unbound)
322 for (; c < c1 && retval == 0; c++)
325 retval = (fn) (&rainj, UINT8_DECODE (ct->property[i]), arg);
336 save_uint8_byte_table (Lisp_Uint8_Byte_Table *ct, Lisp_Char_Table* root,
338 CHISE_Feature feature,
342 Emchar ofs, int place,
343 Lisp_Object (*filter)(Lisp_Object value))
345 struct chartab_range rainj;
347 int unit = 1 << (8 * place);
351 rainj.type = CHARTAB_RANGE_CHAR;
353 for (i = 0, retval = 0; i < 256 && retval == 0; i++)
355 if (ct->property[i] == BT_UINT8_unloaded)
359 else if (ct->property[i] != BT_UINT8_unbound)
362 for (; c < c1 && retval == 0; c++)
365 chise_char_set_feature_value
368 (Fprin1_to_string (UINT8_DECODE (ct->property[i]),
371 Fput_database (Fprin1_to_string (make_char (c), Qnil),
372 Fprin1_to_string (UINT8_DECODE (ct->property[i]),
384 #define BT_UINT16_MIN 0
385 #define BT_UINT16_MAX (USHRT_MAX - 4)
386 #define BT_UINT16_t (USHRT_MAX - 3)
387 #define BT_UINT16_nil (USHRT_MAX - 2)
388 #define BT_UINT16_unbound (USHRT_MAX - 1)
389 #define BT_UINT16_unloaded USHRT_MAX
391 INLINE_HEADER int INT_UINT16_P (Lisp_Object obj);
392 INLINE_HEADER int UINT16_VALUE_P (Lisp_Object obj);
393 INLINE_HEADER unsigned short UINT16_ENCODE (Lisp_Object obj);
394 INLINE_HEADER Lisp_Object UINT16_DECODE (unsigned short us);
397 INT_UINT16_P (Lisp_Object obj)
401 int num = XINT (obj);
403 return (BT_UINT16_MIN <= num) && (num <= BT_UINT16_MAX);
410 UINT16_VALUE_P (Lisp_Object obj)
412 return EQ (obj, Qunloaded) || EQ (obj, Qunbound)
413 || EQ (obj, Qnil) || EQ (obj, Qt) || INT_UINT16_P (obj);
416 INLINE_HEADER unsigned short
417 UINT16_ENCODE (Lisp_Object obj)
419 if (EQ (obj, Qunloaded))
420 return BT_UINT16_unloaded;
421 else if (EQ (obj, Qunbound))
422 return BT_UINT16_unbound;
423 else if (EQ (obj, Qnil))
424 return BT_UINT16_nil;
425 else if (EQ (obj, Qt))
431 INLINE_HEADER Lisp_Object
432 UINT16_DECODE (unsigned short n)
434 if (n == BT_UINT16_unloaded)
436 else if (n == BT_UINT16_unbound)
438 else if (n == BT_UINT16_nil)
440 else if (n == BT_UINT16_t)
446 INLINE_HEADER unsigned short
447 UINT8_TO_UINT16 (unsigned char n)
449 if (n == BT_UINT8_unloaded)
450 return BT_UINT16_unloaded;
451 else if (n == BT_UINT8_unbound)
452 return BT_UINT16_unbound;
453 else if (n == BT_UINT8_nil)
454 return BT_UINT16_nil;
455 else if (n == BT_UINT8_t)
462 mark_uint16_byte_table (Lisp_Object obj)
468 print_uint16_byte_table (Lisp_Object obj,
469 Lisp_Object printcharfun, int escapeflag)
471 Lisp_Uint16_Byte_Table *bte = XUINT16_BYTE_TABLE (obj);
473 struct gcpro gcpro1, gcpro2;
474 GCPRO2 (obj, printcharfun);
476 write_c_string ("\n#<uint16-byte-table", printcharfun);
477 for (i = 0; i < 256; i++)
479 unsigned short n = bte->property[i];
481 write_c_string ("\n ", printcharfun);
482 write_c_string (" ", printcharfun);
483 if (n == BT_UINT16_unbound)
484 write_c_string ("void", printcharfun);
485 else if (n == BT_UINT16_nil)
486 write_c_string ("nil", printcharfun);
487 else if (n == BT_UINT16_t)
488 write_c_string ("t", printcharfun);
493 sprintf (buf, "%hd", n);
494 write_c_string (buf, printcharfun);
498 write_c_string (">", printcharfun);
502 uint16_byte_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
504 Lisp_Uint16_Byte_Table *te1 = XUINT16_BYTE_TABLE (obj1);
505 Lisp_Uint16_Byte_Table *te2 = XUINT16_BYTE_TABLE (obj2);
508 for (i = 0; i < 256; i++)
509 if (te1->property[i] != te2->property[i])
515 uint16_byte_table_hash (Lisp_Object obj, int depth)
517 Lisp_Uint16_Byte_Table *te = XUINT16_BYTE_TABLE (obj);
521 for (i = 0; i < 256; i++)
522 hash = HASH2 (hash, te->property[i]);
526 static const struct lrecord_description uint16_byte_table_description[] = {
530 DEFINE_LRECORD_IMPLEMENTATION ("uint16-byte-table", uint16_byte_table,
531 mark_uint16_byte_table,
532 print_uint16_byte_table,
533 0, uint16_byte_table_equal,
534 uint16_byte_table_hash,
535 uint16_byte_table_description,
536 Lisp_Uint16_Byte_Table);
539 make_uint16_byte_table (unsigned short initval)
543 Lisp_Uint16_Byte_Table *cte;
545 cte = alloc_lcrecord_type (Lisp_Uint16_Byte_Table,
546 &lrecord_uint16_byte_table);
548 for (i = 0; i < 256; i++)
549 cte->property[i] = initval;
551 XSETUINT16_BYTE_TABLE (obj, cte);
556 copy_uint16_byte_table (Lisp_Object entry)
558 Lisp_Uint16_Byte_Table *cte = XUINT16_BYTE_TABLE (entry);
561 Lisp_Uint16_Byte_Table *ctenew
562 = alloc_lcrecord_type (Lisp_Uint16_Byte_Table,
563 &lrecord_uint16_byte_table);
565 for (i = 0; i < 256; i++)
567 ctenew->property[i] = cte->property[i];
570 XSETUINT16_BYTE_TABLE (obj, ctenew);
575 expand_uint8_byte_table_to_uint16 (Lisp_Object table)
579 Lisp_Uint8_Byte_Table* bte = XUINT8_BYTE_TABLE(table);
580 Lisp_Uint16_Byte_Table* cte;
582 cte = alloc_lcrecord_type (Lisp_Uint16_Byte_Table,
583 &lrecord_uint16_byte_table);
584 for (i = 0; i < 256; i++)
586 cte->property[i] = UINT8_TO_UINT16 (bte->property[i]);
588 XSETUINT16_BYTE_TABLE (obj, cte);
593 uint16_byte_table_same_value_p (Lisp_Object obj)
595 Lisp_Uint16_Byte_Table *bte = XUINT16_BYTE_TABLE (obj);
596 unsigned short v0 = bte->property[0];
599 for (i = 1; i < 256; i++)
601 if (bte->property[i] != v0)
608 map_over_uint16_byte_table (Lisp_Uint16_Byte_Table *ct, Lisp_Char_Table* root,
609 Emchar ofs, int place,
610 int (*fn) (struct chartab_range *range,
611 Lisp_Object val, void *arg),
614 struct chartab_range rainj;
616 int unit = 1 << (8 * place);
620 rainj.type = CHARTAB_RANGE_CHAR;
622 for (i = 0, retval = 0; i < 256 && retval == 0; i++)
624 if (ct->property[i] == BT_UINT16_unloaded)
628 for (; c < c1 && retval == 0; c++)
630 Lisp_Object ret = get_char_id_table (root, c);
635 retval = (fn) (&rainj, ret, arg);
639 ct->property[i] = BT_UINT16_unbound;
643 else if (ct->property[i] != BT_UINT16_unbound)
646 for (; c < c1 && retval == 0; c++)
649 retval = (fn) (&rainj, UINT16_DECODE (ct->property[i]), arg);
660 save_uint16_byte_table (Lisp_Uint16_Byte_Table *ct, Lisp_Char_Table* root,
662 CHISE_Feature feature,
666 Emchar ofs, int place,
667 Lisp_Object (*filter)(Lisp_Object value))
669 struct chartab_range rainj;
671 int unit = 1 << (8 * place);
675 rainj.type = CHARTAB_RANGE_CHAR;
677 for (i = 0, retval = 0; i < 256 && retval == 0; i++)
679 if (ct->property[i] == BT_UINT16_unloaded)
683 else if (ct->property[i] != BT_UINT16_unbound)
686 for (; c < c1 && retval == 0; c++)
689 chise_char_set_feature_value
692 (Fprin1_to_string (UINT16_DECODE (ct->property[i]),
695 Fput_database (Fprin1_to_string (make_char (c), Qnil),
696 Fprin1_to_string (UINT16_DECODE (ct->property[i]),
710 mark_byte_table (Lisp_Object obj)
712 Lisp_Byte_Table *cte = XBYTE_TABLE (obj);
715 for (i = 0; i < 256; i++)
717 mark_object (cte->property[i]);
723 print_byte_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
725 Lisp_Byte_Table *bte = XBYTE_TABLE (obj);
727 struct gcpro gcpro1, gcpro2;
728 GCPRO2 (obj, printcharfun);
730 write_c_string ("\n#<byte-table", printcharfun);
731 for (i = 0; i < 256; i++)
733 Lisp_Object elt = bte->property[i];
735 write_c_string ("\n ", printcharfun);
736 write_c_string (" ", printcharfun);
737 if (EQ (elt, Qunbound))
738 write_c_string ("void", printcharfun);
740 print_internal (elt, printcharfun, escapeflag);
743 write_c_string (">", printcharfun);
747 byte_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
749 Lisp_Byte_Table *cte1 = XBYTE_TABLE (obj1);
750 Lisp_Byte_Table *cte2 = XBYTE_TABLE (obj2);
753 for (i = 0; i < 256; i++)
754 if (BYTE_TABLE_P (cte1->property[i]))
756 if (BYTE_TABLE_P (cte2->property[i]))
758 if (!byte_table_equal (cte1->property[i],
759 cte2->property[i], depth + 1))
766 if (!internal_equal (cte1->property[i], cte2->property[i], depth + 1))
772 byte_table_hash (Lisp_Object obj, int depth)
774 Lisp_Byte_Table *cte = XBYTE_TABLE (obj);
776 return internal_array_hash (cte->property, 256, depth);
779 static const struct lrecord_description byte_table_description[] = {
780 { XD_LISP_OBJECT_ARRAY, offsetof(Lisp_Byte_Table, property), 256 },
784 DEFINE_LRECORD_IMPLEMENTATION ("byte-table", byte_table,
789 byte_table_description,
793 make_byte_table (Lisp_Object initval)
797 Lisp_Byte_Table *cte;
799 cte = alloc_lcrecord_type (Lisp_Byte_Table, &lrecord_byte_table);
801 for (i = 0; i < 256; i++)
802 cte->property[i] = initval;
804 XSETBYTE_TABLE (obj, cte);
809 copy_byte_table (Lisp_Object entry)
811 Lisp_Byte_Table *cte = XBYTE_TABLE (entry);
814 Lisp_Byte_Table *ctnew
815 = alloc_lcrecord_type (Lisp_Byte_Table, &lrecord_byte_table);
817 for (i = 0; i < 256; i++)
819 if (UINT8_BYTE_TABLE_P (cte->property[i]))
821 ctnew->property[i] = copy_uint8_byte_table (cte->property[i]);
823 else if (UINT16_BYTE_TABLE_P (cte->property[i]))
825 ctnew->property[i] = copy_uint16_byte_table (cte->property[i]);
827 else if (BYTE_TABLE_P (cte->property[i]))
829 ctnew->property[i] = copy_byte_table (cte->property[i]);
832 ctnew->property[i] = cte->property[i];
835 XSETBYTE_TABLE (obj, ctnew);
840 byte_table_same_value_p (Lisp_Object obj)
842 Lisp_Byte_Table *bte = XBYTE_TABLE (obj);
843 Lisp_Object v0 = bte->property[0];
846 for (i = 1; i < 256; i++)
848 if (!internal_equal (bte->property[i], v0, 0))
855 map_over_byte_table (Lisp_Byte_Table *ct, Lisp_Char_Table* root,
856 Emchar ofs, int place,
857 int (*fn) (struct chartab_range *range,
858 Lisp_Object val, void *arg),
863 int unit = 1 << (8 * place);
866 for (i = 0, retval = 0; i < 256 && retval == 0; i++)
869 if (UINT8_BYTE_TABLE_P (v))
872 = map_over_uint8_byte_table (XUINT8_BYTE_TABLE(v), root,
873 c, place - 1, fn, arg);
876 else if (UINT16_BYTE_TABLE_P (v))
879 = map_over_uint16_byte_table (XUINT16_BYTE_TABLE(v), root,
880 c, place - 1, fn, arg);
883 else if (BYTE_TABLE_P (v))
885 retval = map_over_byte_table (XBYTE_TABLE(v), root,
886 c, place - 1, fn, arg);
889 else if (EQ (v, Qunloaded))
892 struct chartab_range rainj;
893 Emchar c1 = c + unit;
895 rainj.type = CHARTAB_RANGE_CHAR;
897 for (; c < c1 && retval == 0; c++)
899 Lisp_Object ret = get_char_id_table (root, c);
904 retval = (fn) (&rainj, ret, arg);
908 ct->property[i] = Qunbound;
912 else if (!UNBOUNDP (v))
914 struct chartab_range rainj;
915 Emchar c1 = c + unit;
917 rainj.type = CHARTAB_RANGE_CHAR;
919 for (; c < c1 && retval == 0; c++)
922 retval = (fn) (&rainj, v, arg);
933 save_byte_table (Lisp_Byte_Table *ct, Lisp_Char_Table* root,
935 CHISE_Feature feature,
939 Emchar ofs, int place,
940 Lisp_Object (*filter)(Lisp_Object value))
944 int unit = 1 << (8 * place);
947 for (i = 0, retval = 0; i < 256 && retval == 0; i++)
950 if (UINT8_BYTE_TABLE_P (v))
952 save_uint8_byte_table (XUINT8_BYTE_TABLE(v), root,
958 c, place - 1, filter);
961 else if (UINT16_BYTE_TABLE_P (v))
963 save_uint16_byte_table (XUINT16_BYTE_TABLE(v), root,
969 c, place - 1, filter);
972 else if (BYTE_TABLE_P (v))
974 save_byte_table (XBYTE_TABLE(v), root,
980 c, place - 1, filter);
983 else if (EQ (v, Qunloaded))
987 else if (!UNBOUNDP (v))
989 struct chartab_range rainj;
990 Emchar c1 = c + unit;
995 rainj.type = CHARTAB_RANGE_CHAR;
997 for (; c < c1 && retval == 0; c++)
1000 chise_char_set_feature_value
1001 (c, feature, XSTRING_DATA (Fprin1_to_string (v, Qnil)));
1003 Fput_database (Fprin1_to_string (make_char (c), Qnil),
1004 Fprin1_to_string (v, Qnil),
1016 get_byte_table (Lisp_Object table, unsigned char idx)
1018 if (UINT8_BYTE_TABLE_P (table))
1019 return UINT8_DECODE (XUINT8_BYTE_TABLE(table)->property[idx]);
1020 else if (UINT16_BYTE_TABLE_P (table))
1021 return UINT16_DECODE (XUINT16_BYTE_TABLE(table)->property[idx]);
1022 else if (BYTE_TABLE_P (table))
1023 return XBYTE_TABLE(table)->property[idx];
1029 put_byte_table (Lisp_Object table, unsigned char idx, Lisp_Object value)
1031 if (UINT8_BYTE_TABLE_P (table))
1033 if (UINT8_VALUE_P (value))
1035 XUINT8_BYTE_TABLE(table)->property[idx] = UINT8_ENCODE (value);
1036 if (!UINT8_BYTE_TABLE_P (value) &&
1037 !UINT16_BYTE_TABLE_P (value) && !BYTE_TABLE_P (value)
1038 && uint8_byte_table_same_value_p (table))
1043 else if (UINT16_VALUE_P (value))
1045 Lisp_Object new = expand_uint8_byte_table_to_uint16 (table);
1047 XUINT16_BYTE_TABLE(new)->property[idx] = UINT16_ENCODE (value);
1052 Lisp_Object new = make_byte_table (Qnil);
1055 for (i = 0; i < 256; i++)
1057 XBYTE_TABLE(new)->property[i]
1058 = UINT8_DECODE (XUINT8_BYTE_TABLE(table)->property[i]);
1060 XBYTE_TABLE(new)->property[idx] = value;
1064 else if (UINT16_BYTE_TABLE_P (table))
1066 if (UINT16_VALUE_P (value))
1068 XUINT16_BYTE_TABLE(table)->property[idx] = UINT16_ENCODE (value);
1069 if (!UINT8_BYTE_TABLE_P (value) &&
1070 !UINT16_BYTE_TABLE_P (value) && !BYTE_TABLE_P (value)
1071 && uint16_byte_table_same_value_p (table))
1078 Lisp_Object new = make_byte_table (Qnil);
1081 for (i = 0; i < 256; i++)
1083 XBYTE_TABLE(new)->property[i]
1084 = UINT16_DECODE (XUINT16_BYTE_TABLE(table)->property[i]);
1086 XBYTE_TABLE(new)->property[idx] = value;
1090 else if (BYTE_TABLE_P (table))
1092 XBYTE_TABLE(table)->property[idx] = value;
1093 if (!UINT8_BYTE_TABLE_P (value) &&
1094 !UINT16_BYTE_TABLE_P (value) && !BYTE_TABLE_P (value)
1095 && byte_table_same_value_p (table))
1100 else if (!internal_equal (table, value, 0))
1102 if (UINT8_VALUE_P (table) && UINT8_VALUE_P (value))
1104 table = make_uint8_byte_table (UINT8_ENCODE (table));
1105 XUINT8_BYTE_TABLE(table)->property[idx] = UINT8_ENCODE (value);
1107 else if (UINT16_VALUE_P (table) && UINT16_VALUE_P (value))
1109 table = make_uint16_byte_table (UINT16_ENCODE (table));
1110 XUINT16_BYTE_TABLE(table)->property[idx] = UINT16_ENCODE (value);
1114 table = make_byte_table (table);
1115 XBYTE_TABLE(table)->property[idx] = value;
1123 make_char_id_table (Lisp_Object initval)
1126 obj = Fmake_char_table (Qgeneric);
1127 fill_char_table (XCHAR_TABLE (obj), initval);
1132 Lisp_Object Qcomposition;
1133 Lisp_Object Qmap_decomposition;
1134 Lisp_Object Qto_decomposition_at_superscript;
1135 Lisp_Object Qto_decomposition_at_circled;
1136 Lisp_Object Q_canonical;
1137 Lisp_Object Q_superscript_of;
1138 Lisp_Object Q_subscript_of;
1139 Lisp_Object Q_compat_of;
1140 Lisp_Object Q_decomposition;
1141 Lisp_Object Q_identical;
1142 Lisp_Object Q_identical_from;
1143 Lisp_Object Q_denotational;
1144 Lisp_Object Q_denotational_from;
1145 Lisp_Object Q_subsumptive;
1146 Lisp_Object Q_subsumptive_from;
1147 Lisp_Object Q_component;
1148 Lisp_Object Q_component_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.
1245 CHECK_CHAR (character);
1248 (Fcopy_list (Fget_char_attribute (character, Q_subsumptive, Qnil)),
1250 (Fcopy_list (Fget_char_attribute (character, Q_denotational, Qnil)),
1252 (Fcopy_list (Fget_char_attribute (character, Q_identical, Qnil)),
1253 Fcopy_list (Fchar_feature (character, Q_ucs_unified, Qnil,
1260 /* A char table maps from ranges of characters to values.
1262 Implementing a general data structure that maps from arbitrary
1263 ranges of numbers to values is tricky to do efficiently. As it
1264 happens, it should suffice (and is usually more convenient, anyway)
1265 when dealing with characters to restrict the sorts of ranges that
1266 can be assigned values, as follows:
1269 2) All characters in a charset.
1270 3) All characters in a particular row of a charset, where a "row"
1271 means all characters with the same first byte.
1272 4) A particular character in a charset.
1274 We use char tables to generalize the 256-element vectors now
1275 littering the Emacs code.
1277 Possible uses (all should be converted at some point):
1283 5) keyboard-translate-table?
1286 abstract type to generalize the Emacs vectors and Mule
1287 vectors-of-vectors goo.
1290 /************************************************************************/
1291 /* Char Table object */
1292 /************************************************************************/
1294 #if defined(MULE)&&!defined(UTF2000)
1297 mark_char_table_entry (Lisp_Object obj)
1299 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj);
1302 for (i = 0; i < 96; i++)
1304 mark_object (cte->level2[i]);
1310 char_table_entry_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
1312 Lisp_Char_Table_Entry *cte1 = XCHAR_TABLE_ENTRY (obj1);
1313 Lisp_Char_Table_Entry *cte2 = XCHAR_TABLE_ENTRY (obj2);
1316 for (i = 0; i < 96; i++)
1317 if (!internal_equal (cte1->level2[i], cte2->level2[i], depth + 1))
1323 static unsigned long
1324 char_table_entry_hash (Lisp_Object obj, int depth)
1326 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj);
1328 return internal_array_hash (cte->level2, 96, depth);
1331 static const struct lrecord_description char_table_entry_description[] = {
1332 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table_Entry, level2), 96 },
1336 DEFINE_LRECORD_IMPLEMENTATION ("char-table-entry", char_table_entry,
1337 mark_char_table_entry, internal_object_printer,
1338 0, char_table_entry_equal,
1339 char_table_entry_hash,
1340 char_table_entry_description,
1341 Lisp_Char_Table_Entry);
1345 mark_char_table (Lisp_Object obj)
1347 Lisp_Char_Table *ct = XCHAR_TABLE (obj);
1350 mark_object (ct->table);
1351 mark_object (ct->name);
1352 #ifndef HAVE_LIBCHISE
1353 mark_object (ct->db);
1358 for (i = 0; i < NUM_ASCII_CHARS; i++)
1359 mark_object (ct->ascii[i]);
1361 for (i = 0; i < NUM_LEADING_BYTES; i++)
1362 mark_object (ct->level1[i]);
1366 return ct->default_value;
1368 return ct->mirror_table;
1372 /* WARNING: All functions of this nature need to be written extremely
1373 carefully to avoid crashes during GC. Cf. prune_specifiers()
1374 and prune_weak_hash_tables(). */
1377 prune_syntax_tables (void)
1379 Lisp_Object rest, prev = Qnil;
1381 for (rest = Vall_syntax_tables;
1383 rest = XCHAR_TABLE (rest)->next_table)
1385 if (! marked_p (rest))
1387 /* This table is garbage. Remove it from the list. */
1389 Vall_syntax_tables = XCHAR_TABLE (rest)->next_table;
1391 XCHAR_TABLE (prev)->next_table =
1392 XCHAR_TABLE (rest)->next_table;
1398 char_table_type_to_symbol (enum char_table_type type)
1403 case CHAR_TABLE_TYPE_GENERIC: return Qgeneric;
1404 case CHAR_TABLE_TYPE_SYNTAX: return Qsyntax;
1405 case CHAR_TABLE_TYPE_DISPLAY: return Qdisplay;
1406 case CHAR_TABLE_TYPE_CHAR: return Qchar;
1408 case CHAR_TABLE_TYPE_CATEGORY: return Qcategory;
1413 static enum char_table_type
1414 symbol_to_char_table_type (Lisp_Object symbol)
1416 CHECK_SYMBOL (symbol);
1418 if (EQ (symbol, Qgeneric)) return CHAR_TABLE_TYPE_GENERIC;
1419 if (EQ (symbol, Qsyntax)) return CHAR_TABLE_TYPE_SYNTAX;
1420 if (EQ (symbol, Qdisplay)) return CHAR_TABLE_TYPE_DISPLAY;
1421 if (EQ (symbol, Qchar)) return CHAR_TABLE_TYPE_CHAR;
1423 if (EQ (symbol, Qcategory)) return CHAR_TABLE_TYPE_CATEGORY;
1426 signal_simple_error ("Unrecognized char table type", symbol);
1427 return CHAR_TABLE_TYPE_GENERIC; /* not reached */
1432 print_chartab_range (Emchar first, Emchar last, Lisp_Object val,
1433 Lisp_Object printcharfun)
1437 write_c_string (" (", printcharfun);
1438 print_internal (make_char (first), printcharfun, 0);
1439 write_c_string (" ", printcharfun);
1440 print_internal (make_char (last), printcharfun, 0);
1441 write_c_string (") ", printcharfun);
1445 write_c_string (" ", printcharfun);
1446 print_internal (make_char (first), printcharfun, 0);
1447 write_c_string (" ", printcharfun);
1449 print_internal (val, printcharfun, 1);
1453 #if defined(MULE)&&!defined(UTF2000)
1456 print_chartab_charset_row (Lisp_Object charset,
1458 Lisp_Char_Table_Entry *cte,
1459 Lisp_Object printcharfun)
1462 Lisp_Object cat = Qunbound;
1465 for (i = 32; i < 128; i++)
1467 Lisp_Object pam = cte->level2[i - 32];
1479 print_chartab_range (MAKE_CHAR (charset, first, 0),
1480 MAKE_CHAR (charset, i - 1, 0),
1483 print_chartab_range (MAKE_CHAR (charset, row, first),
1484 MAKE_CHAR (charset, row, i - 1),
1494 print_chartab_range (MAKE_CHAR (charset, first, 0),
1495 MAKE_CHAR (charset, i - 1, 0),
1498 print_chartab_range (MAKE_CHAR (charset, row, first),
1499 MAKE_CHAR (charset, row, i - 1),
1505 print_chartab_two_byte_charset (Lisp_Object charset,
1506 Lisp_Char_Table_Entry *cte,
1507 Lisp_Object printcharfun)
1511 for (i = 32; i < 128; i++)
1513 Lisp_Object jen = cte->level2[i - 32];
1515 if (!CHAR_TABLE_ENTRYP (jen))
1519 write_c_string (" [", printcharfun);
1520 print_internal (XCHARSET_NAME (charset), printcharfun, 0);
1521 sprintf (buf, " %d] ", i);
1522 write_c_string (buf, printcharfun);
1523 print_internal (jen, printcharfun, 0);
1526 print_chartab_charset_row (charset, i, XCHAR_TABLE_ENTRY (jen),
1534 print_char_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1536 Lisp_Char_Table *ct = XCHAR_TABLE (obj);
1539 struct gcpro gcpro1, gcpro2;
1540 GCPRO2 (obj, printcharfun);
1542 write_c_string ("#s(char-table ", printcharfun);
1543 write_c_string (" ", printcharfun);
1544 write_c_string (string_data
1546 (XSYMBOL (char_table_type_to_symbol (ct->type)))),
1548 write_c_string ("\n ", printcharfun);
1549 print_internal (ct->default_value, printcharfun, escapeflag);
1550 for (i = 0; i < 256; i++)
1552 Lisp_Object elt = get_byte_table (ct->table, i);
1553 if (i != 0) write_c_string ("\n ", printcharfun);
1554 if (EQ (elt, Qunbound))
1555 write_c_string ("void", printcharfun);
1557 print_internal (elt, printcharfun, escapeflag);
1560 #else /* non UTF2000 */
1563 sprintf (buf, "#s(char-table type %s data (",
1564 string_data (symbol_name (XSYMBOL
1565 (char_table_type_to_symbol (ct->type)))));
1566 write_c_string (buf, printcharfun);
1568 /* Now write out the ASCII/Control-1 stuff. */
1572 Lisp_Object val = Qunbound;
1574 for (i = 0; i < NUM_ASCII_CHARS; i++)
1583 if (!EQ (ct->ascii[i], val))
1585 print_chartab_range (first, i - 1, val, printcharfun);
1592 print_chartab_range (first, i - 1, val, printcharfun);
1599 for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES;
1602 Lisp_Object ann = ct->level1[i - MIN_LEADING_BYTE];
1603 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (i);
1605 if (!CHARSETP (charset) || i == LEADING_BYTE_ASCII
1606 || i == LEADING_BYTE_CONTROL_1)
1608 if (!CHAR_TABLE_ENTRYP (ann))
1610 write_c_string (" ", printcharfun);
1611 print_internal (XCHARSET_NAME (charset),
1613 write_c_string (" ", printcharfun);
1614 print_internal (ann, printcharfun, 0);
1618 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (ann);
1619 if (XCHARSET_DIMENSION (charset) == 1)
1620 print_chartab_charset_row (charset, -1, cte, printcharfun);
1622 print_chartab_two_byte_charset (charset, cte, printcharfun);
1627 #endif /* non UTF2000 */
1629 write_c_string ("))", printcharfun);
1633 char_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
1635 Lisp_Char_Table *ct1 = XCHAR_TABLE (obj1);
1636 Lisp_Char_Table *ct2 = XCHAR_TABLE (obj2);
1639 if (CHAR_TABLE_TYPE (ct1) != CHAR_TABLE_TYPE (ct2))
1643 for (i = 0; i < 256; i++)
1645 if (!internal_equal (get_byte_table (ct1->table, i),
1646 get_byte_table (ct2->table, i), 0))
1650 for (i = 0; i < NUM_ASCII_CHARS; i++)
1651 if (!internal_equal (ct1->ascii[i], ct2->ascii[i], depth + 1))
1655 for (i = 0; i < NUM_LEADING_BYTES; i++)
1656 if (!internal_equal (ct1->level1[i], ct2->level1[i], depth + 1))
1659 #endif /* non UTF2000 */
1664 static unsigned long
1665 char_table_hash (Lisp_Object obj, int depth)
1667 Lisp_Char_Table *ct = XCHAR_TABLE (obj);
1669 return byte_table_hash (ct->table, depth + 1);
1671 unsigned long hashval = internal_array_hash (ct->ascii, NUM_ASCII_CHARS,
1674 hashval = HASH2 (hashval,
1675 internal_array_hash (ct->level1, NUM_LEADING_BYTES, depth));
1681 static const struct lrecord_description char_table_description[] = {
1683 { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, table) },
1684 { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, default_value) },
1685 { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, name) },
1686 #ifndef HAVE_LIBCHISE
1687 { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, db) },
1690 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, ascii), NUM_ASCII_CHARS },
1692 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, level1), NUM_LEADING_BYTES },
1696 { XD_LISP_OBJECT, offsetof (Lisp_Char_Table, mirror_table) },
1698 { XD_LO_LINK, offsetof (Lisp_Char_Table, next_table) },
1702 DEFINE_LRECORD_IMPLEMENTATION ("char-table", char_table,
1703 mark_char_table, print_char_table, 0,
1704 char_table_equal, char_table_hash,
1705 char_table_description,
1708 DEFUN ("char-table-p", Fchar_table_p, 1, 1, 0, /*
1709 Return non-nil if OBJECT is a char table.
1711 A char table is a table that maps characters (or ranges of characters)
1712 to values. Char tables are specialized for characters, only allowing
1713 particular sorts of ranges to be assigned values. Although this
1714 loses in generality, it makes for extremely fast (constant-time)
1715 lookups, and thus is feasible for applications that do an extremely
1716 large number of lookups (e.g. scanning a buffer for a character in
1717 a particular syntax, where a lookup in the syntax table must occur
1718 once per character).
1720 When Mule support exists, the types of ranges that can be assigned
1724 -- an entire charset
1725 -- a single row in a two-octet charset
1726 -- a single character
1728 When Mule support is not present, the types of ranges that can be
1732 -- a single character
1734 To create a char table, use `make-char-table'.
1735 To modify a char table, use `put-char-table' or `remove-char-table'.
1736 To retrieve the value for a particular character, use `get-char-table'.
1737 See also `map-char-table', `clear-char-table', `copy-char-table',
1738 `valid-char-table-type-p', `char-table-type-list',
1739 `valid-char-table-value-p', and `check-char-table-value'.
1743 return CHAR_TABLEP (object) ? Qt : Qnil;
1746 DEFUN ("char-table-type-list", Fchar_table_type_list, 0, 0, 0, /*
1747 Return a list of the recognized char table types.
1748 See `valid-char-table-type-p'.
1753 return list5 (Qchar, Qcategory, Qdisplay, Qgeneric, Qsyntax);
1755 return list4 (Qchar, Qdisplay, Qgeneric, Qsyntax);
1759 DEFUN ("valid-char-table-type-p", Fvalid_char_table_type_p, 1, 1, 0, /*
1760 Return t if TYPE if a recognized char table type.
1762 Each char table type is used for a different purpose and allows different
1763 sorts of values. The different char table types are
1766 Used for category tables, which specify the regexp categories
1767 that a character is in. The valid values are nil or a
1768 bit vector of 95 elements. Higher-level Lisp functions are
1769 provided for working with category tables. Currently categories
1770 and category tables only exist when Mule support is present.
1772 A generalized char table, for mapping from one character to
1773 another. Used for case tables, syntax matching tables,
1774 `keyboard-translate-table', etc. The valid values are characters.
1776 An even more generalized char table, for mapping from a
1777 character to anything.
1779 Used for display tables, which specify how a particular character
1780 is to appear when displayed. #### Not yet implemented.
1782 Used for syntax tables, which specify the syntax of a particular
1783 character. Higher-level Lisp functions are provided for
1784 working with syntax tables. The valid values are integers.
1789 return (EQ (type, Qchar) ||
1791 EQ (type, Qcategory) ||
1793 EQ (type, Qdisplay) ||
1794 EQ (type, Qgeneric) ||
1795 EQ (type, Qsyntax)) ? Qt : Qnil;
1798 DEFUN ("char-table-type", Fchar_table_type, 1, 1, 0, /*
1799 Return the type of CHAR-TABLE.
1800 See `valid-char-table-type-p'.
1804 CHECK_CHAR_TABLE (char_table);
1805 return char_table_type_to_symbol (XCHAR_TABLE (char_table)->type);
1809 fill_char_table (Lisp_Char_Table *ct, Lisp_Object value)
1812 ct->table = Qunbound;
1813 ct->default_value = value;
1818 for (i = 0; i < NUM_ASCII_CHARS; i++)
1819 ct->ascii[i] = value;
1821 for (i = 0; i < NUM_LEADING_BYTES; i++)
1822 ct->level1[i] = value;
1827 if (ct->type == CHAR_TABLE_TYPE_SYNTAX)
1828 update_syntax_table (ct);
1832 DEFUN ("reset-char-table", Freset_char_table, 1, 1, 0, /*
1833 Reset CHAR-TABLE to its default state.
1837 Lisp_Char_Table *ct;
1839 CHECK_CHAR_TABLE (char_table);
1840 ct = XCHAR_TABLE (char_table);
1844 case CHAR_TABLE_TYPE_CHAR:
1845 fill_char_table (ct, make_char (0));
1847 case CHAR_TABLE_TYPE_DISPLAY:
1848 case CHAR_TABLE_TYPE_GENERIC:
1850 case CHAR_TABLE_TYPE_CATEGORY:
1852 fill_char_table (ct, Qnil);
1855 case CHAR_TABLE_TYPE_SYNTAX:
1856 fill_char_table (ct, make_int (Sinherit));
1866 DEFUN ("make-char-table", Fmake_char_table, 1, 1, 0, /*
1867 Return a new, empty char table of type TYPE.
1868 Currently recognized types are 'char, 'category, 'display, 'generic,
1869 and 'syntax. See `valid-char-table-type-p'.
1873 Lisp_Char_Table *ct;
1875 enum char_table_type ty = symbol_to_char_table_type (type);
1877 ct = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table);
1880 if (ty == CHAR_TABLE_TYPE_SYNTAX)
1882 ct->mirror_table = Fmake_char_table (Qgeneric);
1883 fill_char_table (XCHAR_TABLE (ct->mirror_table),
1887 ct->mirror_table = Qnil;
1890 #ifndef HAVE_LIBCHISE
1894 ct->next_table = Qnil;
1895 XSETCHAR_TABLE (obj, ct);
1896 if (ty == CHAR_TABLE_TYPE_SYNTAX)
1898 ct->next_table = Vall_syntax_tables;
1899 Vall_syntax_tables = obj;
1901 Freset_char_table (obj);
1905 #if defined(MULE)&&!defined(UTF2000)
1908 make_char_table_entry (Lisp_Object initval)
1912 Lisp_Char_Table_Entry *cte =
1913 alloc_lcrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry);
1915 for (i = 0; i < 96; i++)
1916 cte->level2[i] = initval;
1918 XSETCHAR_TABLE_ENTRY (obj, cte);
1923 copy_char_table_entry (Lisp_Object entry)
1925 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (entry);
1928 Lisp_Char_Table_Entry *ctenew =
1929 alloc_lcrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry);
1931 for (i = 0; i < 96; i++)
1933 Lisp_Object new = cte->level2[i];
1934 if (CHAR_TABLE_ENTRYP (new))
1935 ctenew->level2[i] = copy_char_table_entry (new);
1937 ctenew->level2[i] = new;
1940 XSETCHAR_TABLE_ENTRY (obj, ctenew);
1946 DEFUN ("copy-char-table", Fcopy_char_table, 1, 1, 0, /*
1947 Return a new char table which is a copy of CHAR-TABLE.
1948 It will contain the same values for the same characters and ranges
1949 as CHAR-TABLE. The values will not themselves be copied.
1953 Lisp_Char_Table *ct, *ctnew;
1959 CHECK_CHAR_TABLE (char_table);
1960 ct = XCHAR_TABLE (char_table);
1961 ctnew = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table);
1962 ctnew->type = ct->type;
1964 ctnew->default_value = ct->default_value;
1965 /* [tomo:2002-01-21] Perhaps this code seems wrong */
1966 ctnew->name = ct->name;
1967 #ifndef HAVE_LIBCHISE
1971 if (UINT8_BYTE_TABLE_P (ct->table))
1973 ctnew->table = copy_uint8_byte_table (ct->table);
1975 else if (UINT16_BYTE_TABLE_P (ct->table))
1977 ctnew->table = copy_uint16_byte_table (ct->table);
1979 else if (BYTE_TABLE_P (ct->table))
1981 ctnew->table = copy_byte_table (ct->table);
1983 else if (!UNBOUNDP (ct->table))
1984 ctnew->table = ct->table;
1985 #else /* non UTF2000 */
1987 for (i = 0; i < NUM_ASCII_CHARS; i++)
1989 Lisp_Object new = ct->ascii[i];
1991 assert (! (CHAR_TABLE_ENTRYP (new)));
1993 ctnew->ascii[i] = new;
1998 for (i = 0; i < NUM_LEADING_BYTES; i++)
2000 Lisp_Object new = ct->level1[i];
2001 if (CHAR_TABLE_ENTRYP (new))
2002 ctnew->level1[i] = copy_char_table_entry (new);
2004 ctnew->level1[i] = new;
2008 #endif /* non UTF2000 */
2011 if (CHAR_TABLEP (ct->mirror_table))
2012 ctnew->mirror_table = Fcopy_char_table (ct->mirror_table);
2014 ctnew->mirror_table = ct->mirror_table;
2016 ctnew->next_table = Qnil;
2017 XSETCHAR_TABLE (obj, ctnew);
2018 if (ctnew->type == CHAR_TABLE_TYPE_SYNTAX)
2020 ctnew->next_table = Vall_syntax_tables;
2021 Vall_syntax_tables = obj;
2026 INLINE_HEADER int XCHARSET_CELL_RANGE (Lisp_Object ccs);
2028 XCHARSET_CELL_RANGE (Lisp_Object ccs)
2030 switch (XCHARSET_CHARS (ccs))
2033 return (33 << 8) | 126;
2035 return (32 << 8) | 127;
2038 return (0 << 8) | 127;
2040 return (0 << 8) | 255;
2052 decode_char_table_range (Lisp_Object range, struct chartab_range *outrange)
2055 outrange->type = CHARTAB_RANGE_ALL;
2057 else if (EQ (range, Qnil))
2058 outrange->type = CHARTAB_RANGE_DEFAULT;
2060 else if (CHAR_OR_CHAR_INTP (range))
2062 outrange->type = CHARTAB_RANGE_CHAR;
2063 outrange->ch = XCHAR_OR_CHAR_INT (range);
2067 signal_simple_error ("Range must be t or a character", range);
2069 else if (VECTORP (range))
2071 Lisp_Vector *vec = XVECTOR (range);
2072 Lisp_Object *elts = vector_data (vec);
2073 int cell_min, cell_max;
2075 outrange->type = CHARTAB_RANGE_ROW;
2076 outrange->charset = Fget_charset (elts[0]);
2077 CHECK_INT (elts[1]);
2078 outrange->row = XINT (elts[1]);
2079 if (XCHARSET_DIMENSION (outrange->charset) < 2)
2080 signal_simple_error ("Charset in row vector must be multi-byte",
2084 int ret = XCHARSET_CELL_RANGE (outrange->charset);
2086 cell_min = ret >> 8;
2087 cell_max = ret & 0xFF;
2089 if (XCHARSET_DIMENSION (outrange->charset) == 2)
2090 check_int_range (outrange->row, cell_min, cell_max);
2092 else if (XCHARSET_DIMENSION (outrange->charset) == 3)
2094 check_int_range (outrange->row >> 8 , cell_min, cell_max);
2095 check_int_range (outrange->row & 0xFF, cell_min, cell_max);
2097 else if (XCHARSET_DIMENSION (outrange->charset) == 4)
2099 check_int_range ( outrange->row >> 16 , cell_min, cell_max);
2100 check_int_range ((outrange->row >> 8) & 0xFF, cell_min, cell_max);
2101 check_int_range ( outrange->row & 0xFF, cell_min, cell_max);
2109 if (!CHARSETP (range) && !SYMBOLP (range))
2111 ("Char table range must be t, charset, char, or vector", range);
2112 outrange->type = CHARTAB_RANGE_CHARSET;
2113 outrange->charset = Fget_charset (range);
2118 #if defined(MULE)&&!defined(UTF2000)
2120 /* called from CHAR_TABLE_VALUE(). */
2122 get_non_ascii_char_table_value (Lisp_Char_Table *ct, Charset_ID leading_byte,
2127 Lisp_Object charset;
2129 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (leading_byte);
2134 BREAKUP_CHAR (c, charset, byte1, byte2);
2136 BREAKUP_CHAR_1_UNSAFE (c, charset, byte1, byte2);
2138 val = ct->level1[leading_byte - MIN_LEADING_BYTE];
2139 if (CHAR_TABLE_ENTRYP (val))
2141 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
2142 val = cte->level2[byte1 - 32];
2143 if (CHAR_TABLE_ENTRYP (val))
2145 cte = XCHAR_TABLE_ENTRY (val);
2146 assert (byte2 >= 32);
2147 val = cte->level2[byte2 - 32];
2148 assert (!CHAR_TABLE_ENTRYP (val));
2158 get_char_table (Emchar ch, Lisp_Char_Table *ct)
2162 Lisp_Object ret = get_char_id_table (ct, ch);
2167 if (EQ (CHAR_TABLE_NAME (ct), Qdowncase))
2168 ret = Fchar_feature (make_char (ch), Q_lowercase, Qnil,
2170 else if (EQ (CHAR_TABLE_NAME (ct), Qflippedcase))
2171 ret = Fchar_feature (make_char (ch), Q_uppercase, Qnil,
2177 ret = Ffind_char (ret);
2185 Lisp_Object charset;
2189 BREAKUP_CHAR (ch, charset, byte1, byte2);
2191 if (EQ (charset, Vcharset_ascii))
2192 val = ct->ascii[byte1];
2193 else if (EQ (charset, Vcharset_control_1))
2194 val = ct->ascii[byte1 + 128];
2197 int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE;
2198 val = ct->level1[lb];
2199 if (CHAR_TABLE_ENTRYP (val))
2201 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
2202 val = cte->level2[byte1 - 32];
2203 if (CHAR_TABLE_ENTRYP (val))
2205 cte = XCHAR_TABLE_ENTRY (val);
2206 assert (byte2 >= 32);
2207 val = cte->level2[byte2 - 32];
2208 assert (!CHAR_TABLE_ENTRYP (val));
2215 #else /* not MULE */
2216 return ct->ascii[(unsigned char)ch];
2217 #endif /* not MULE */
2221 DEFUN ("get-char-table", Fget_char_table, 2, 2, 0, /*
2222 Find value for CHARACTER in CHAR-TABLE.
2224 (character, char_table))
2226 CHECK_CHAR_TABLE (char_table);
2227 CHECK_CHAR_COERCE_INT (character);
2229 return get_char_table (XCHAR (character), XCHAR_TABLE (char_table));
2232 DEFUN ("get-range-char-table", Fget_range_char_table, 2, 3, 0, /*
2233 Find value for a range in CHAR-TABLE.
2234 If there is more than one value, return MULTI (defaults to nil).
2236 (range, char_table, multi))
2238 Lisp_Char_Table *ct;
2239 struct chartab_range rainj;
2241 if (CHAR_OR_CHAR_INTP (range))
2242 return Fget_char_table (range, char_table);
2243 CHECK_CHAR_TABLE (char_table);
2244 ct = XCHAR_TABLE (char_table);
2246 decode_char_table_range (range, &rainj);
2249 case CHARTAB_RANGE_ALL:
2252 if (UINT8_BYTE_TABLE_P (ct->table))
2254 else if (UINT16_BYTE_TABLE_P (ct->table))
2256 else if (BYTE_TABLE_P (ct->table))
2260 #else /* non UTF2000 */
2262 Lisp_Object first = ct->ascii[0];
2264 for (i = 1; i < NUM_ASCII_CHARS; i++)
2265 if (!EQ (first, ct->ascii[i]))
2269 for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES;
2272 if (!CHARSETP (CHARSET_BY_LEADING_BYTE (i))
2273 || i == LEADING_BYTE_ASCII
2274 || i == LEADING_BYTE_CONTROL_1)
2276 if (!EQ (first, ct->level1[i - MIN_LEADING_BYTE]))
2282 #endif /* non UTF2000 */
2286 case CHARTAB_RANGE_CHARSET:
2290 if (EQ (rainj.charset, Vcharset_ascii))
2293 Lisp_Object first = ct->ascii[0];
2295 for (i = 1; i < 128; i++)
2296 if (!EQ (first, ct->ascii[i]))
2301 if (EQ (rainj.charset, Vcharset_control_1))
2304 Lisp_Object first = ct->ascii[128];
2306 for (i = 129; i < 160; i++)
2307 if (!EQ (first, ct->ascii[i]))
2313 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (rainj.charset) -
2315 if (CHAR_TABLE_ENTRYP (val))
2321 case CHARTAB_RANGE_ROW:
2326 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (rainj.charset) -
2328 if (!CHAR_TABLE_ENTRYP (val))
2330 val = XCHAR_TABLE_ENTRY (val)->level2[rainj.row - 32];
2331 if (CHAR_TABLE_ENTRYP (val))
2335 #endif /* not UTF2000 */
2336 #endif /* not MULE */
2339 case CHARTAB_RANGE_DEFAULT:
2340 return ct->default_value;
2341 #endif /* not UTF2000 */
2347 return Qnil; /* not reached */
2351 check_valid_char_table_value (Lisp_Object value, enum char_table_type type,
2352 Error_behavior errb)
2356 case CHAR_TABLE_TYPE_SYNTAX:
2357 if (!ERRB_EQ (errb, ERROR_ME))
2358 return INTP (value) || (CONSP (value) && INTP (XCAR (value))
2359 && CHAR_OR_CHAR_INTP (XCDR (value)));
2362 Lisp_Object cdr = XCDR (value);
2363 CHECK_INT (XCAR (value));
2364 CHECK_CHAR_COERCE_INT (cdr);
2371 case CHAR_TABLE_TYPE_CATEGORY:
2372 if (!ERRB_EQ (errb, ERROR_ME))
2373 return CATEGORY_TABLE_VALUEP (value);
2374 CHECK_CATEGORY_TABLE_VALUE (value);
2378 case CHAR_TABLE_TYPE_GENERIC:
2381 case CHAR_TABLE_TYPE_DISPLAY:
2383 maybe_signal_simple_error ("Display char tables not yet implemented",
2384 value, Qchar_table, errb);
2387 case CHAR_TABLE_TYPE_CHAR:
2388 if (!ERRB_EQ (errb, ERROR_ME))
2389 return CHAR_OR_CHAR_INTP (value);
2390 CHECK_CHAR_COERCE_INT (value);
2397 return 0; /* not reached */
2401 canonicalize_char_table_value (Lisp_Object value, enum char_table_type type)
2405 case CHAR_TABLE_TYPE_SYNTAX:
2408 Lisp_Object car = XCAR (value);
2409 Lisp_Object cdr = XCDR (value);
2410 CHECK_CHAR_COERCE_INT (cdr);
2411 return Fcons (car, cdr);
2414 case CHAR_TABLE_TYPE_CHAR:
2415 CHECK_CHAR_COERCE_INT (value);
2423 DEFUN ("valid-char-table-value-p", Fvalid_char_table_value_p, 2, 2, 0, /*
2424 Return non-nil if VALUE is a valid value for CHAR-TABLE-TYPE.
2426 (value, char_table_type))
2428 enum char_table_type type = symbol_to_char_table_type (char_table_type);
2430 return check_valid_char_table_value (value, type, ERROR_ME_NOT) ? Qt : Qnil;
2433 DEFUN ("check-valid-char-table-value", Fcheck_valid_char_table_value, 2, 2, 0, /*
2434 Signal an error if VALUE is not a valid value for CHAR-TABLE-TYPE.
2436 (value, char_table_type))
2438 enum char_table_type type = symbol_to_char_table_type (char_table_type);
2440 check_valid_char_table_value (value, type, ERROR_ME);
2445 Lisp_Char_Table* char_attribute_table_to_put;
2446 Lisp_Object Qput_char_table_map_function;
2447 Lisp_Object value_to_put;
2449 DEFUN ("put-char-table-map-function",
2450 Fput_char_table_map_function, 2, 2, 0, /*
2451 For internal use. Don't use it.
2455 put_char_id_table_0 (char_attribute_table_to_put,
2456 XCHAR (c), value_to_put);
2461 /* Assign VAL to all characters in RANGE in char table CT. */
2464 put_char_table (Lisp_Char_Table *ct, struct chartab_range *range,
2467 switch (range->type)
2469 case CHARTAB_RANGE_ALL:
2470 fill_char_table (ct, val);
2471 return; /* avoid the duplicate call to update_syntax_table() below,
2472 since fill_char_table() also did that. */
2475 case CHARTAB_RANGE_DEFAULT:
2476 ct->default_value = val;
2481 case CHARTAB_RANGE_CHARSET:
2484 Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (range->charset);
2486 if ( CHAR_TABLEP (encoding_table) )
2488 Lisp_Object mother = XCHARSET_MOTHER (range->charset);
2490 char_attribute_table_to_put = ct;
2492 Fmap_char_attribute (Qput_char_table_map_function,
2493 XCHAR_TABLE_NAME (encoding_table),
2495 if ( CHARSETP (mother) )
2497 struct chartab_range r;
2499 r.type = CHARTAB_RANGE_CHARSET;
2501 put_char_table (ct, &r, val);
2509 for (c = 0; c < 1 << 24; c++)
2511 if ( charset_code_point (range->charset, c) >= 0 )
2512 put_char_id_table_0 (ct, c, val);
2518 if (EQ (range->charset, Vcharset_ascii))
2521 for (i = 0; i < 128; i++)
2524 else if (EQ (range->charset, Vcharset_control_1))
2527 for (i = 128; i < 160; i++)
2532 int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE;
2533 ct->level1[lb] = val;
2538 case CHARTAB_RANGE_ROW:
2541 int cell_min, cell_max, i;
2543 i = XCHARSET_CELL_RANGE (range->charset);
2545 cell_max = i & 0xFF;
2546 for (i = cell_min; i <= cell_max; i++)
2549 = DECODE_CHAR (range->charset, (range->row << 8) | i, 0);
2551 if ( charset_code_point (range->charset, ch, 0) >= 0 )
2552 put_char_id_table_0 (ct, ch, val);
2557 Lisp_Char_Table_Entry *cte;
2558 int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE;
2559 /* make sure that there is a separate entry for the row. */
2560 if (!CHAR_TABLE_ENTRYP (ct->level1[lb]))
2561 ct->level1[lb] = make_char_table_entry (ct->level1[lb]);
2562 cte = XCHAR_TABLE_ENTRY (ct->level1[lb]);
2563 cte->level2[range->row - 32] = val;
2565 #endif /* not UTF2000 */
2569 case CHARTAB_RANGE_CHAR:
2571 put_char_id_table_0 (ct, range->ch, val);
2575 Lisp_Object charset;
2578 BREAKUP_CHAR (range->ch, charset, byte1, byte2);
2579 if (EQ (charset, Vcharset_ascii))
2580 ct->ascii[byte1] = val;
2581 else if (EQ (charset, Vcharset_control_1))
2582 ct->ascii[byte1 + 128] = val;
2585 Lisp_Char_Table_Entry *cte;
2586 int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE;
2587 /* make sure that there is a separate entry for the row. */
2588 if (!CHAR_TABLE_ENTRYP (ct->level1[lb]))
2589 ct->level1[lb] = make_char_table_entry (ct->level1[lb]);
2590 cte = XCHAR_TABLE_ENTRY (ct->level1[lb]);
2591 /* now CTE is a char table entry for the charset;
2592 each entry is for a single row (or character of
2593 a one-octet charset). */
2594 if (XCHARSET_DIMENSION (charset) == 1)
2595 cte->level2[byte1 - 32] = val;
2598 /* assigning to one character in a two-octet charset. */
2599 /* make sure that the charset row contains a separate
2600 entry for each character. */
2601 if (!CHAR_TABLE_ENTRYP (cte->level2[byte1 - 32]))
2602 cte->level2[byte1 - 32] =
2603 make_char_table_entry (cte->level2[byte1 - 32]);
2604 cte = XCHAR_TABLE_ENTRY (cte->level2[byte1 - 32]);
2605 cte->level2[byte2 - 32] = val;
2609 #else /* not MULE */
2610 ct->ascii[(unsigned char) (range->ch)] = val;
2612 #endif /* not MULE */
2616 if (ct->type == CHAR_TABLE_TYPE_SYNTAX)
2617 update_syntax_table (ct);
2621 DEFUN ("put-char-table", Fput_char_table, 3, 3, 0, /*
2622 Set the value for chars in RANGE to be VALUE in CHAR-TABLE.
2624 RANGE specifies one or more characters to be affected and should be
2625 one of the following:
2627 -- t (all characters are affected)
2628 -- A charset (only allowed when Mule support is present)
2629 -- A vector of two elements: a two-octet charset and a row number
2630 (only allowed when Mule support is present)
2631 -- A single character
2633 VALUE must be a value appropriate for the type of CHAR-TABLE.
2634 See `valid-char-table-type-p'.
2636 (range, value, char_table))
2638 Lisp_Char_Table *ct;
2639 struct chartab_range rainj;
2641 CHECK_CHAR_TABLE (char_table);
2642 ct = XCHAR_TABLE (char_table);
2643 check_valid_char_table_value (value, ct->type, ERROR_ME);
2644 decode_char_table_range (range, &rainj);
2645 value = canonicalize_char_table_value (value, ct->type);
2646 put_char_table (ct, &rainj, value);
2651 /* Map FN over the ASCII chars in CT. */
2654 map_over_charset_ascii (Lisp_Char_Table *ct,
2655 int (*fn) (struct chartab_range *range,
2656 Lisp_Object val, void *arg),
2659 struct chartab_range rainj;
2668 rainj.type = CHARTAB_RANGE_CHAR;
2670 for (i = start, retval = 0; i < stop && retval == 0; i++)
2672 rainj.ch = (Emchar) i;
2673 retval = (fn) (&rainj, ct->ascii[i], arg);
2681 /* Map FN over the Control-1 chars in CT. */
2684 map_over_charset_control_1 (Lisp_Char_Table *ct,
2685 int (*fn) (struct chartab_range *range,
2686 Lisp_Object val, void *arg),
2689 struct chartab_range rainj;
2692 int stop = start + 32;
2694 rainj.type = CHARTAB_RANGE_CHAR;
2696 for (i = start, retval = 0; i < stop && retval == 0; i++)
2698 rainj.ch = (Emchar) (i);
2699 retval = (fn) (&rainj, ct->ascii[i], arg);
2705 /* Map FN over the row ROW of two-byte charset CHARSET.
2706 There must be a separate value for that row in the char table.
2707 CTE specifies the char table entry for CHARSET. */
2710 map_over_charset_row (Lisp_Char_Table_Entry *cte,
2711 Lisp_Object charset, int row,
2712 int (*fn) (struct chartab_range *range,
2713 Lisp_Object val, void *arg),
2716 Lisp_Object val = cte->level2[row - 32];
2718 if (!CHAR_TABLE_ENTRYP (val))
2720 struct chartab_range rainj;
2722 rainj.type = CHARTAB_RANGE_ROW;
2723 rainj.charset = charset;
2725 return (fn) (&rainj, val, arg);
2729 struct chartab_range rainj;
2731 int charset94_p = (XCHARSET_CHARS (charset) == 94);
2732 int start = charset94_p ? 33 : 32;
2733 int stop = charset94_p ? 127 : 128;
2735 cte = XCHAR_TABLE_ENTRY (val);
2737 rainj.type = CHARTAB_RANGE_CHAR;
2739 for (i = start, retval = 0; i < stop && retval == 0; i++)
2741 rainj.ch = MAKE_CHAR (charset, row, i);
2742 retval = (fn) (&rainj, cte->level2[i - 32], arg);
2750 map_over_other_charset (Lisp_Char_Table *ct, Charset_ID lb,
2751 int (*fn) (struct chartab_range *range,
2752 Lisp_Object val, void *arg),
2755 Lisp_Object val = ct->level1[lb - MIN_LEADING_BYTE];
2756 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (lb);
2758 if (!CHARSETP (charset)
2759 || lb == LEADING_BYTE_ASCII
2760 || lb == LEADING_BYTE_CONTROL_1)
2763 if (!CHAR_TABLE_ENTRYP (val))
2765 struct chartab_range rainj;
2767 rainj.type = CHARTAB_RANGE_CHARSET;
2768 rainj.charset = charset;
2769 return (fn) (&rainj, val, arg);
2773 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
2774 int charset94_p = (XCHARSET_CHARS (charset) == 94);
2775 int start = charset94_p ? 33 : 32;
2776 int stop = charset94_p ? 127 : 128;
2779 if (XCHARSET_DIMENSION (charset) == 1)
2781 struct chartab_range rainj;
2782 rainj.type = CHARTAB_RANGE_CHAR;
2784 for (i = start, retval = 0; i < stop && retval == 0; i++)
2786 rainj.ch = MAKE_CHAR (charset, i, 0);
2787 retval = (fn) (&rainj, cte->level2[i - 32], arg);
2792 for (i = start, retval = 0; i < stop && retval == 0; i++)
2793 retval = map_over_charset_row (cte, charset, i, fn, arg);
2801 #endif /* not UTF2000 */
2804 struct map_char_table_for_charset_arg
2806 int (*fn) (struct chartab_range *range, Lisp_Object val, void *arg);
2807 Lisp_Char_Table *ct;
2812 map_char_table_for_charset_fun (struct chartab_range *range,
2813 Lisp_Object val, void *arg)
2815 struct map_char_table_for_charset_arg *closure =
2816 (struct map_char_table_for_charset_arg *) arg;
2819 switch (range->type)
2821 case CHARTAB_RANGE_ALL:
2824 case CHARTAB_RANGE_DEFAULT:
2827 case CHARTAB_RANGE_CHARSET:
2830 case CHARTAB_RANGE_ROW:
2833 case CHARTAB_RANGE_CHAR:
2834 ret = get_char_table (range->ch, closure->ct);
2835 if (!UNBOUNDP (ret))
2836 return (closure->fn) (range, ret, closure->arg);
2848 /* Map FN (with client data ARG) over range RANGE in char table CT.
2849 Mapping stops the first time FN returns non-zero, and that value
2850 becomes the return value of map_char_table(). */
2853 map_char_table (Lisp_Char_Table *ct,
2854 struct chartab_range *range,
2855 int (*fn) (struct chartab_range *range,
2856 Lisp_Object val, void *arg),
2859 switch (range->type)
2861 case CHARTAB_RANGE_ALL:
2863 if (!UNBOUNDP (ct->default_value))
2865 struct chartab_range rainj;
2868 rainj.type = CHARTAB_RANGE_DEFAULT;
2869 retval = (fn) (&rainj, ct->default_value, arg);
2873 if (UINT8_BYTE_TABLE_P (ct->table))
2874 return map_over_uint8_byte_table (XUINT8_BYTE_TABLE(ct->table), ct,
2876 else if (UINT16_BYTE_TABLE_P (ct->table))
2877 return map_over_uint16_byte_table (XUINT16_BYTE_TABLE(ct->table), ct,
2879 else if (BYTE_TABLE_P (ct->table))
2880 return map_over_byte_table (XBYTE_TABLE(ct->table), ct,
2882 else if (EQ (ct->table, Qunloaded))
2885 struct chartab_range rainj;
2888 Emchar c1 = c + unit;
2891 rainj.type = CHARTAB_RANGE_CHAR;
2893 for (retval = 0; c < c1 && retval == 0; c++)
2895 Lisp_Object ret = get_char_id_table (ct, c);
2897 if (!UNBOUNDP (ret))
2900 retval = (fn) (&rainj, ct->table, arg);
2905 ct->table = Qunbound;
2908 else if (!UNBOUNDP (ct->table))
2909 return (fn) (range, ct->table, arg);
2915 retval = map_over_charset_ascii (ct, fn, arg);
2919 retval = map_over_charset_control_1 (ct, fn, arg);
2924 Charset_ID start = MIN_LEADING_BYTE;
2925 Charset_ID stop = start + NUM_LEADING_BYTES;
2927 for (i = start, retval = 0; i < stop && retval == 0; i++)
2929 retval = map_over_other_charset (ct, i, fn, arg);
2938 case CHARTAB_RANGE_DEFAULT:
2939 if (!UNBOUNDP (ct->default_value))
2940 return (fn) (range, ct->default_value, arg);
2945 case CHARTAB_RANGE_CHARSET:
2948 Lisp_Object encoding_table
2949 = XCHARSET_ENCODING_TABLE (range->charset);
2951 if (!NILP (encoding_table))
2953 struct chartab_range rainj;
2954 struct map_char_table_for_charset_arg mcarg;
2957 if (XCHAR_TABLE_UNLOADED(encoding_table))
2958 Fload_char_attribute_table (XCHAR_TABLE_NAME (encoding_table));
2963 rainj.type = CHARTAB_RANGE_ALL;
2964 return map_char_table (XCHAR_TABLE(encoding_table),
2966 &map_char_table_for_charset_fun,
2972 return map_over_other_charset (ct,
2973 XCHARSET_LEADING_BYTE (range->charset),
2977 case CHARTAB_RANGE_ROW:
2980 int cell_min, cell_max, i;
2982 struct chartab_range rainj;
2984 i = XCHARSET_CELL_RANGE (range->charset);
2986 cell_max = i & 0xFF;
2987 rainj.type = CHARTAB_RANGE_CHAR;
2988 for (retval =0, i = cell_min; i <= cell_max && retval == 0; i++)
2991 = DECODE_CHAR (range->charset, (range->row << 8) | i, 0);
2993 if ( charset_code_point (range->charset, ch, 0) >= 0 )
2996 = get_byte_table (get_byte_table
3000 (unsigned char)(ch >> 24)),
3001 (unsigned char) (ch >> 16)),
3002 (unsigned char) (ch >> 8)),
3003 (unsigned char) ch);
3006 val = ct->default_value;
3008 retval = (fn) (&rainj, val, arg);
3015 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (range->charset)
3016 - MIN_LEADING_BYTE];
3017 if (!CHAR_TABLE_ENTRYP (val))
3019 struct chartab_range rainj;
3021 rainj.type = CHARTAB_RANGE_ROW;
3022 rainj.charset = range->charset;
3023 rainj.row = range->row;
3024 return (fn) (&rainj, val, arg);
3027 return map_over_charset_row (XCHAR_TABLE_ENTRY (val),
3028 range->charset, range->row,
3031 #endif /* not UTF2000 */
3034 case CHARTAB_RANGE_CHAR:
3036 Emchar ch = range->ch;
3037 Lisp_Object val = CHAR_TABLE_VALUE_UNSAFE (ct, ch);
3039 if (!UNBOUNDP (val))
3041 struct chartab_range rainj;
3043 rainj.type = CHARTAB_RANGE_CHAR;
3045 return (fn) (&rainj, val, arg);
3057 struct slow_map_char_table_arg
3059 Lisp_Object function;
3064 slow_map_char_table_fun (struct chartab_range *range,
3065 Lisp_Object val, void *arg)
3067 Lisp_Object ranjarg = Qnil;
3068 struct slow_map_char_table_arg *closure =
3069 (struct slow_map_char_table_arg *) arg;
3071 switch (range->type)
3073 case CHARTAB_RANGE_ALL:
3078 case CHARTAB_RANGE_DEFAULT:
3084 case CHARTAB_RANGE_CHARSET:
3085 ranjarg = XCHARSET_NAME (range->charset);
3088 case CHARTAB_RANGE_ROW:
3089 ranjarg = vector2 (XCHARSET_NAME (range->charset),
3090 make_int (range->row));
3093 case CHARTAB_RANGE_CHAR:
3094 ranjarg = make_char (range->ch);
3100 closure->retval = call2 (closure->function, ranjarg, val);
3101 return !NILP (closure->retval);
3104 DEFUN ("map-char-table", Fmap_char_table, 2, 3, 0, /*
3105 Map FUNCTION over entries in CHAR-TABLE, calling it with two args,
3106 each key and value in the table.
3108 RANGE specifies a subrange to map over and is in the same format as
3109 the RANGE argument to `put-range-table'. If omitted or t, it defaults to
3112 (function, char_table, range))
3114 Lisp_Char_Table *ct;
3115 struct slow_map_char_table_arg slarg;
3116 struct gcpro gcpro1, gcpro2;
3117 struct chartab_range rainj;
3119 CHECK_CHAR_TABLE (char_table);
3120 ct = XCHAR_TABLE (char_table);
3123 decode_char_table_range (range, &rainj);
3124 slarg.function = function;
3125 slarg.retval = Qnil;
3126 GCPRO2 (slarg.function, slarg.retval);
3127 map_char_table (ct, &rainj, slow_map_char_table_fun, &slarg);
3130 return slarg.retval;
3134 /************************************************************************/
3135 /* Character Attributes */
3136 /************************************************************************/
3140 Lisp_Object Vchar_attribute_hash_table;
3142 /* We store the char-attributes in hash tables with the names as the
3143 key and the actual char-id-table object as the value. Occasionally
3144 we need to use them in a list format. These routines provide us
3146 struct char_attribute_list_closure
3148 Lisp_Object *char_attribute_list;
3152 add_char_attribute_to_list_mapper (Lisp_Object key, Lisp_Object value,
3153 void *char_attribute_list_closure)
3155 /* This function can GC */
3156 struct char_attribute_list_closure *calcl
3157 = (struct char_attribute_list_closure*) char_attribute_list_closure;
3158 Lisp_Object *char_attribute_list = calcl->char_attribute_list;
3160 *char_attribute_list = Fcons (key, *char_attribute_list);
3164 #ifdef HAVE_LIBCHISE
3166 char_attribute_list_reset_map_func (CHISE_DS *ds, unsigned char *name)
3168 Fmount_char_attribute_table (intern (name));
3172 DEFUN ("char-attribute-list", Fchar_attribute_list, 0, 1, 0, /*
3173 Return the list of all existing character attributes except coded-charsets.
3177 DEFUN ("char-attribute-list", Fchar_attribute_list, 0, 0, 0, /*
3178 Return the list of all existing character attributes except coded-charsets.
3183 Lisp_Object char_attribute_list = Qnil;
3184 struct gcpro gcpro1;
3185 struct char_attribute_list_closure char_attribute_list_closure;
3187 #ifdef HAVE_LIBCHISE
3190 open_chise_data_source_maybe ();
3191 chise_ds_foreach_char_feature_name
3192 (default_chise_data_source, &char_attribute_list_reset_map_func);
3195 GCPRO1 (char_attribute_list);
3196 char_attribute_list_closure.char_attribute_list = &char_attribute_list;
3197 elisp_maphash (add_char_attribute_to_list_mapper,
3198 Vchar_attribute_hash_table,
3199 &char_attribute_list_closure);
3201 return char_attribute_list;
3204 DEFUN ("find-char-attribute-table", Ffind_char_attribute_table, 1, 1, 0, /*
3205 Return char-id-table corresponding to ATTRIBUTE.
3209 return Fgethash (attribute, Vchar_attribute_hash_table, Qnil);
3213 /* We store the char-id-tables in hash tables with the attributes as
3214 the key and the actual char-id-table object as the value. Each
3215 char-id-table stores values of an attribute corresponding with
3216 characters. Occasionally we need to get attributes of a character
3217 in a association-list format. These routines provide us with
3219 struct char_attribute_alist_closure
3222 Lisp_Object *char_attribute_alist;
3226 add_char_attribute_alist_mapper (Lisp_Object key, Lisp_Object value,
3227 void *char_attribute_alist_closure)
3229 /* This function can GC */
3230 struct char_attribute_alist_closure *caacl =
3231 (struct char_attribute_alist_closure*) char_attribute_alist_closure;
3233 = get_char_id_table (XCHAR_TABLE(value), caacl->char_id);
3234 if (!UNBOUNDP (ret))
3236 Lisp_Object *char_attribute_alist = caacl->char_attribute_alist;
3237 *char_attribute_alist
3238 = Fcons (Fcons (key, ret), *char_attribute_alist);
3243 DEFUN ("char-attribute-alist", Fchar_attribute_alist, 1, 1, 0, /*
3244 Return the alist of attributes of CHARACTER.
3248 struct gcpro gcpro1;
3249 struct char_attribute_alist_closure char_attribute_alist_closure;
3250 Lisp_Object alist = Qnil;
3252 CHECK_CHAR (character);
3255 char_attribute_alist_closure.char_id = XCHAR (character);
3256 char_attribute_alist_closure.char_attribute_alist = &alist;
3257 elisp_maphash (add_char_attribute_alist_mapper,
3258 Vchar_attribute_hash_table,
3259 &char_attribute_alist_closure);
3265 DEFUN ("get-char-attribute", Fget_char_attribute, 2, 3, 0, /*
3266 Return the value of CHARACTER's ATTRIBUTE.
3267 Return DEFAULT-VALUE if the value is not exist.
3269 (character, attribute, default_value))
3273 CHECK_CHAR (character);
3275 if (CHARSETP (attribute))
3276 attribute = XCHARSET_NAME (attribute);
3278 table = Fgethash (attribute, Vchar_attribute_hash_table,
3280 if (!UNBOUNDP (table))
3282 Lisp_Object ret = get_char_id_table (XCHAR_TABLE(table),
3284 if (!UNBOUNDP (ret))
3287 return default_value;
3291 find_char_feature_in_family (Lisp_Object character,
3292 Lisp_Object con_feature,
3293 Lisp_Object feature,
3294 Lisp_Object feature_rel_max)
3296 Lisp_Object ancestors
3297 = Fget_char_attribute (character, con_feature, Qnil);
3299 while (!NILP (ancestors))
3301 Lisp_Object ancestor = XCAR (ancestors);
3304 if (EQ (ancestor, character))
3307 ret = Fchar_feature (ancestor, feature, Qunbound,
3308 Qnil, make_int (0));
3309 if (!UNBOUNDP (ret))
3312 ancestors = XCDR (ancestors);
3314 ret = Fget_char_attribute (ancestor, Q_subsumptive_from, Qnil);
3316 ancestors = nconc2 (Fcopy_sequence (ancestors), ret);
3318 ret = Fget_char_attribute (ancestor, Q_denotational_from, Qnil);
3320 ancestors = nconc2 (Fcopy_sequence (ancestors), ret);
3325 DEFUN ("char-feature", Fchar_feature, 2, 5, 0, /*
3326 Return the value of CHARACTER's FEATURE.
3327 Return DEFAULT-VALUE if the value is not exist.
3329 (character, attribute, default_value,
3330 feature_rel_max, char_rel_max))
3333 = Fget_char_attribute (character, attribute, Qunbound);
3335 if (!UNBOUNDP (ret))
3338 if (NILP (feature_rel_max)
3339 || (INTP (feature_rel_max) &&
3340 XINT (feature_rel_max) > 0))
3342 Lisp_String* name = symbol_name (XSYMBOL (attribute));
3343 Bufbyte *name_str = string_data (name);
3345 if (name_str[0] == '=' && name_str[1] == '>')
3347 Bytecount length = string_length (name) - 1;
3348 Lisp_Object map_to = make_uninit_string (length);
3350 memcpy (XSTRING_DATA (map_to) + 1, name_str + 2, length - 1);
3351 XSTRING_DATA(map_to)[0] = '=';
3352 ret = Fchar_feature (character, Fintern (map_to, Qnil),
3354 NILP (feature_rel_max)
3356 : make_int (XINT (feature_rel_max) - 1),
3358 if (!UNBOUNDP (ret))
3363 if ( !(EQ (attribute, Q_identical)) &&
3364 !(EQ (attribute, Q_subsumptive_from)) &&
3365 !(EQ (attribute, Q_denotational_from)) &&
3366 ( (NILP (char_rel_max)
3367 || (INTP (char_rel_max) &&
3368 XINT (char_rel_max) > 0)) ) )
3370 Lisp_String* name = symbol_name (XSYMBOL (attribute));
3371 Bufbyte *name_str = string_data (name);
3373 if ( (name_str[0] != '=') || (name_str[1] == '>') )
3375 ret = find_char_feature_in_family (character, Q_identical,
3376 attribute, feature_rel_max);
3377 if (!UNBOUNDP (ret))
3380 ret = find_char_feature_in_family (character, Q_subsumptive_from,
3381 attribute, feature_rel_max);
3382 if (!UNBOUNDP (ret))
3385 ret = find_char_feature_in_family (character, Q_denotational_from,
3386 attribute, feature_rel_max);
3387 if (!UNBOUNDP (ret))
3391 return default_value;
3395 put_char_composition (Lisp_Object character, Lisp_Object value);
3397 put_char_composition (Lisp_Object character, Lisp_Object value)
3400 signal_simple_error ("Invalid value for =decomposition",
3403 if (CONSP (XCDR (value)))
3405 if (NILP (Fcdr (XCDR (value))))
3407 Lisp_Object base = XCAR (value);
3408 Lisp_Object modifier = XCAR (XCDR (value));
3412 base = make_char (XINT (base));
3413 Fsetcar (value, base);
3415 if (INTP (modifier))
3417 modifier = make_char (XINT (modifier));
3418 Fsetcar (XCDR (value), modifier);
3423 = Fchar_feature (base, Qcomposition, Qnil,
3425 Lisp_Object ret = Fassq (modifier, alist);
3428 Fput_char_attribute (base, Qcomposition,
3429 Fcons (Fcons (modifier, character),
3432 Fsetcdr (ret, character);
3434 else if (EQ (base, Qsuper))
3435 return Q_superscript_of;
3436 else if (EQ (base, Qsub))
3437 return Q_subscript_of;
3438 else if (EQ (base, Qcompat))
3441 else if (EQ (XCAR (value), Qsuper))
3442 return Qto_decomposition_at_superscript;
3443 else if (EQ (XCAR (value), Qcircle))
3444 return Qto_decomposition_at_circled;
3447 Fintern (concat2 (build_string ("=>decomposition@"),
3448 symbol_name (XSYMBOL (XCAR (value)))),
3455 Lisp_Object v = Fcar (value);
3459 Emchar c = DECODE_CHAR (Vcharset_ucs, XINT (v), 0);
3461 = Fchar_feature (make_char (c), Q_ucs_unified, Qnil,
3466 Fput_char_attribute (make_char (c), Q_ucs_unified,
3467 Fcons (character, Qnil));
3469 else if (NILP (Fmemq (character, ret)))
3471 Fput_char_attribute (make_char (c), Q_ucs_unified,
3472 Fcons (character, ret));
3477 return Qmap_decomposition;
3481 put_char_attribute (Lisp_Object character, Lisp_Object attribute,
3484 Lisp_Object table = Fgethash (attribute,
3485 Vchar_attribute_hash_table,
3490 table = make_char_id_table (Qunbound);
3491 Fputhash (attribute, table, Vchar_attribute_hash_table);
3493 XCHAR_TABLE_NAME (table) = attribute;
3496 put_char_id_table (XCHAR_TABLE(table), character, value);
3500 DEFUN ("put-char-attribute", Fput_char_attribute, 3, 3, 0, /*
3501 Store CHARACTER's ATTRIBUTE with VALUE.
3503 (character, attribute, value))
3505 Lisp_Object ccs = Ffind_charset (attribute);
3507 CHECK_CHAR (character);
3511 value = put_char_ccs_code_point (character, ccs, value);
3512 attribute = XCHARSET_NAME (ccs);
3514 else if ( EQ (attribute, Qmap_decomposition) ||
3515 EQ (attribute, Q_decomposition) )
3517 attribute = put_char_composition (character, value);
3518 if ( !EQ (attribute, Qmap_decomposition) &&
3519 SYMBOLP (XCAR (value)) )
3520 value = XCDR (value);
3522 else if (EQ (attribute, Qto_ucs))
3528 signal_simple_error ("Invalid value for =>ucs", value);
3530 c = DECODE_CHAR (Vcharset_ucs, XINT (value), 0);
3532 ret = Fchar_feature (make_char (c), Q_ucs_unified, Qnil,
3535 put_char_attribute (make_char (c), Q_ucs_unified,
3537 else if (NILP (Fmemq (character, ret)))
3538 Fput_char_attribute (make_char (c), Q_ucs_unified,
3539 Fcons (character, ret));
3541 if ( EQ (attribute, Q_subsumptive) ||
3542 EQ (attribute, Q_subsumptive_from) ||
3543 EQ (attribute, Q_denotational) ||
3544 EQ (attribute, Q_denotational_from) ||
3545 EQ (attribute, Q_identical) ||
3546 EQ (attribute, Q_identical_from) ||
3547 EQ (attribute, Q_canonical) ||
3548 EQ (attribute, Q_superscript_of) ||
3549 EQ (attribute, Q_subscript_of) ||
3550 EQ (attribute, Q_compat_of) ||
3551 EQ (attribute, Q_component) ||
3552 EQ (attribute, Q_component_of) ||
3553 !NILP (Fstring_match
3554 (build_string ("^\\(<-\\|->\\)\\("
3556 "\\|superscript\\|subscript\\|compat"
3557 "\\|fullwidth\\|halfwidth"
3558 "\\|simplified\\|vulgar\\|wrong"
3559 "\\|same\\|original\\|ancient"
3560 "\\|Oracle-Bones\\)[^*]*$"),
3561 Fsymbol_name (attribute),
3564 Lisp_Object rest = value;
3566 Lisp_Object rev_feature = Qnil;
3567 struct gcpro gcpro1;
3568 GCPRO1 (rev_feature);
3570 if (EQ (attribute, Q_identical))
3571 rev_feature = Q_identical_from;
3572 else if (EQ (attribute, Q_identical_from))
3573 rev_feature = Q_identical;
3574 else if (EQ (attribute, Q_subsumptive))
3575 rev_feature = Q_subsumptive_from;
3576 else if (EQ (attribute, Q_subsumptive_from))
3577 rev_feature = Q_subsumptive;
3578 else if (EQ (attribute, Q_denotational))
3579 rev_feature = Q_denotational_from;
3580 else if (EQ (attribute, Q_denotational_from))
3581 rev_feature = Q_denotational;
3582 else if (EQ (attribute, Q_component))
3583 rev_feature = Q_component_of;
3584 else if (EQ (attribute, Q_component_of))
3585 rev_feature = Q_component;
3588 Lisp_String* name = symbol_name (XSYMBOL (attribute));
3589 Bufbyte *name_str = string_data (name);
3591 if ( (name_str[0] == '<' && name_str[1] == '-') ||
3592 (name_str[0] == '-' && name_str[1] == '>') )
3594 Bytecount length = string_length (name);
3595 Bufbyte *rev_name_str = alloca (length + 1);
3597 memcpy (rev_name_str + 2, name_str + 2, length - 2);
3598 if (name_str[0] == '<')
3600 rev_name_str[0] = '-';
3601 rev_name_str[1] = '>';
3605 rev_name_str[0] = '<';
3606 rev_name_str[1] = '-';
3608 rev_name_str[length] = 0;
3609 rev_feature = intern (rev_name_str);
3613 while (CONSP (rest))
3618 ret = Fdefine_char (ret);
3619 else if (INTP (ret))
3621 int code_point = XINT (ret);
3622 Emchar cid = DECODE_CHAR (Vcharset_ucs, code_point, 0);
3625 ret = make_char (cid);
3627 ret = make_char (code_point);
3630 if ( !NILP (ret) && !EQ (ret, character) )
3634 ffv = Fget_char_attribute (ret, rev_feature, Qnil);
3636 put_char_attribute (ret, rev_feature, list1 (character));
3637 else if (NILP (Fmemq (character, ffv)))
3640 nconc2 (Fcopy_sequence (ffv), list1 (character)));
3641 Fsetcar (rest, ret);
3648 else if ( EQ (attribute, Qideographic_structure) ||
3649 !NILP (Fstring_match
3650 (build_string ("^=>decomposition\\(\\|@[^*]+\\)$"),
3651 Fsymbol_name (attribute),
3653 value = Fcopy_sequence (Fchar_refs_simplify_char_specs (value));
3655 return put_char_attribute (character, attribute, value);
3658 DEFUN ("remove-char-attribute", Fremove_char_attribute, 2, 2, 0, /*
3659 Remove CHARACTER's ATTRIBUTE.
3661 (character, attribute))
3665 CHECK_CHAR (character);
3666 ccs = Ffind_charset (attribute);
3669 return remove_char_ccs (character, ccs);
3673 Lisp_Object table = Fgethash (attribute,
3674 Vchar_attribute_hash_table,
3676 if (!UNBOUNDP (table))
3678 put_char_id_table (XCHAR_TABLE(table), character, Qunbound);
3687 int char_table_open_db_maybe (Lisp_Char_Table* cit);
3688 void char_table_close_db_maybe (Lisp_Char_Table* cit);
3689 Lisp_Object char_table_get_db (Lisp_Char_Table* cit, Emchar ch);
3691 #ifdef HAVE_LIBCHISE
3693 open_chise_data_source_maybe ()
3695 if (default_chise_data_source == NULL)
3697 Lisp_Object db_dir = Vdata_directory;
3698 int modemask = 0755; /* rwxr-xr-x */
3701 db_dir = build_string ("../etc");
3702 db_dir = Fexpand_file_name (build_string ("chise-db"), db_dir);
3704 default_chise_data_source
3705 = CHISE_DS_open (CHISE_DS_Berkeley_DB, XSTRING_DATA (db_dir),
3706 0 /* DB_HASH */, modemask);
3707 if (default_chise_data_source == NULL)
3710 chise_ds_set_make_string_function (default_chise_data_source,
3716 #endif /* HAVE_LIBCHISE */
3718 DEFUN ("close-char-data-source", Fclose_char_data_source, 0, 0, 0, /*
3719 Close data-source of CHISE.
3723 #ifdef HAVE_LIBCHISE
3724 int status = CHISE_DS_close (default_chise_data_source);
3726 default_chise_data_source = NULL;
3729 #endif /* HAVE_LIBCHISE */
3734 char_table_open_db_maybe (Lisp_Char_Table* cit)
3736 Lisp_Object attribute = CHAR_TABLE_NAME (cit);
3738 if (!NILP (attribute))
3740 #ifdef HAVE_LIBCHISE
3741 if ( open_chise_data_source_maybe () )
3743 #else /* HAVE_LIBCHISE */
3744 if (NILP (Fdatabase_live_p (cit->db)))
3747 = char_attribute_system_db_file (Qsystem_char_id, attribute, 0);
3749 cit->db = Fopen_database (db_file, Qnil, Qnil,
3750 build_string ("r"), Qnil);
3754 #endif /* not HAVE_LIBCHISE */
3762 char_table_close_db_maybe (Lisp_Char_Table* cit)
3764 #ifndef HAVE_LIBCHISE
3765 if (!NILP (cit->db))
3767 if (!NILP (Fdatabase_live_p (cit->db)))
3768 Fclose_database (cit->db);
3771 #endif /* not HAVE_LIBCHISE */
3775 char_table_get_db (Lisp_Char_Table* cit, Emchar ch)
3778 #ifdef HAVE_LIBCHISE
3781 = chise_ds_load_char_feature_value (default_chise_data_source, ch,
3782 XSTRING_DATA(Fsymbol_name
3789 val = Fread (make_string (chise_value_data (&value),
3790 chise_value_size (&value) ));
3792 val = read_from_c_string (chise_value_data (&value),
3793 chise_value_size (&value) );
3798 #else /* HAVE_LIBCHISE */
3799 val = Fget_database (Fprin1_to_string (make_char (ch), Qnil),
3801 if (!UNBOUNDP (val))
3805 #endif /* not HAVE_LIBCHISE */
3809 #ifndef HAVE_LIBCHISE
3811 char_attribute_system_db_file (Lisp_Object key_type, Lisp_Object attribute,
3814 Lisp_Object db_dir = Vdata_directory;
3817 db_dir = build_string ("../etc");
3819 db_dir = Fexpand_file_name (build_string ("chise-db"), db_dir);
3820 if (writing_mode && NILP (Ffile_exists_p (db_dir)))
3821 Fmake_directory_internal (db_dir);
3823 db_dir = Fexpand_file_name (Fsymbol_name (key_type), db_dir);
3824 if (writing_mode && NILP (Ffile_exists_p (db_dir)))
3825 Fmake_directory_internal (db_dir);
3828 Lisp_Object attribute_name = Fsymbol_name (attribute);
3829 Lisp_Object dest = Qnil, ret;
3831 struct gcpro gcpro1, gcpro2;
3832 int len = XSTRING_CHAR_LENGTH (attribute_name);
3836 for (i = 0; i < len; i++)
3838 Emchar c = string_char (XSTRING (attribute_name), i);
3840 if ( (c == '/') || (c == '%') )
3844 sprintf (str, "%%%02X", c);
3845 dest = concat3 (dest,
3846 Fsubstring (attribute_name,
3847 make_int (base), make_int (i)),
3848 build_string (str));
3852 ret = Fsubstring (attribute_name, make_int (base), make_int (len));
3853 dest = concat2 (dest, ret);
3855 return Fexpand_file_name (dest, db_dir);
3858 #endif /* not HAVE_LIBCHISE */
3860 DEFUN ("save-char-attribute-table", Fsave_char_attribute_table, 1, 1, 0, /*
3861 Save values of ATTRIBUTE into database file.
3865 Lisp_Object table = Fgethash (attribute,
3866 Vchar_attribute_hash_table, Qunbound);
3867 Lisp_Char_Table *ct;
3868 #ifdef HAVE_LIBCHISE
3869 CHISE_Feature feature;
3870 #else /* HAVE_LIBCHISE */
3871 Lisp_Object db_file;
3873 #endif /* not HAVE_LIBCHISE */
3875 if (CHAR_TABLEP (table))
3876 ct = XCHAR_TABLE (table);
3880 #ifdef HAVE_LIBCHISE
3881 if ( open_chise_data_source_maybe () )
3884 = chise_ds_get_feature (default_chise_data_source,
3885 XSTRING_DATA (Fsymbol_name (attribute)));
3886 #else /* HAVE_LIBCHISE */
3887 db_file = char_attribute_system_db_file (Qsystem_char_id, attribute, 1);
3888 db = Fopen_database (db_file, Qnil, Qnil, build_string ("w+"), Qnil);
3889 #endif /* not HAVE_LIBCHISE */
3891 #ifdef HAVE_LIBCHISE
3893 #else /* HAVE_LIBCHISE */
3895 #endif /* not HAVE_LIBCHISE */
3898 Lisp_Object (*filter)(Lisp_Object value);
3900 if ( !NILP (Ffind_charset (attribute)) )
3902 else if ( EQ (attribute, Qideographic_structure) ||
3903 EQ (attribute, Q_identical) ||
3904 EQ (attribute, Q_identical_from) ||
3905 EQ (attribute, Q_canonical) ||
3906 EQ (attribute, Q_superscript_of) ||
3907 EQ (attribute, Q_subscript_of) ||
3908 EQ (attribute, Q_compat_of) ||
3909 !NILP (Fstring_match
3910 (build_string ("^\\(<-\\|->\\)\\(simplified"
3911 "\\|same\\|vulgar\\|wrong"
3912 "\\|original\\|ancient"
3913 "\\|Oracle-Bones\\)[^*]*$"),
3914 Fsymbol_name (attribute),
3916 filter = &Fchar_refs_simplify_char_specs;
3920 if (UINT8_BYTE_TABLE_P (ct->table))
3921 save_uint8_byte_table (XUINT8_BYTE_TABLE(ct->table), ct,
3922 #ifdef HAVE_LIBCHISE
3924 #else /* HAVE_LIBCHISE */
3926 #endif /* not HAVE_LIBCHISE */
3928 else if (UINT16_BYTE_TABLE_P (ct->table))
3929 save_uint16_byte_table (XUINT16_BYTE_TABLE(ct->table), ct,
3930 #ifdef HAVE_LIBCHISE
3932 #else /* HAVE_LIBCHISE */
3934 #endif /* not HAVE_LIBCHISE */
3936 else if (BYTE_TABLE_P (ct->table))
3937 save_byte_table (XBYTE_TABLE(ct->table), ct,
3938 #ifdef HAVE_LIBCHISE
3940 #else /* HAVE_LIBCHISE */
3942 #endif /* not HAVE_LIBCHISE */
3944 #ifdef HAVE_LIBCHISE
3945 chise_feature_sync (feature);
3946 #else /* HAVE_LIBCHISE */
3947 Fclose_database (db);
3948 #endif /* not HAVE_LIBCHISE */
3955 DEFUN ("mount-char-attribute-table", Fmount_char_attribute_table, 1, 1, 0, /*
3956 Mount database file on char-attribute-table ATTRIBUTE.
3960 Lisp_Object table = Fgethash (attribute,
3961 Vchar_attribute_hash_table, Qunbound);
3963 if (UNBOUNDP (table))
3965 Lisp_Char_Table *ct;
3967 table = make_char_id_table (Qunbound);
3968 Fputhash (attribute, table, Vchar_attribute_hash_table);
3969 XCHAR_TABLE_NAME(table) = attribute;
3970 ct = XCHAR_TABLE (table);
3971 ct->table = Qunloaded;
3972 XCHAR_TABLE_UNLOADED(table) = 1;
3973 #ifndef HAVE_LIBCHISE
3975 #endif /* not HAVE_LIBCHISE */
3981 DEFUN ("close-char-attribute-table", Fclose_char_attribute_table, 1, 1, 0, /*
3982 Close database of ATTRIBUTE.
3986 Lisp_Object table = Fgethash (attribute,
3987 Vchar_attribute_hash_table, Qunbound);
3988 Lisp_Char_Table *ct;
3990 if (CHAR_TABLEP (table))
3991 ct = XCHAR_TABLE (table);
3994 char_table_close_db_maybe (ct);
3998 DEFUN ("reset-char-attribute-table", Freset_char_attribute_table, 1, 1, 0, /*
3999 Reset values of ATTRIBUTE with database file.
4003 #ifdef HAVE_LIBCHISE
4004 CHISE_Feature feature
4005 = chise_ds_get_feature (default_chise_data_source,
4006 XSTRING_DATA (Fsymbol_name
4009 if (feature == NULL)
4012 if (chise_feature_setup_db (feature, 0) == 0)
4014 Lisp_Object table = Fgethash (attribute,
4015 Vchar_attribute_hash_table, Qunbound);
4016 Lisp_Char_Table *ct;
4018 chise_feature_sync (feature);
4019 if (UNBOUNDP (table))
4021 table = make_char_id_table (Qunbound);
4022 Fputhash (attribute, table, Vchar_attribute_hash_table);
4023 XCHAR_TABLE_NAME(table) = attribute;
4025 ct = XCHAR_TABLE (table);
4026 ct->table = Qunloaded;
4027 char_table_close_db_maybe (ct);
4028 XCHAR_TABLE_UNLOADED(table) = 1;
4032 Lisp_Object table = Fgethash (attribute,
4033 Vchar_attribute_hash_table, Qunbound);
4034 Lisp_Char_Table *ct;
4036 = char_attribute_system_db_file (Qsystem_char_id, attribute, 0);
4038 if (!NILP (Ffile_exists_p (db_file)))
4040 if (UNBOUNDP (table))
4042 table = make_char_id_table (Qunbound);
4043 Fputhash (attribute, table, Vchar_attribute_hash_table);
4044 XCHAR_TABLE_NAME(table) = attribute;
4046 ct = XCHAR_TABLE (table);
4047 ct->table = Qunloaded;
4048 char_table_close_db_maybe (ct);
4049 XCHAR_TABLE_UNLOADED(table) = 1;
4057 load_char_attribute_maybe (Lisp_Char_Table* cit, Emchar ch)
4059 Lisp_Object attribute = CHAR_TABLE_NAME (cit);
4061 if (!NILP (attribute))
4065 if (char_table_open_db_maybe (cit))
4068 val = char_table_get_db (cit, ch);
4070 if (!NILP (Vchar_db_stingy_mode))
4071 char_table_close_db_maybe (cit);
4078 Lisp_Char_Table* char_attribute_table_to_load;
4080 #ifdef HAVE_LIBCHISE
4082 load_char_attribute_table_map_func (CHISE_Char_ID cid,
4083 CHISE_Feature feature,
4084 CHISE_Value *value);
4086 load_char_attribute_table_map_func (CHISE_Char_ID cid,
4087 CHISE_Feature feature,
4091 Lisp_Object ret = get_char_id_table_0 (char_attribute_table_to_load, code);
4093 if (EQ (ret, Qunloaded))
4094 put_char_id_table_0 (char_attribute_table_to_load, code,
4095 Fread (make_string ((Bufbyte *) value->data,
4099 #else /* HAVE_LIBCHISE */
4100 Lisp_Object Qload_char_attribute_table_map_function;
4102 DEFUN ("load-char-attribute-table-map-function",
4103 Fload_char_attribute_table_map_function, 2, 2, 0, /*
4104 For internal use. Don't use it.
4108 Lisp_Object c = Fread (key);
4109 Emchar code = XCHAR (c);
4110 Lisp_Object ret = get_char_id_table_0 (char_attribute_table_to_load, code);
4112 if (EQ (ret, Qunloaded))
4113 put_char_id_table_0 (char_attribute_table_to_load, code, Fread (value));
4116 #endif /* not HAVE_LIBCHISE */
4118 DEFUN ("load-char-attribute-table", Fload_char_attribute_table, 1, 1, 0, /*
4119 Load values of ATTRIBUTE into database file.
4123 Lisp_Object table = Fgethash (attribute,
4124 Vchar_attribute_hash_table,
4126 if (CHAR_TABLEP (table))
4128 Lisp_Char_Table *cit = XCHAR_TABLE (table);
4130 if (char_table_open_db_maybe (cit))
4133 char_attribute_table_to_load = XCHAR_TABLE (table);
4135 struct gcpro gcpro1;
4138 #ifdef HAVE_LIBCHISE
4139 chise_feature_foreach_char_with_value
4140 (chise_ds_get_feature (default_chise_data_source,
4141 XSTRING_DATA (Fsymbol_name (cit->name))),
4142 &load_char_attribute_table_map_func);
4143 #else /* HAVE_LIBCHISE */
4144 Fmap_database (Qload_char_attribute_table_map_function, cit->db);
4145 #endif /* not HAVE_LIBCHISE */
4148 char_table_close_db_maybe (cit);
4149 XCHAR_TABLE_UNLOADED(table) = 0;
4154 #endif /* HAVE_CHISE */
4156 DEFUN ("map-char-attribute", Fmap_char_attribute, 2, 3, 0, /*
4157 Map FUNCTION over entries in ATTRIBUTE, calling it with two args,
4158 each key and value in the table.
4160 RANGE specifies a subrange to map over and is in the same format as
4161 the RANGE argument to `put-range-table'. If omitted or t, it defaults to
4164 (function, attribute, range))
4167 Lisp_Char_Table *ct;
4168 struct slow_map_char_table_arg slarg;
4169 struct gcpro gcpro1, gcpro2;
4170 struct chartab_range rainj;
4172 if (!NILP (ccs = Ffind_charset (attribute)))
4174 Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (ccs);
4176 if (CHAR_TABLEP (encoding_table))
4177 ct = XCHAR_TABLE (encoding_table);
4183 Lisp_Object table = Fgethash (attribute,
4184 Vchar_attribute_hash_table,
4186 if (CHAR_TABLEP (table))
4187 ct = XCHAR_TABLE (table);
4193 decode_char_table_range (range, &rainj);
4195 if (CHAR_TABLE_UNLOADED(ct))
4196 Fload_char_attribute_table (attribute);
4198 slarg.function = function;
4199 slarg.retval = Qnil;
4200 GCPRO2 (slarg.function, slarg.retval);
4201 map_char_table (ct, &rainj, slow_map_char_table_fun, &slarg);
4204 return slarg.retval;
4207 DEFUN ("define-char", Fdefine_char, 1, 1, 0, /*
4208 Store character's ATTRIBUTES.
4213 Lisp_Object code = Fcdr (Fassq (Qmap_ucs, attributes));
4214 Lisp_Object character;
4217 code = Fcdr (Fassq (Qucs, attributes));
4222 while (CONSP (rest))
4224 Lisp_Object cell = Fcar (rest);
4227 if ( !LISTP (cell) )
4228 signal_simple_error ("Invalid argument", attributes);
4230 ccs = Ffind_charset (Fcar (cell));
4236 character = Fdecode_char (ccs, cell, Qt, Qt);
4237 if (!NILP (character))
4238 goto setup_attributes;
4240 if ( (XCHARSET_FINAL (ccs) != 0) ||
4241 (XCHARSET_MAX_CODE (ccs) > 0) ||
4242 (EQ (ccs, Vcharset_chinese_big5)) )
4246 = Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
4248 character = Fdecode_char (ccs, cell, Qnil, Qt);
4249 if (!NILP (character))
4250 goto setup_attributes;
4257 int cid = XINT (Vnext_defined_char_id);
4259 if (cid <= 0xE00000)
4261 character = make_char (cid);
4262 Vnext_defined_char_id = make_int (cid + 1);
4263 goto setup_attributes;
4267 if ( (!NILP (code = Fcdr (Fassq (Qto_ucs, attributes)))) )
4270 signal_simple_error ("Invalid argument", attributes);
4272 character = make_char (XINT (code) + 0x100000);
4273 goto setup_attributes;
4278 else if (!INTP (code))
4279 signal_simple_error ("Invalid argument", attributes);
4281 character = make_char (XINT (code));
4285 while (CONSP (rest))
4287 Lisp_Object cell = Fcar (rest);
4290 signal_simple_error ("Invalid argument", attributes);
4292 Fput_char_attribute (character, Fcar (cell), Fcdr (cell));
4298 DEFUN ("find-char", Ffind_char, 1, 1, 0, /*
4299 Retrieve the character of the given ATTRIBUTES.
4303 Lisp_Object rest = attributes;
4306 while (CONSP (rest))
4308 Lisp_Object cell = Fcar (rest);
4312 signal_simple_error ("Invalid argument", attributes);
4313 if (!NILP (ccs = Ffind_charset (Fcar (cell))))
4317 return Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
4319 return Fdecode_char (ccs, cell, Qnil, Qnil);
4323 if ( (!NILP (code = Fcdr (Fassq (Qto_ucs, attributes)))) )
4326 signal_simple_error ("Invalid argument", attributes);
4328 return make_char (XINT (code) + 0x100000);
4336 /************************************************************************/
4337 /* Char table read syntax */
4338 /************************************************************************/
4341 chartab_type_validate (Lisp_Object keyword, Lisp_Object value,
4342 Error_behavior errb)
4344 /* #### should deal with ERRB */
4345 symbol_to_char_table_type (value);
4350 chartab_data_validate (Lisp_Object keyword, Lisp_Object value,
4351 Error_behavior errb)
4355 /* #### should deal with ERRB */
4356 EXTERNAL_LIST_LOOP (rest, value)
4358 Lisp_Object range = XCAR (rest);
4359 struct chartab_range dummy;
4363 signal_simple_error ("Invalid list format", value);
4366 if (!CONSP (XCDR (range))
4367 || !NILP (XCDR (XCDR (range))))
4368 signal_simple_error ("Invalid range format", range);
4369 decode_char_table_range (XCAR (range), &dummy);
4370 decode_char_table_range (XCAR (XCDR (range)), &dummy);
4373 decode_char_table_range (range, &dummy);
4380 chartab_instantiate (Lisp_Object data)
4382 Lisp_Object chartab;
4383 Lisp_Object type = Qgeneric;
4384 Lisp_Object dataval = Qnil;
4386 while (!NILP (data))
4388 Lisp_Object keyw = Fcar (data);
4394 if (EQ (keyw, Qtype))
4396 else if (EQ (keyw, Qdata))
4400 chartab = Fmake_char_table (type);
4403 while (!NILP (data))
4405 Lisp_Object range = Fcar (data);
4406 Lisp_Object val = Fcar (Fcdr (data));
4408 data = Fcdr (Fcdr (data));
4411 if (CHAR_OR_CHAR_INTP (XCAR (range)))
4413 Emchar first = XCHAR_OR_CHAR_INT (Fcar (range));
4414 Emchar last = XCHAR_OR_CHAR_INT (Fcar (Fcdr (range)));
4417 for (i = first; i <= last; i++)
4418 Fput_char_table (make_char (i), val, chartab);
4424 Fput_char_table (range, val, chartab);
4433 /************************************************************************/
4434 /* Category Tables, specifically */
4435 /************************************************************************/
4437 DEFUN ("category-table-p", Fcategory_table_p, 1, 1, 0, /*
4438 Return t if OBJECT is a category table.
4439 A category table is a type of char table used for keeping track of
4440 categories. Categories are used for classifying characters for use
4441 in regexps -- you can refer to a category rather than having to use
4442 a complicated [] expression (and category lookups are significantly
4445 There are 95 different categories available, one for each printable
4446 character (including space) in the ASCII charset. Each category
4447 is designated by one such character, called a "category designator".
4448 They are specified in a regexp using the syntax "\\cX", where X is
4449 a category designator.
4451 A category table specifies, for each character, the categories that
4452 the character is in. Note that a character can be in more than one
4453 category. More specifically, a category table maps from a character
4454 to either the value nil (meaning the character is in no categories)
4455 or a 95-element bit vector, specifying for each of the 95 categories
4456 whether the character is in that category.
4458 Special Lisp functions are provided that abstract this, so you do not
4459 have to directly manipulate bit vectors.
4463 return (CHAR_TABLEP (object) &&
4464 XCHAR_TABLE_TYPE (object) == CHAR_TABLE_TYPE_CATEGORY) ?
4469 check_category_table (Lisp_Object object, Lisp_Object default_)
4473 while (NILP (Fcategory_table_p (object)))
4474 object = wrong_type_argument (Qcategory_table_p, object);
4479 check_category_char (Emchar ch, Lisp_Object table,
4480 unsigned int designator, unsigned int not_p)
4482 REGISTER Lisp_Object temp;
4483 Lisp_Char_Table *ctbl;
4484 #ifdef ERROR_CHECK_TYPECHECK
4485 if (NILP (Fcategory_table_p (table)))
4486 signal_simple_error ("Expected category table", table);
4488 ctbl = XCHAR_TABLE (table);
4489 temp = get_char_table (ch, ctbl);
4494 return bit_vector_bit (XBIT_VECTOR (temp), designator) ? !not_p : not_p;
4497 DEFUN ("check-category-at", Fcheck_category_at, 2, 4, 0, /*
4498 Return t if category of the character at POSITION includes DESIGNATOR.
4499 Optional third arg BUFFER specifies which buffer to use, and defaults
4500 to the current buffer.
4501 Optional fourth arg CATEGORY-TABLE specifies the category table to
4502 use, and defaults to BUFFER's category table.
4504 (position, designator, buffer, category_table))
4509 struct buffer *buf = decode_buffer (buffer, 0);
4511 CHECK_INT (position);
4512 CHECK_CATEGORY_DESIGNATOR (designator);
4513 des = XCHAR (designator);
4514 ctbl = check_category_table (category_table, Vstandard_category_table);
4515 ch = BUF_FETCH_CHAR (buf, XINT (position));
4516 return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil;
4519 DEFUN ("char-in-category-p", Fchar_in_category_p, 2, 3, 0, /*
4520 Return t if category of CHARACTER includes DESIGNATOR, else nil.
4521 Optional third arg CATEGORY-TABLE specifies the category table to use,
4522 and defaults to the standard category table.
4524 (character, designator, category_table))
4530 CHECK_CATEGORY_DESIGNATOR (designator);
4531 des = XCHAR (designator);
4532 CHECK_CHAR (character);
4533 ch = XCHAR (character);
4534 ctbl = check_category_table (category_table, Vstandard_category_table);
4535 return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil;
4538 DEFUN ("category-table", Fcategory_table, 0, 1, 0, /*
4539 Return BUFFER's current category table.
4540 BUFFER defaults to the current buffer.
4544 return decode_buffer (buffer, 0)->category_table;
4547 DEFUN ("standard-category-table", Fstandard_category_table, 0, 0, 0, /*
4548 Return the standard category table.
4549 This is the one used for new buffers.
4553 return Vstandard_category_table;
4556 DEFUN ("copy-category-table", Fcopy_category_table, 0, 1, 0, /*
4557 Return a new category table which is a copy of CATEGORY-TABLE.
4558 CATEGORY-TABLE defaults to the standard category table.
4562 if (NILP (Vstandard_category_table))
4563 return Fmake_char_table (Qcategory);
4566 check_category_table (category_table, Vstandard_category_table);
4567 return Fcopy_char_table (category_table);
4570 DEFUN ("set-category-table", Fset_category_table, 1, 2, 0, /*
4571 Select CATEGORY-TABLE as the new category table for BUFFER.
4572 BUFFER defaults to the current buffer if omitted.
4574 (category_table, buffer))
4576 struct buffer *buf = decode_buffer (buffer, 0);
4577 category_table = check_category_table (category_table, Qnil);
4578 buf->category_table = category_table;
4579 /* Indicate that this buffer now has a specified category table. */
4580 buf->local_var_flags |= XINT (buffer_local_flags.category_table);
4581 return category_table;
4584 DEFUN ("category-designator-p", Fcategory_designator_p, 1, 1, 0, /*
4585 Return t if OBJECT is a category designator (a char in the range ' ' to '~').
4589 return CATEGORY_DESIGNATORP (object) ? Qt : Qnil;
4592 DEFUN ("category-table-value-p", Fcategory_table_value_p, 1, 1, 0, /*
4593 Return t if OBJECT is a category table value.
4594 Valid values are nil or a bit vector of size 95.
4598 return CATEGORY_TABLE_VALUEP (object) ? Qt : Qnil;
4602 #define CATEGORYP(x) \
4603 (CHARP (x) && XCHAR (x) >= 0x20 && XCHAR (x) <= 0x7E)
4605 #define CATEGORY_SET(c) \
4606 (get_char_table(c, XCHAR_TABLE(current_buffer->category_table)))
4608 /* Return 1 if CATEGORY_SET contains CATEGORY, else return 0.
4609 The faster version of `!NILP (Faref (category_set, category))'. */
4610 #define CATEGORY_MEMBER(category, category_set) \
4611 (bit_vector_bit(XBIT_VECTOR (category_set), category - 32))
4613 /* Return 1 if there is a word boundary between two word-constituent
4614 characters C1 and C2 if they appear in this order, else return 0.
4615 Use the macro WORD_BOUNDARY_P instead of calling this function
4618 int word_boundary_p (Emchar c1, Emchar c2);
4620 word_boundary_p (Emchar c1, Emchar c2)
4622 Lisp_Object category_set1, category_set2;
4627 if (COMPOSITE_CHAR_P (c1))
4628 c1 = cmpchar_component (c1, 0, 1);
4629 if (COMPOSITE_CHAR_P (c2))
4630 c2 = cmpchar_component (c2, 0, 1);
4634 if (EQ (CHAR_CHARSET (c1), CHAR_CHARSET (c2)))
4637 tail = Vword_separating_categories;
4643 tail = Vword_combining_categories;
4648 category_set1 = CATEGORY_SET (c1);
4649 if (NILP (category_set1))
4650 return default_result;
4651 category_set2 = CATEGORY_SET (c2);
4652 if (NILP (category_set2))
4653 return default_result;
4655 for (; CONSP (tail); tail = XCONS (tail)->cdr)
4657 Lisp_Object elt = XCONS(tail)->car;
4660 && CATEGORYP (XCONS (elt)->car)
4661 && CATEGORYP (XCONS (elt)->cdr)
4662 && CATEGORY_MEMBER (XCHAR (XCONS (elt)->car), category_set1)
4663 && CATEGORY_MEMBER (XCHAR (XCONS (elt)->cdr), category_set2))
4664 return !default_result;
4666 return default_result;
4672 syms_of_chartab (void)
4675 INIT_LRECORD_IMPLEMENTATION (uint8_byte_table);
4676 INIT_LRECORD_IMPLEMENTATION (uint16_byte_table);
4677 INIT_LRECORD_IMPLEMENTATION (byte_table);
4679 defsymbol (&Qto_ucs, "=>ucs");
4680 defsymbol (&Q_ucs_unified, "->ucs-unified");
4681 defsymbol (&Q_subsumptive, "->subsumptive");
4682 defsymbol (&Q_subsumptive_from, "<-subsumptive");
4683 defsymbol (&Q_denotational, "->denotational");
4684 defsymbol (&Q_denotational_from, "<-denotational");
4685 defsymbol (&Q_identical, "->identical");
4686 defsymbol (&Q_identical_from, "<-identical");
4687 defsymbol (&Q_component, "->ideographic-component-forms");
4688 defsymbol (&Q_component_of, "<-ideographic-component-forms");
4689 defsymbol (&Qcomposition, "composition");
4690 defsymbol (&Qmap_decomposition, "=decomposition");
4691 defsymbol (&Qto_decomposition_at_superscript,
4692 "=>decomposition@superscript");
4693 defsymbol (&Qto_decomposition_at_circled, "=>decomposition@circled");
4694 defsymbol (&Q_canonical, "->canonical");
4695 defsymbol (&Q_superscript_of, "<-superscript");
4696 defsymbol (&Q_subscript_of, "<-subscript");
4697 defsymbol (&Q_compat_of, "<-compat");
4698 defsymbol (&Q_decomposition, "->decomposition");
4699 defsymbol (&Qcompat, "compat");
4700 defsymbol (&Qisolated, "isolated");
4701 defsymbol (&Qinitial, "initial");
4702 defsymbol (&Qmedial, "medial");
4703 defsymbol (&Qfinal, "final");
4704 defsymbol (&Qvertical, "vertical");
4705 defsymbol (&QnoBreak, "noBreak");
4706 defsymbol (&Qfraction, "fraction");
4707 defsymbol (&Qsuper, "super");
4708 defsymbol (&Qsub, "sub");
4709 defsymbol (&Qcircle, "circle");
4710 defsymbol (&Qsquare, "square");
4711 defsymbol (&Qwide, "wide");
4712 defsymbol (&Qnarrow, "narrow");
4713 defsymbol (&Qsmall, "small");
4714 defsymbol (&Qfont, "font");
4716 DEFSUBR (Fchar_attribute_list);
4717 DEFSUBR (Ffind_char_attribute_table);
4718 defsymbol (&Qput_char_table_map_function, "put-char-table-map-function");
4719 DEFSUBR (Fput_char_table_map_function);
4721 DEFSUBR (Fsave_char_attribute_table);
4722 DEFSUBR (Fmount_char_attribute_table);
4723 DEFSUBR (Freset_char_attribute_table);
4724 DEFSUBR (Fclose_char_attribute_table);
4725 DEFSUBR (Fclose_char_data_source);
4726 #ifndef HAVE_LIBCHISE
4727 defsymbol (&Qload_char_attribute_table_map_function,
4728 "load-char-attribute-table-map-function");
4729 DEFSUBR (Fload_char_attribute_table_map_function);
4731 DEFSUBR (Fload_char_attribute_table);
4733 DEFSUBR (Fchar_feature);
4734 DEFSUBR (Fchar_attribute_alist);
4735 DEFSUBR (Fget_char_attribute);
4736 DEFSUBR (Fput_char_attribute);
4737 DEFSUBR (Fremove_char_attribute);
4738 DEFSUBR (Fmap_char_attribute);
4739 DEFSUBR (Fdefine_char);
4740 DEFSUBR (Ffind_char);
4741 DEFSUBR (Fchar_variants);
4743 DEFSUBR (Fget_composite_char);
4746 INIT_LRECORD_IMPLEMENTATION (char_table);
4750 INIT_LRECORD_IMPLEMENTATION (char_table_entry);
4753 defsymbol (&Qcategory_table_p, "category-table-p");
4754 defsymbol (&Qcategory_designator_p, "category-designator-p");
4755 defsymbol (&Qcategory_table_value_p, "category-table-value-p");
4758 defsymbol (&Qchar_table, "char-table");
4759 defsymbol (&Qchar_tablep, "char-table-p");
4761 DEFSUBR (Fchar_table_p);
4762 DEFSUBR (Fchar_table_type_list);
4763 DEFSUBR (Fvalid_char_table_type_p);
4764 DEFSUBR (Fchar_table_type);
4765 DEFSUBR (Freset_char_table);
4766 DEFSUBR (Fmake_char_table);
4767 DEFSUBR (Fcopy_char_table);
4768 DEFSUBR (Fget_char_table);
4769 DEFSUBR (Fget_range_char_table);
4770 DEFSUBR (Fvalid_char_table_value_p);
4771 DEFSUBR (Fcheck_valid_char_table_value);
4772 DEFSUBR (Fput_char_table);
4773 DEFSUBR (Fmap_char_table);
4776 DEFSUBR (Fcategory_table_p);
4777 DEFSUBR (Fcategory_table);
4778 DEFSUBR (Fstandard_category_table);
4779 DEFSUBR (Fcopy_category_table);
4780 DEFSUBR (Fset_category_table);
4781 DEFSUBR (Fcheck_category_at);
4782 DEFSUBR (Fchar_in_category_p);
4783 DEFSUBR (Fcategory_designator_p);
4784 DEFSUBR (Fcategory_table_value_p);
4790 vars_of_chartab (void)
4793 DEFVAR_LISP ("next-defined-char-id", &Vnext_defined_char_id /*
4795 Vnext_defined_char_id = make_int (0x0F0000);
4799 DEFVAR_LISP ("char-db-stingy-mode", &Vchar_db_stingy_mode /*
4801 Vchar_db_stingy_mode = Qt;
4803 #ifdef HAVE_LIBCHISE
4804 Vchise_db_directory = build_string(chise_db_dir);
4805 DEFVAR_LISP ("chise-db-directory", &Vchise_db_directory /*
4806 Directory of CHISE character databases.
4809 Vchise_system_db_directory = build_string(chise_system_db_dir);
4810 DEFVAR_LISP ("chise-system-db-directory", &Vchise_system_db_directory /*
4811 Directory of system character database of CHISE.
4815 #endif /* HAVE_CHISE */
4816 /* DO NOT staticpro this. It works just like Vweak_hash_tables. */
4817 Vall_syntax_tables = Qnil;
4818 dump_add_weak_object_chain (&Vall_syntax_tables);
4822 structure_type_create_chartab (void)
4824 struct structure_type *st;
4826 st = define_structure_type (Qchar_table, 0, chartab_instantiate);
4828 define_structure_type_keyword (st, Qtype, chartab_type_validate);
4829 define_structure_type_keyword (st, Qdata, chartab_data_validate);
4833 complex_vars_of_chartab (void)
4836 staticpro (&Vchar_attribute_hash_table);
4837 Vchar_attribute_hash_table
4838 = make_lisp_hash_table (16, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
4839 #endif /* UTF2000 */
4841 /* Set this now, so first buffer creation can refer to it. */
4842 /* Make it nil before calling copy-category-table
4843 so that copy-category-table will know not to try to copy from garbage */
4844 Vstandard_category_table = Qnil;
4845 Vstandard_category_table = Fcopy_category_table (Qnil);
4846 staticpro (&Vstandard_category_table);
4848 DEFVAR_LISP ("word-combining-categories", &Vword_combining_categories /*
4849 List of pair (cons) of categories to determine word boundary.
4851 Emacs treats a sequence of word constituent characters as a single
4852 word (i.e. finds no word boundary between them) iff they belongs to
4853 the same charset. But, exceptions are allowed in the following cases.
4855 \(1) The case that characters are in different charsets is controlled
4856 by the variable `word-combining-categories'.
4858 Emacs finds no word boundary between characters of different charsets
4859 if they have categories matching some element of this list.
4861 More precisely, if an element of this list is a cons of category CAT1
4862 and CAT2, and a multibyte character C1 which has CAT1 is followed by
4863 C2 which has CAT2, there's no word boundary between C1 and C2.
4865 For instance, to tell that ASCII characters and Latin-1 characters can
4866 form a single word, the element `(?l . ?l)' should be in this list
4867 because both characters have the category `l' (Latin characters).
4869 \(2) The case that character are in the same charset is controlled by
4870 the variable `word-separating-categories'.
4872 Emacs find a word boundary between characters of the same charset
4873 if they have categories matching some element of this list.
4875 More precisely, if an element of this list is a cons of category CAT1
4876 and CAT2, and a multibyte character C1 which has CAT1 is followed by
4877 C2 which has CAT2, there's a word boundary between C1 and C2.
4879 For instance, to tell that there's a word boundary between Japanese
4880 Hiragana and Japanese Kanji (both are in the same charset), the
4881 element `(?H . ?C) should be in this list.
4884 Vword_combining_categories = Qnil;
4886 DEFVAR_LISP ("word-separating-categories", &Vword_separating_categories /*
4887 List of pair (cons) of categories to determine word boundary.
4888 See the documentation of the variable `word-combining-categories'.
4891 Vword_separating_categories = Qnil;