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 Q_decomposition;
1135 Lisp_Object Q_identical;
1136 Lisp_Object Q_identical_from;
1137 Lisp_Object Q_denotational;
1138 Lisp_Object Q_denotational_from;
1139 Lisp_Object Q_subsumptive;
1140 Lisp_Object Q_subsumptive_from;
1141 Lisp_Object Q_component;
1142 Lisp_Object Q_component_of;
1143 Lisp_Object Qto_ucs;
1144 Lisp_Object Q_ucs_unified;
1145 Lisp_Object Qcompat;
1146 Lisp_Object Qisolated;
1147 Lisp_Object Qinitial;
1148 Lisp_Object Qmedial;
1150 Lisp_Object Qvertical;
1151 Lisp_Object QnoBreak;
1152 Lisp_Object Qfraction;
1155 Lisp_Object Qcircle;
1156 Lisp_Object Qsquare;
1158 Lisp_Object Qnarrow;
1162 Emchar to_char_id (Lisp_Object v, char* err_msg, Lisp_Object err_arg);
1165 to_char_id (Lisp_Object v, char* err_msg, Lisp_Object err_arg)
1171 else if (EQ (v, Qcompat))
1173 else if (EQ (v, Qisolated))
1175 else if (EQ (v, Qinitial))
1177 else if (EQ (v, Qmedial))
1179 else if (EQ (v, Qfinal))
1181 else if (EQ (v, Qvertical))
1183 else if (EQ (v, QnoBreak))
1185 else if (EQ (v, Qfraction))
1187 else if (EQ (v, Qsuper))
1189 else if (EQ (v, Qsub))
1191 else if (EQ (v, Qcircle))
1193 else if (EQ (v, Qsquare))
1195 else if (EQ (v, Qwide))
1197 else if (EQ (v, Qnarrow))
1199 else if (EQ (v, Qsmall))
1201 else if (EQ (v, Qfont))
1204 signal_simple_error (err_msg, err_arg);
1207 DEFUN ("get-composite-char", Fget_composite_char, 1, 1, 0, /*
1208 Return character corresponding with list.
1212 Lisp_Object base, modifier;
1216 signal_simple_error ("Invalid value for composition", list);
1219 while (!NILP (rest))
1224 signal_simple_error ("Invalid value for composition", list);
1225 modifier = Fcar (rest);
1227 base = Fcdr (Fassq (modifier,
1228 Fchar_feature (base, Qcomposition, Qnil,
1234 DEFUN ("char-variants", Fchar_variants, 1, 1, 0, /*
1235 Return variants of CHARACTER.
1239 CHECK_CHAR (character);
1242 (Fcopy_list (Fget_char_attribute (character, Q_subsumptive, Qnil)),
1244 (Fcopy_list (Fget_char_attribute (character, Q_denotational, Qnil)),
1246 (Fcopy_list (Fget_char_attribute (character, Q_identical, Qnil)),
1247 Fcopy_list (Fchar_feature (character, Q_ucs_unified, Qnil,
1254 /* A char table maps from ranges of characters to values.
1256 Implementing a general data structure that maps from arbitrary
1257 ranges of numbers to values is tricky to do efficiently. As it
1258 happens, it should suffice (and is usually more convenient, anyway)
1259 when dealing with characters to restrict the sorts of ranges that
1260 can be assigned values, as follows:
1263 2) All characters in a charset.
1264 3) All characters in a particular row of a charset, where a "row"
1265 means all characters with the same first byte.
1266 4) A particular character in a charset.
1268 We use char tables to generalize the 256-element vectors now
1269 littering the Emacs code.
1271 Possible uses (all should be converted at some point):
1277 5) keyboard-translate-table?
1280 abstract type to generalize the Emacs vectors and Mule
1281 vectors-of-vectors goo.
1284 /************************************************************************/
1285 /* Char Table object */
1286 /************************************************************************/
1288 #if defined(MULE)&&!defined(UTF2000)
1291 mark_char_table_entry (Lisp_Object obj)
1293 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj);
1296 for (i = 0; i < 96; i++)
1298 mark_object (cte->level2[i]);
1304 char_table_entry_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
1306 Lisp_Char_Table_Entry *cte1 = XCHAR_TABLE_ENTRY (obj1);
1307 Lisp_Char_Table_Entry *cte2 = XCHAR_TABLE_ENTRY (obj2);
1310 for (i = 0; i < 96; i++)
1311 if (!internal_equal (cte1->level2[i], cte2->level2[i], depth + 1))
1317 static unsigned long
1318 char_table_entry_hash (Lisp_Object obj, int depth)
1320 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj);
1322 return internal_array_hash (cte->level2, 96, depth);
1325 static const struct lrecord_description char_table_entry_description[] = {
1326 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table_Entry, level2), 96 },
1330 DEFINE_LRECORD_IMPLEMENTATION ("char-table-entry", char_table_entry,
1331 mark_char_table_entry, internal_object_printer,
1332 0, char_table_entry_equal,
1333 char_table_entry_hash,
1334 char_table_entry_description,
1335 Lisp_Char_Table_Entry);
1339 mark_char_table (Lisp_Object obj)
1341 Lisp_Char_Table *ct = XCHAR_TABLE (obj);
1344 mark_object (ct->table);
1345 mark_object (ct->name);
1346 #ifndef HAVE_LIBCHISE
1347 mark_object (ct->db);
1352 for (i = 0; i < NUM_ASCII_CHARS; i++)
1353 mark_object (ct->ascii[i]);
1355 for (i = 0; i < NUM_LEADING_BYTES; i++)
1356 mark_object (ct->level1[i]);
1360 return ct->default_value;
1362 return ct->mirror_table;
1366 /* WARNING: All functions of this nature need to be written extremely
1367 carefully to avoid crashes during GC. Cf. prune_specifiers()
1368 and prune_weak_hash_tables(). */
1371 prune_syntax_tables (void)
1373 Lisp_Object rest, prev = Qnil;
1375 for (rest = Vall_syntax_tables;
1377 rest = XCHAR_TABLE (rest)->next_table)
1379 if (! marked_p (rest))
1381 /* This table is garbage. Remove it from the list. */
1383 Vall_syntax_tables = XCHAR_TABLE (rest)->next_table;
1385 XCHAR_TABLE (prev)->next_table =
1386 XCHAR_TABLE (rest)->next_table;
1392 char_table_type_to_symbol (enum char_table_type type)
1397 case CHAR_TABLE_TYPE_GENERIC: return Qgeneric;
1398 case CHAR_TABLE_TYPE_SYNTAX: return Qsyntax;
1399 case CHAR_TABLE_TYPE_DISPLAY: return Qdisplay;
1400 case CHAR_TABLE_TYPE_CHAR: return Qchar;
1402 case CHAR_TABLE_TYPE_CATEGORY: return Qcategory;
1407 static enum char_table_type
1408 symbol_to_char_table_type (Lisp_Object symbol)
1410 CHECK_SYMBOL (symbol);
1412 if (EQ (symbol, Qgeneric)) return CHAR_TABLE_TYPE_GENERIC;
1413 if (EQ (symbol, Qsyntax)) return CHAR_TABLE_TYPE_SYNTAX;
1414 if (EQ (symbol, Qdisplay)) return CHAR_TABLE_TYPE_DISPLAY;
1415 if (EQ (symbol, Qchar)) return CHAR_TABLE_TYPE_CHAR;
1417 if (EQ (symbol, Qcategory)) return CHAR_TABLE_TYPE_CATEGORY;
1420 signal_simple_error ("Unrecognized char table type", symbol);
1421 return CHAR_TABLE_TYPE_GENERIC; /* not reached */
1426 print_chartab_range (Emchar first, Emchar last, Lisp_Object val,
1427 Lisp_Object printcharfun)
1431 write_c_string (" (", printcharfun);
1432 print_internal (make_char (first), printcharfun, 0);
1433 write_c_string (" ", printcharfun);
1434 print_internal (make_char (last), printcharfun, 0);
1435 write_c_string (") ", printcharfun);
1439 write_c_string (" ", printcharfun);
1440 print_internal (make_char (first), printcharfun, 0);
1441 write_c_string (" ", printcharfun);
1443 print_internal (val, printcharfun, 1);
1447 #if defined(MULE)&&!defined(UTF2000)
1450 print_chartab_charset_row (Lisp_Object charset,
1452 Lisp_Char_Table_Entry *cte,
1453 Lisp_Object printcharfun)
1456 Lisp_Object cat = Qunbound;
1459 for (i = 32; i < 128; i++)
1461 Lisp_Object pam = cte->level2[i - 32];
1473 print_chartab_range (MAKE_CHAR (charset, first, 0),
1474 MAKE_CHAR (charset, i - 1, 0),
1477 print_chartab_range (MAKE_CHAR (charset, row, first),
1478 MAKE_CHAR (charset, row, i - 1),
1488 print_chartab_range (MAKE_CHAR (charset, first, 0),
1489 MAKE_CHAR (charset, i - 1, 0),
1492 print_chartab_range (MAKE_CHAR (charset, row, first),
1493 MAKE_CHAR (charset, row, i - 1),
1499 print_chartab_two_byte_charset (Lisp_Object charset,
1500 Lisp_Char_Table_Entry *cte,
1501 Lisp_Object printcharfun)
1505 for (i = 32; i < 128; i++)
1507 Lisp_Object jen = cte->level2[i - 32];
1509 if (!CHAR_TABLE_ENTRYP (jen))
1513 write_c_string (" [", printcharfun);
1514 print_internal (XCHARSET_NAME (charset), printcharfun, 0);
1515 sprintf (buf, " %d] ", i);
1516 write_c_string (buf, printcharfun);
1517 print_internal (jen, printcharfun, 0);
1520 print_chartab_charset_row (charset, i, XCHAR_TABLE_ENTRY (jen),
1528 print_char_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1530 Lisp_Char_Table *ct = XCHAR_TABLE (obj);
1533 struct gcpro gcpro1, gcpro2;
1534 GCPRO2 (obj, printcharfun);
1536 write_c_string ("#s(char-table ", printcharfun);
1537 write_c_string (" ", printcharfun);
1538 write_c_string (string_data
1540 (XSYMBOL (char_table_type_to_symbol (ct->type)))),
1542 write_c_string ("\n ", printcharfun);
1543 print_internal (ct->default_value, printcharfun, escapeflag);
1544 for (i = 0; i < 256; i++)
1546 Lisp_Object elt = get_byte_table (ct->table, i);
1547 if (i != 0) write_c_string ("\n ", printcharfun);
1548 if (EQ (elt, Qunbound))
1549 write_c_string ("void", printcharfun);
1551 print_internal (elt, printcharfun, escapeflag);
1554 #else /* non UTF2000 */
1557 sprintf (buf, "#s(char-table type %s data (",
1558 string_data (symbol_name (XSYMBOL
1559 (char_table_type_to_symbol (ct->type)))));
1560 write_c_string (buf, printcharfun);
1562 /* Now write out the ASCII/Control-1 stuff. */
1566 Lisp_Object val = Qunbound;
1568 for (i = 0; i < NUM_ASCII_CHARS; i++)
1577 if (!EQ (ct->ascii[i], val))
1579 print_chartab_range (first, i - 1, val, printcharfun);
1586 print_chartab_range (first, i - 1, val, printcharfun);
1593 for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES;
1596 Lisp_Object ann = ct->level1[i - MIN_LEADING_BYTE];
1597 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (i);
1599 if (!CHARSETP (charset) || i == LEADING_BYTE_ASCII
1600 || i == LEADING_BYTE_CONTROL_1)
1602 if (!CHAR_TABLE_ENTRYP (ann))
1604 write_c_string (" ", printcharfun);
1605 print_internal (XCHARSET_NAME (charset),
1607 write_c_string (" ", printcharfun);
1608 print_internal (ann, printcharfun, 0);
1612 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (ann);
1613 if (XCHARSET_DIMENSION (charset) == 1)
1614 print_chartab_charset_row (charset, -1, cte, printcharfun);
1616 print_chartab_two_byte_charset (charset, cte, printcharfun);
1621 #endif /* non UTF2000 */
1623 write_c_string ("))", printcharfun);
1627 char_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
1629 Lisp_Char_Table *ct1 = XCHAR_TABLE (obj1);
1630 Lisp_Char_Table *ct2 = XCHAR_TABLE (obj2);
1633 if (CHAR_TABLE_TYPE (ct1) != CHAR_TABLE_TYPE (ct2))
1637 for (i = 0; i < 256; i++)
1639 if (!internal_equal (get_byte_table (ct1->table, i),
1640 get_byte_table (ct2->table, i), 0))
1644 for (i = 0; i < NUM_ASCII_CHARS; i++)
1645 if (!internal_equal (ct1->ascii[i], ct2->ascii[i], depth + 1))
1649 for (i = 0; i < NUM_LEADING_BYTES; i++)
1650 if (!internal_equal (ct1->level1[i], ct2->level1[i], depth + 1))
1653 #endif /* non UTF2000 */
1658 static unsigned long
1659 char_table_hash (Lisp_Object obj, int depth)
1661 Lisp_Char_Table *ct = XCHAR_TABLE (obj);
1663 return byte_table_hash (ct->table, depth + 1);
1665 unsigned long hashval = internal_array_hash (ct->ascii, NUM_ASCII_CHARS,
1668 hashval = HASH2 (hashval,
1669 internal_array_hash (ct->level1, NUM_LEADING_BYTES, depth));
1675 static const struct lrecord_description char_table_description[] = {
1677 { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, table) },
1678 { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, default_value) },
1679 { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, name) },
1680 #ifndef HAVE_LIBCHISE
1681 { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, db) },
1684 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, ascii), NUM_ASCII_CHARS },
1686 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, level1), NUM_LEADING_BYTES },
1690 { XD_LISP_OBJECT, offsetof (Lisp_Char_Table, mirror_table) },
1692 { XD_LO_LINK, offsetof (Lisp_Char_Table, next_table) },
1696 DEFINE_LRECORD_IMPLEMENTATION ("char-table", char_table,
1697 mark_char_table, print_char_table, 0,
1698 char_table_equal, char_table_hash,
1699 char_table_description,
1702 DEFUN ("char-table-p", Fchar_table_p, 1, 1, 0, /*
1703 Return non-nil if OBJECT is a char table.
1705 A char table is a table that maps characters (or ranges of characters)
1706 to values. Char tables are specialized for characters, only allowing
1707 particular sorts of ranges to be assigned values. Although this
1708 loses in generality, it makes for extremely fast (constant-time)
1709 lookups, and thus is feasible for applications that do an extremely
1710 large number of lookups (e.g. scanning a buffer for a character in
1711 a particular syntax, where a lookup in the syntax table must occur
1712 once per character).
1714 When Mule support exists, the types of ranges that can be assigned
1718 -- an entire charset
1719 -- a single row in a two-octet charset
1720 -- a single character
1722 When Mule support is not present, the types of ranges that can be
1726 -- a single character
1728 To create a char table, use `make-char-table'.
1729 To modify a char table, use `put-char-table' or `remove-char-table'.
1730 To retrieve the value for a particular character, use `get-char-table'.
1731 See also `map-char-table', `clear-char-table', `copy-char-table',
1732 `valid-char-table-type-p', `char-table-type-list',
1733 `valid-char-table-value-p', and `check-char-table-value'.
1737 return CHAR_TABLEP (object) ? Qt : Qnil;
1740 DEFUN ("char-table-type-list", Fchar_table_type_list, 0, 0, 0, /*
1741 Return a list of the recognized char table types.
1742 See `valid-char-table-type-p'.
1747 return list5 (Qchar, Qcategory, Qdisplay, Qgeneric, Qsyntax);
1749 return list4 (Qchar, Qdisplay, Qgeneric, Qsyntax);
1753 DEFUN ("valid-char-table-type-p", Fvalid_char_table_type_p, 1, 1, 0, /*
1754 Return t if TYPE if a recognized char table type.
1756 Each char table type is used for a different purpose and allows different
1757 sorts of values. The different char table types are
1760 Used for category tables, which specify the regexp categories
1761 that a character is in. The valid values are nil or a
1762 bit vector of 95 elements. Higher-level Lisp functions are
1763 provided for working with category tables. Currently categories
1764 and category tables only exist when Mule support is present.
1766 A generalized char table, for mapping from one character to
1767 another. Used for case tables, syntax matching tables,
1768 `keyboard-translate-table', etc. The valid values are characters.
1770 An even more generalized char table, for mapping from a
1771 character to anything.
1773 Used for display tables, which specify how a particular character
1774 is to appear when displayed. #### Not yet implemented.
1776 Used for syntax tables, which specify the syntax of a particular
1777 character. Higher-level Lisp functions are provided for
1778 working with syntax tables. The valid values are integers.
1783 return (EQ (type, Qchar) ||
1785 EQ (type, Qcategory) ||
1787 EQ (type, Qdisplay) ||
1788 EQ (type, Qgeneric) ||
1789 EQ (type, Qsyntax)) ? Qt : Qnil;
1792 DEFUN ("char-table-type", Fchar_table_type, 1, 1, 0, /*
1793 Return the type of CHAR-TABLE.
1794 See `valid-char-table-type-p'.
1798 CHECK_CHAR_TABLE (char_table);
1799 return char_table_type_to_symbol (XCHAR_TABLE (char_table)->type);
1803 fill_char_table (Lisp_Char_Table *ct, Lisp_Object value)
1806 ct->table = Qunbound;
1807 ct->default_value = value;
1812 for (i = 0; i < NUM_ASCII_CHARS; i++)
1813 ct->ascii[i] = value;
1815 for (i = 0; i < NUM_LEADING_BYTES; i++)
1816 ct->level1[i] = value;
1821 if (ct->type == CHAR_TABLE_TYPE_SYNTAX)
1822 update_syntax_table (ct);
1826 DEFUN ("reset-char-table", Freset_char_table, 1, 1, 0, /*
1827 Reset CHAR-TABLE to its default state.
1831 Lisp_Char_Table *ct;
1833 CHECK_CHAR_TABLE (char_table);
1834 ct = XCHAR_TABLE (char_table);
1838 case CHAR_TABLE_TYPE_CHAR:
1839 fill_char_table (ct, make_char (0));
1841 case CHAR_TABLE_TYPE_DISPLAY:
1842 case CHAR_TABLE_TYPE_GENERIC:
1844 case CHAR_TABLE_TYPE_CATEGORY:
1846 fill_char_table (ct, Qnil);
1849 case CHAR_TABLE_TYPE_SYNTAX:
1850 fill_char_table (ct, make_int (Sinherit));
1860 DEFUN ("make-char-table", Fmake_char_table, 1, 1, 0, /*
1861 Return a new, empty char table of type TYPE.
1862 Currently recognized types are 'char, 'category, 'display, 'generic,
1863 and 'syntax. See `valid-char-table-type-p'.
1867 Lisp_Char_Table *ct;
1869 enum char_table_type ty = symbol_to_char_table_type (type);
1871 ct = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table);
1874 if (ty == CHAR_TABLE_TYPE_SYNTAX)
1876 ct->mirror_table = Fmake_char_table (Qgeneric);
1877 fill_char_table (XCHAR_TABLE (ct->mirror_table),
1881 ct->mirror_table = Qnil;
1884 #ifndef HAVE_LIBCHISE
1888 ct->next_table = Qnil;
1889 XSETCHAR_TABLE (obj, ct);
1890 if (ty == CHAR_TABLE_TYPE_SYNTAX)
1892 ct->next_table = Vall_syntax_tables;
1893 Vall_syntax_tables = obj;
1895 Freset_char_table (obj);
1899 #if defined(MULE)&&!defined(UTF2000)
1902 make_char_table_entry (Lisp_Object initval)
1906 Lisp_Char_Table_Entry *cte =
1907 alloc_lcrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry);
1909 for (i = 0; i < 96; i++)
1910 cte->level2[i] = initval;
1912 XSETCHAR_TABLE_ENTRY (obj, cte);
1917 copy_char_table_entry (Lisp_Object entry)
1919 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (entry);
1922 Lisp_Char_Table_Entry *ctenew =
1923 alloc_lcrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry);
1925 for (i = 0; i < 96; i++)
1927 Lisp_Object new = cte->level2[i];
1928 if (CHAR_TABLE_ENTRYP (new))
1929 ctenew->level2[i] = copy_char_table_entry (new);
1931 ctenew->level2[i] = new;
1934 XSETCHAR_TABLE_ENTRY (obj, ctenew);
1940 DEFUN ("copy-char-table", Fcopy_char_table, 1, 1, 0, /*
1941 Return a new char table which is a copy of CHAR-TABLE.
1942 It will contain the same values for the same characters and ranges
1943 as CHAR-TABLE. The values will not themselves be copied.
1947 Lisp_Char_Table *ct, *ctnew;
1953 CHECK_CHAR_TABLE (char_table);
1954 ct = XCHAR_TABLE (char_table);
1955 ctnew = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table);
1956 ctnew->type = ct->type;
1958 ctnew->default_value = ct->default_value;
1959 /* [tomo:2002-01-21] Perhaps this code seems wrong */
1960 ctnew->name = ct->name;
1961 #ifndef HAVE_LIBCHISE
1965 if (UINT8_BYTE_TABLE_P (ct->table))
1967 ctnew->table = copy_uint8_byte_table (ct->table);
1969 else if (UINT16_BYTE_TABLE_P (ct->table))
1971 ctnew->table = copy_uint16_byte_table (ct->table);
1973 else if (BYTE_TABLE_P (ct->table))
1975 ctnew->table = copy_byte_table (ct->table);
1977 else if (!UNBOUNDP (ct->table))
1978 ctnew->table = ct->table;
1979 #else /* non UTF2000 */
1981 for (i = 0; i < NUM_ASCII_CHARS; i++)
1983 Lisp_Object new = ct->ascii[i];
1985 assert (! (CHAR_TABLE_ENTRYP (new)));
1987 ctnew->ascii[i] = new;
1992 for (i = 0; i < NUM_LEADING_BYTES; i++)
1994 Lisp_Object new = ct->level1[i];
1995 if (CHAR_TABLE_ENTRYP (new))
1996 ctnew->level1[i] = copy_char_table_entry (new);
1998 ctnew->level1[i] = new;
2002 #endif /* non UTF2000 */
2005 if (CHAR_TABLEP (ct->mirror_table))
2006 ctnew->mirror_table = Fcopy_char_table (ct->mirror_table);
2008 ctnew->mirror_table = ct->mirror_table;
2010 ctnew->next_table = Qnil;
2011 XSETCHAR_TABLE (obj, ctnew);
2012 if (ctnew->type == CHAR_TABLE_TYPE_SYNTAX)
2014 ctnew->next_table = Vall_syntax_tables;
2015 Vall_syntax_tables = obj;
2020 INLINE_HEADER int XCHARSET_CELL_RANGE (Lisp_Object ccs);
2022 XCHARSET_CELL_RANGE (Lisp_Object ccs)
2024 switch (XCHARSET_CHARS (ccs))
2027 return (33 << 8) | 126;
2029 return (32 << 8) | 127;
2032 return (0 << 8) | 127;
2034 return (0 << 8) | 255;
2046 decode_char_table_range (Lisp_Object range, struct chartab_range *outrange)
2049 outrange->type = CHARTAB_RANGE_ALL;
2051 else if (EQ (range, Qnil))
2052 outrange->type = CHARTAB_RANGE_DEFAULT;
2054 else if (CHAR_OR_CHAR_INTP (range))
2056 outrange->type = CHARTAB_RANGE_CHAR;
2057 outrange->ch = XCHAR_OR_CHAR_INT (range);
2061 signal_simple_error ("Range must be t or a character", range);
2063 else if (VECTORP (range))
2065 Lisp_Vector *vec = XVECTOR (range);
2066 Lisp_Object *elts = vector_data (vec);
2067 int cell_min, cell_max;
2069 outrange->type = CHARTAB_RANGE_ROW;
2070 outrange->charset = Fget_charset (elts[0]);
2071 CHECK_INT (elts[1]);
2072 outrange->row = XINT (elts[1]);
2073 if (XCHARSET_DIMENSION (outrange->charset) < 2)
2074 signal_simple_error ("Charset in row vector must be multi-byte",
2078 int ret = XCHARSET_CELL_RANGE (outrange->charset);
2080 cell_min = ret >> 8;
2081 cell_max = ret & 0xFF;
2083 if (XCHARSET_DIMENSION (outrange->charset) == 2)
2084 check_int_range (outrange->row, cell_min, cell_max);
2086 else if (XCHARSET_DIMENSION (outrange->charset) == 3)
2088 check_int_range (outrange->row >> 8 , cell_min, cell_max);
2089 check_int_range (outrange->row & 0xFF, cell_min, cell_max);
2091 else if (XCHARSET_DIMENSION (outrange->charset) == 4)
2093 check_int_range ( outrange->row >> 16 , cell_min, cell_max);
2094 check_int_range ((outrange->row >> 8) & 0xFF, cell_min, cell_max);
2095 check_int_range ( outrange->row & 0xFF, cell_min, cell_max);
2103 if (!CHARSETP (range) && !SYMBOLP (range))
2105 ("Char table range must be t, charset, char, or vector", range);
2106 outrange->type = CHARTAB_RANGE_CHARSET;
2107 outrange->charset = Fget_charset (range);
2112 #if defined(MULE)&&!defined(UTF2000)
2114 /* called from CHAR_TABLE_VALUE(). */
2116 get_non_ascii_char_table_value (Lisp_Char_Table *ct, Charset_ID leading_byte,
2121 Lisp_Object charset;
2123 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (leading_byte);
2128 BREAKUP_CHAR (c, charset, byte1, byte2);
2130 BREAKUP_CHAR_1_UNSAFE (c, charset, byte1, byte2);
2132 val = ct->level1[leading_byte - MIN_LEADING_BYTE];
2133 if (CHAR_TABLE_ENTRYP (val))
2135 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
2136 val = cte->level2[byte1 - 32];
2137 if (CHAR_TABLE_ENTRYP (val))
2139 cte = XCHAR_TABLE_ENTRY (val);
2140 assert (byte2 >= 32);
2141 val = cte->level2[byte2 - 32];
2142 assert (!CHAR_TABLE_ENTRYP (val));
2152 get_char_table (Emchar ch, Lisp_Char_Table *ct)
2156 Lisp_Object ret = get_char_id_table (ct, ch);
2161 if (EQ (CHAR_TABLE_NAME (ct), Qdowncase))
2162 ret = Fchar_feature (make_char (ch), Q_lowercase, Qnil,
2164 else if (EQ (CHAR_TABLE_NAME (ct), Qflippedcase))
2165 ret = Fchar_feature (make_char (ch), Q_uppercase, Qnil,
2171 ret = Ffind_char (ret);
2179 Lisp_Object charset;
2183 BREAKUP_CHAR (ch, charset, byte1, byte2);
2185 if (EQ (charset, Vcharset_ascii))
2186 val = ct->ascii[byte1];
2187 else if (EQ (charset, Vcharset_control_1))
2188 val = ct->ascii[byte1 + 128];
2191 int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE;
2192 val = ct->level1[lb];
2193 if (CHAR_TABLE_ENTRYP (val))
2195 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
2196 val = cte->level2[byte1 - 32];
2197 if (CHAR_TABLE_ENTRYP (val))
2199 cte = XCHAR_TABLE_ENTRY (val);
2200 assert (byte2 >= 32);
2201 val = cte->level2[byte2 - 32];
2202 assert (!CHAR_TABLE_ENTRYP (val));
2209 #else /* not MULE */
2210 return ct->ascii[(unsigned char)ch];
2211 #endif /* not MULE */
2215 DEFUN ("get-char-table", Fget_char_table, 2, 2, 0, /*
2216 Find value for CHARACTER in CHAR-TABLE.
2218 (character, char_table))
2220 CHECK_CHAR_TABLE (char_table);
2221 CHECK_CHAR_COERCE_INT (character);
2223 return get_char_table (XCHAR (character), XCHAR_TABLE (char_table));
2226 DEFUN ("get-range-char-table", Fget_range_char_table, 2, 3, 0, /*
2227 Find value for a range in CHAR-TABLE.
2228 If there is more than one value, return MULTI (defaults to nil).
2230 (range, char_table, multi))
2232 Lisp_Char_Table *ct;
2233 struct chartab_range rainj;
2235 if (CHAR_OR_CHAR_INTP (range))
2236 return Fget_char_table (range, char_table);
2237 CHECK_CHAR_TABLE (char_table);
2238 ct = XCHAR_TABLE (char_table);
2240 decode_char_table_range (range, &rainj);
2243 case CHARTAB_RANGE_ALL:
2246 if (UINT8_BYTE_TABLE_P (ct->table))
2248 else if (UINT16_BYTE_TABLE_P (ct->table))
2250 else if (BYTE_TABLE_P (ct->table))
2254 #else /* non UTF2000 */
2256 Lisp_Object first = ct->ascii[0];
2258 for (i = 1; i < NUM_ASCII_CHARS; i++)
2259 if (!EQ (first, ct->ascii[i]))
2263 for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES;
2266 if (!CHARSETP (CHARSET_BY_LEADING_BYTE (i))
2267 || i == LEADING_BYTE_ASCII
2268 || i == LEADING_BYTE_CONTROL_1)
2270 if (!EQ (first, ct->level1[i - MIN_LEADING_BYTE]))
2276 #endif /* non UTF2000 */
2280 case CHARTAB_RANGE_CHARSET:
2284 if (EQ (rainj.charset, Vcharset_ascii))
2287 Lisp_Object first = ct->ascii[0];
2289 for (i = 1; i < 128; i++)
2290 if (!EQ (first, ct->ascii[i]))
2295 if (EQ (rainj.charset, Vcharset_control_1))
2298 Lisp_Object first = ct->ascii[128];
2300 for (i = 129; i < 160; i++)
2301 if (!EQ (first, ct->ascii[i]))
2307 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (rainj.charset) -
2309 if (CHAR_TABLE_ENTRYP (val))
2315 case CHARTAB_RANGE_ROW:
2320 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (rainj.charset) -
2322 if (!CHAR_TABLE_ENTRYP (val))
2324 val = XCHAR_TABLE_ENTRY (val)->level2[rainj.row - 32];
2325 if (CHAR_TABLE_ENTRYP (val))
2329 #endif /* not UTF2000 */
2330 #endif /* not MULE */
2333 case CHARTAB_RANGE_DEFAULT:
2334 return ct->default_value;
2335 #endif /* not UTF2000 */
2341 return Qnil; /* not reached */
2345 check_valid_char_table_value (Lisp_Object value, enum char_table_type type,
2346 Error_behavior errb)
2350 case CHAR_TABLE_TYPE_SYNTAX:
2351 if (!ERRB_EQ (errb, ERROR_ME))
2352 return INTP (value) || (CONSP (value) && INTP (XCAR (value))
2353 && CHAR_OR_CHAR_INTP (XCDR (value)));
2356 Lisp_Object cdr = XCDR (value);
2357 CHECK_INT (XCAR (value));
2358 CHECK_CHAR_COERCE_INT (cdr);
2365 case CHAR_TABLE_TYPE_CATEGORY:
2366 if (!ERRB_EQ (errb, ERROR_ME))
2367 return CATEGORY_TABLE_VALUEP (value);
2368 CHECK_CATEGORY_TABLE_VALUE (value);
2372 case CHAR_TABLE_TYPE_GENERIC:
2375 case CHAR_TABLE_TYPE_DISPLAY:
2377 maybe_signal_simple_error ("Display char tables not yet implemented",
2378 value, Qchar_table, errb);
2381 case CHAR_TABLE_TYPE_CHAR:
2382 if (!ERRB_EQ (errb, ERROR_ME))
2383 return CHAR_OR_CHAR_INTP (value);
2384 CHECK_CHAR_COERCE_INT (value);
2391 return 0; /* not reached */
2395 canonicalize_char_table_value (Lisp_Object value, enum char_table_type type)
2399 case CHAR_TABLE_TYPE_SYNTAX:
2402 Lisp_Object car = XCAR (value);
2403 Lisp_Object cdr = XCDR (value);
2404 CHECK_CHAR_COERCE_INT (cdr);
2405 return Fcons (car, cdr);
2408 case CHAR_TABLE_TYPE_CHAR:
2409 CHECK_CHAR_COERCE_INT (value);
2417 DEFUN ("valid-char-table-value-p", Fvalid_char_table_value_p, 2, 2, 0, /*
2418 Return non-nil if VALUE is a valid value for CHAR-TABLE-TYPE.
2420 (value, char_table_type))
2422 enum char_table_type type = symbol_to_char_table_type (char_table_type);
2424 return check_valid_char_table_value (value, type, ERROR_ME_NOT) ? Qt : Qnil;
2427 DEFUN ("check-valid-char-table-value", Fcheck_valid_char_table_value, 2, 2, 0, /*
2428 Signal an error if VALUE is not a valid value for CHAR-TABLE-TYPE.
2430 (value, char_table_type))
2432 enum char_table_type type = symbol_to_char_table_type (char_table_type);
2434 check_valid_char_table_value (value, type, ERROR_ME);
2439 Lisp_Char_Table* char_attribute_table_to_put;
2440 Lisp_Object Qput_char_table_map_function;
2441 Lisp_Object value_to_put;
2443 DEFUN ("put-char-table-map-function",
2444 Fput_char_table_map_function, 2, 2, 0, /*
2445 For internal use. Don't use it.
2449 put_char_id_table_0 (char_attribute_table_to_put,
2450 XCHAR (c), value_to_put);
2455 /* Assign VAL to all characters in RANGE in char table CT. */
2458 put_char_table (Lisp_Char_Table *ct, struct chartab_range *range,
2461 switch (range->type)
2463 case CHARTAB_RANGE_ALL:
2464 fill_char_table (ct, val);
2465 return; /* avoid the duplicate call to update_syntax_table() below,
2466 since fill_char_table() also did that. */
2469 case CHARTAB_RANGE_DEFAULT:
2470 ct->default_value = val;
2475 case CHARTAB_RANGE_CHARSET:
2478 Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (range->charset);
2480 if ( CHAR_TABLEP (encoding_table) )
2482 Lisp_Object mother = XCHARSET_MOTHER (range->charset);
2484 char_attribute_table_to_put = ct;
2486 Fmap_char_attribute (Qput_char_table_map_function,
2487 XCHAR_TABLE_NAME (encoding_table),
2489 if ( CHARSETP (mother) )
2491 struct chartab_range r;
2493 r.type = CHARTAB_RANGE_CHARSET;
2495 put_char_table (ct, &r, val);
2503 for (c = 0; c < 1 << 24; c++)
2505 if ( charset_code_point (range->charset, c) >= 0 )
2506 put_char_id_table_0 (ct, c, val);
2512 if (EQ (range->charset, Vcharset_ascii))
2515 for (i = 0; i < 128; i++)
2518 else if (EQ (range->charset, Vcharset_control_1))
2521 for (i = 128; i < 160; i++)
2526 int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE;
2527 ct->level1[lb] = val;
2532 case CHARTAB_RANGE_ROW:
2535 int cell_min, cell_max, i;
2537 i = XCHARSET_CELL_RANGE (range->charset);
2539 cell_max = i & 0xFF;
2540 for (i = cell_min; i <= cell_max; i++)
2543 = DECODE_CHAR (range->charset, (range->row << 8) | i, 0);
2545 if ( charset_code_point (range->charset, ch, 0) >= 0 )
2546 put_char_id_table_0 (ct, ch, val);
2551 Lisp_Char_Table_Entry *cte;
2552 int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE;
2553 /* make sure that there is a separate entry for the row. */
2554 if (!CHAR_TABLE_ENTRYP (ct->level1[lb]))
2555 ct->level1[lb] = make_char_table_entry (ct->level1[lb]);
2556 cte = XCHAR_TABLE_ENTRY (ct->level1[lb]);
2557 cte->level2[range->row - 32] = val;
2559 #endif /* not UTF2000 */
2563 case CHARTAB_RANGE_CHAR:
2565 put_char_id_table_0 (ct, range->ch, val);
2569 Lisp_Object charset;
2572 BREAKUP_CHAR (range->ch, charset, byte1, byte2);
2573 if (EQ (charset, Vcharset_ascii))
2574 ct->ascii[byte1] = val;
2575 else if (EQ (charset, Vcharset_control_1))
2576 ct->ascii[byte1 + 128] = val;
2579 Lisp_Char_Table_Entry *cte;
2580 int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE;
2581 /* make sure that there is a separate entry for the row. */
2582 if (!CHAR_TABLE_ENTRYP (ct->level1[lb]))
2583 ct->level1[lb] = make_char_table_entry (ct->level1[lb]);
2584 cte = XCHAR_TABLE_ENTRY (ct->level1[lb]);
2585 /* now CTE is a char table entry for the charset;
2586 each entry is for a single row (or character of
2587 a one-octet charset). */
2588 if (XCHARSET_DIMENSION (charset) == 1)
2589 cte->level2[byte1 - 32] = val;
2592 /* assigning to one character in a two-octet charset. */
2593 /* make sure that the charset row contains a separate
2594 entry for each character. */
2595 if (!CHAR_TABLE_ENTRYP (cte->level2[byte1 - 32]))
2596 cte->level2[byte1 - 32] =
2597 make_char_table_entry (cte->level2[byte1 - 32]);
2598 cte = XCHAR_TABLE_ENTRY (cte->level2[byte1 - 32]);
2599 cte->level2[byte2 - 32] = val;
2603 #else /* not MULE */
2604 ct->ascii[(unsigned char) (range->ch)] = val;
2606 #endif /* not MULE */
2610 if (ct->type == CHAR_TABLE_TYPE_SYNTAX)
2611 update_syntax_table (ct);
2615 DEFUN ("put-char-table", Fput_char_table, 3, 3, 0, /*
2616 Set the value for chars in RANGE to be VALUE in CHAR-TABLE.
2618 RANGE specifies one or more characters to be affected and should be
2619 one of the following:
2621 -- t (all characters are affected)
2622 -- A charset (only allowed when Mule support is present)
2623 -- A vector of two elements: a two-octet charset and a row number
2624 (only allowed when Mule support is present)
2625 -- A single character
2627 VALUE must be a value appropriate for the type of CHAR-TABLE.
2628 See `valid-char-table-type-p'.
2630 (range, value, char_table))
2632 Lisp_Char_Table *ct;
2633 struct chartab_range rainj;
2635 CHECK_CHAR_TABLE (char_table);
2636 ct = XCHAR_TABLE (char_table);
2637 check_valid_char_table_value (value, ct->type, ERROR_ME);
2638 decode_char_table_range (range, &rainj);
2639 value = canonicalize_char_table_value (value, ct->type);
2640 put_char_table (ct, &rainj, value);
2645 /* Map FN over the ASCII chars in CT. */
2648 map_over_charset_ascii (Lisp_Char_Table *ct,
2649 int (*fn) (struct chartab_range *range,
2650 Lisp_Object val, void *arg),
2653 struct chartab_range rainj;
2662 rainj.type = CHARTAB_RANGE_CHAR;
2664 for (i = start, retval = 0; i < stop && retval == 0; i++)
2666 rainj.ch = (Emchar) i;
2667 retval = (fn) (&rainj, ct->ascii[i], arg);
2675 /* Map FN over the Control-1 chars in CT. */
2678 map_over_charset_control_1 (Lisp_Char_Table *ct,
2679 int (*fn) (struct chartab_range *range,
2680 Lisp_Object val, void *arg),
2683 struct chartab_range rainj;
2686 int stop = start + 32;
2688 rainj.type = CHARTAB_RANGE_CHAR;
2690 for (i = start, retval = 0; i < stop && retval == 0; i++)
2692 rainj.ch = (Emchar) (i);
2693 retval = (fn) (&rainj, ct->ascii[i], arg);
2699 /* Map FN over the row ROW of two-byte charset CHARSET.
2700 There must be a separate value for that row in the char table.
2701 CTE specifies the char table entry for CHARSET. */
2704 map_over_charset_row (Lisp_Char_Table_Entry *cte,
2705 Lisp_Object charset, int row,
2706 int (*fn) (struct chartab_range *range,
2707 Lisp_Object val, void *arg),
2710 Lisp_Object val = cte->level2[row - 32];
2712 if (!CHAR_TABLE_ENTRYP (val))
2714 struct chartab_range rainj;
2716 rainj.type = CHARTAB_RANGE_ROW;
2717 rainj.charset = charset;
2719 return (fn) (&rainj, val, arg);
2723 struct chartab_range rainj;
2725 int charset94_p = (XCHARSET_CHARS (charset) == 94);
2726 int start = charset94_p ? 33 : 32;
2727 int stop = charset94_p ? 127 : 128;
2729 cte = XCHAR_TABLE_ENTRY (val);
2731 rainj.type = CHARTAB_RANGE_CHAR;
2733 for (i = start, retval = 0; i < stop && retval == 0; i++)
2735 rainj.ch = MAKE_CHAR (charset, row, i);
2736 retval = (fn) (&rainj, cte->level2[i - 32], arg);
2744 map_over_other_charset (Lisp_Char_Table *ct, Charset_ID lb,
2745 int (*fn) (struct chartab_range *range,
2746 Lisp_Object val, void *arg),
2749 Lisp_Object val = ct->level1[lb - MIN_LEADING_BYTE];
2750 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (lb);
2752 if (!CHARSETP (charset)
2753 || lb == LEADING_BYTE_ASCII
2754 || lb == LEADING_BYTE_CONTROL_1)
2757 if (!CHAR_TABLE_ENTRYP (val))
2759 struct chartab_range rainj;
2761 rainj.type = CHARTAB_RANGE_CHARSET;
2762 rainj.charset = charset;
2763 return (fn) (&rainj, val, arg);
2767 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
2768 int charset94_p = (XCHARSET_CHARS (charset) == 94);
2769 int start = charset94_p ? 33 : 32;
2770 int stop = charset94_p ? 127 : 128;
2773 if (XCHARSET_DIMENSION (charset) == 1)
2775 struct chartab_range rainj;
2776 rainj.type = CHARTAB_RANGE_CHAR;
2778 for (i = start, retval = 0; i < stop && retval == 0; i++)
2780 rainj.ch = MAKE_CHAR (charset, i, 0);
2781 retval = (fn) (&rainj, cte->level2[i - 32], arg);
2786 for (i = start, retval = 0; i < stop && retval == 0; i++)
2787 retval = map_over_charset_row (cte, charset, i, fn, arg);
2795 #endif /* not UTF2000 */
2798 struct map_char_table_for_charset_arg
2800 int (*fn) (struct chartab_range *range, Lisp_Object val, void *arg);
2801 Lisp_Char_Table *ct;
2806 map_char_table_for_charset_fun (struct chartab_range *range,
2807 Lisp_Object val, void *arg)
2809 struct map_char_table_for_charset_arg *closure =
2810 (struct map_char_table_for_charset_arg *) arg;
2813 switch (range->type)
2815 case CHARTAB_RANGE_ALL:
2818 case CHARTAB_RANGE_DEFAULT:
2821 case CHARTAB_RANGE_CHARSET:
2824 case CHARTAB_RANGE_ROW:
2827 case CHARTAB_RANGE_CHAR:
2828 ret = get_char_table (range->ch, closure->ct);
2829 if (!UNBOUNDP (ret))
2830 return (closure->fn) (range, ret, closure->arg);
2842 /* Map FN (with client data ARG) over range RANGE in char table CT.
2843 Mapping stops the first time FN returns non-zero, and that value
2844 becomes the return value of map_char_table(). */
2847 map_char_table (Lisp_Char_Table *ct,
2848 struct chartab_range *range,
2849 int (*fn) (struct chartab_range *range,
2850 Lisp_Object val, void *arg),
2853 switch (range->type)
2855 case CHARTAB_RANGE_ALL:
2857 if (!UNBOUNDP (ct->default_value))
2859 struct chartab_range rainj;
2862 rainj.type = CHARTAB_RANGE_DEFAULT;
2863 retval = (fn) (&rainj, ct->default_value, arg);
2867 if (UINT8_BYTE_TABLE_P (ct->table))
2868 return map_over_uint8_byte_table (XUINT8_BYTE_TABLE(ct->table), ct,
2870 else if (UINT16_BYTE_TABLE_P (ct->table))
2871 return map_over_uint16_byte_table (XUINT16_BYTE_TABLE(ct->table), ct,
2873 else if (BYTE_TABLE_P (ct->table))
2874 return map_over_byte_table (XBYTE_TABLE(ct->table), ct,
2876 else if (EQ (ct->table, Qunloaded))
2879 struct chartab_range rainj;
2882 Emchar c1 = c + unit;
2885 rainj.type = CHARTAB_RANGE_CHAR;
2887 for (retval = 0; c < c1 && retval == 0; c++)
2889 Lisp_Object ret = get_char_id_table (ct, c);
2891 if (!UNBOUNDP (ret))
2894 retval = (fn) (&rainj, ct->table, arg);
2899 ct->table = Qunbound;
2902 else if (!UNBOUNDP (ct->table))
2903 return (fn) (range, ct->table, arg);
2909 retval = map_over_charset_ascii (ct, fn, arg);
2913 retval = map_over_charset_control_1 (ct, fn, arg);
2918 Charset_ID start = MIN_LEADING_BYTE;
2919 Charset_ID stop = start + NUM_LEADING_BYTES;
2921 for (i = start, retval = 0; i < stop && retval == 0; i++)
2923 retval = map_over_other_charset (ct, i, fn, arg);
2932 case CHARTAB_RANGE_DEFAULT:
2933 if (!UNBOUNDP (ct->default_value))
2934 return (fn) (range, ct->default_value, arg);
2939 case CHARTAB_RANGE_CHARSET:
2942 Lisp_Object encoding_table
2943 = XCHARSET_ENCODING_TABLE (range->charset);
2945 if (!NILP (encoding_table))
2947 struct chartab_range rainj;
2948 struct map_char_table_for_charset_arg mcarg;
2951 if (XCHAR_TABLE_UNLOADED(encoding_table))
2952 Fload_char_attribute_table (XCHAR_TABLE_NAME (encoding_table));
2957 rainj.type = CHARTAB_RANGE_ALL;
2958 return map_char_table (XCHAR_TABLE(encoding_table),
2960 &map_char_table_for_charset_fun,
2966 return map_over_other_charset (ct,
2967 XCHARSET_LEADING_BYTE (range->charset),
2971 case CHARTAB_RANGE_ROW:
2974 int cell_min, cell_max, i;
2976 struct chartab_range rainj;
2978 i = XCHARSET_CELL_RANGE (range->charset);
2980 cell_max = i & 0xFF;
2981 rainj.type = CHARTAB_RANGE_CHAR;
2982 for (retval =0, i = cell_min; i <= cell_max && retval == 0; i++)
2985 = DECODE_CHAR (range->charset, (range->row << 8) | i, 0);
2987 if ( charset_code_point (range->charset, ch, 0) >= 0 )
2990 = get_byte_table (get_byte_table
2994 (unsigned char)(ch >> 24)),
2995 (unsigned char) (ch >> 16)),
2996 (unsigned char) (ch >> 8)),
2997 (unsigned char) ch);
3000 val = ct->default_value;
3002 retval = (fn) (&rainj, val, arg);
3009 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (range->charset)
3010 - MIN_LEADING_BYTE];
3011 if (!CHAR_TABLE_ENTRYP (val))
3013 struct chartab_range rainj;
3015 rainj.type = CHARTAB_RANGE_ROW;
3016 rainj.charset = range->charset;
3017 rainj.row = range->row;
3018 return (fn) (&rainj, val, arg);
3021 return map_over_charset_row (XCHAR_TABLE_ENTRY (val),
3022 range->charset, range->row,
3025 #endif /* not UTF2000 */
3028 case CHARTAB_RANGE_CHAR:
3030 Emchar ch = range->ch;
3031 Lisp_Object val = CHAR_TABLE_VALUE_UNSAFE (ct, ch);
3033 if (!UNBOUNDP (val))
3035 struct chartab_range rainj;
3037 rainj.type = CHARTAB_RANGE_CHAR;
3039 return (fn) (&rainj, val, arg);
3051 struct slow_map_char_table_arg
3053 Lisp_Object function;
3058 slow_map_char_table_fun (struct chartab_range *range,
3059 Lisp_Object val, void *arg)
3061 Lisp_Object ranjarg = Qnil;
3062 struct slow_map_char_table_arg *closure =
3063 (struct slow_map_char_table_arg *) arg;
3065 switch (range->type)
3067 case CHARTAB_RANGE_ALL:
3072 case CHARTAB_RANGE_DEFAULT:
3078 case CHARTAB_RANGE_CHARSET:
3079 ranjarg = XCHARSET_NAME (range->charset);
3082 case CHARTAB_RANGE_ROW:
3083 ranjarg = vector2 (XCHARSET_NAME (range->charset),
3084 make_int (range->row));
3087 case CHARTAB_RANGE_CHAR:
3088 ranjarg = make_char (range->ch);
3094 closure->retval = call2 (closure->function, ranjarg, val);
3095 return !NILP (closure->retval);
3098 DEFUN ("map-char-table", Fmap_char_table, 2, 3, 0, /*
3099 Map FUNCTION over entries in CHAR-TABLE, calling it with two args,
3100 each key and value in the table.
3102 RANGE specifies a subrange to map over and is in the same format as
3103 the RANGE argument to `put-range-table'. If omitted or t, it defaults to
3106 (function, char_table, range))
3108 Lisp_Char_Table *ct;
3109 struct slow_map_char_table_arg slarg;
3110 struct gcpro gcpro1, gcpro2;
3111 struct chartab_range rainj;
3113 CHECK_CHAR_TABLE (char_table);
3114 ct = XCHAR_TABLE (char_table);
3117 decode_char_table_range (range, &rainj);
3118 slarg.function = function;
3119 slarg.retval = Qnil;
3120 GCPRO2 (slarg.function, slarg.retval);
3121 map_char_table (ct, &rainj, slow_map_char_table_fun, &slarg);
3124 return slarg.retval;
3128 /************************************************************************/
3129 /* Character Attributes */
3130 /************************************************************************/
3134 Lisp_Object Vchar_attribute_hash_table;
3136 /* We store the char-attributes in hash tables with the names as the
3137 key and the actual char-id-table object as the value. Occasionally
3138 we need to use them in a list format. These routines provide us
3140 struct char_attribute_list_closure
3142 Lisp_Object *char_attribute_list;
3146 add_char_attribute_to_list_mapper (Lisp_Object key, Lisp_Object value,
3147 void *char_attribute_list_closure)
3149 /* This function can GC */
3150 struct char_attribute_list_closure *calcl
3151 = (struct char_attribute_list_closure*) char_attribute_list_closure;
3152 Lisp_Object *char_attribute_list = calcl->char_attribute_list;
3154 *char_attribute_list = Fcons (key, *char_attribute_list);
3158 #ifdef HAVE_LIBCHISE
3160 char_attribute_list_reset_map_func (CHISE_DS *ds, unsigned char *name)
3162 Fmount_char_attribute_table (intern (name));
3166 DEFUN ("char-attribute-list", Fchar_attribute_list, 0, 1, 0, /*
3167 Return the list of all existing character attributes except coded-charsets.
3171 DEFUN ("char-attribute-list", Fchar_attribute_list, 0, 0, 0, /*
3172 Return the list of all existing character attributes except coded-charsets.
3177 Lisp_Object char_attribute_list = Qnil;
3178 struct gcpro gcpro1;
3179 struct char_attribute_list_closure char_attribute_list_closure;
3181 #ifdef HAVE_LIBCHISE
3184 open_chise_data_source_maybe ();
3185 chise_ds_foreach_char_feature_name
3186 (default_chise_data_source, &char_attribute_list_reset_map_func);
3189 GCPRO1 (char_attribute_list);
3190 char_attribute_list_closure.char_attribute_list = &char_attribute_list;
3191 elisp_maphash (add_char_attribute_to_list_mapper,
3192 Vchar_attribute_hash_table,
3193 &char_attribute_list_closure);
3195 return char_attribute_list;
3198 DEFUN ("find-char-attribute-table", Ffind_char_attribute_table, 1, 1, 0, /*
3199 Return char-id-table corresponding to ATTRIBUTE.
3203 return Fgethash (attribute, Vchar_attribute_hash_table, Qnil);
3207 /* We store the char-id-tables in hash tables with the attributes as
3208 the key and the actual char-id-table object as the value. Each
3209 char-id-table stores values of an attribute corresponding with
3210 characters. Occasionally we need to get attributes of a character
3211 in a association-list format. These routines provide us with
3213 struct char_attribute_alist_closure
3216 Lisp_Object *char_attribute_alist;
3220 add_char_attribute_alist_mapper (Lisp_Object key, Lisp_Object value,
3221 void *char_attribute_alist_closure)
3223 /* This function can GC */
3224 struct char_attribute_alist_closure *caacl =
3225 (struct char_attribute_alist_closure*) char_attribute_alist_closure;
3227 = get_char_id_table (XCHAR_TABLE(value), caacl->char_id);
3228 if (!UNBOUNDP (ret))
3230 Lisp_Object *char_attribute_alist = caacl->char_attribute_alist;
3231 *char_attribute_alist
3232 = Fcons (Fcons (key, ret), *char_attribute_alist);
3237 DEFUN ("char-attribute-alist", Fchar_attribute_alist, 1, 1, 0, /*
3238 Return the alist of attributes of CHARACTER.
3242 struct gcpro gcpro1;
3243 struct char_attribute_alist_closure char_attribute_alist_closure;
3244 Lisp_Object alist = Qnil;
3246 CHECK_CHAR (character);
3249 char_attribute_alist_closure.char_id = XCHAR (character);
3250 char_attribute_alist_closure.char_attribute_alist = &alist;
3251 elisp_maphash (add_char_attribute_alist_mapper,
3252 Vchar_attribute_hash_table,
3253 &char_attribute_alist_closure);
3259 DEFUN ("get-char-attribute", Fget_char_attribute, 2, 3, 0, /*
3260 Return the value of CHARACTER's ATTRIBUTE.
3261 Return DEFAULT-VALUE if the value is not exist.
3263 (character, attribute, default_value))
3267 CHECK_CHAR (character);
3269 if (CHARSETP (attribute))
3270 attribute = XCHARSET_NAME (attribute);
3272 table = Fgethash (attribute, Vchar_attribute_hash_table,
3274 if (!UNBOUNDP (table))
3276 Lisp_Object ret = get_char_id_table (XCHAR_TABLE(table),
3278 if (!UNBOUNDP (ret))
3281 return default_value;
3285 find_char_feature_in_family (Lisp_Object character,
3286 Lisp_Object con_feature,
3287 Lisp_Object feature,
3288 Lisp_Object feature_rel_max)
3290 Lisp_Object ancestors
3291 = Fget_char_attribute (character, con_feature, Qnil);
3293 while (!NILP (ancestors))
3295 Lisp_Object ancestor = XCAR (ancestors);
3298 if (EQ (ancestor, character))
3301 ret = Fchar_feature (ancestor, feature, Qunbound,
3302 Qnil, make_int (0));
3303 if (!UNBOUNDP (ret))
3306 ancestors = XCDR (ancestors);
3308 ret = Fget_char_attribute (ancestor, Q_subsumptive_from, Qnil);
3310 ancestors = nconc2 (Fcopy_sequence (ancestors), ret);
3312 ret = Fget_char_attribute (ancestor, Q_denotational_from, Qnil);
3314 ancestors = nconc2 (Fcopy_sequence (ancestors), ret);
3319 DEFUN ("char-feature", Fchar_feature, 2, 5, 0, /*
3320 Return the value of CHARACTER's FEATURE.
3321 Return DEFAULT-VALUE if the value is not exist.
3323 (character, attribute, default_value,
3324 feature_rel_max, char_rel_max))
3327 = Fget_char_attribute (character, attribute, Qunbound);
3329 if (!UNBOUNDP (ret))
3332 if (NILP (feature_rel_max)
3333 || (INTP (feature_rel_max) &&
3334 XINT (feature_rel_max) > 0))
3336 Lisp_String* name = symbol_name (XSYMBOL (attribute));
3337 Bufbyte *name_str = string_data (name);
3339 if (name_str[0] == '=' && name_str[1] == '>')
3341 Bytecount length = string_length (name) - 1;
3342 Lisp_Object map_to = make_uninit_string (length);
3344 memcpy (XSTRING_DATA (map_to) + 1, name_str + 2, length - 1);
3345 XSTRING_DATA(map_to)[0] = '=';
3346 ret = Fchar_feature (character, Fintern (map_to, Qnil),
3348 NILP (feature_rel_max)
3350 : make_int (XINT (feature_rel_max) - 1),
3352 if (!UNBOUNDP (ret))
3357 if ( !(EQ (attribute, Q_identical)) &&
3358 !(EQ (attribute, Q_subsumptive_from)) &&
3359 !(EQ (attribute, Q_denotational_from)) &&
3360 ( (NILP (char_rel_max)
3361 || (INTP (char_rel_max) &&
3362 XINT (char_rel_max) > 0)) ) )
3364 Lisp_String* name = symbol_name (XSYMBOL (attribute));
3365 Bufbyte *name_str = string_data (name);
3367 if ( (name_str[0] != '=') || (name_str[1] == '>') )
3369 ret = find_char_feature_in_family (character, Q_identical,
3370 attribute, feature_rel_max);
3371 if (!UNBOUNDP (ret))
3374 ret = find_char_feature_in_family (character, Q_subsumptive_from,
3375 attribute, feature_rel_max);
3376 if (!UNBOUNDP (ret))
3379 ret = find_char_feature_in_family (character, Q_denotational_from,
3380 attribute, feature_rel_max);
3381 if (!UNBOUNDP (ret))
3385 return default_value;
3388 void put_char_composition (Lisp_Object character, Lisp_Object value);
3390 put_char_composition (Lisp_Object character, Lisp_Object value)
3393 signal_simple_error ("Invalid value for ->decomposition",
3396 if (CONSP (Fcdr (value)))
3398 if (NILP (Fcdr (Fcdr (value))))
3400 Lisp_Object base = Fcar (value);
3401 Lisp_Object modifier = Fcar (Fcdr (value));
3405 base = make_char (XINT (base));
3406 Fsetcar (value, base);
3408 if (INTP (modifier))
3410 modifier = make_char (XINT (modifier));
3411 Fsetcar (Fcdr (value), modifier);
3416 = Fchar_feature (base, Qcomposition, Qnil,
3418 Lisp_Object ret = Fassq (modifier, alist);
3421 Fput_char_attribute (base, Qcomposition,
3422 Fcons (Fcons (modifier, character),
3425 Fsetcdr (ret, character);
3431 Lisp_Object v = Fcar (value);
3435 Emchar c = DECODE_CHAR (Vcharset_ucs, XINT (v), 0);
3437 = Fchar_feature (make_char (c), Q_ucs_unified, Qnil,
3442 Fput_char_attribute (make_char (c), Q_ucs_unified,
3443 Fcons (character, Qnil));
3445 else if (NILP (Fmemq (character, ret)))
3447 Fput_char_attribute (make_char (c), Q_ucs_unified,
3448 Fcons (character, ret));
3455 put_char_attribute (Lisp_Object character, Lisp_Object attribute,
3458 Lisp_Object table = Fgethash (attribute,
3459 Vchar_attribute_hash_table,
3464 table = make_char_id_table (Qunbound);
3465 Fputhash (attribute, table, Vchar_attribute_hash_table);
3467 XCHAR_TABLE_NAME (table) = attribute;
3470 put_char_id_table (XCHAR_TABLE(table), character, value);
3474 DEFUN ("put-char-attribute", Fput_char_attribute, 3, 3, 0, /*
3475 Store CHARACTER's ATTRIBUTE with VALUE.
3477 (character, attribute, value))
3479 Lisp_Object ccs = Ffind_charset (attribute);
3481 CHECK_CHAR (character);
3485 value = put_char_ccs_code_point (character, ccs, value);
3486 attribute = XCHARSET_NAME (ccs);
3488 else if (EQ (attribute, Qmap_decomposition))
3489 put_char_composition (character, value);
3490 else if (EQ (attribute, Q_decomposition))
3492 attribute = Qmap_decomposition;
3493 put_char_composition (character, value);
3495 else if (EQ (attribute, Qto_ucs))
3501 signal_simple_error ("Invalid value for =>ucs", value);
3503 c = DECODE_CHAR (Vcharset_ucs, XINT (value), 0);
3505 ret = Fchar_feature (make_char (c), Q_ucs_unified, Qnil,
3508 put_char_attribute (make_char (c), Q_ucs_unified,
3510 else if (NILP (Fmemq (character, ret)))
3511 Fput_char_attribute (make_char (c), Q_ucs_unified,
3512 Fcons (character, ret));
3514 else if ( EQ (attribute, Q_subsumptive) ||
3515 EQ (attribute, Q_subsumptive_from) ||
3516 EQ (attribute, Q_denotational) ||
3517 EQ (attribute, Q_denotational_from) ||
3518 EQ (attribute, Q_identical) ||
3519 EQ (attribute, Q_identical_from) ||
3520 EQ (attribute, Q_component) ||
3521 EQ (attribute, Q_component_of) ||
3522 !NILP (Fstring_match
3523 (build_string ("^\\(<-\\|->\\)\\("
3524 "fullwidth\\|halfwidth"
3525 "\\|simplified\\|vulgar\\|wrong"
3526 "\\|same\\|original\\|ancient"
3527 "\\|Oracle-Bones\\)[^*]*$"),
3528 Fsymbol_name (attribute),
3531 Lisp_Object rest = value;
3533 Lisp_Object rev_feature = Qnil;
3534 struct gcpro gcpro1;
3535 GCPRO1 (rev_feature);
3537 if (EQ (attribute, Q_identical))
3538 rev_feature = Q_identical_from;
3539 else if (EQ (attribute, Q_identical_from))
3540 rev_feature = Q_identical;
3541 else if (EQ (attribute, Q_subsumptive))
3542 rev_feature = Q_subsumptive_from;
3543 else if (EQ (attribute, Q_subsumptive_from))
3544 rev_feature = Q_subsumptive;
3545 else if (EQ (attribute, Q_denotational))
3546 rev_feature = Q_denotational_from;
3547 else if (EQ (attribute, Q_denotational_from))
3548 rev_feature = Q_denotational;
3549 else if (EQ (attribute, Q_component))
3550 rev_feature = Q_component_of;
3551 else if (EQ (attribute, Q_component_of))
3552 rev_feature = Q_component;
3555 Lisp_String* name = symbol_name (XSYMBOL (attribute));
3556 Bufbyte *name_str = string_data (name);
3558 if ( (name_str[0] == '<' && name_str[1] == '-') ||
3559 (name_str[0] == '-' && name_str[1] == '>') )
3561 Bytecount length = string_length (name);
3562 Bufbyte *rev_name_str = alloca (length + 1);
3564 memcpy (rev_name_str + 2, name_str + 2, length - 2);
3565 if (name_str[0] == '<')
3567 rev_name_str[0] = '-';
3568 rev_name_str[1] = '>';
3572 rev_name_str[0] = '<';
3573 rev_name_str[1] = '-';
3575 rev_name_str[length] = 0;
3576 rev_feature = intern (rev_name_str);
3580 while (CONSP (rest))
3585 ret = Fdefine_char (ret);
3587 if ( !NILP (ret) && !EQ (ret, character) )
3591 ffv = Fget_char_attribute (ret, rev_feature, Qnil);
3593 put_char_attribute (ret, rev_feature, list1 (character));
3594 else if (NILP (Fmemq (character, ffv)))
3597 nconc2 (Fcopy_sequence (ffv), list1 (character)));
3598 Fsetcar (rest, ret);
3605 else if (EQ (attribute, Qideographic_structure))
3606 value = Fcopy_sequence (Fchar_refs_simplify_char_specs (value));
3608 return put_char_attribute (character, attribute, value);
3611 DEFUN ("remove-char-attribute", Fremove_char_attribute, 2, 2, 0, /*
3612 Remove CHARACTER's ATTRIBUTE.
3614 (character, attribute))
3618 CHECK_CHAR (character);
3619 ccs = Ffind_charset (attribute);
3622 return remove_char_ccs (character, ccs);
3626 Lisp_Object table = Fgethash (attribute,
3627 Vchar_attribute_hash_table,
3629 if (!UNBOUNDP (table))
3631 put_char_id_table (XCHAR_TABLE(table), character, Qunbound);
3640 int char_table_open_db_maybe (Lisp_Char_Table* cit);
3641 void char_table_close_db_maybe (Lisp_Char_Table* cit);
3642 Lisp_Object char_table_get_db (Lisp_Char_Table* cit, Emchar ch);
3644 #ifdef HAVE_LIBCHISE
3646 open_chise_data_source_maybe ()
3648 if (default_chise_data_source == NULL)
3650 Lisp_Object db_dir = Vdata_directory;
3651 int modemask = 0755; /* rwxr-xr-x */
3654 db_dir = build_string ("../etc");
3655 db_dir = Fexpand_file_name (build_string ("chise-db"), db_dir);
3657 default_chise_data_source
3658 = CHISE_DS_open (CHISE_DS_Berkeley_DB, XSTRING_DATA (db_dir),
3659 0 /* DB_HASH */, modemask);
3660 if (default_chise_data_source == NULL)
3663 chise_ds_set_make_string_function (default_chise_data_source,
3669 #endif /* HAVE_LIBCHISE */
3671 DEFUN ("close-char-data-source", Fclose_char_data_source, 0, 0, 0, /*
3672 Close data-source of CHISE.
3676 #ifdef HAVE_LIBCHISE
3677 int status = CHISE_DS_close (default_chise_data_source);
3679 default_chise_data_source = NULL;
3682 #endif /* HAVE_LIBCHISE */
3687 char_table_open_db_maybe (Lisp_Char_Table* cit)
3689 Lisp_Object attribute = CHAR_TABLE_NAME (cit);
3691 if (!NILP (attribute))
3693 #ifdef HAVE_LIBCHISE
3694 if ( open_chise_data_source_maybe () )
3696 #else /* HAVE_LIBCHISE */
3697 if (NILP (Fdatabase_live_p (cit->db)))
3700 = char_attribute_system_db_file (Qsystem_char_id, attribute, 0);
3702 cit->db = Fopen_database (db_file, Qnil, Qnil,
3703 build_string ("r"), Qnil);
3707 #endif /* not HAVE_LIBCHISE */
3715 char_table_close_db_maybe (Lisp_Char_Table* cit)
3717 #ifndef HAVE_LIBCHISE
3718 if (!NILP (cit->db))
3720 if (!NILP (Fdatabase_live_p (cit->db)))
3721 Fclose_database (cit->db);
3724 #endif /* not HAVE_LIBCHISE */
3728 char_table_get_db (Lisp_Char_Table* cit, Emchar ch)
3731 #ifdef HAVE_LIBCHISE
3734 = chise_ds_load_char_feature_value (default_chise_data_source, ch,
3735 XSTRING_DATA(Fsymbol_name
3742 val = Fread (make_string (chise_value_data (&value),
3743 chise_value_size (&value) ));
3745 val = read_from_c_string (chise_value_data (&value),
3746 chise_value_size (&value) );
3751 #else /* HAVE_LIBCHISE */
3752 val = Fget_database (Fprin1_to_string (make_char (ch), Qnil),
3754 if (!UNBOUNDP (val))
3758 #endif /* not HAVE_LIBCHISE */
3762 #ifndef HAVE_LIBCHISE
3764 char_attribute_system_db_file (Lisp_Object key_type, Lisp_Object attribute,
3767 Lisp_Object db_dir = Vdata_directory;
3770 db_dir = build_string ("../etc");
3772 db_dir = Fexpand_file_name (build_string ("chise-db"), db_dir);
3773 if (writing_mode && NILP (Ffile_exists_p (db_dir)))
3774 Fmake_directory_internal (db_dir);
3776 db_dir = Fexpand_file_name (Fsymbol_name (key_type), db_dir);
3777 if (writing_mode && NILP (Ffile_exists_p (db_dir)))
3778 Fmake_directory_internal (db_dir);
3781 Lisp_Object attribute_name = Fsymbol_name (attribute);
3782 Lisp_Object dest = Qnil, ret;
3784 struct gcpro gcpro1, gcpro2;
3785 int len = XSTRING_CHAR_LENGTH (attribute_name);
3789 for (i = 0; i < len; i++)
3791 Emchar c = string_char (XSTRING (attribute_name), i);
3793 if ( (c == '/') || (c == '%') )
3797 sprintf (str, "%%%02X", c);
3798 dest = concat3 (dest,
3799 Fsubstring (attribute_name,
3800 make_int (base), make_int (i)),
3801 build_string (str));
3805 ret = Fsubstring (attribute_name, make_int (base), make_int (len));
3806 dest = concat2 (dest, ret);
3808 return Fexpand_file_name (dest, db_dir);
3811 #endif /* not HAVE_LIBCHISE */
3813 DEFUN ("save-char-attribute-table", Fsave_char_attribute_table, 1, 1, 0, /*
3814 Save values of ATTRIBUTE into database file.
3818 Lisp_Object table = Fgethash (attribute,
3819 Vchar_attribute_hash_table, Qunbound);
3820 Lisp_Char_Table *ct;
3821 #ifdef HAVE_LIBCHISE
3822 CHISE_Feature feature;
3823 #else /* HAVE_LIBCHISE */
3824 Lisp_Object db_file;
3826 #endif /* not HAVE_LIBCHISE */
3828 if (CHAR_TABLEP (table))
3829 ct = XCHAR_TABLE (table);
3833 #ifdef HAVE_LIBCHISE
3834 if ( open_chise_data_source_maybe () )
3837 = chise_ds_get_feature (default_chise_data_source,
3838 XSTRING_DATA (Fsymbol_name (attribute)));
3839 #else /* HAVE_LIBCHISE */
3840 db_file = char_attribute_system_db_file (Qsystem_char_id, attribute, 1);
3841 db = Fopen_database (db_file, Qnil, Qnil, build_string ("w+"), Qnil);
3842 #endif /* not HAVE_LIBCHISE */
3844 #ifdef HAVE_LIBCHISE
3846 #else /* HAVE_LIBCHISE */
3848 #endif /* not HAVE_LIBCHISE */
3851 Lisp_Object (*filter)(Lisp_Object value);
3853 if ( !NILP (Ffind_charset (attribute)) )
3855 else if ( EQ (attribute, Qideographic_structure)
3856 || EQ (attribute, Q_identical)
3857 || EQ (attribute, Q_identical_from)
3858 || !NILP (Fstring_match
3859 (build_string ("^\\(<-\\|->\\)\\(simplified"
3860 "\\|same\\|vulgar\\|wrong"
3861 "\\|original\\|ancient"
3862 "\\|Oracle-Bones\\)[^*]*$"),
3863 Fsymbol_name (attribute),
3865 filter = &Fchar_refs_simplify_char_specs;
3869 if (UINT8_BYTE_TABLE_P (ct->table))
3870 save_uint8_byte_table (XUINT8_BYTE_TABLE(ct->table), ct,
3871 #ifdef HAVE_LIBCHISE
3873 #else /* HAVE_LIBCHISE */
3875 #endif /* not HAVE_LIBCHISE */
3877 else if (UINT16_BYTE_TABLE_P (ct->table))
3878 save_uint16_byte_table (XUINT16_BYTE_TABLE(ct->table), ct,
3879 #ifdef HAVE_LIBCHISE
3881 #else /* HAVE_LIBCHISE */
3883 #endif /* not HAVE_LIBCHISE */
3885 else if (BYTE_TABLE_P (ct->table))
3886 save_byte_table (XBYTE_TABLE(ct->table), ct,
3887 #ifdef HAVE_LIBCHISE
3889 #else /* HAVE_LIBCHISE */
3891 #endif /* not HAVE_LIBCHISE */
3893 #ifdef HAVE_LIBCHISE
3894 chise_feature_sync (feature);
3895 #else /* HAVE_LIBCHISE */
3896 Fclose_database (db);
3897 #endif /* not HAVE_LIBCHISE */
3904 DEFUN ("mount-char-attribute-table", Fmount_char_attribute_table, 1, 1, 0, /*
3905 Mount database file on char-attribute-table ATTRIBUTE.
3909 Lisp_Object table = Fgethash (attribute,
3910 Vchar_attribute_hash_table, Qunbound);
3912 if (UNBOUNDP (table))
3914 Lisp_Char_Table *ct;
3916 table = make_char_id_table (Qunbound);
3917 Fputhash (attribute, table, Vchar_attribute_hash_table);
3918 XCHAR_TABLE_NAME(table) = attribute;
3919 ct = XCHAR_TABLE (table);
3920 ct->table = Qunloaded;
3921 XCHAR_TABLE_UNLOADED(table) = 1;
3922 #ifndef HAVE_LIBCHISE
3924 #endif /* not HAVE_LIBCHISE */
3930 DEFUN ("close-char-attribute-table", Fclose_char_attribute_table, 1, 1, 0, /*
3931 Close database of ATTRIBUTE.
3935 Lisp_Object table = Fgethash (attribute,
3936 Vchar_attribute_hash_table, Qunbound);
3937 Lisp_Char_Table *ct;
3939 if (CHAR_TABLEP (table))
3940 ct = XCHAR_TABLE (table);
3943 char_table_close_db_maybe (ct);
3947 DEFUN ("reset-char-attribute-table", Freset_char_attribute_table, 1, 1, 0, /*
3948 Reset values of ATTRIBUTE with database file.
3952 #ifdef HAVE_LIBCHISE
3953 CHISE_Feature feature
3954 = chise_ds_get_feature (default_chise_data_source,
3955 XSTRING_DATA (Fsymbol_name
3958 if (feature == NULL)
3961 if (chise_feature_setup_db (feature, 0) == 0)
3963 Lisp_Object table = Fgethash (attribute,
3964 Vchar_attribute_hash_table, Qunbound);
3965 Lisp_Char_Table *ct;
3967 chise_feature_sync (feature);
3968 if (UNBOUNDP (table))
3970 table = make_char_id_table (Qunbound);
3971 Fputhash (attribute, table, Vchar_attribute_hash_table);
3972 XCHAR_TABLE_NAME(table) = attribute;
3974 ct = XCHAR_TABLE (table);
3975 ct->table = Qunloaded;
3976 char_table_close_db_maybe (ct);
3977 XCHAR_TABLE_UNLOADED(table) = 1;
3981 Lisp_Object table = Fgethash (attribute,
3982 Vchar_attribute_hash_table, Qunbound);
3983 Lisp_Char_Table *ct;
3985 = char_attribute_system_db_file (Qsystem_char_id, attribute, 0);
3987 if (!NILP (Ffile_exists_p (db_file)))
3989 if (UNBOUNDP (table))
3991 table = make_char_id_table (Qunbound);
3992 Fputhash (attribute, table, Vchar_attribute_hash_table);
3993 XCHAR_TABLE_NAME(table) = attribute;
3995 ct = XCHAR_TABLE (table);
3996 ct->table = Qunloaded;
3997 char_table_close_db_maybe (ct);
3998 XCHAR_TABLE_UNLOADED(table) = 1;
4006 load_char_attribute_maybe (Lisp_Char_Table* cit, Emchar ch)
4008 Lisp_Object attribute = CHAR_TABLE_NAME (cit);
4010 if (!NILP (attribute))
4014 if (char_table_open_db_maybe (cit))
4017 val = char_table_get_db (cit, ch);
4019 if (!NILP (Vchar_db_stingy_mode))
4020 char_table_close_db_maybe (cit);
4027 Lisp_Char_Table* char_attribute_table_to_load;
4029 #ifdef HAVE_LIBCHISE
4031 load_char_attribute_table_map_func (CHISE_Char_ID cid,
4032 CHISE_Feature feature,
4033 CHISE_Value *value);
4035 load_char_attribute_table_map_func (CHISE_Char_ID cid,
4036 CHISE_Feature feature,
4040 Lisp_Object ret = get_char_id_table_0 (char_attribute_table_to_load, code);
4042 if (EQ (ret, Qunloaded))
4043 put_char_id_table_0 (char_attribute_table_to_load, code,
4044 Fread (make_string ((Bufbyte *) value->data,
4048 #else /* HAVE_LIBCHISE */
4049 Lisp_Object Qload_char_attribute_table_map_function;
4051 DEFUN ("load-char-attribute-table-map-function",
4052 Fload_char_attribute_table_map_function, 2, 2, 0, /*
4053 For internal use. Don't use it.
4057 Lisp_Object c = Fread (key);
4058 Emchar code = XCHAR (c);
4059 Lisp_Object ret = get_char_id_table_0 (char_attribute_table_to_load, code);
4061 if (EQ (ret, Qunloaded))
4062 put_char_id_table_0 (char_attribute_table_to_load, code, Fread (value));
4065 #endif /* not HAVE_LIBCHISE */
4067 DEFUN ("load-char-attribute-table", Fload_char_attribute_table, 1, 1, 0, /*
4068 Load values of ATTRIBUTE into database file.
4072 Lisp_Object table = Fgethash (attribute,
4073 Vchar_attribute_hash_table,
4075 if (CHAR_TABLEP (table))
4077 Lisp_Char_Table *cit = XCHAR_TABLE (table);
4079 if (char_table_open_db_maybe (cit))
4082 char_attribute_table_to_load = XCHAR_TABLE (table);
4084 struct gcpro gcpro1;
4087 #ifdef HAVE_LIBCHISE
4088 chise_feature_foreach_char_with_value
4089 (chise_ds_get_feature (default_chise_data_source,
4090 XSTRING_DATA (Fsymbol_name (cit->name))),
4091 &load_char_attribute_table_map_func);
4092 #else /* HAVE_LIBCHISE */
4093 Fmap_database (Qload_char_attribute_table_map_function, cit->db);
4094 #endif /* not HAVE_LIBCHISE */
4097 char_table_close_db_maybe (cit);
4098 XCHAR_TABLE_UNLOADED(table) = 0;
4103 #endif /* HAVE_CHISE */
4105 DEFUN ("map-char-attribute", Fmap_char_attribute, 2, 3, 0, /*
4106 Map FUNCTION over entries in ATTRIBUTE, calling it with two args,
4107 each key and value in the table.
4109 RANGE specifies a subrange to map over and is in the same format as
4110 the RANGE argument to `put-range-table'. If omitted or t, it defaults to
4113 (function, attribute, range))
4116 Lisp_Char_Table *ct;
4117 struct slow_map_char_table_arg slarg;
4118 struct gcpro gcpro1, gcpro2;
4119 struct chartab_range rainj;
4121 if (!NILP (ccs = Ffind_charset (attribute)))
4123 Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (ccs);
4125 if (CHAR_TABLEP (encoding_table))
4126 ct = XCHAR_TABLE (encoding_table);
4132 Lisp_Object table = Fgethash (attribute,
4133 Vchar_attribute_hash_table,
4135 if (CHAR_TABLEP (table))
4136 ct = XCHAR_TABLE (table);
4142 decode_char_table_range (range, &rainj);
4144 if (CHAR_TABLE_UNLOADED(ct))
4145 Fload_char_attribute_table (attribute);
4147 slarg.function = function;
4148 slarg.retval = Qnil;
4149 GCPRO2 (slarg.function, slarg.retval);
4150 map_char_table (ct, &rainj, slow_map_char_table_fun, &slarg);
4153 return slarg.retval;
4156 DEFUN ("define-char", Fdefine_char, 1, 1, 0, /*
4157 Store character's ATTRIBUTES.
4162 Lisp_Object code = Fcdr (Fassq (Qmap_ucs, attributes));
4163 Lisp_Object character;
4166 code = Fcdr (Fassq (Qucs, attributes));
4171 while (CONSP (rest))
4173 Lisp_Object cell = Fcar (rest);
4176 if ( !LISTP (cell) )
4177 signal_simple_error ("Invalid argument", attributes);
4179 ccs = Ffind_charset (Fcar (cell));
4185 character = Fdecode_char (ccs, cell, Qt, Qt);
4186 if (!NILP (character))
4187 goto setup_attributes;
4189 if ( (XCHARSET_FINAL (ccs) != 0) ||
4190 (XCHARSET_MAX_CODE (ccs) > 0) ||
4191 (EQ (ccs, Vcharset_chinese_big5)) )
4195 = Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
4197 character = Fdecode_char (ccs, cell, Qnil, Qt);
4198 if (!NILP (character))
4199 goto setup_attributes;
4206 int cid = XINT (Vnext_defined_char_id);
4208 if (cid <= 0xE00000)
4210 character = make_char (cid);
4211 Vnext_defined_char_id = make_int (cid + 1);
4212 goto setup_attributes;
4216 if ( (!NILP (code = Fcdr (Fassq (Qto_ucs, attributes)))) )
4219 signal_simple_error ("Invalid argument", attributes);
4221 character = make_char (XINT (code) + 0x100000);
4222 goto setup_attributes;
4227 else if (!INTP (code))
4228 signal_simple_error ("Invalid argument", attributes);
4230 character = make_char (XINT (code));
4234 while (CONSP (rest))
4236 Lisp_Object cell = Fcar (rest);
4239 signal_simple_error ("Invalid argument", attributes);
4241 Fput_char_attribute (character, Fcar (cell), Fcdr (cell));
4247 DEFUN ("find-char", Ffind_char, 1, 1, 0, /*
4248 Retrieve the character of the given ATTRIBUTES.
4252 Lisp_Object rest = attributes;
4255 while (CONSP (rest))
4257 Lisp_Object cell = Fcar (rest);
4261 signal_simple_error ("Invalid argument", attributes);
4262 if (!NILP (ccs = Ffind_charset (Fcar (cell))))
4266 return Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
4268 return Fdecode_char (ccs, cell, Qnil, Qnil);
4272 if ( (!NILP (code = Fcdr (Fassq (Qto_ucs, attributes)))) )
4275 signal_simple_error ("Invalid argument", attributes);
4277 return make_char (XINT (code) + 0x100000);
4285 /************************************************************************/
4286 /* Char table read syntax */
4287 /************************************************************************/
4290 chartab_type_validate (Lisp_Object keyword, Lisp_Object value,
4291 Error_behavior errb)
4293 /* #### should deal with ERRB */
4294 symbol_to_char_table_type (value);
4299 chartab_data_validate (Lisp_Object keyword, Lisp_Object value,
4300 Error_behavior errb)
4304 /* #### should deal with ERRB */
4305 EXTERNAL_LIST_LOOP (rest, value)
4307 Lisp_Object range = XCAR (rest);
4308 struct chartab_range dummy;
4312 signal_simple_error ("Invalid list format", value);
4315 if (!CONSP (XCDR (range))
4316 || !NILP (XCDR (XCDR (range))))
4317 signal_simple_error ("Invalid range format", range);
4318 decode_char_table_range (XCAR (range), &dummy);
4319 decode_char_table_range (XCAR (XCDR (range)), &dummy);
4322 decode_char_table_range (range, &dummy);
4329 chartab_instantiate (Lisp_Object data)
4331 Lisp_Object chartab;
4332 Lisp_Object type = Qgeneric;
4333 Lisp_Object dataval = Qnil;
4335 while (!NILP (data))
4337 Lisp_Object keyw = Fcar (data);
4343 if (EQ (keyw, Qtype))
4345 else if (EQ (keyw, Qdata))
4349 chartab = Fmake_char_table (type);
4352 while (!NILP (data))
4354 Lisp_Object range = Fcar (data);
4355 Lisp_Object val = Fcar (Fcdr (data));
4357 data = Fcdr (Fcdr (data));
4360 if (CHAR_OR_CHAR_INTP (XCAR (range)))
4362 Emchar first = XCHAR_OR_CHAR_INT (Fcar (range));
4363 Emchar last = XCHAR_OR_CHAR_INT (Fcar (Fcdr (range)));
4366 for (i = first; i <= last; i++)
4367 Fput_char_table (make_char (i), val, chartab);
4373 Fput_char_table (range, val, chartab);
4382 /************************************************************************/
4383 /* Category Tables, specifically */
4384 /************************************************************************/
4386 DEFUN ("category-table-p", Fcategory_table_p, 1, 1, 0, /*
4387 Return t if OBJECT is a category table.
4388 A category table is a type of char table used for keeping track of
4389 categories. Categories are used for classifying characters for use
4390 in regexps -- you can refer to a category rather than having to use
4391 a complicated [] expression (and category lookups are significantly
4394 There are 95 different categories available, one for each printable
4395 character (including space) in the ASCII charset. Each category
4396 is designated by one such character, called a "category designator".
4397 They are specified in a regexp using the syntax "\\cX", where X is
4398 a category designator.
4400 A category table specifies, for each character, the categories that
4401 the character is in. Note that a character can be in more than one
4402 category. More specifically, a category table maps from a character
4403 to either the value nil (meaning the character is in no categories)
4404 or a 95-element bit vector, specifying for each of the 95 categories
4405 whether the character is in that category.
4407 Special Lisp functions are provided that abstract this, so you do not
4408 have to directly manipulate bit vectors.
4412 return (CHAR_TABLEP (object) &&
4413 XCHAR_TABLE_TYPE (object) == CHAR_TABLE_TYPE_CATEGORY) ?
4418 check_category_table (Lisp_Object object, Lisp_Object default_)
4422 while (NILP (Fcategory_table_p (object)))
4423 object = wrong_type_argument (Qcategory_table_p, object);
4428 check_category_char (Emchar ch, Lisp_Object table,
4429 unsigned int designator, unsigned int not_p)
4431 REGISTER Lisp_Object temp;
4432 Lisp_Char_Table *ctbl;
4433 #ifdef ERROR_CHECK_TYPECHECK
4434 if (NILP (Fcategory_table_p (table)))
4435 signal_simple_error ("Expected category table", table);
4437 ctbl = XCHAR_TABLE (table);
4438 temp = get_char_table (ch, ctbl);
4443 return bit_vector_bit (XBIT_VECTOR (temp), designator) ? !not_p : not_p;
4446 DEFUN ("check-category-at", Fcheck_category_at, 2, 4, 0, /*
4447 Return t if category of the character at POSITION includes DESIGNATOR.
4448 Optional third arg BUFFER specifies which buffer to use, and defaults
4449 to the current buffer.
4450 Optional fourth arg CATEGORY-TABLE specifies the category table to
4451 use, and defaults to BUFFER's category table.
4453 (position, designator, buffer, category_table))
4458 struct buffer *buf = decode_buffer (buffer, 0);
4460 CHECK_INT (position);
4461 CHECK_CATEGORY_DESIGNATOR (designator);
4462 des = XCHAR (designator);
4463 ctbl = check_category_table (category_table, Vstandard_category_table);
4464 ch = BUF_FETCH_CHAR (buf, XINT (position));
4465 return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil;
4468 DEFUN ("char-in-category-p", Fchar_in_category_p, 2, 3, 0, /*
4469 Return t if category of CHARACTER includes DESIGNATOR, else nil.
4470 Optional third arg CATEGORY-TABLE specifies the category table to use,
4471 and defaults to the standard category table.
4473 (character, designator, category_table))
4479 CHECK_CATEGORY_DESIGNATOR (designator);
4480 des = XCHAR (designator);
4481 CHECK_CHAR (character);
4482 ch = XCHAR (character);
4483 ctbl = check_category_table (category_table, Vstandard_category_table);
4484 return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil;
4487 DEFUN ("category-table", Fcategory_table, 0, 1, 0, /*
4488 Return BUFFER's current category table.
4489 BUFFER defaults to the current buffer.
4493 return decode_buffer (buffer, 0)->category_table;
4496 DEFUN ("standard-category-table", Fstandard_category_table, 0, 0, 0, /*
4497 Return the standard category table.
4498 This is the one used for new buffers.
4502 return Vstandard_category_table;
4505 DEFUN ("copy-category-table", Fcopy_category_table, 0, 1, 0, /*
4506 Return a new category table which is a copy of CATEGORY-TABLE.
4507 CATEGORY-TABLE defaults to the standard category table.
4511 if (NILP (Vstandard_category_table))
4512 return Fmake_char_table (Qcategory);
4515 check_category_table (category_table, Vstandard_category_table);
4516 return Fcopy_char_table (category_table);
4519 DEFUN ("set-category-table", Fset_category_table, 1, 2, 0, /*
4520 Select CATEGORY-TABLE as the new category table for BUFFER.
4521 BUFFER defaults to the current buffer if omitted.
4523 (category_table, buffer))
4525 struct buffer *buf = decode_buffer (buffer, 0);
4526 category_table = check_category_table (category_table, Qnil);
4527 buf->category_table = category_table;
4528 /* Indicate that this buffer now has a specified category table. */
4529 buf->local_var_flags |= XINT (buffer_local_flags.category_table);
4530 return category_table;
4533 DEFUN ("category-designator-p", Fcategory_designator_p, 1, 1, 0, /*
4534 Return t if OBJECT is a category designator (a char in the range ' ' to '~').
4538 return CATEGORY_DESIGNATORP (object) ? Qt : Qnil;
4541 DEFUN ("category-table-value-p", Fcategory_table_value_p, 1, 1, 0, /*
4542 Return t if OBJECT is a category table value.
4543 Valid values are nil or a bit vector of size 95.
4547 return CATEGORY_TABLE_VALUEP (object) ? Qt : Qnil;
4551 #define CATEGORYP(x) \
4552 (CHARP (x) && XCHAR (x) >= 0x20 && XCHAR (x) <= 0x7E)
4554 #define CATEGORY_SET(c) \
4555 (get_char_table(c, XCHAR_TABLE(current_buffer->category_table)))
4557 /* Return 1 if CATEGORY_SET contains CATEGORY, else return 0.
4558 The faster version of `!NILP (Faref (category_set, category))'. */
4559 #define CATEGORY_MEMBER(category, category_set) \
4560 (bit_vector_bit(XBIT_VECTOR (category_set), category - 32))
4562 /* Return 1 if there is a word boundary between two word-constituent
4563 characters C1 and C2 if they appear in this order, else return 0.
4564 Use the macro WORD_BOUNDARY_P instead of calling this function
4567 int word_boundary_p (Emchar c1, Emchar c2);
4569 word_boundary_p (Emchar c1, Emchar c2)
4571 Lisp_Object category_set1, category_set2;
4576 if (COMPOSITE_CHAR_P (c1))
4577 c1 = cmpchar_component (c1, 0, 1);
4578 if (COMPOSITE_CHAR_P (c2))
4579 c2 = cmpchar_component (c2, 0, 1);
4583 if (EQ (CHAR_CHARSET (c1), CHAR_CHARSET (c2)))
4586 tail = Vword_separating_categories;
4592 tail = Vword_combining_categories;
4597 category_set1 = CATEGORY_SET (c1);
4598 if (NILP (category_set1))
4599 return default_result;
4600 category_set2 = CATEGORY_SET (c2);
4601 if (NILP (category_set2))
4602 return default_result;
4604 for (; CONSP (tail); tail = XCONS (tail)->cdr)
4606 Lisp_Object elt = XCONS(tail)->car;
4609 && CATEGORYP (XCONS (elt)->car)
4610 && CATEGORYP (XCONS (elt)->cdr)
4611 && CATEGORY_MEMBER (XCHAR (XCONS (elt)->car), category_set1)
4612 && CATEGORY_MEMBER (XCHAR (XCONS (elt)->cdr), category_set2))
4613 return !default_result;
4615 return default_result;
4621 syms_of_chartab (void)
4624 INIT_LRECORD_IMPLEMENTATION (uint8_byte_table);
4625 INIT_LRECORD_IMPLEMENTATION (uint16_byte_table);
4626 INIT_LRECORD_IMPLEMENTATION (byte_table);
4628 defsymbol (&Qto_ucs, "=>ucs");
4629 defsymbol (&Q_ucs_unified, "->ucs-unified");
4630 defsymbol (&Q_subsumptive, "->subsumptive");
4631 defsymbol (&Q_subsumptive_from, "<-subsumptive");
4632 defsymbol (&Q_denotational, "->denotational");
4633 defsymbol (&Q_denotational_from, "<-denotational");
4634 defsymbol (&Q_identical, "->identical");
4635 defsymbol (&Q_identical_from, "<-identical");
4636 defsymbol (&Q_component, "->ideographic-component-forms");
4637 defsymbol (&Q_component_of, "<-ideographic-component-forms");
4638 defsymbol (&Qcomposition, "composition");
4639 defsymbol (&Qmap_decomposition, "=decomposition");
4640 defsymbol (&Q_decomposition, "->decomposition");
4641 defsymbol (&Qcompat, "compat");
4642 defsymbol (&Qisolated, "isolated");
4643 defsymbol (&Qinitial, "initial");
4644 defsymbol (&Qmedial, "medial");
4645 defsymbol (&Qfinal, "final");
4646 defsymbol (&Qvertical, "vertical");
4647 defsymbol (&QnoBreak, "noBreak");
4648 defsymbol (&Qfraction, "fraction");
4649 defsymbol (&Qsuper, "super");
4650 defsymbol (&Qsub, "sub");
4651 defsymbol (&Qcircle, "circle");
4652 defsymbol (&Qsquare, "square");
4653 defsymbol (&Qwide, "wide");
4654 defsymbol (&Qnarrow, "narrow");
4655 defsymbol (&Qsmall, "small");
4656 defsymbol (&Qfont, "font");
4658 DEFSUBR (Fchar_attribute_list);
4659 DEFSUBR (Ffind_char_attribute_table);
4660 defsymbol (&Qput_char_table_map_function, "put-char-table-map-function");
4661 DEFSUBR (Fput_char_table_map_function);
4663 DEFSUBR (Fsave_char_attribute_table);
4664 DEFSUBR (Fmount_char_attribute_table);
4665 DEFSUBR (Freset_char_attribute_table);
4666 DEFSUBR (Fclose_char_attribute_table);
4667 DEFSUBR (Fclose_char_data_source);
4668 #ifndef HAVE_LIBCHISE
4669 defsymbol (&Qload_char_attribute_table_map_function,
4670 "load-char-attribute-table-map-function");
4671 DEFSUBR (Fload_char_attribute_table_map_function);
4673 DEFSUBR (Fload_char_attribute_table);
4675 DEFSUBR (Fchar_feature);
4676 DEFSUBR (Fchar_attribute_alist);
4677 DEFSUBR (Fget_char_attribute);
4678 DEFSUBR (Fput_char_attribute);
4679 DEFSUBR (Fremove_char_attribute);
4680 DEFSUBR (Fmap_char_attribute);
4681 DEFSUBR (Fdefine_char);
4682 DEFSUBR (Ffind_char);
4683 DEFSUBR (Fchar_variants);
4685 DEFSUBR (Fget_composite_char);
4688 INIT_LRECORD_IMPLEMENTATION (char_table);
4692 INIT_LRECORD_IMPLEMENTATION (char_table_entry);
4695 defsymbol (&Qcategory_table_p, "category-table-p");
4696 defsymbol (&Qcategory_designator_p, "category-designator-p");
4697 defsymbol (&Qcategory_table_value_p, "category-table-value-p");
4700 defsymbol (&Qchar_table, "char-table");
4701 defsymbol (&Qchar_tablep, "char-table-p");
4703 DEFSUBR (Fchar_table_p);
4704 DEFSUBR (Fchar_table_type_list);
4705 DEFSUBR (Fvalid_char_table_type_p);
4706 DEFSUBR (Fchar_table_type);
4707 DEFSUBR (Freset_char_table);
4708 DEFSUBR (Fmake_char_table);
4709 DEFSUBR (Fcopy_char_table);
4710 DEFSUBR (Fget_char_table);
4711 DEFSUBR (Fget_range_char_table);
4712 DEFSUBR (Fvalid_char_table_value_p);
4713 DEFSUBR (Fcheck_valid_char_table_value);
4714 DEFSUBR (Fput_char_table);
4715 DEFSUBR (Fmap_char_table);
4718 DEFSUBR (Fcategory_table_p);
4719 DEFSUBR (Fcategory_table);
4720 DEFSUBR (Fstandard_category_table);
4721 DEFSUBR (Fcopy_category_table);
4722 DEFSUBR (Fset_category_table);
4723 DEFSUBR (Fcheck_category_at);
4724 DEFSUBR (Fchar_in_category_p);
4725 DEFSUBR (Fcategory_designator_p);
4726 DEFSUBR (Fcategory_table_value_p);
4732 vars_of_chartab (void)
4735 DEFVAR_LISP ("next-defined-char-id", &Vnext_defined_char_id /*
4737 Vnext_defined_char_id = make_int (0x0F0000);
4741 DEFVAR_LISP ("char-db-stingy-mode", &Vchar_db_stingy_mode /*
4743 Vchar_db_stingy_mode = Qt;
4745 #ifdef HAVE_LIBCHISE
4746 Vchise_db_directory = build_string(chise_db_dir);
4747 DEFVAR_LISP ("chise-db-directory", &Vchise_db_directory /*
4748 Directory of CHISE character databases.
4751 Vchise_system_db_directory = build_string(chise_system_db_dir);
4752 DEFVAR_LISP ("chise-system-db-directory", &Vchise_system_db_directory /*
4753 Directory of system character database of CHISE.
4757 #endif /* HAVE_CHISE */
4758 /* DO NOT staticpro this. It works just like Vweak_hash_tables. */
4759 Vall_syntax_tables = Qnil;
4760 dump_add_weak_object_chain (&Vall_syntax_tables);
4764 structure_type_create_chartab (void)
4766 struct structure_type *st;
4768 st = define_structure_type (Qchar_table, 0, chartab_instantiate);
4770 define_structure_type_keyword (st, Qtype, chartab_type_validate);
4771 define_structure_type_keyword (st, Qdata, chartab_data_validate);
4775 complex_vars_of_chartab (void)
4778 staticpro (&Vchar_attribute_hash_table);
4779 Vchar_attribute_hash_table
4780 = make_lisp_hash_table (16, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
4781 #endif /* UTF2000 */
4783 /* Set this now, so first buffer creation can refer to it. */
4784 /* Make it nil before calling copy-category-table
4785 so that copy-category-table will know not to try to copy from garbage */
4786 Vstandard_category_table = Qnil;
4787 Vstandard_category_table = Fcopy_category_table (Qnil);
4788 staticpro (&Vstandard_category_table);
4790 DEFVAR_LISP ("word-combining-categories", &Vword_combining_categories /*
4791 List of pair (cons) of categories to determine word boundary.
4793 Emacs treats a sequence of word constituent characters as a single
4794 word (i.e. finds no word boundary between them) iff they belongs to
4795 the same charset. But, exceptions are allowed in the following cases.
4797 \(1) The case that characters are in different charsets is controlled
4798 by the variable `word-combining-categories'.
4800 Emacs finds no word boundary between characters of different charsets
4801 if they have categories matching some element of this list.
4803 More precisely, if an element of this list is a cons of category CAT1
4804 and CAT2, and a multibyte character C1 which has CAT1 is followed by
4805 C2 which has CAT2, there's no word boundary between C1 and C2.
4807 For instance, to tell that ASCII characters and Latin-1 characters can
4808 form a single word, the element `(?l . ?l)' should be in this list
4809 because both characters have the category `l' (Latin characters).
4811 \(2) The case that character are in the same charset is controlled by
4812 the variable `word-separating-categories'.
4814 Emacs find a word boundary between characters of the same charset
4815 if they have categories matching some element of this list.
4817 More precisely, if an element of this list is a cons of category CAT1
4818 and CAT2, and a multibyte character C1 which has CAT1 is followed by
4819 C2 which has CAT2, there's a word boundary between C1 and C2.
4821 For instance, to tell that there's a word boundary between Japanese
4822 Hiragana and Japanese Kanji (both are in the same charset), the
4823 element `(?H . ?C) should be in this list.
4826 Vword_combining_categories = Qnil;
4828 DEFVAR_LISP ("word-separating-categories", &Vword_separating_categories /*
4829 List of pair (cons) of categories to determine word boundary.
4830 See the documentation of the variable `word-combining-categories'.
4833 Vword_separating_categories = Qnil;