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_halfwidth_of;
1138 Lisp_Object Q_superscript_of;
1139 Lisp_Object Q_subscript_of;
1140 Lisp_Object Q_circled_of;
1141 Lisp_Object Q_decomposition;
1142 Lisp_Object Q_identical;
1143 Lisp_Object Q_identical_from;
1144 Lisp_Object Q_denotational;
1145 Lisp_Object Q_denotational_from;
1146 Lisp_Object Q_subsumptive;
1147 Lisp_Object Q_subsumptive_from;
1148 Lisp_Object Q_component;
1149 Lisp_Object Q_component_of;
1150 Lisp_Object Qto_ucs;
1151 Lisp_Object Q_ucs_unified;
1152 Lisp_Object Qcompat;
1153 Lisp_Object Qisolated;
1154 Lisp_Object Qinitial;
1155 Lisp_Object Qmedial;
1157 Lisp_Object Qvertical;
1158 Lisp_Object QnoBreak;
1159 Lisp_Object Qfraction;
1162 Lisp_Object Qcircle;
1163 Lisp_Object Qsquare;
1165 Lisp_Object Qnarrow;
1169 Emchar to_char_id (Lisp_Object v, char* err_msg, Lisp_Object err_arg);
1172 to_char_id (Lisp_Object v, char* err_msg, Lisp_Object err_arg)
1178 else if (EQ (v, Qcompat))
1180 else if (EQ (v, Qisolated))
1182 else if (EQ (v, Qinitial))
1184 else if (EQ (v, Qmedial))
1186 else if (EQ (v, Qfinal))
1188 else if (EQ (v, Qvertical))
1190 else if (EQ (v, QnoBreak))
1192 else if (EQ (v, Qfraction))
1194 else if (EQ (v, Qsuper))
1196 else if (EQ (v, Qsub))
1198 else if (EQ (v, Qcircle))
1200 else if (EQ (v, Qsquare))
1202 else if (EQ (v, Qwide))
1204 else if (EQ (v, Qnarrow))
1206 else if (EQ (v, Qsmall))
1208 else if (EQ (v, Qfont))
1211 signal_simple_error (err_msg, err_arg);
1214 DEFUN ("get-composite-char", Fget_composite_char, 1, 1, 0, /*
1215 Return character corresponding with list.
1219 Lisp_Object base, modifier;
1223 signal_simple_error ("Invalid value for composition", list);
1226 while (!NILP (rest))
1231 signal_simple_error ("Invalid value for composition", list);
1232 modifier = Fcar (rest);
1234 base = Fcdr (Fassq (modifier,
1235 Fchar_feature (base, Qcomposition, Qnil,
1241 DEFUN ("char-variants", Fchar_variants, 1, 1, 0, /*
1242 Return variants of CHARACTER.
1246 CHECK_CHAR (character);
1249 (Fcopy_list (Fget_char_attribute (character, Q_subsumptive, Qnil)),
1251 (Fcopy_list (Fget_char_attribute (character, Q_denotational, Qnil)),
1253 (Fcopy_list (Fget_char_attribute (character, Q_identical, Qnil)),
1254 Fcopy_list (Fchar_feature (character, Q_ucs_unified, Qnil,
1261 /* A char table maps from ranges of characters to values.
1263 Implementing a general data structure that maps from arbitrary
1264 ranges of numbers to values is tricky to do efficiently. As it
1265 happens, it should suffice (and is usually more convenient, anyway)
1266 when dealing with characters to restrict the sorts of ranges that
1267 can be assigned values, as follows:
1270 2) All characters in a charset.
1271 3) All characters in a particular row of a charset, where a "row"
1272 means all characters with the same first byte.
1273 4) A particular character in a charset.
1275 We use char tables to generalize the 256-element vectors now
1276 littering the Emacs code.
1278 Possible uses (all should be converted at some point):
1284 5) keyboard-translate-table?
1287 abstract type to generalize the Emacs vectors and Mule
1288 vectors-of-vectors goo.
1291 /************************************************************************/
1292 /* Char Table object */
1293 /************************************************************************/
1295 #if defined(MULE)&&!defined(UTF2000)
1298 mark_char_table_entry (Lisp_Object obj)
1300 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj);
1303 for (i = 0; i < 96; i++)
1305 mark_object (cte->level2[i]);
1311 char_table_entry_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
1313 Lisp_Char_Table_Entry *cte1 = XCHAR_TABLE_ENTRY (obj1);
1314 Lisp_Char_Table_Entry *cte2 = XCHAR_TABLE_ENTRY (obj2);
1317 for (i = 0; i < 96; i++)
1318 if (!internal_equal (cte1->level2[i], cte2->level2[i], depth + 1))
1324 static unsigned long
1325 char_table_entry_hash (Lisp_Object obj, int depth)
1327 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj);
1329 return internal_array_hash (cte->level2, 96, depth);
1332 static const struct lrecord_description char_table_entry_description[] = {
1333 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table_Entry, level2), 96 },
1337 DEFINE_LRECORD_IMPLEMENTATION ("char-table-entry", char_table_entry,
1338 mark_char_table_entry, internal_object_printer,
1339 0, char_table_entry_equal,
1340 char_table_entry_hash,
1341 char_table_entry_description,
1342 Lisp_Char_Table_Entry);
1346 mark_char_table (Lisp_Object obj)
1348 Lisp_Char_Table *ct = XCHAR_TABLE (obj);
1351 mark_object (ct->table);
1352 mark_object (ct->name);
1353 #ifndef HAVE_LIBCHISE
1354 mark_object (ct->db);
1359 for (i = 0; i < NUM_ASCII_CHARS; i++)
1360 mark_object (ct->ascii[i]);
1362 for (i = 0; i < NUM_LEADING_BYTES; i++)
1363 mark_object (ct->level1[i]);
1367 return ct->default_value;
1369 return ct->mirror_table;
1373 /* WARNING: All functions of this nature need to be written extremely
1374 carefully to avoid crashes during GC. Cf. prune_specifiers()
1375 and prune_weak_hash_tables(). */
1378 prune_syntax_tables (void)
1380 Lisp_Object rest, prev = Qnil;
1382 for (rest = Vall_syntax_tables;
1384 rest = XCHAR_TABLE (rest)->next_table)
1386 if (! marked_p (rest))
1388 /* This table is garbage. Remove it from the list. */
1390 Vall_syntax_tables = XCHAR_TABLE (rest)->next_table;
1392 XCHAR_TABLE (prev)->next_table =
1393 XCHAR_TABLE (rest)->next_table;
1399 char_table_type_to_symbol (enum char_table_type type)
1404 case CHAR_TABLE_TYPE_GENERIC: return Qgeneric;
1405 case CHAR_TABLE_TYPE_SYNTAX: return Qsyntax;
1406 case CHAR_TABLE_TYPE_DISPLAY: return Qdisplay;
1407 case CHAR_TABLE_TYPE_CHAR: return Qchar;
1409 case CHAR_TABLE_TYPE_CATEGORY: return Qcategory;
1414 static enum char_table_type
1415 symbol_to_char_table_type (Lisp_Object symbol)
1417 CHECK_SYMBOL (symbol);
1419 if (EQ (symbol, Qgeneric)) return CHAR_TABLE_TYPE_GENERIC;
1420 if (EQ (symbol, Qsyntax)) return CHAR_TABLE_TYPE_SYNTAX;
1421 if (EQ (symbol, Qdisplay)) return CHAR_TABLE_TYPE_DISPLAY;
1422 if (EQ (symbol, Qchar)) return CHAR_TABLE_TYPE_CHAR;
1424 if (EQ (symbol, Qcategory)) return CHAR_TABLE_TYPE_CATEGORY;
1427 signal_simple_error ("Unrecognized char table type", symbol);
1428 return CHAR_TABLE_TYPE_GENERIC; /* not reached */
1433 print_chartab_range (Emchar first, Emchar last, Lisp_Object val,
1434 Lisp_Object printcharfun)
1438 write_c_string (" (", printcharfun);
1439 print_internal (make_char (first), printcharfun, 0);
1440 write_c_string (" ", printcharfun);
1441 print_internal (make_char (last), printcharfun, 0);
1442 write_c_string (") ", printcharfun);
1446 write_c_string (" ", printcharfun);
1447 print_internal (make_char (first), printcharfun, 0);
1448 write_c_string (" ", printcharfun);
1450 print_internal (val, printcharfun, 1);
1454 #if defined(MULE)&&!defined(UTF2000)
1457 print_chartab_charset_row (Lisp_Object charset,
1459 Lisp_Char_Table_Entry *cte,
1460 Lisp_Object printcharfun)
1463 Lisp_Object cat = Qunbound;
1466 for (i = 32; i < 128; i++)
1468 Lisp_Object pam = cte->level2[i - 32];
1480 print_chartab_range (MAKE_CHAR (charset, first, 0),
1481 MAKE_CHAR (charset, i - 1, 0),
1484 print_chartab_range (MAKE_CHAR (charset, row, first),
1485 MAKE_CHAR (charset, row, i - 1),
1495 print_chartab_range (MAKE_CHAR (charset, first, 0),
1496 MAKE_CHAR (charset, i - 1, 0),
1499 print_chartab_range (MAKE_CHAR (charset, row, first),
1500 MAKE_CHAR (charset, row, i - 1),
1506 print_chartab_two_byte_charset (Lisp_Object charset,
1507 Lisp_Char_Table_Entry *cte,
1508 Lisp_Object printcharfun)
1512 for (i = 32; i < 128; i++)
1514 Lisp_Object jen = cte->level2[i - 32];
1516 if (!CHAR_TABLE_ENTRYP (jen))
1520 write_c_string (" [", printcharfun);
1521 print_internal (XCHARSET_NAME (charset), printcharfun, 0);
1522 sprintf (buf, " %d] ", i);
1523 write_c_string (buf, printcharfun);
1524 print_internal (jen, printcharfun, 0);
1527 print_chartab_charset_row (charset, i, XCHAR_TABLE_ENTRY (jen),
1535 print_char_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1537 Lisp_Char_Table *ct = XCHAR_TABLE (obj);
1540 struct gcpro gcpro1, gcpro2;
1541 GCPRO2 (obj, printcharfun);
1543 write_c_string ("#s(char-table ", printcharfun);
1544 write_c_string (" ", printcharfun);
1545 write_c_string (string_data
1547 (XSYMBOL (char_table_type_to_symbol (ct->type)))),
1549 write_c_string ("\n ", printcharfun);
1550 print_internal (ct->default_value, printcharfun, escapeflag);
1551 for (i = 0; i < 256; i++)
1553 Lisp_Object elt = get_byte_table (ct->table, i);
1554 if (i != 0) write_c_string ("\n ", printcharfun);
1555 if (EQ (elt, Qunbound))
1556 write_c_string ("void", printcharfun);
1558 print_internal (elt, printcharfun, escapeflag);
1561 #else /* non UTF2000 */
1564 sprintf (buf, "#s(char-table type %s data (",
1565 string_data (symbol_name (XSYMBOL
1566 (char_table_type_to_symbol (ct->type)))));
1567 write_c_string (buf, printcharfun);
1569 /* Now write out the ASCII/Control-1 stuff. */
1573 Lisp_Object val = Qunbound;
1575 for (i = 0; i < NUM_ASCII_CHARS; i++)
1584 if (!EQ (ct->ascii[i], val))
1586 print_chartab_range (first, i - 1, val, printcharfun);
1593 print_chartab_range (first, i - 1, val, printcharfun);
1600 for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES;
1603 Lisp_Object ann = ct->level1[i - MIN_LEADING_BYTE];
1604 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (i);
1606 if (!CHARSETP (charset) || i == LEADING_BYTE_ASCII
1607 || i == LEADING_BYTE_CONTROL_1)
1609 if (!CHAR_TABLE_ENTRYP (ann))
1611 write_c_string (" ", printcharfun);
1612 print_internal (XCHARSET_NAME (charset),
1614 write_c_string (" ", printcharfun);
1615 print_internal (ann, printcharfun, 0);
1619 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (ann);
1620 if (XCHARSET_DIMENSION (charset) == 1)
1621 print_chartab_charset_row (charset, -1, cte, printcharfun);
1623 print_chartab_two_byte_charset (charset, cte, printcharfun);
1628 #endif /* non UTF2000 */
1630 write_c_string ("))", printcharfun);
1634 char_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
1636 Lisp_Char_Table *ct1 = XCHAR_TABLE (obj1);
1637 Lisp_Char_Table *ct2 = XCHAR_TABLE (obj2);
1640 if (CHAR_TABLE_TYPE (ct1) != CHAR_TABLE_TYPE (ct2))
1644 for (i = 0; i < 256; i++)
1646 if (!internal_equal (get_byte_table (ct1->table, i),
1647 get_byte_table (ct2->table, i), 0))
1651 for (i = 0; i < NUM_ASCII_CHARS; i++)
1652 if (!internal_equal (ct1->ascii[i], ct2->ascii[i], depth + 1))
1656 for (i = 0; i < NUM_LEADING_BYTES; i++)
1657 if (!internal_equal (ct1->level1[i], ct2->level1[i], depth + 1))
1660 #endif /* non UTF2000 */
1665 static unsigned long
1666 char_table_hash (Lisp_Object obj, int depth)
1668 Lisp_Char_Table *ct = XCHAR_TABLE (obj);
1670 return byte_table_hash (ct->table, depth + 1);
1672 unsigned long hashval = internal_array_hash (ct->ascii, NUM_ASCII_CHARS,
1675 hashval = HASH2 (hashval,
1676 internal_array_hash (ct->level1, NUM_LEADING_BYTES, depth));
1682 static const struct lrecord_description char_table_description[] = {
1684 { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, table) },
1685 { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, default_value) },
1686 { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, name) },
1687 #ifndef HAVE_LIBCHISE
1688 { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, db) },
1691 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, ascii), NUM_ASCII_CHARS },
1693 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, level1), NUM_LEADING_BYTES },
1697 { XD_LISP_OBJECT, offsetof (Lisp_Char_Table, mirror_table) },
1699 { XD_LO_LINK, offsetof (Lisp_Char_Table, next_table) },
1703 DEFINE_LRECORD_IMPLEMENTATION ("char-table", char_table,
1704 mark_char_table, print_char_table, 0,
1705 char_table_equal, char_table_hash,
1706 char_table_description,
1709 DEFUN ("char-table-p", Fchar_table_p, 1, 1, 0, /*
1710 Return non-nil if OBJECT is a char table.
1712 A char table is a table that maps characters (or ranges of characters)
1713 to values. Char tables are specialized for characters, only allowing
1714 particular sorts of ranges to be assigned values. Although this
1715 loses in generality, it makes for extremely fast (constant-time)
1716 lookups, and thus is feasible for applications that do an extremely
1717 large number of lookups (e.g. scanning a buffer for a character in
1718 a particular syntax, where a lookup in the syntax table must occur
1719 once per character).
1721 When Mule support exists, the types of ranges that can be assigned
1725 -- an entire charset
1726 -- a single row in a two-octet charset
1727 -- a single character
1729 When Mule support is not present, the types of ranges that can be
1733 -- a single character
1735 To create a char table, use `make-char-table'.
1736 To modify a char table, use `put-char-table' or `remove-char-table'.
1737 To retrieve the value for a particular character, use `get-char-table'.
1738 See also `map-char-table', `clear-char-table', `copy-char-table',
1739 `valid-char-table-type-p', `char-table-type-list',
1740 `valid-char-table-value-p', and `check-char-table-value'.
1744 return CHAR_TABLEP (object) ? Qt : Qnil;
1747 DEFUN ("char-table-type-list", Fchar_table_type_list, 0, 0, 0, /*
1748 Return a list of the recognized char table types.
1749 See `valid-char-table-type-p'.
1754 return list5 (Qchar, Qcategory, Qdisplay, Qgeneric, Qsyntax);
1756 return list4 (Qchar, Qdisplay, Qgeneric, Qsyntax);
1760 DEFUN ("valid-char-table-type-p", Fvalid_char_table_type_p, 1, 1, 0, /*
1761 Return t if TYPE if a recognized char table type.
1763 Each char table type is used for a different purpose and allows different
1764 sorts of values. The different char table types are
1767 Used for category tables, which specify the regexp categories
1768 that a character is in. The valid values are nil or a
1769 bit vector of 95 elements. Higher-level Lisp functions are
1770 provided for working with category tables. Currently categories
1771 and category tables only exist when Mule support is present.
1773 A generalized char table, for mapping from one character to
1774 another. Used for case tables, syntax matching tables,
1775 `keyboard-translate-table', etc. The valid values are characters.
1777 An even more generalized char table, for mapping from a
1778 character to anything.
1780 Used for display tables, which specify how a particular character
1781 is to appear when displayed. #### Not yet implemented.
1783 Used for syntax tables, which specify the syntax of a particular
1784 character. Higher-level Lisp functions are provided for
1785 working with syntax tables. The valid values are integers.
1790 return (EQ (type, Qchar) ||
1792 EQ (type, Qcategory) ||
1794 EQ (type, Qdisplay) ||
1795 EQ (type, Qgeneric) ||
1796 EQ (type, Qsyntax)) ? Qt : Qnil;
1799 DEFUN ("char-table-type", Fchar_table_type, 1, 1, 0, /*
1800 Return the type of CHAR-TABLE.
1801 See `valid-char-table-type-p'.
1805 CHECK_CHAR_TABLE (char_table);
1806 return char_table_type_to_symbol (XCHAR_TABLE (char_table)->type);
1810 fill_char_table (Lisp_Char_Table *ct, Lisp_Object value)
1813 ct->table = Qunbound;
1814 ct->default_value = value;
1819 for (i = 0; i < NUM_ASCII_CHARS; i++)
1820 ct->ascii[i] = value;
1822 for (i = 0; i < NUM_LEADING_BYTES; i++)
1823 ct->level1[i] = value;
1828 if (ct->type == CHAR_TABLE_TYPE_SYNTAX)
1829 update_syntax_table (ct);
1833 DEFUN ("reset-char-table", Freset_char_table, 1, 1, 0, /*
1834 Reset CHAR-TABLE to its default state.
1838 Lisp_Char_Table *ct;
1840 CHECK_CHAR_TABLE (char_table);
1841 ct = XCHAR_TABLE (char_table);
1845 case CHAR_TABLE_TYPE_CHAR:
1846 fill_char_table (ct, make_char (0));
1848 case CHAR_TABLE_TYPE_DISPLAY:
1849 case CHAR_TABLE_TYPE_GENERIC:
1851 case CHAR_TABLE_TYPE_CATEGORY:
1853 fill_char_table (ct, Qnil);
1856 case CHAR_TABLE_TYPE_SYNTAX:
1857 fill_char_table (ct, make_int (Sinherit));
1867 DEFUN ("make-char-table", Fmake_char_table, 1, 1, 0, /*
1868 Return a new, empty char table of type TYPE.
1869 Currently recognized types are 'char, 'category, 'display, 'generic,
1870 and 'syntax. See `valid-char-table-type-p'.
1874 Lisp_Char_Table *ct;
1876 enum char_table_type ty = symbol_to_char_table_type (type);
1878 ct = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table);
1881 if (ty == CHAR_TABLE_TYPE_SYNTAX)
1883 ct->mirror_table = Fmake_char_table (Qgeneric);
1884 fill_char_table (XCHAR_TABLE (ct->mirror_table),
1888 ct->mirror_table = Qnil;
1891 #ifndef HAVE_LIBCHISE
1895 ct->next_table = Qnil;
1896 XSETCHAR_TABLE (obj, ct);
1897 if (ty == CHAR_TABLE_TYPE_SYNTAX)
1899 ct->next_table = Vall_syntax_tables;
1900 Vall_syntax_tables = obj;
1902 Freset_char_table (obj);
1906 #if defined(MULE)&&!defined(UTF2000)
1909 make_char_table_entry (Lisp_Object initval)
1913 Lisp_Char_Table_Entry *cte =
1914 alloc_lcrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry);
1916 for (i = 0; i < 96; i++)
1917 cte->level2[i] = initval;
1919 XSETCHAR_TABLE_ENTRY (obj, cte);
1924 copy_char_table_entry (Lisp_Object entry)
1926 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (entry);
1929 Lisp_Char_Table_Entry *ctenew =
1930 alloc_lcrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry);
1932 for (i = 0; i < 96; i++)
1934 Lisp_Object new = cte->level2[i];
1935 if (CHAR_TABLE_ENTRYP (new))
1936 ctenew->level2[i] = copy_char_table_entry (new);
1938 ctenew->level2[i] = new;
1941 XSETCHAR_TABLE_ENTRY (obj, ctenew);
1947 DEFUN ("copy-char-table", Fcopy_char_table, 1, 1, 0, /*
1948 Return a new char table which is a copy of CHAR-TABLE.
1949 It will contain the same values for the same characters and ranges
1950 as CHAR-TABLE. The values will not themselves be copied.
1954 Lisp_Char_Table *ct, *ctnew;
1960 CHECK_CHAR_TABLE (char_table);
1961 ct = XCHAR_TABLE (char_table);
1962 ctnew = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table);
1963 ctnew->type = ct->type;
1965 ctnew->default_value = ct->default_value;
1966 /* [tomo:2002-01-21] Perhaps this code seems wrong */
1967 ctnew->name = ct->name;
1968 #ifndef HAVE_LIBCHISE
1972 if (UINT8_BYTE_TABLE_P (ct->table))
1974 ctnew->table = copy_uint8_byte_table (ct->table);
1976 else if (UINT16_BYTE_TABLE_P (ct->table))
1978 ctnew->table = copy_uint16_byte_table (ct->table);
1980 else if (BYTE_TABLE_P (ct->table))
1982 ctnew->table = copy_byte_table (ct->table);
1984 else if (!UNBOUNDP (ct->table))
1985 ctnew->table = ct->table;
1986 #else /* non UTF2000 */
1988 for (i = 0; i < NUM_ASCII_CHARS; i++)
1990 Lisp_Object new = ct->ascii[i];
1992 assert (! (CHAR_TABLE_ENTRYP (new)));
1994 ctnew->ascii[i] = new;
1999 for (i = 0; i < NUM_LEADING_BYTES; i++)
2001 Lisp_Object new = ct->level1[i];
2002 if (CHAR_TABLE_ENTRYP (new))
2003 ctnew->level1[i] = copy_char_table_entry (new);
2005 ctnew->level1[i] = new;
2009 #endif /* non UTF2000 */
2012 if (CHAR_TABLEP (ct->mirror_table))
2013 ctnew->mirror_table = Fcopy_char_table (ct->mirror_table);
2015 ctnew->mirror_table = ct->mirror_table;
2017 ctnew->next_table = Qnil;
2018 XSETCHAR_TABLE (obj, ctnew);
2019 if (ctnew->type == CHAR_TABLE_TYPE_SYNTAX)
2021 ctnew->next_table = Vall_syntax_tables;
2022 Vall_syntax_tables = obj;
2027 INLINE_HEADER int XCHARSET_CELL_RANGE (Lisp_Object ccs);
2029 XCHARSET_CELL_RANGE (Lisp_Object ccs)
2031 switch (XCHARSET_CHARS (ccs))
2034 return (33 << 8) | 126;
2036 return (32 << 8) | 127;
2039 return (0 << 8) | 127;
2041 return (0 << 8) | 255;
2053 decode_char_table_range (Lisp_Object range, struct chartab_range *outrange)
2056 outrange->type = CHARTAB_RANGE_ALL;
2058 else if (EQ (range, Qnil))
2059 outrange->type = CHARTAB_RANGE_DEFAULT;
2061 else if (CHAR_OR_CHAR_INTP (range))
2063 outrange->type = CHARTAB_RANGE_CHAR;
2064 outrange->ch = XCHAR_OR_CHAR_INT (range);
2068 signal_simple_error ("Range must be t or a character", range);
2070 else if (VECTORP (range))
2072 Lisp_Vector *vec = XVECTOR (range);
2073 Lisp_Object *elts = vector_data (vec);
2074 int cell_min, cell_max;
2076 outrange->type = CHARTAB_RANGE_ROW;
2077 outrange->charset = Fget_charset (elts[0]);
2078 CHECK_INT (elts[1]);
2079 outrange->row = XINT (elts[1]);
2080 if (XCHARSET_DIMENSION (outrange->charset) < 2)
2081 signal_simple_error ("Charset in row vector must be multi-byte",
2085 int ret = XCHARSET_CELL_RANGE (outrange->charset);
2087 cell_min = ret >> 8;
2088 cell_max = ret & 0xFF;
2090 if (XCHARSET_DIMENSION (outrange->charset) == 2)
2091 check_int_range (outrange->row, cell_min, cell_max);
2093 else if (XCHARSET_DIMENSION (outrange->charset) == 3)
2095 check_int_range (outrange->row >> 8 , cell_min, cell_max);
2096 check_int_range (outrange->row & 0xFF, cell_min, cell_max);
2098 else if (XCHARSET_DIMENSION (outrange->charset) == 4)
2100 check_int_range ( outrange->row >> 16 , cell_min, cell_max);
2101 check_int_range ((outrange->row >> 8) & 0xFF, cell_min, cell_max);
2102 check_int_range ( outrange->row & 0xFF, cell_min, cell_max);
2110 if (!CHARSETP (range) && !SYMBOLP (range))
2112 ("Char table range must be t, charset, char, or vector", range);
2113 outrange->type = CHARTAB_RANGE_CHARSET;
2114 outrange->charset = Fget_charset (range);
2119 #if defined(MULE)&&!defined(UTF2000)
2121 /* called from CHAR_TABLE_VALUE(). */
2123 get_non_ascii_char_table_value (Lisp_Char_Table *ct, Charset_ID leading_byte,
2128 Lisp_Object charset;
2130 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (leading_byte);
2135 BREAKUP_CHAR (c, charset, byte1, byte2);
2137 BREAKUP_CHAR_1_UNSAFE (c, charset, byte1, byte2);
2139 val = ct->level1[leading_byte - MIN_LEADING_BYTE];
2140 if (CHAR_TABLE_ENTRYP (val))
2142 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
2143 val = cte->level2[byte1 - 32];
2144 if (CHAR_TABLE_ENTRYP (val))
2146 cte = XCHAR_TABLE_ENTRY (val);
2147 assert (byte2 >= 32);
2148 val = cte->level2[byte2 - 32];
2149 assert (!CHAR_TABLE_ENTRYP (val));
2159 get_char_table (Emchar ch, Lisp_Char_Table *ct)
2163 Lisp_Object ret = get_char_id_table (ct, ch);
2168 if (EQ (CHAR_TABLE_NAME (ct), Qdowncase))
2169 ret = Fchar_feature (make_char (ch), Q_lowercase, Qnil,
2171 else if (EQ (CHAR_TABLE_NAME (ct), Qflippedcase))
2172 ret = Fchar_feature (make_char (ch), Q_uppercase, Qnil,
2178 ret = Ffind_char (ret);
2186 Lisp_Object charset;
2190 BREAKUP_CHAR (ch, charset, byte1, byte2);
2192 if (EQ (charset, Vcharset_ascii))
2193 val = ct->ascii[byte1];
2194 else if (EQ (charset, Vcharset_control_1))
2195 val = ct->ascii[byte1 + 128];
2198 int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE;
2199 val = ct->level1[lb];
2200 if (CHAR_TABLE_ENTRYP (val))
2202 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
2203 val = cte->level2[byte1 - 32];
2204 if (CHAR_TABLE_ENTRYP (val))
2206 cte = XCHAR_TABLE_ENTRY (val);
2207 assert (byte2 >= 32);
2208 val = cte->level2[byte2 - 32];
2209 assert (!CHAR_TABLE_ENTRYP (val));
2216 #else /* not MULE */
2217 return ct->ascii[(unsigned char)ch];
2218 #endif /* not MULE */
2222 DEFUN ("get-char-table", Fget_char_table, 2, 2, 0, /*
2223 Find value for CHARACTER in CHAR-TABLE.
2225 (character, char_table))
2227 CHECK_CHAR_TABLE (char_table);
2228 CHECK_CHAR_COERCE_INT (character);
2230 return get_char_table (XCHAR (character), XCHAR_TABLE (char_table));
2233 DEFUN ("get-range-char-table", Fget_range_char_table, 2, 3, 0, /*
2234 Find value for a range in CHAR-TABLE.
2235 If there is more than one value, return MULTI (defaults to nil).
2237 (range, char_table, multi))
2239 Lisp_Char_Table *ct;
2240 struct chartab_range rainj;
2242 if (CHAR_OR_CHAR_INTP (range))
2243 return Fget_char_table (range, char_table);
2244 CHECK_CHAR_TABLE (char_table);
2245 ct = XCHAR_TABLE (char_table);
2247 decode_char_table_range (range, &rainj);
2250 case CHARTAB_RANGE_ALL:
2253 if (UINT8_BYTE_TABLE_P (ct->table))
2255 else if (UINT16_BYTE_TABLE_P (ct->table))
2257 else if (BYTE_TABLE_P (ct->table))
2261 #else /* non UTF2000 */
2263 Lisp_Object first = ct->ascii[0];
2265 for (i = 1; i < NUM_ASCII_CHARS; i++)
2266 if (!EQ (first, ct->ascii[i]))
2270 for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES;
2273 if (!CHARSETP (CHARSET_BY_LEADING_BYTE (i))
2274 || i == LEADING_BYTE_ASCII
2275 || i == LEADING_BYTE_CONTROL_1)
2277 if (!EQ (first, ct->level1[i - MIN_LEADING_BYTE]))
2283 #endif /* non UTF2000 */
2287 case CHARTAB_RANGE_CHARSET:
2291 if (EQ (rainj.charset, Vcharset_ascii))
2294 Lisp_Object first = ct->ascii[0];
2296 for (i = 1; i < 128; i++)
2297 if (!EQ (first, ct->ascii[i]))
2302 if (EQ (rainj.charset, Vcharset_control_1))
2305 Lisp_Object first = ct->ascii[128];
2307 for (i = 129; i < 160; i++)
2308 if (!EQ (first, ct->ascii[i]))
2314 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (rainj.charset) -
2316 if (CHAR_TABLE_ENTRYP (val))
2322 case CHARTAB_RANGE_ROW:
2327 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (rainj.charset) -
2329 if (!CHAR_TABLE_ENTRYP (val))
2331 val = XCHAR_TABLE_ENTRY (val)->level2[rainj.row - 32];
2332 if (CHAR_TABLE_ENTRYP (val))
2336 #endif /* not UTF2000 */
2337 #endif /* not MULE */
2340 case CHARTAB_RANGE_DEFAULT:
2341 return ct->default_value;
2342 #endif /* not UTF2000 */
2348 return Qnil; /* not reached */
2352 check_valid_char_table_value (Lisp_Object value, enum char_table_type type,
2353 Error_behavior errb)
2357 case CHAR_TABLE_TYPE_SYNTAX:
2358 if (!ERRB_EQ (errb, ERROR_ME))
2359 return INTP (value) || (CONSP (value) && INTP (XCAR (value))
2360 && CHAR_OR_CHAR_INTP (XCDR (value)));
2363 Lisp_Object cdr = XCDR (value);
2364 CHECK_INT (XCAR (value));
2365 CHECK_CHAR_COERCE_INT (cdr);
2372 case CHAR_TABLE_TYPE_CATEGORY:
2373 if (!ERRB_EQ (errb, ERROR_ME))
2374 return CATEGORY_TABLE_VALUEP (value);
2375 CHECK_CATEGORY_TABLE_VALUE (value);
2379 case CHAR_TABLE_TYPE_GENERIC:
2382 case CHAR_TABLE_TYPE_DISPLAY:
2384 maybe_signal_simple_error ("Display char tables not yet implemented",
2385 value, Qchar_table, errb);
2388 case CHAR_TABLE_TYPE_CHAR:
2389 if (!ERRB_EQ (errb, ERROR_ME))
2390 return CHAR_OR_CHAR_INTP (value);
2391 CHECK_CHAR_COERCE_INT (value);
2398 return 0; /* not reached */
2402 canonicalize_char_table_value (Lisp_Object value, enum char_table_type type)
2406 case CHAR_TABLE_TYPE_SYNTAX:
2409 Lisp_Object car = XCAR (value);
2410 Lisp_Object cdr = XCDR (value);
2411 CHECK_CHAR_COERCE_INT (cdr);
2412 return Fcons (car, cdr);
2415 case CHAR_TABLE_TYPE_CHAR:
2416 CHECK_CHAR_COERCE_INT (value);
2424 DEFUN ("valid-char-table-value-p", Fvalid_char_table_value_p, 2, 2, 0, /*
2425 Return non-nil if VALUE is a valid value for CHAR-TABLE-TYPE.
2427 (value, char_table_type))
2429 enum char_table_type type = symbol_to_char_table_type (char_table_type);
2431 return check_valid_char_table_value (value, type, ERROR_ME_NOT) ? Qt : Qnil;
2434 DEFUN ("check-valid-char-table-value", Fcheck_valid_char_table_value, 2, 2, 0, /*
2435 Signal an error if VALUE is not a valid value for CHAR-TABLE-TYPE.
2437 (value, char_table_type))
2439 enum char_table_type type = symbol_to_char_table_type (char_table_type);
2441 check_valid_char_table_value (value, type, ERROR_ME);
2446 Lisp_Char_Table* char_attribute_table_to_put;
2447 Lisp_Object Qput_char_table_map_function;
2448 Lisp_Object value_to_put;
2450 DEFUN ("put-char-table-map-function",
2451 Fput_char_table_map_function, 2, 2, 0, /*
2452 For internal use. Don't use it.
2456 put_char_id_table_0 (char_attribute_table_to_put,
2457 XCHAR (c), value_to_put);
2462 /* Assign VAL to all characters in RANGE in char table CT. */
2465 put_char_table (Lisp_Char_Table *ct, struct chartab_range *range,
2468 switch (range->type)
2470 case CHARTAB_RANGE_ALL:
2471 fill_char_table (ct, val);
2472 return; /* avoid the duplicate call to update_syntax_table() below,
2473 since fill_char_table() also did that. */
2476 case CHARTAB_RANGE_DEFAULT:
2477 ct->default_value = val;
2482 case CHARTAB_RANGE_CHARSET:
2485 Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (range->charset);
2487 if ( CHAR_TABLEP (encoding_table) )
2489 Lisp_Object mother = XCHARSET_MOTHER (range->charset);
2491 char_attribute_table_to_put = ct;
2493 Fmap_char_attribute (Qput_char_table_map_function,
2494 XCHAR_TABLE_NAME (encoding_table),
2496 if ( CHARSETP (mother) )
2498 struct chartab_range r;
2500 r.type = CHARTAB_RANGE_CHARSET;
2502 put_char_table (ct, &r, val);
2510 for (c = 0; c < 1 << 24; c++)
2512 if ( charset_code_point (range->charset, c) >= 0 )
2513 put_char_id_table_0 (ct, c, val);
2519 if (EQ (range->charset, Vcharset_ascii))
2522 for (i = 0; i < 128; i++)
2525 else if (EQ (range->charset, Vcharset_control_1))
2528 for (i = 128; i < 160; i++)
2533 int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE;
2534 ct->level1[lb] = val;
2539 case CHARTAB_RANGE_ROW:
2542 int cell_min, cell_max, i;
2544 i = XCHARSET_CELL_RANGE (range->charset);
2546 cell_max = i & 0xFF;
2547 for (i = cell_min; i <= cell_max; i++)
2550 = DECODE_CHAR (range->charset, (range->row << 8) | i, 0);
2552 if ( charset_code_point (range->charset, ch, 0) >= 0 )
2553 put_char_id_table_0 (ct, ch, val);
2558 Lisp_Char_Table_Entry *cte;
2559 int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE;
2560 /* make sure that there is a separate entry for the row. */
2561 if (!CHAR_TABLE_ENTRYP (ct->level1[lb]))
2562 ct->level1[lb] = make_char_table_entry (ct->level1[lb]);
2563 cte = XCHAR_TABLE_ENTRY (ct->level1[lb]);
2564 cte->level2[range->row - 32] = val;
2566 #endif /* not UTF2000 */
2570 case CHARTAB_RANGE_CHAR:
2572 put_char_id_table_0 (ct, range->ch, val);
2576 Lisp_Object charset;
2579 BREAKUP_CHAR (range->ch, charset, byte1, byte2);
2580 if (EQ (charset, Vcharset_ascii))
2581 ct->ascii[byte1] = val;
2582 else if (EQ (charset, Vcharset_control_1))
2583 ct->ascii[byte1 + 128] = val;
2586 Lisp_Char_Table_Entry *cte;
2587 int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE;
2588 /* make sure that there is a separate entry for the row. */
2589 if (!CHAR_TABLE_ENTRYP (ct->level1[lb]))
2590 ct->level1[lb] = make_char_table_entry (ct->level1[lb]);
2591 cte = XCHAR_TABLE_ENTRY (ct->level1[lb]);
2592 /* now CTE is a char table entry for the charset;
2593 each entry is for a single row (or character of
2594 a one-octet charset). */
2595 if (XCHARSET_DIMENSION (charset) == 1)
2596 cte->level2[byte1 - 32] = val;
2599 /* assigning to one character in a two-octet charset. */
2600 /* make sure that the charset row contains a separate
2601 entry for each character. */
2602 if (!CHAR_TABLE_ENTRYP (cte->level2[byte1 - 32]))
2603 cte->level2[byte1 - 32] =
2604 make_char_table_entry (cte->level2[byte1 - 32]);
2605 cte = XCHAR_TABLE_ENTRY (cte->level2[byte1 - 32]);
2606 cte->level2[byte2 - 32] = val;
2610 #else /* not MULE */
2611 ct->ascii[(unsigned char) (range->ch)] = val;
2613 #endif /* not MULE */
2617 if (ct->type == CHAR_TABLE_TYPE_SYNTAX)
2618 update_syntax_table (ct);
2622 DEFUN ("put-char-table", Fput_char_table, 3, 3, 0, /*
2623 Set the value for chars in RANGE to be VALUE in CHAR-TABLE.
2625 RANGE specifies one or more characters to be affected and should be
2626 one of the following:
2628 -- t (all characters are affected)
2629 -- A charset (only allowed when Mule support is present)
2630 -- A vector of two elements: a two-octet charset and a row number
2631 (only allowed when Mule support is present)
2632 -- A single character
2634 VALUE must be a value appropriate for the type of CHAR-TABLE.
2635 See `valid-char-table-type-p'.
2637 (range, value, char_table))
2639 Lisp_Char_Table *ct;
2640 struct chartab_range rainj;
2642 CHECK_CHAR_TABLE (char_table);
2643 ct = XCHAR_TABLE (char_table);
2644 check_valid_char_table_value (value, ct->type, ERROR_ME);
2645 decode_char_table_range (range, &rainj);
2646 value = canonicalize_char_table_value (value, ct->type);
2647 put_char_table (ct, &rainj, value);
2652 /* Map FN over the ASCII chars in CT. */
2655 map_over_charset_ascii (Lisp_Char_Table *ct,
2656 int (*fn) (struct chartab_range *range,
2657 Lisp_Object val, void *arg),
2660 struct chartab_range rainj;
2669 rainj.type = CHARTAB_RANGE_CHAR;
2671 for (i = start, retval = 0; i < stop && retval == 0; i++)
2673 rainj.ch = (Emchar) i;
2674 retval = (fn) (&rainj, ct->ascii[i], arg);
2682 /* Map FN over the Control-1 chars in CT. */
2685 map_over_charset_control_1 (Lisp_Char_Table *ct,
2686 int (*fn) (struct chartab_range *range,
2687 Lisp_Object val, void *arg),
2690 struct chartab_range rainj;
2693 int stop = start + 32;
2695 rainj.type = CHARTAB_RANGE_CHAR;
2697 for (i = start, retval = 0; i < stop && retval == 0; i++)
2699 rainj.ch = (Emchar) (i);
2700 retval = (fn) (&rainj, ct->ascii[i], arg);
2706 /* Map FN over the row ROW of two-byte charset CHARSET.
2707 There must be a separate value for that row in the char table.
2708 CTE specifies the char table entry for CHARSET. */
2711 map_over_charset_row (Lisp_Char_Table_Entry *cte,
2712 Lisp_Object charset, int row,
2713 int (*fn) (struct chartab_range *range,
2714 Lisp_Object val, void *arg),
2717 Lisp_Object val = cte->level2[row - 32];
2719 if (!CHAR_TABLE_ENTRYP (val))
2721 struct chartab_range rainj;
2723 rainj.type = CHARTAB_RANGE_ROW;
2724 rainj.charset = charset;
2726 return (fn) (&rainj, val, arg);
2730 struct chartab_range rainj;
2732 int charset94_p = (XCHARSET_CHARS (charset) == 94);
2733 int start = charset94_p ? 33 : 32;
2734 int stop = charset94_p ? 127 : 128;
2736 cte = XCHAR_TABLE_ENTRY (val);
2738 rainj.type = CHARTAB_RANGE_CHAR;
2740 for (i = start, retval = 0; i < stop && retval == 0; i++)
2742 rainj.ch = MAKE_CHAR (charset, row, i);
2743 retval = (fn) (&rainj, cte->level2[i - 32], arg);
2751 map_over_other_charset (Lisp_Char_Table *ct, Charset_ID lb,
2752 int (*fn) (struct chartab_range *range,
2753 Lisp_Object val, void *arg),
2756 Lisp_Object val = ct->level1[lb - MIN_LEADING_BYTE];
2757 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (lb);
2759 if (!CHARSETP (charset)
2760 || lb == LEADING_BYTE_ASCII
2761 || lb == LEADING_BYTE_CONTROL_1)
2764 if (!CHAR_TABLE_ENTRYP (val))
2766 struct chartab_range rainj;
2768 rainj.type = CHARTAB_RANGE_CHARSET;
2769 rainj.charset = charset;
2770 return (fn) (&rainj, val, arg);
2774 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
2775 int charset94_p = (XCHARSET_CHARS (charset) == 94);
2776 int start = charset94_p ? 33 : 32;
2777 int stop = charset94_p ? 127 : 128;
2780 if (XCHARSET_DIMENSION (charset) == 1)
2782 struct chartab_range rainj;
2783 rainj.type = CHARTAB_RANGE_CHAR;
2785 for (i = start, retval = 0; i < stop && retval == 0; i++)
2787 rainj.ch = MAKE_CHAR (charset, i, 0);
2788 retval = (fn) (&rainj, cte->level2[i - 32], arg);
2793 for (i = start, retval = 0; i < stop && retval == 0; i++)
2794 retval = map_over_charset_row (cte, charset, i, fn, arg);
2802 #endif /* not UTF2000 */
2805 struct map_char_table_for_charset_arg
2807 int (*fn) (struct chartab_range *range, Lisp_Object val, void *arg);
2808 Lisp_Char_Table *ct;
2813 map_char_table_for_charset_fun (struct chartab_range *range,
2814 Lisp_Object val, void *arg)
2816 struct map_char_table_for_charset_arg *closure =
2817 (struct map_char_table_for_charset_arg *) arg;
2820 switch (range->type)
2822 case CHARTAB_RANGE_ALL:
2825 case CHARTAB_RANGE_DEFAULT:
2828 case CHARTAB_RANGE_CHARSET:
2831 case CHARTAB_RANGE_ROW:
2834 case CHARTAB_RANGE_CHAR:
2835 ret = get_char_table (range->ch, closure->ct);
2836 if (!UNBOUNDP (ret))
2837 return (closure->fn) (range, ret, closure->arg);
2849 /* Map FN (with client data ARG) over range RANGE in char table CT.
2850 Mapping stops the first time FN returns non-zero, and that value
2851 becomes the return value of map_char_table(). */
2854 map_char_table (Lisp_Char_Table *ct,
2855 struct chartab_range *range,
2856 int (*fn) (struct chartab_range *range,
2857 Lisp_Object val, void *arg),
2860 switch (range->type)
2862 case CHARTAB_RANGE_ALL:
2864 if (!UNBOUNDP (ct->default_value))
2866 struct chartab_range rainj;
2869 rainj.type = CHARTAB_RANGE_DEFAULT;
2870 retval = (fn) (&rainj, ct->default_value, arg);
2874 if (UINT8_BYTE_TABLE_P (ct->table))
2875 return map_over_uint8_byte_table (XUINT8_BYTE_TABLE(ct->table), ct,
2877 else if (UINT16_BYTE_TABLE_P (ct->table))
2878 return map_over_uint16_byte_table (XUINT16_BYTE_TABLE(ct->table), ct,
2880 else if (BYTE_TABLE_P (ct->table))
2881 return map_over_byte_table (XBYTE_TABLE(ct->table), ct,
2883 else if (EQ (ct->table, Qunloaded))
2886 struct chartab_range rainj;
2889 Emchar c1 = c + unit;
2892 rainj.type = CHARTAB_RANGE_CHAR;
2894 for (retval = 0; c < c1 && retval == 0; c++)
2896 Lisp_Object ret = get_char_id_table (ct, c);
2898 if (!UNBOUNDP (ret))
2901 retval = (fn) (&rainj, ct->table, arg);
2906 ct->table = Qunbound;
2909 else if (!UNBOUNDP (ct->table))
2910 return (fn) (range, ct->table, arg);
2916 retval = map_over_charset_ascii (ct, fn, arg);
2920 retval = map_over_charset_control_1 (ct, fn, arg);
2925 Charset_ID start = MIN_LEADING_BYTE;
2926 Charset_ID stop = start + NUM_LEADING_BYTES;
2928 for (i = start, retval = 0; i < stop && retval == 0; i++)
2930 retval = map_over_other_charset (ct, i, fn, arg);
2939 case CHARTAB_RANGE_DEFAULT:
2940 if (!UNBOUNDP (ct->default_value))
2941 return (fn) (range, ct->default_value, arg);
2946 case CHARTAB_RANGE_CHARSET:
2949 Lisp_Object encoding_table
2950 = XCHARSET_ENCODING_TABLE (range->charset);
2952 if (!NILP (encoding_table))
2954 struct chartab_range rainj;
2955 struct map_char_table_for_charset_arg mcarg;
2958 if (XCHAR_TABLE_UNLOADED(encoding_table))
2959 Fload_char_attribute_table (XCHAR_TABLE_NAME (encoding_table));
2964 rainj.type = CHARTAB_RANGE_ALL;
2965 return map_char_table (XCHAR_TABLE(encoding_table),
2967 &map_char_table_for_charset_fun,
2973 return map_over_other_charset (ct,
2974 XCHARSET_LEADING_BYTE (range->charset),
2978 case CHARTAB_RANGE_ROW:
2981 int cell_min, cell_max, i;
2983 struct chartab_range rainj;
2985 i = XCHARSET_CELL_RANGE (range->charset);
2987 cell_max = i & 0xFF;
2988 rainj.type = CHARTAB_RANGE_CHAR;
2989 for (retval =0, i = cell_min; i <= cell_max && retval == 0; i++)
2992 = DECODE_CHAR (range->charset, (range->row << 8) | i, 0);
2994 if ( charset_code_point (range->charset, ch, 0) >= 0 )
2997 = get_byte_table (get_byte_table
3001 (unsigned char)(ch >> 24)),
3002 (unsigned char) (ch >> 16)),
3003 (unsigned char) (ch >> 8)),
3004 (unsigned char) ch);
3007 val = ct->default_value;
3009 retval = (fn) (&rainj, val, arg);
3016 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (range->charset)
3017 - MIN_LEADING_BYTE];
3018 if (!CHAR_TABLE_ENTRYP (val))
3020 struct chartab_range rainj;
3022 rainj.type = CHARTAB_RANGE_ROW;
3023 rainj.charset = range->charset;
3024 rainj.row = range->row;
3025 return (fn) (&rainj, val, arg);
3028 return map_over_charset_row (XCHAR_TABLE_ENTRY (val),
3029 range->charset, range->row,
3032 #endif /* not UTF2000 */
3035 case CHARTAB_RANGE_CHAR:
3037 Emchar ch = range->ch;
3038 Lisp_Object val = CHAR_TABLE_VALUE_UNSAFE (ct, ch);
3040 if (!UNBOUNDP (val))
3042 struct chartab_range rainj;
3044 rainj.type = CHARTAB_RANGE_CHAR;
3046 return (fn) (&rainj, val, arg);
3058 struct slow_map_char_table_arg
3060 Lisp_Object function;
3065 slow_map_char_table_fun (struct chartab_range *range,
3066 Lisp_Object val, void *arg)
3068 Lisp_Object ranjarg = Qnil;
3069 struct slow_map_char_table_arg *closure =
3070 (struct slow_map_char_table_arg *) arg;
3072 switch (range->type)
3074 case CHARTAB_RANGE_ALL:
3079 case CHARTAB_RANGE_DEFAULT:
3085 case CHARTAB_RANGE_CHARSET:
3086 ranjarg = XCHARSET_NAME (range->charset);
3089 case CHARTAB_RANGE_ROW:
3090 ranjarg = vector2 (XCHARSET_NAME (range->charset),
3091 make_int (range->row));
3094 case CHARTAB_RANGE_CHAR:
3095 ranjarg = make_char (range->ch);
3101 closure->retval = call2 (closure->function, ranjarg, val);
3102 return !NILP (closure->retval);
3105 DEFUN ("map-char-table", Fmap_char_table, 2, 3, 0, /*
3106 Map FUNCTION over entries in CHAR-TABLE, calling it with two args,
3107 each key and value in the table.
3109 RANGE specifies a subrange to map over and is in the same format as
3110 the RANGE argument to `put-range-table'. If omitted or t, it defaults to
3113 (function, char_table, range))
3115 Lisp_Char_Table *ct;
3116 struct slow_map_char_table_arg slarg;
3117 struct gcpro gcpro1, gcpro2;
3118 struct chartab_range rainj;
3120 CHECK_CHAR_TABLE (char_table);
3121 ct = XCHAR_TABLE (char_table);
3124 decode_char_table_range (range, &rainj);
3125 slarg.function = function;
3126 slarg.retval = Qnil;
3127 GCPRO2 (slarg.function, slarg.retval);
3128 map_char_table (ct, &rainj, slow_map_char_table_fun, &slarg);
3131 return slarg.retval;
3135 /************************************************************************/
3136 /* Character Attributes */
3137 /************************************************************************/
3141 Lisp_Object Vchar_attribute_hash_table;
3143 /* We store the char-attributes in hash tables with the names as the
3144 key and the actual char-id-table object as the value. Occasionally
3145 we need to use them in a list format. These routines provide us
3147 struct char_attribute_list_closure
3149 Lisp_Object *char_attribute_list;
3153 add_char_attribute_to_list_mapper (Lisp_Object key, Lisp_Object value,
3154 void *char_attribute_list_closure)
3156 /* This function can GC */
3157 struct char_attribute_list_closure *calcl
3158 = (struct char_attribute_list_closure*) char_attribute_list_closure;
3159 Lisp_Object *char_attribute_list = calcl->char_attribute_list;
3161 *char_attribute_list = Fcons (key, *char_attribute_list);
3165 #ifdef HAVE_LIBCHISE
3167 char_attribute_list_reset_map_func (CHISE_DS *ds, unsigned char *name)
3169 Fmount_char_attribute_table (intern (name));
3173 DEFUN ("char-attribute-list", Fchar_attribute_list, 0, 1, 0, /*
3174 Return the list of all existing character attributes except coded-charsets.
3178 DEFUN ("char-attribute-list", Fchar_attribute_list, 0, 0, 0, /*
3179 Return the list of all existing character attributes except coded-charsets.
3184 Lisp_Object char_attribute_list = Qnil;
3185 struct gcpro gcpro1;
3186 struct char_attribute_list_closure char_attribute_list_closure;
3188 #ifdef HAVE_LIBCHISE
3191 open_chise_data_source_maybe ();
3192 chise_ds_foreach_char_feature_name
3193 (default_chise_data_source, &char_attribute_list_reset_map_func);
3196 GCPRO1 (char_attribute_list);
3197 char_attribute_list_closure.char_attribute_list = &char_attribute_list;
3198 elisp_maphash (add_char_attribute_to_list_mapper,
3199 Vchar_attribute_hash_table,
3200 &char_attribute_list_closure);
3202 return char_attribute_list;
3205 DEFUN ("find-char-attribute-table", Ffind_char_attribute_table, 1, 1, 0, /*
3206 Return char-id-table corresponding to ATTRIBUTE.
3210 return Fgethash (attribute, Vchar_attribute_hash_table, Qnil);
3214 /* We store the char-id-tables in hash tables with the attributes as
3215 the key and the actual char-id-table object as the value. Each
3216 char-id-table stores values of an attribute corresponding with
3217 characters. Occasionally we need to get attributes of a character
3218 in a association-list format. These routines provide us with
3220 struct char_attribute_alist_closure
3223 Lisp_Object *char_attribute_alist;
3227 add_char_attribute_alist_mapper (Lisp_Object key, Lisp_Object value,
3228 void *char_attribute_alist_closure)
3230 /* This function can GC */
3231 struct char_attribute_alist_closure *caacl =
3232 (struct char_attribute_alist_closure*) char_attribute_alist_closure;
3234 = get_char_id_table (XCHAR_TABLE(value), caacl->char_id);
3235 if (!UNBOUNDP (ret))
3237 Lisp_Object *char_attribute_alist = caacl->char_attribute_alist;
3238 *char_attribute_alist
3239 = Fcons (Fcons (key, ret), *char_attribute_alist);
3244 DEFUN ("char-attribute-alist", Fchar_attribute_alist, 1, 1, 0, /*
3245 Return the alist of attributes of CHARACTER.
3249 struct gcpro gcpro1;
3250 struct char_attribute_alist_closure char_attribute_alist_closure;
3251 Lisp_Object alist = Qnil;
3253 CHECK_CHAR (character);
3256 char_attribute_alist_closure.char_id = XCHAR (character);
3257 char_attribute_alist_closure.char_attribute_alist = &alist;
3258 elisp_maphash (add_char_attribute_alist_mapper,
3259 Vchar_attribute_hash_table,
3260 &char_attribute_alist_closure);
3266 DEFUN ("get-char-attribute", Fget_char_attribute, 2, 3, 0, /*
3267 Return the value of CHARACTER's ATTRIBUTE.
3268 Return DEFAULT-VALUE if the value is not exist.
3270 (character, attribute, default_value))
3274 CHECK_CHAR (character);
3276 if (CHARSETP (attribute))
3277 attribute = XCHARSET_NAME (attribute);
3279 table = Fgethash (attribute, Vchar_attribute_hash_table,
3281 if (!UNBOUNDP (table))
3283 Lisp_Object ret = get_char_id_table (XCHAR_TABLE(table),
3285 if (!UNBOUNDP (ret))
3288 return default_value;
3292 find_char_feature_in_family (Lisp_Object character,
3293 Lisp_Object con_feature,
3294 Lisp_Object feature,
3295 Lisp_Object feature_rel_max)
3297 Lisp_Object ancestors
3298 = Fget_char_attribute (character, con_feature, Qnil);
3300 while (!NILP (ancestors))
3302 Lisp_Object ancestor = XCAR (ancestors);
3305 if (EQ (ancestor, character))
3308 ret = Fchar_feature (ancestor, feature, Qunbound,
3309 Qnil, make_int (0));
3310 if (!UNBOUNDP (ret))
3313 ancestors = XCDR (ancestors);
3315 ret = Fget_char_attribute (ancestor, Q_subsumptive_from, Qnil);
3317 ancestors = nconc2 (Fcopy_sequence (ancestors), ret);
3319 ret = Fget_char_attribute (ancestor, Q_denotational_from, Qnil);
3321 ancestors = nconc2 (Fcopy_sequence (ancestors), ret);
3326 DEFUN ("char-feature", Fchar_feature, 2, 5, 0, /*
3327 Return the value of CHARACTER's FEATURE.
3328 Return DEFAULT-VALUE if the value is not exist.
3330 (character, attribute, default_value,
3331 feature_rel_max, char_rel_max))
3334 = Fget_char_attribute (character, attribute, Qunbound);
3336 if (!UNBOUNDP (ret))
3339 if (NILP (feature_rel_max)
3340 || (INTP (feature_rel_max) &&
3341 XINT (feature_rel_max) > 0))
3343 Lisp_String* name = symbol_name (XSYMBOL (attribute));
3344 Bufbyte *name_str = string_data (name);
3346 if (name_str[0] == '=' && name_str[1] == '>')
3348 Bytecount length = string_length (name) - 1;
3349 Lisp_Object map_to = make_uninit_string (length);
3351 memcpy (XSTRING_DATA (map_to) + 1, name_str + 2, length - 1);
3352 XSTRING_DATA(map_to)[0] = '=';
3353 ret = Fchar_feature (character, Fintern (map_to, Qnil),
3355 NILP (feature_rel_max)
3357 : make_int (XINT (feature_rel_max) - 1),
3359 if (!UNBOUNDP (ret))
3364 if ( !(EQ (attribute, Q_identical)) &&
3365 !(EQ (attribute, Q_subsumptive_from)) &&
3366 !(EQ (attribute, Q_denotational_from)) &&
3367 ( (NILP (char_rel_max)
3368 || (INTP (char_rel_max) &&
3369 XINT (char_rel_max) > 0)) ) )
3371 Lisp_String* name = symbol_name (XSYMBOL (attribute));
3372 Bufbyte *name_str = string_data (name);
3374 if ( (name_str[0] != '=') || (name_str[1] == '>') )
3376 ret = find_char_feature_in_family (character, Q_identical,
3377 attribute, feature_rel_max);
3378 if (!UNBOUNDP (ret))
3381 ret = find_char_feature_in_family (character, Q_subsumptive_from,
3382 attribute, feature_rel_max);
3383 if (!UNBOUNDP (ret))
3386 ret = find_char_feature_in_family (character, Q_denotational_from,
3387 attribute, feature_rel_max);
3388 if (!UNBOUNDP (ret))
3392 return default_value;
3396 put_char_composition (Lisp_Object character, Lisp_Object value);
3398 put_char_composition (Lisp_Object character, Lisp_Object value)
3401 signal_simple_error ("Invalid value for =decomposition",
3404 if (CONSP (XCDR (value)))
3406 if (NILP (Fcdr (XCDR (value))))
3408 Lisp_Object base = XCAR (value);
3409 Lisp_Object modifier = XCAR (XCDR (value));
3413 base = make_char (XINT (base));
3414 Fsetcar (value, base);
3416 if (INTP (modifier))
3418 modifier = make_char (XINT (modifier));
3419 Fsetcar (XCDR (value), modifier);
3424 = Fchar_feature (base, Qcomposition, Qnil,
3426 Lisp_Object ret = Fassq (modifier, alist);
3429 Fput_char_attribute (base, Qcomposition,
3430 Fcons (Fcons (modifier, character),
3433 Fsetcdr (ret, character);
3435 else if (EQ (base, Qnarrow))
3436 return Q_halfwidth_of;
3437 else if (EQ (base, Qsuper))
3438 return Q_superscript_of;
3439 else if (EQ (base, Qsub))
3440 return Q_subscript_of;
3441 else if (EQ (base, Qcircle))
3442 return Q_circled_of;
3443 else if ( EQ (base, Qisolated)||
3444 EQ (base, Qinitial) ||
3445 EQ (base, Qmedial) ||
3448 Fintern (concat2 (build_string ("<-formed@"),
3449 Fsymbol_name (base)),
3451 else if (SYMBOLP (base))
3453 Fintern (concat2 (build_string ("<-"),
3454 Fsymbol_name (base)),
3457 else if (EQ (XCAR (value), Qsuper))
3458 return Qto_decomposition_at_superscript;
3459 else if (EQ (XCAR (value), Qcircle))
3460 return Qto_decomposition_at_circled;
3463 Fintern (concat2 (build_string ("=>decomposition@"),
3464 Fsymbol_name (XCAR (value))),
3471 Lisp_Object v = Fcar (value);
3475 Emchar c = DECODE_CHAR (Vcharset_ucs, XINT (v), 0);
3477 = Fchar_feature (make_char (c), Q_ucs_unified, Qnil,
3482 Fput_char_attribute (make_char (c), Q_ucs_unified,
3483 Fcons (character, Qnil));
3485 else if (NILP (Fmemq (character, ret)))
3487 Fput_char_attribute (make_char (c), Q_ucs_unified,
3488 Fcons (character, ret));
3493 return Qmap_decomposition;
3497 put_char_attribute (Lisp_Object character, Lisp_Object attribute,
3500 Lisp_Object table = Fgethash (attribute,
3501 Vchar_attribute_hash_table,
3506 table = make_char_id_table (Qunbound);
3507 Fputhash (attribute, table, Vchar_attribute_hash_table);
3509 XCHAR_TABLE_NAME (table) = attribute;
3512 put_char_id_table (XCHAR_TABLE(table), character, value);
3516 DEFUN ("put-char-attribute", Fput_char_attribute, 3, 3, 0, /*
3517 Store CHARACTER's ATTRIBUTE with VALUE.
3519 (character, attribute, value))
3521 Lisp_Object ccs = Ffind_charset (attribute);
3523 CHECK_CHAR (character);
3527 value = put_char_ccs_code_point (character, ccs, value);
3528 attribute = XCHARSET_NAME (ccs);
3530 else if ( EQ (attribute, Qmap_decomposition) ||
3531 EQ (attribute, Q_decomposition) )
3533 attribute = put_char_composition (character, value);
3534 if ( !EQ (attribute, Qmap_decomposition) &&
3535 SYMBOLP (XCAR (value)) )
3536 value = XCDR (value);
3538 else if (EQ (attribute, Qto_ucs))
3544 signal_simple_error ("Invalid value for =>ucs", value);
3546 c = DECODE_CHAR (Vcharset_ucs, XINT (value), 0);
3548 ret = Fchar_feature (make_char (c), Q_ucs_unified, Qnil,
3551 put_char_attribute (make_char (c), Q_ucs_unified,
3553 else if (NILP (Fmemq (character, ret)))
3554 Fput_char_attribute (make_char (c), Q_ucs_unified,
3555 Fcons (character, ret));
3557 if ( EQ (attribute, Q_subsumptive) ||
3558 EQ (attribute, Q_subsumptive_from) ||
3559 EQ (attribute, Q_denotational) ||
3560 EQ (attribute, Q_denotational_from) ||
3561 EQ (attribute, Q_identical) ||
3562 EQ (attribute, Q_identical_from) ||
3563 EQ (attribute, Q_canonical) ||
3564 EQ (attribute, Q_halfwidth_of) ||
3565 EQ (attribute, Q_superscript_of) ||
3566 EQ (attribute, Q_subscript_of) ||
3567 EQ (attribute, Q_circled_of) ||
3568 EQ (attribute, Q_component) ||
3569 EQ (attribute, Q_component_of) ||
3570 !NILP (Fstring_match
3571 (build_string ("^\\(<-\\|->\\)\\("
3573 "\\|halfwidth\\|superscript\\|subscript"
3574 "\\|circled\\|font\\|compat"
3575 "\\|fullwidth\\|halfwidth"
3576 "\\|simplified\\|vulgar\\|wrong"
3577 "\\|same\\|original\\|ancient"
3578 "\\|Oracle-Bones\\)[^*]*$"),
3579 Fsymbol_name (attribute),
3582 Lisp_Object rest = value;
3584 Lisp_Object rev_feature = Qnil;
3585 struct gcpro gcpro1;
3586 GCPRO1 (rev_feature);
3588 if (EQ (attribute, Q_identical))
3589 rev_feature = Q_identical_from;
3590 else if (EQ (attribute, Q_identical_from))
3591 rev_feature = Q_identical;
3592 else if (EQ (attribute, Q_subsumptive))
3593 rev_feature = Q_subsumptive_from;
3594 else if (EQ (attribute, Q_subsumptive_from))
3595 rev_feature = Q_subsumptive;
3596 else if (EQ (attribute, Q_denotational))
3597 rev_feature = Q_denotational_from;
3598 else if (EQ (attribute, Q_denotational_from))
3599 rev_feature = Q_denotational;
3600 else if (EQ (attribute, Q_component))
3601 rev_feature = Q_component_of;
3602 else if (EQ (attribute, Q_component_of))
3603 rev_feature = Q_component;
3606 Lisp_String* name = symbol_name (XSYMBOL (attribute));
3607 Bufbyte *name_str = string_data (name);
3609 if ( (name_str[0] == '<' && name_str[1] == '-') ||
3610 (name_str[0] == '-' && name_str[1] == '>') )
3612 Bytecount length = string_length (name);
3613 Bufbyte *rev_name_str = alloca (length + 1);
3615 memcpy (rev_name_str + 2, name_str + 2, length - 2);
3616 if (name_str[0] == '<')
3618 rev_name_str[0] = '-';
3619 rev_name_str[1] = '>';
3623 rev_name_str[0] = '<';
3624 rev_name_str[1] = '-';
3626 rev_name_str[length] = 0;
3627 rev_feature = intern (rev_name_str);
3631 while (CONSP (rest))
3636 ret = Fdefine_char (ret);
3637 else if (INTP (ret))
3639 int code_point = XINT (ret);
3640 Emchar cid = DECODE_CHAR (Vcharset_ucs, code_point, 0);
3643 ret = make_char (cid);
3645 ret = make_char (code_point);
3648 if ( !NILP (ret) && !EQ (ret, character) )
3652 ffv = Fget_char_attribute (ret, rev_feature, Qnil);
3654 put_char_attribute (ret, rev_feature, list1 (character));
3655 else if (NILP (Fmemq (character, ffv)))
3658 nconc2 (Fcopy_sequence (ffv), list1 (character)));
3659 Fsetcar (rest, ret);
3666 else if ( EQ (attribute, Qideographic_structure) ||
3667 !NILP (Fstring_match
3668 (build_string ("^=>decomposition\\(\\|@[^*]+\\)$"),
3669 Fsymbol_name (attribute),
3671 value = Fcopy_sequence (Fchar_refs_simplify_char_specs (value));
3673 return put_char_attribute (character, attribute, value);
3676 DEFUN ("remove-char-attribute", Fremove_char_attribute, 2, 2, 0, /*
3677 Remove CHARACTER's ATTRIBUTE.
3679 (character, attribute))
3683 CHECK_CHAR (character);
3684 ccs = Ffind_charset (attribute);
3687 return remove_char_ccs (character, ccs);
3691 Lisp_Object table = Fgethash (attribute,
3692 Vchar_attribute_hash_table,
3694 if (!UNBOUNDP (table))
3696 put_char_id_table (XCHAR_TABLE(table), character, Qunbound);
3705 int char_table_open_db_maybe (Lisp_Char_Table* cit);
3706 void char_table_close_db_maybe (Lisp_Char_Table* cit);
3707 Lisp_Object char_table_get_db (Lisp_Char_Table* cit, Emchar ch);
3709 #ifdef HAVE_LIBCHISE
3711 open_chise_data_source_maybe ()
3713 if (default_chise_data_source == NULL)
3715 Lisp_Object db_dir = Vdata_directory;
3716 int modemask = 0755; /* rwxr-xr-x */
3719 db_dir = build_string ("../etc");
3720 db_dir = Fexpand_file_name (build_string ("chise-db"), db_dir);
3722 default_chise_data_source
3723 = CHISE_DS_open (CHISE_DS_Berkeley_DB, XSTRING_DATA (db_dir),
3724 0 /* DB_HASH */, modemask);
3725 if (default_chise_data_source == NULL)
3728 chise_ds_set_make_string_function (default_chise_data_source,
3734 #endif /* HAVE_LIBCHISE */
3736 DEFUN ("close-char-data-source", Fclose_char_data_source, 0, 0, 0, /*
3737 Close data-source of CHISE.
3741 #ifdef HAVE_LIBCHISE
3742 int status = CHISE_DS_close (default_chise_data_source);
3744 default_chise_data_source = NULL;
3747 #endif /* HAVE_LIBCHISE */
3752 char_table_open_db_maybe (Lisp_Char_Table* cit)
3754 Lisp_Object attribute = CHAR_TABLE_NAME (cit);
3756 if (!NILP (attribute))
3758 #ifdef HAVE_LIBCHISE
3759 if ( open_chise_data_source_maybe () )
3761 #else /* HAVE_LIBCHISE */
3762 if (NILP (Fdatabase_live_p (cit->db)))
3765 = char_attribute_system_db_file (Qsystem_char_id, attribute, 0);
3767 cit->db = Fopen_database (db_file, Qnil, Qnil,
3768 build_string ("r"), Qnil);
3772 #endif /* not HAVE_LIBCHISE */
3780 char_table_close_db_maybe (Lisp_Char_Table* cit)
3782 #ifndef HAVE_LIBCHISE
3783 if (!NILP (cit->db))
3785 if (!NILP (Fdatabase_live_p (cit->db)))
3786 Fclose_database (cit->db);
3789 #endif /* not HAVE_LIBCHISE */
3793 char_table_get_db (Lisp_Char_Table* cit, Emchar ch)
3796 #ifdef HAVE_LIBCHISE
3799 = chise_ds_load_char_feature_value (default_chise_data_source, ch,
3800 XSTRING_DATA(Fsymbol_name
3807 val = Fread (make_string (chise_value_data (&value),
3808 chise_value_size (&value) ));
3810 val = read_from_c_string (chise_value_data (&value),
3811 chise_value_size (&value) );
3816 #else /* HAVE_LIBCHISE */
3817 val = Fget_database (Fprin1_to_string (make_char (ch), Qnil),
3819 if (!UNBOUNDP (val))
3823 #endif /* not HAVE_LIBCHISE */
3827 #ifndef HAVE_LIBCHISE
3829 char_attribute_system_db_file (Lisp_Object key_type, Lisp_Object attribute,
3832 Lisp_Object db_dir = Vdata_directory;
3835 db_dir = build_string ("../etc");
3837 db_dir = Fexpand_file_name (build_string ("chise-db"), db_dir);
3838 if (writing_mode && NILP (Ffile_exists_p (db_dir)))
3839 Fmake_directory_internal (db_dir);
3841 db_dir = Fexpand_file_name (Fsymbol_name (key_type), db_dir);
3842 if (writing_mode && NILP (Ffile_exists_p (db_dir)))
3843 Fmake_directory_internal (db_dir);
3846 Lisp_Object attribute_name = Fsymbol_name (attribute);
3847 Lisp_Object dest = Qnil, ret;
3849 struct gcpro gcpro1, gcpro2;
3850 int len = XSTRING_CHAR_LENGTH (attribute_name);
3854 for (i = 0; i < len; i++)
3856 Emchar c = string_char (XSTRING (attribute_name), i);
3858 if ( (c == '/') || (c == '%') )
3862 sprintf (str, "%%%02X", c);
3863 dest = concat3 (dest,
3864 Fsubstring (attribute_name,
3865 make_int (base), make_int (i)),
3866 build_string (str));
3870 ret = Fsubstring (attribute_name, make_int (base), make_int (len));
3871 dest = concat2 (dest, ret);
3873 return Fexpand_file_name (dest, db_dir);
3876 #endif /* not HAVE_LIBCHISE */
3878 DEFUN ("save-char-attribute-table", Fsave_char_attribute_table, 1, 1, 0, /*
3879 Save values of ATTRIBUTE into database file.
3883 Lisp_Object table = Fgethash (attribute,
3884 Vchar_attribute_hash_table, Qunbound);
3885 Lisp_Char_Table *ct;
3886 #ifdef HAVE_LIBCHISE
3887 CHISE_Feature feature;
3888 #else /* HAVE_LIBCHISE */
3889 Lisp_Object db_file;
3891 #endif /* not HAVE_LIBCHISE */
3893 if (CHAR_TABLEP (table))
3894 ct = XCHAR_TABLE (table);
3898 #ifdef HAVE_LIBCHISE
3899 if ( open_chise_data_source_maybe () )
3902 = chise_ds_get_feature (default_chise_data_source,
3903 XSTRING_DATA (Fsymbol_name (attribute)));
3904 #else /* HAVE_LIBCHISE */
3905 db_file = char_attribute_system_db_file (Qsystem_char_id, attribute, 1);
3906 db = Fopen_database (db_file, Qnil, Qnil, build_string ("w+"), Qnil);
3907 #endif /* not HAVE_LIBCHISE */
3909 #ifdef HAVE_LIBCHISE
3911 #else /* HAVE_LIBCHISE */
3913 #endif /* not HAVE_LIBCHISE */
3916 Lisp_Object (*filter)(Lisp_Object value);
3918 if ( !NILP (Ffind_charset (attribute)) )
3920 else if ( EQ (attribute, Qideographic_structure) ||
3921 EQ (attribute, Q_identical) ||
3922 EQ (attribute, Q_identical_from) ||
3923 EQ (attribute, Q_canonical) ||
3924 EQ (attribute, Q_halfwidth_of) ||
3925 EQ (attribute, Q_superscript_of) ||
3926 EQ (attribute, Q_subscript_of) ||
3927 EQ (attribute, Q_circled_of) ||
3928 !NILP (Fstring_match
3929 (build_string ("^\\(<-\\|->\\)\\(simplified"
3930 "\\|same\\|vulgar\\|wrong"
3931 "\\|original\\|ancient"
3932 "\\|Oracle-Bones\\)[^*]*$"),
3933 Fsymbol_name (attribute),
3935 filter = &Fchar_refs_simplify_char_specs;
3939 if (UINT8_BYTE_TABLE_P (ct->table))
3940 save_uint8_byte_table (XUINT8_BYTE_TABLE(ct->table), ct,
3941 #ifdef HAVE_LIBCHISE
3943 #else /* HAVE_LIBCHISE */
3945 #endif /* not HAVE_LIBCHISE */
3947 else if (UINT16_BYTE_TABLE_P (ct->table))
3948 save_uint16_byte_table (XUINT16_BYTE_TABLE(ct->table), ct,
3949 #ifdef HAVE_LIBCHISE
3951 #else /* HAVE_LIBCHISE */
3953 #endif /* not HAVE_LIBCHISE */
3955 else if (BYTE_TABLE_P (ct->table))
3956 save_byte_table (XBYTE_TABLE(ct->table), ct,
3957 #ifdef HAVE_LIBCHISE
3959 #else /* HAVE_LIBCHISE */
3961 #endif /* not HAVE_LIBCHISE */
3963 #ifdef HAVE_LIBCHISE
3964 chise_feature_sync (feature);
3965 #else /* HAVE_LIBCHISE */
3966 Fclose_database (db);
3967 #endif /* not HAVE_LIBCHISE */
3974 DEFUN ("mount-char-attribute-table", Fmount_char_attribute_table, 1, 1, 0, /*
3975 Mount database file on char-attribute-table ATTRIBUTE.
3979 Lisp_Object table = Fgethash (attribute,
3980 Vchar_attribute_hash_table, Qunbound);
3982 if (UNBOUNDP (table))
3984 Lisp_Char_Table *ct;
3986 table = make_char_id_table (Qunbound);
3987 Fputhash (attribute, table, Vchar_attribute_hash_table);
3988 XCHAR_TABLE_NAME(table) = attribute;
3989 ct = XCHAR_TABLE (table);
3990 ct->table = Qunloaded;
3991 XCHAR_TABLE_UNLOADED(table) = 1;
3992 #ifndef HAVE_LIBCHISE
3994 #endif /* not HAVE_LIBCHISE */
4000 DEFUN ("close-char-attribute-table", Fclose_char_attribute_table, 1, 1, 0, /*
4001 Close database of ATTRIBUTE.
4005 Lisp_Object table = Fgethash (attribute,
4006 Vchar_attribute_hash_table, Qunbound);
4007 Lisp_Char_Table *ct;
4009 if (CHAR_TABLEP (table))
4010 ct = XCHAR_TABLE (table);
4013 char_table_close_db_maybe (ct);
4017 DEFUN ("reset-char-attribute-table", Freset_char_attribute_table, 1, 1, 0, /*
4018 Reset values of ATTRIBUTE with database file.
4022 #ifdef HAVE_LIBCHISE
4023 CHISE_Feature feature
4024 = chise_ds_get_feature (default_chise_data_source,
4025 XSTRING_DATA (Fsymbol_name
4028 if (feature == NULL)
4031 if (chise_feature_setup_db (feature, 0) == 0)
4033 Lisp_Object table = Fgethash (attribute,
4034 Vchar_attribute_hash_table, Qunbound);
4035 Lisp_Char_Table *ct;
4037 chise_feature_sync (feature);
4038 if (UNBOUNDP (table))
4040 table = make_char_id_table (Qunbound);
4041 Fputhash (attribute, table, Vchar_attribute_hash_table);
4042 XCHAR_TABLE_NAME(table) = attribute;
4044 ct = XCHAR_TABLE (table);
4045 ct->table = Qunloaded;
4046 char_table_close_db_maybe (ct);
4047 XCHAR_TABLE_UNLOADED(table) = 1;
4051 Lisp_Object table = Fgethash (attribute,
4052 Vchar_attribute_hash_table, Qunbound);
4053 Lisp_Char_Table *ct;
4055 = char_attribute_system_db_file (Qsystem_char_id, attribute, 0);
4057 if (!NILP (Ffile_exists_p (db_file)))
4059 if (UNBOUNDP (table))
4061 table = make_char_id_table (Qunbound);
4062 Fputhash (attribute, table, Vchar_attribute_hash_table);
4063 XCHAR_TABLE_NAME(table) = attribute;
4065 ct = XCHAR_TABLE (table);
4066 ct->table = Qunloaded;
4067 char_table_close_db_maybe (ct);
4068 XCHAR_TABLE_UNLOADED(table) = 1;
4076 load_char_attribute_maybe (Lisp_Char_Table* cit, Emchar ch)
4078 Lisp_Object attribute = CHAR_TABLE_NAME (cit);
4080 if (!NILP (attribute))
4084 if (char_table_open_db_maybe (cit))
4087 val = char_table_get_db (cit, ch);
4089 if (!NILP (Vchar_db_stingy_mode))
4090 char_table_close_db_maybe (cit);
4097 Lisp_Char_Table* char_attribute_table_to_load;
4099 #ifdef HAVE_LIBCHISE
4101 load_char_attribute_table_map_func (CHISE_Char_ID cid,
4102 CHISE_Feature feature,
4103 CHISE_Value *value);
4105 load_char_attribute_table_map_func (CHISE_Char_ID cid,
4106 CHISE_Feature feature,
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,
4114 Fread (make_string ((Bufbyte *) value->data,
4118 #else /* HAVE_LIBCHISE */
4119 Lisp_Object Qload_char_attribute_table_map_function;
4121 DEFUN ("load-char-attribute-table-map-function",
4122 Fload_char_attribute_table_map_function, 2, 2, 0, /*
4123 For internal use. Don't use it.
4127 Lisp_Object c = Fread (key);
4128 Emchar code = XCHAR (c);
4129 Lisp_Object ret = get_char_id_table_0 (char_attribute_table_to_load, code);
4131 if (EQ (ret, Qunloaded))
4132 put_char_id_table_0 (char_attribute_table_to_load, code, Fread (value));
4135 #endif /* not HAVE_LIBCHISE */
4137 DEFUN ("load-char-attribute-table", Fload_char_attribute_table, 1, 1, 0, /*
4138 Load values of ATTRIBUTE into database file.
4142 Lisp_Object table = Fgethash (attribute,
4143 Vchar_attribute_hash_table,
4145 if (CHAR_TABLEP (table))
4147 Lisp_Char_Table *cit = XCHAR_TABLE (table);
4149 if (char_table_open_db_maybe (cit))
4152 char_attribute_table_to_load = XCHAR_TABLE (table);
4154 struct gcpro gcpro1;
4157 #ifdef HAVE_LIBCHISE
4158 chise_feature_foreach_char_with_value
4159 (chise_ds_get_feature (default_chise_data_source,
4160 XSTRING_DATA (Fsymbol_name (cit->name))),
4161 &load_char_attribute_table_map_func);
4162 #else /* HAVE_LIBCHISE */
4163 Fmap_database (Qload_char_attribute_table_map_function, cit->db);
4164 #endif /* not HAVE_LIBCHISE */
4167 char_table_close_db_maybe (cit);
4168 XCHAR_TABLE_UNLOADED(table) = 0;
4173 #endif /* HAVE_CHISE */
4175 DEFUN ("map-char-attribute", Fmap_char_attribute, 2, 3, 0, /*
4176 Map FUNCTION over entries in ATTRIBUTE, calling it with two args,
4177 each key and value in the table.
4179 RANGE specifies a subrange to map over and is in the same format as
4180 the RANGE argument to `put-range-table'. If omitted or t, it defaults to
4183 (function, attribute, range))
4186 Lisp_Char_Table *ct;
4187 struct slow_map_char_table_arg slarg;
4188 struct gcpro gcpro1, gcpro2;
4189 struct chartab_range rainj;
4191 if (!NILP (ccs = Ffind_charset (attribute)))
4193 Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (ccs);
4195 if (CHAR_TABLEP (encoding_table))
4196 ct = XCHAR_TABLE (encoding_table);
4202 Lisp_Object table = Fgethash (attribute,
4203 Vchar_attribute_hash_table,
4205 if (CHAR_TABLEP (table))
4206 ct = XCHAR_TABLE (table);
4212 decode_char_table_range (range, &rainj);
4214 if (CHAR_TABLE_UNLOADED(ct))
4215 Fload_char_attribute_table (attribute);
4217 slarg.function = function;
4218 slarg.retval = Qnil;
4219 GCPRO2 (slarg.function, slarg.retval);
4220 map_char_table (ct, &rainj, slow_map_char_table_fun, &slarg);
4223 return slarg.retval;
4226 DEFUN ("define-char", Fdefine_char, 1, 1, 0, /*
4227 Store character's ATTRIBUTES.
4232 Lisp_Object code = Fcdr (Fassq (Qmap_ucs, attributes));
4233 Lisp_Object character;
4236 code = Fcdr (Fassq (Qucs, attributes));
4241 while (CONSP (rest))
4243 Lisp_Object cell = Fcar (rest);
4246 if ( !LISTP (cell) )
4247 signal_simple_error ("Invalid argument", attributes);
4249 ccs = Ffind_charset (Fcar (cell));
4255 character = Fdecode_char (ccs, cell, Qt, Qt);
4256 if (!NILP (character))
4257 goto setup_attributes;
4259 if ( (XCHARSET_FINAL (ccs) != 0) ||
4260 (XCHARSET_MAX_CODE (ccs) > 0) ||
4261 (EQ (ccs, Vcharset_chinese_big5)) )
4265 = Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
4267 character = Fdecode_char (ccs, cell, Qnil, Qt);
4268 if (!NILP (character))
4269 goto setup_attributes;
4276 int cid = XINT (Vnext_defined_char_id);
4278 if (cid <= 0xE00000)
4280 character = make_char (cid);
4281 Vnext_defined_char_id = make_int (cid + 1);
4282 goto setup_attributes;
4286 if ( (!NILP (code = Fcdr (Fassq (Qto_ucs, attributes)))) )
4289 signal_simple_error ("Invalid argument", attributes);
4291 character = make_char (XINT (code) + 0x100000);
4292 goto setup_attributes;
4297 else if (!INTP (code))
4298 signal_simple_error ("Invalid argument", attributes);
4300 character = make_char (XINT (code));
4304 while (CONSP (rest))
4306 Lisp_Object cell = Fcar (rest);
4309 signal_simple_error ("Invalid argument", attributes);
4311 Fput_char_attribute (character, Fcar (cell), Fcdr (cell));
4317 DEFUN ("find-char", Ffind_char, 1, 1, 0, /*
4318 Retrieve the character of the given ATTRIBUTES.
4322 Lisp_Object rest = attributes;
4325 while (CONSP (rest))
4327 Lisp_Object cell = Fcar (rest);
4331 signal_simple_error ("Invalid argument", attributes);
4332 if (!NILP (ccs = Ffind_charset (Fcar (cell))))
4336 return Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
4338 return Fdecode_char (ccs, cell, Qnil, Qnil);
4342 if ( (!NILP (code = Fcdr (Fassq (Qto_ucs, attributes)))) )
4345 signal_simple_error ("Invalid argument", attributes);
4347 return make_char (XINT (code) + 0x100000);
4355 /************************************************************************/
4356 /* Char table read syntax */
4357 /************************************************************************/
4360 chartab_type_validate (Lisp_Object keyword, Lisp_Object value,
4361 Error_behavior errb)
4363 /* #### should deal with ERRB */
4364 symbol_to_char_table_type (value);
4369 chartab_data_validate (Lisp_Object keyword, Lisp_Object value,
4370 Error_behavior errb)
4374 /* #### should deal with ERRB */
4375 EXTERNAL_LIST_LOOP (rest, value)
4377 Lisp_Object range = XCAR (rest);
4378 struct chartab_range dummy;
4382 signal_simple_error ("Invalid list format", value);
4385 if (!CONSP (XCDR (range))
4386 || !NILP (XCDR (XCDR (range))))
4387 signal_simple_error ("Invalid range format", range);
4388 decode_char_table_range (XCAR (range), &dummy);
4389 decode_char_table_range (XCAR (XCDR (range)), &dummy);
4392 decode_char_table_range (range, &dummy);
4399 chartab_instantiate (Lisp_Object data)
4401 Lisp_Object chartab;
4402 Lisp_Object type = Qgeneric;
4403 Lisp_Object dataval = Qnil;
4405 while (!NILP (data))
4407 Lisp_Object keyw = Fcar (data);
4413 if (EQ (keyw, Qtype))
4415 else if (EQ (keyw, Qdata))
4419 chartab = Fmake_char_table (type);
4422 while (!NILP (data))
4424 Lisp_Object range = Fcar (data);
4425 Lisp_Object val = Fcar (Fcdr (data));
4427 data = Fcdr (Fcdr (data));
4430 if (CHAR_OR_CHAR_INTP (XCAR (range)))
4432 Emchar first = XCHAR_OR_CHAR_INT (Fcar (range));
4433 Emchar last = XCHAR_OR_CHAR_INT (Fcar (Fcdr (range)));
4436 for (i = first; i <= last; i++)
4437 Fput_char_table (make_char (i), val, chartab);
4443 Fput_char_table (range, val, chartab);
4452 /************************************************************************/
4453 /* Category Tables, specifically */
4454 /************************************************************************/
4456 DEFUN ("category-table-p", Fcategory_table_p, 1, 1, 0, /*
4457 Return t if OBJECT is a category table.
4458 A category table is a type of char table used for keeping track of
4459 categories. Categories are used for classifying characters for use
4460 in regexps -- you can refer to a category rather than having to use
4461 a complicated [] expression (and category lookups are significantly
4464 There are 95 different categories available, one for each printable
4465 character (including space) in the ASCII charset. Each category
4466 is designated by one such character, called a "category designator".
4467 They are specified in a regexp using the syntax "\\cX", where X is
4468 a category designator.
4470 A category table specifies, for each character, the categories that
4471 the character is in. Note that a character can be in more than one
4472 category. More specifically, a category table maps from a character
4473 to either the value nil (meaning the character is in no categories)
4474 or a 95-element bit vector, specifying for each of the 95 categories
4475 whether the character is in that category.
4477 Special Lisp functions are provided that abstract this, so you do not
4478 have to directly manipulate bit vectors.
4482 return (CHAR_TABLEP (object) &&
4483 XCHAR_TABLE_TYPE (object) == CHAR_TABLE_TYPE_CATEGORY) ?
4488 check_category_table (Lisp_Object object, Lisp_Object default_)
4492 while (NILP (Fcategory_table_p (object)))
4493 object = wrong_type_argument (Qcategory_table_p, object);
4498 check_category_char (Emchar ch, Lisp_Object table,
4499 unsigned int designator, unsigned int not_p)
4501 REGISTER Lisp_Object temp;
4502 Lisp_Char_Table *ctbl;
4503 #ifdef ERROR_CHECK_TYPECHECK
4504 if (NILP (Fcategory_table_p (table)))
4505 signal_simple_error ("Expected category table", table);
4507 ctbl = XCHAR_TABLE (table);
4508 temp = get_char_table (ch, ctbl);
4513 return bit_vector_bit (XBIT_VECTOR (temp), designator) ? !not_p : not_p;
4516 DEFUN ("check-category-at", Fcheck_category_at, 2, 4, 0, /*
4517 Return t if category of the character at POSITION includes DESIGNATOR.
4518 Optional third arg BUFFER specifies which buffer to use, and defaults
4519 to the current buffer.
4520 Optional fourth arg CATEGORY-TABLE specifies the category table to
4521 use, and defaults to BUFFER's category table.
4523 (position, designator, buffer, category_table))
4528 struct buffer *buf = decode_buffer (buffer, 0);
4530 CHECK_INT (position);
4531 CHECK_CATEGORY_DESIGNATOR (designator);
4532 des = XCHAR (designator);
4533 ctbl = check_category_table (category_table, Vstandard_category_table);
4534 ch = BUF_FETCH_CHAR (buf, XINT (position));
4535 return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil;
4538 DEFUN ("char-in-category-p", Fchar_in_category_p, 2, 3, 0, /*
4539 Return t if category of CHARACTER includes DESIGNATOR, else nil.
4540 Optional third arg CATEGORY-TABLE specifies the category table to use,
4541 and defaults to the standard category table.
4543 (character, designator, category_table))
4549 CHECK_CATEGORY_DESIGNATOR (designator);
4550 des = XCHAR (designator);
4551 CHECK_CHAR (character);
4552 ch = XCHAR (character);
4553 ctbl = check_category_table (category_table, Vstandard_category_table);
4554 return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil;
4557 DEFUN ("category-table", Fcategory_table, 0, 1, 0, /*
4558 Return BUFFER's current category table.
4559 BUFFER defaults to the current buffer.
4563 return decode_buffer (buffer, 0)->category_table;
4566 DEFUN ("standard-category-table", Fstandard_category_table, 0, 0, 0, /*
4567 Return the standard category table.
4568 This is the one used for new buffers.
4572 return Vstandard_category_table;
4575 DEFUN ("copy-category-table", Fcopy_category_table, 0, 1, 0, /*
4576 Return a new category table which is a copy of CATEGORY-TABLE.
4577 CATEGORY-TABLE defaults to the standard category table.
4581 if (NILP (Vstandard_category_table))
4582 return Fmake_char_table (Qcategory);
4585 check_category_table (category_table, Vstandard_category_table);
4586 return Fcopy_char_table (category_table);
4589 DEFUN ("set-category-table", Fset_category_table, 1, 2, 0, /*
4590 Select CATEGORY-TABLE as the new category table for BUFFER.
4591 BUFFER defaults to the current buffer if omitted.
4593 (category_table, buffer))
4595 struct buffer *buf = decode_buffer (buffer, 0);
4596 category_table = check_category_table (category_table, Qnil);
4597 buf->category_table = category_table;
4598 /* Indicate that this buffer now has a specified category table. */
4599 buf->local_var_flags |= XINT (buffer_local_flags.category_table);
4600 return category_table;
4603 DEFUN ("category-designator-p", Fcategory_designator_p, 1, 1, 0, /*
4604 Return t if OBJECT is a category designator (a char in the range ' ' to '~').
4608 return CATEGORY_DESIGNATORP (object) ? Qt : Qnil;
4611 DEFUN ("category-table-value-p", Fcategory_table_value_p, 1, 1, 0, /*
4612 Return t if OBJECT is a category table value.
4613 Valid values are nil or a bit vector of size 95.
4617 return CATEGORY_TABLE_VALUEP (object) ? Qt : Qnil;
4621 #define CATEGORYP(x) \
4622 (CHARP (x) && XCHAR (x) >= 0x20 && XCHAR (x) <= 0x7E)
4624 #define CATEGORY_SET(c) \
4625 (get_char_table(c, XCHAR_TABLE(current_buffer->category_table)))
4627 /* Return 1 if CATEGORY_SET contains CATEGORY, else return 0.
4628 The faster version of `!NILP (Faref (category_set, category))'. */
4629 #define CATEGORY_MEMBER(category, category_set) \
4630 (bit_vector_bit(XBIT_VECTOR (category_set), category - 32))
4632 /* Return 1 if there is a word boundary between two word-constituent
4633 characters C1 and C2 if they appear in this order, else return 0.
4634 Use the macro WORD_BOUNDARY_P instead of calling this function
4637 int word_boundary_p (Emchar c1, Emchar c2);
4639 word_boundary_p (Emchar c1, Emchar c2)
4641 Lisp_Object category_set1, category_set2;
4646 if (COMPOSITE_CHAR_P (c1))
4647 c1 = cmpchar_component (c1, 0, 1);
4648 if (COMPOSITE_CHAR_P (c2))
4649 c2 = cmpchar_component (c2, 0, 1);
4653 if (EQ (CHAR_CHARSET (c1), CHAR_CHARSET (c2)))
4656 tail = Vword_separating_categories;
4662 tail = Vword_combining_categories;
4667 category_set1 = CATEGORY_SET (c1);
4668 if (NILP (category_set1))
4669 return default_result;
4670 category_set2 = CATEGORY_SET (c2);
4671 if (NILP (category_set2))
4672 return default_result;
4674 for (; CONSP (tail); tail = XCONS (tail)->cdr)
4676 Lisp_Object elt = XCONS(tail)->car;
4679 && CATEGORYP (XCONS (elt)->car)
4680 && CATEGORYP (XCONS (elt)->cdr)
4681 && CATEGORY_MEMBER (XCHAR (XCONS (elt)->car), category_set1)
4682 && CATEGORY_MEMBER (XCHAR (XCONS (elt)->cdr), category_set2))
4683 return !default_result;
4685 return default_result;
4691 syms_of_chartab (void)
4694 INIT_LRECORD_IMPLEMENTATION (uint8_byte_table);
4695 INIT_LRECORD_IMPLEMENTATION (uint16_byte_table);
4696 INIT_LRECORD_IMPLEMENTATION (byte_table);
4698 defsymbol (&Qto_ucs, "=>ucs");
4699 defsymbol (&Q_ucs_unified, "->ucs-unified");
4700 defsymbol (&Q_subsumptive, "->subsumptive");
4701 defsymbol (&Q_subsumptive_from, "<-subsumptive");
4702 defsymbol (&Q_denotational, "->denotational");
4703 defsymbol (&Q_denotational_from, "<-denotational");
4704 defsymbol (&Q_identical, "->identical");
4705 defsymbol (&Q_identical_from, "<-identical");
4706 defsymbol (&Q_component, "->ideographic-component-forms");
4707 defsymbol (&Q_component_of, "<-ideographic-component-forms");
4708 defsymbol (&Qcomposition, "composition");
4709 defsymbol (&Qmap_decomposition, "=decomposition");
4710 defsymbol (&Qto_decomposition_at_superscript,
4711 "=>decomposition@superscript");
4712 defsymbol (&Qto_decomposition_at_circled, "=>decomposition@circled");
4713 defsymbol (&Q_canonical, "->canonical");
4714 defsymbol (&Q_halfwidth_of, "<-halfwidth");
4715 defsymbol (&Q_superscript_of, "<-superscript");
4716 defsymbol (&Q_subscript_of, "<-subscript");
4717 defsymbol (&Q_circled_of, "<-circled");
4718 defsymbol (&Q_decomposition, "->decomposition");
4719 defsymbol (&Qcompat, "compat");
4720 defsymbol (&Qisolated, "isolated");
4721 defsymbol (&Qinitial, "initial");
4722 defsymbol (&Qmedial, "medial");
4723 defsymbol (&Qfinal, "final");
4724 defsymbol (&Qvertical, "vertical");
4725 defsymbol (&QnoBreak, "noBreak");
4726 defsymbol (&Qfraction, "fraction");
4727 defsymbol (&Qsuper, "super");
4728 defsymbol (&Qsub, "sub");
4729 defsymbol (&Qcircle, "circle");
4730 defsymbol (&Qsquare, "square");
4731 defsymbol (&Qwide, "wide");
4732 defsymbol (&Qnarrow, "narrow");
4733 defsymbol (&Qsmall, "small");
4734 defsymbol (&Qfont, "font");
4736 DEFSUBR (Fchar_attribute_list);
4737 DEFSUBR (Ffind_char_attribute_table);
4738 defsymbol (&Qput_char_table_map_function, "put-char-table-map-function");
4739 DEFSUBR (Fput_char_table_map_function);
4741 DEFSUBR (Fsave_char_attribute_table);
4742 DEFSUBR (Fmount_char_attribute_table);
4743 DEFSUBR (Freset_char_attribute_table);
4744 DEFSUBR (Fclose_char_attribute_table);
4745 DEFSUBR (Fclose_char_data_source);
4746 #ifndef HAVE_LIBCHISE
4747 defsymbol (&Qload_char_attribute_table_map_function,
4748 "load-char-attribute-table-map-function");
4749 DEFSUBR (Fload_char_attribute_table_map_function);
4751 DEFSUBR (Fload_char_attribute_table);
4753 DEFSUBR (Fchar_feature);
4754 DEFSUBR (Fchar_attribute_alist);
4755 DEFSUBR (Fget_char_attribute);
4756 DEFSUBR (Fput_char_attribute);
4757 DEFSUBR (Fremove_char_attribute);
4758 DEFSUBR (Fmap_char_attribute);
4759 DEFSUBR (Fdefine_char);
4760 DEFSUBR (Ffind_char);
4761 DEFSUBR (Fchar_variants);
4763 DEFSUBR (Fget_composite_char);
4766 INIT_LRECORD_IMPLEMENTATION (char_table);
4770 INIT_LRECORD_IMPLEMENTATION (char_table_entry);
4773 defsymbol (&Qcategory_table_p, "category-table-p");
4774 defsymbol (&Qcategory_designator_p, "category-designator-p");
4775 defsymbol (&Qcategory_table_value_p, "category-table-value-p");
4778 defsymbol (&Qchar_table, "char-table");
4779 defsymbol (&Qchar_tablep, "char-table-p");
4781 DEFSUBR (Fchar_table_p);
4782 DEFSUBR (Fchar_table_type_list);
4783 DEFSUBR (Fvalid_char_table_type_p);
4784 DEFSUBR (Fchar_table_type);
4785 DEFSUBR (Freset_char_table);
4786 DEFSUBR (Fmake_char_table);
4787 DEFSUBR (Fcopy_char_table);
4788 DEFSUBR (Fget_char_table);
4789 DEFSUBR (Fget_range_char_table);
4790 DEFSUBR (Fvalid_char_table_value_p);
4791 DEFSUBR (Fcheck_valid_char_table_value);
4792 DEFSUBR (Fput_char_table);
4793 DEFSUBR (Fmap_char_table);
4796 DEFSUBR (Fcategory_table_p);
4797 DEFSUBR (Fcategory_table);
4798 DEFSUBR (Fstandard_category_table);
4799 DEFSUBR (Fcopy_category_table);
4800 DEFSUBR (Fset_category_table);
4801 DEFSUBR (Fcheck_category_at);
4802 DEFSUBR (Fchar_in_category_p);
4803 DEFSUBR (Fcategory_designator_p);
4804 DEFSUBR (Fcategory_table_value_p);
4810 vars_of_chartab (void)
4813 DEFVAR_LISP ("next-defined-char-id", &Vnext_defined_char_id /*
4815 Vnext_defined_char_id = make_int (0x0F0000);
4819 DEFVAR_LISP ("char-db-stingy-mode", &Vchar_db_stingy_mode /*
4821 Vchar_db_stingy_mode = Qt;
4823 #ifdef HAVE_LIBCHISE
4824 Vchise_db_directory = build_string(chise_db_dir);
4825 DEFVAR_LISP ("chise-db-directory", &Vchise_db_directory /*
4826 Directory of CHISE character databases.
4829 Vchise_system_db_directory = build_string(chise_system_db_dir);
4830 DEFVAR_LISP ("chise-system-db-directory", &Vchise_system_db_directory /*
4831 Directory of system character database of CHISE.
4835 #endif /* HAVE_CHISE */
4836 /* DO NOT staticpro this. It works just like Vweak_hash_tables. */
4837 Vall_syntax_tables = Qnil;
4838 dump_add_weak_object_chain (&Vall_syntax_tables);
4842 structure_type_create_chartab (void)
4844 struct structure_type *st;
4846 st = define_structure_type (Qchar_table, 0, chartab_instantiate);
4848 define_structure_type_keyword (st, Qtype, chartab_type_validate);
4849 define_structure_type_keyword (st, Qdata, chartab_data_validate);
4853 complex_vars_of_chartab (void)
4856 staticpro (&Vchar_attribute_hash_table);
4857 Vchar_attribute_hash_table
4858 = make_lisp_hash_table (16, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
4859 #endif /* UTF2000 */
4861 /* Set this now, so first buffer creation can refer to it. */
4862 /* Make it nil before calling copy-category-table
4863 so that copy-category-table will know not to try to copy from garbage */
4864 Vstandard_category_table = Qnil;
4865 Vstandard_category_table = Fcopy_category_table (Qnil);
4866 staticpro (&Vstandard_category_table);
4868 DEFVAR_LISP ("word-combining-categories", &Vword_combining_categories /*
4869 List of pair (cons) of categories to determine word boundary.
4871 Emacs treats a sequence of word constituent characters as a single
4872 word (i.e. finds no word boundary between them) iff they belongs to
4873 the same charset. But, exceptions are allowed in the following cases.
4875 \(1) The case that characters are in different charsets is controlled
4876 by the variable `word-combining-categories'.
4878 Emacs finds no word boundary between characters of different charsets
4879 if they have categories matching some element of this list.
4881 More precisely, if an element of this list is a cons of category CAT1
4882 and CAT2, and a multibyte character C1 which has CAT1 is followed by
4883 C2 which has CAT2, there's no word boundary between C1 and C2.
4885 For instance, to tell that ASCII characters and Latin-1 characters can
4886 form a single word, the element `(?l . ?l)' should be in this list
4887 because both characters have the category `l' (Latin characters).
4889 \(2) The case that character are in the same charset is controlled by
4890 the variable `word-separating-categories'.
4892 Emacs find a word boundary between characters of the same charset
4893 if they have categories matching some element of this list.
4895 More precisely, if an element of this list is a cons of category CAT1
4896 and CAT2, and a multibyte character C1 which has CAT1 is followed by
4897 C2 which has CAT2, there's a word boundary between C1 and C2.
4899 For instance, to tell that there's a word boundary between Japanese
4900 Hiragana and Japanese Kanji (both are in the same charset), the
4901 element `(?H . ?C) should be in this list.
4904 Vword_combining_categories = Qnil;
4906 DEFVAR_LISP ("word-separating-categories", &Vword_separating_categories /*
4907 List of pair (cons) of categories to determine word boundary.
4908 See the documentation of the variable `word-combining-categories'.
4911 Vword_separating_categories = Qnil;