1 /* XEmacs routines to deal with char tables.
2 Copyright (C) 1992, 1995 Free Software Foundation, Inc.
3 Copyright (C) 1995 Sun Microsystems, Inc.
4 Copyright (C) 1995, 1996 Ben Wing.
5 Copyright (C) 1995, 1997, 1999 Electrotechnical Laboratory, JAPAN.
6 Licensed to the Free Software Foundation.
7 Copyright (C) 1999,2000,2001,2002,2003,2004 MORIOKA Tomohiko
9 This file is part of XEmacs.
11 XEmacs is free software; you can redistribute it and/or modify it
12 under the terms of the GNU General Public License as published by the
13 Free Software Foundation; either version 2, or (at your option) any
16 XEmacs is distributed in the hope that it will be useful, but WITHOUT
17 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
18 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
21 You should have received a copy of the GNU General Public License
22 along with XEmacs; see the file COPYING. If not, write to
23 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 Boston, MA 02111-1307, USA. */
26 /* Synched up with: Mule 2.3. Not synched with FSF.
28 This file was written independently of the FSF implementation,
29 and is not compatible. */
33 Ben Wing: wrote, for 19.13 (Mule). Some category table stuff
34 loosely based on the original Mule.
35 Jareth Hein: fixed a couple of bugs in the implementation, and
36 added regex support for categories with check_category_at
37 MORIOKA Tomohiko: Rewritten for XEmacs CHISE
50 Lisp_Object Qchar_tablep, Qchar_table;
52 Lisp_Object Vall_syntax_tables;
55 Lisp_Object Qcategory_table_p;
56 Lisp_Object Qcategory_designator_p;
57 Lisp_Object Qcategory_table_value_p;
59 Lisp_Object Vstandard_category_table;
61 /* Variables to determine word boundary. */
62 Lisp_Object Vword_combining_categories, Vword_separating_categories;
67 Lisp_Object Vchise_db_directory;
68 Lisp_Object Vchise_system_db_directory;
70 CHISE_DS *default_chise_data_source = NULL;
75 EXFUN (Fchar_refs_simplify_char_specs, 1);
76 extern Lisp_Object Qideographic_structure;
78 Lisp_Object Vnext_defined_char_id;
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 Q_decomposition;
1134 Lisp_Object Q_identical;
1135 Lisp_Object Q_identical_from;
1136 Lisp_Object Q_denotational;
1137 Lisp_Object Q_denotational_from;
1138 Lisp_Object Q_subsumptive;
1139 Lisp_Object Q_subsumptive_from;
1140 Lisp_Object Q_component;
1141 Lisp_Object Q_component_of;
1142 Lisp_Object Qto_ucs;
1143 Lisp_Object Q_ucs_unified;
1144 Lisp_Object Qcompat;
1145 Lisp_Object Qisolated;
1146 Lisp_Object Qinitial;
1147 Lisp_Object Qmedial;
1149 Lisp_Object Qvertical;
1150 Lisp_Object QnoBreak;
1151 Lisp_Object Qfraction;
1154 Lisp_Object Qcircle;
1155 Lisp_Object Qsquare;
1157 Lisp_Object Qnarrow;
1161 Emchar to_char_id (Lisp_Object v, char* err_msg, Lisp_Object err_arg);
1164 to_char_id (Lisp_Object v, char* err_msg, Lisp_Object err_arg)
1170 else if (EQ (v, Qcompat))
1172 else if (EQ (v, Qisolated))
1174 else if (EQ (v, Qinitial))
1176 else if (EQ (v, Qmedial))
1178 else if (EQ (v, Qfinal))
1180 else if (EQ (v, Qvertical))
1182 else if (EQ (v, QnoBreak))
1184 else if (EQ (v, Qfraction))
1186 else if (EQ (v, Qsuper))
1188 else if (EQ (v, Qsub))
1190 else if (EQ (v, Qcircle))
1192 else if (EQ (v, Qsquare))
1194 else if (EQ (v, Qwide))
1196 else if (EQ (v, Qnarrow))
1198 else if (EQ (v, Qsmall))
1200 else if (EQ (v, Qfont))
1203 signal_simple_error (err_msg, err_arg);
1206 DEFUN ("get-composite-char", Fget_composite_char, 1, 1, 0, /*
1207 Return character corresponding with list.
1211 Lisp_Object base, modifier;
1215 signal_simple_error ("Invalid value for composition", list);
1218 while (!NILP (rest))
1223 signal_simple_error ("Invalid value for composition", list);
1224 modifier = Fcar (rest);
1226 base = Fcdr (Fassq (modifier,
1227 Fchar_feature (base, Qcomposition, Qnil,
1233 DEFUN ("char-variants", Fchar_variants, 1, 1, 0, /*
1234 Return variants of CHARACTER.
1238 CHECK_CHAR (character);
1241 (Fcopy_list (Fget_char_attribute (character, Q_subsumptive, Qnil)),
1243 (Fcopy_list (Fget_char_attribute (character, Q_denotational, Qnil)),
1245 (Fcopy_list (Fget_char_attribute (character, Q_identical, Qnil)),
1246 Fcopy_list (Fchar_feature (character, Q_ucs_unified, Qnil,
1253 /* A char table maps from ranges of characters to values.
1255 Implementing a general data structure that maps from arbitrary
1256 ranges of numbers to values is tricky to do efficiently. As it
1257 happens, it should suffice (and is usually more convenient, anyway)
1258 when dealing with characters to restrict the sorts of ranges that
1259 can be assigned values, as follows:
1262 2) All characters in a charset.
1263 3) All characters in a particular row of a charset, where a "row"
1264 means all characters with the same first byte.
1265 4) A particular character in a charset.
1267 We use char tables to generalize the 256-element vectors now
1268 littering the Emacs code.
1270 Possible uses (all should be converted at some point):
1276 5) keyboard-translate-table?
1279 abstract type to generalize the Emacs vectors and Mule
1280 vectors-of-vectors goo.
1283 /************************************************************************/
1284 /* Char Table object */
1285 /************************************************************************/
1287 #if defined(MULE)&&!defined(UTF2000)
1290 mark_char_table_entry (Lisp_Object obj)
1292 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj);
1295 for (i = 0; i < 96; i++)
1297 mark_object (cte->level2[i]);
1303 char_table_entry_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
1305 Lisp_Char_Table_Entry *cte1 = XCHAR_TABLE_ENTRY (obj1);
1306 Lisp_Char_Table_Entry *cte2 = XCHAR_TABLE_ENTRY (obj2);
1309 for (i = 0; i < 96; i++)
1310 if (!internal_equal (cte1->level2[i], cte2->level2[i], depth + 1))
1316 static unsigned long
1317 char_table_entry_hash (Lisp_Object obj, int depth)
1319 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj);
1321 return internal_array_hash (cte->level2, 96, depth);
1324 static const struct lrecord_description char_table_entry_description[] = {
1325 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table_Entry, level2), 96 },
1329 DEFINE_LRECORD_IMPLEMENTATION ("char-table-entry", char_table_entry,
1330 mark_char_table_entry, internal_object_printer,
1331 0, char_table_entry_equal,
1332 char_table_entry_hash,
1333 char_table_entry_description,
1334 Lisp_Char_Table_Entry);
1338 mark_char_table (Lisp_Object obj)
1340 Lisp_Char_Table *ct = XCHAR_TABLE (obj);
1343 mark_object (ct->table);
1344 mark_object (ct->name);
1345 #ifndef HAVE_LIBCHISE
1346 mark_object (ct->db);
1351 for (i = 0; i < NUM_ASCII_CHARS; i++)
1352 mark_object (ct->ascii[i]);
1354 for (i = 0; i < NUM_LEADING_BYTES; i++)
1355 mark_object (ct->level1[i]);
1359 return ct->default_value;
1361 return ct->mirror_table;
1365 /* WARNING: All functions of this nature need to be written extremely
1366 carefully to avoid crashes during GC. Cf. prune_specifiers()
1367 and prune_weak_hash_tables(). */
1370 prune_syntax_tables (void)
1372 Lisp_Object rest, prev = Qnil;
1374 for (rest = Vall_syntax_tables;
1376 rest = XCHAR_TABLE (rest)->next_table)
1378 if (! marked_p (rest))
1380 /* This table is garbage. Remove it from the list. */
1382 Vall_syntax_tables = XCHAR_TABLE (rest)->next_table;
1384 XCHAR_TABLE (prev)->next_table =
1385 XCHAR_TABLE (rest)->next_table;
1391 char_table_type_to_symbol (enum char_table_type type)
1396 case CHAR_TABLE_TYPE_GENERIC: return Qgeneric;
1397 case CHAR_TABLE_TYPE_SYNTAX: return Qsyntax;
1398 case CHAR_TABLE_TYPE_DISPLAY: return Qdisplay;
1399 case CHAR_TABLE_TYPE_CHAR: return Qchar;
1401 case CHAR_TABLE_TYPE_CATEGORY: return Qcategory;
1406 static enum char_table_type
1407 symbol_to_char_table_type (Lisp_Object symbol)
1409 CHECK_SYMBOL (symbol);
1411 if (EQ (symbol, Qgeneric)) return CHAR_TABLE_TYPE_GENERIC;
1412 if (EQ (symbol, Qsyntax)) return CHAR_TABLE_TYPE_SYNTAX;
1413 if (EQ (symbol, Qdisplay)) return CHAR_TABLE_TYPE_DISPLAY;
1414 if (EQ (symbol, Qchar)) return CHAR_TABLE_TYPE_CHAR;
1416 if (EQ (symbol, Qcategory)) return CHAR_TABLE_TYPE_CATEGORY;
1419 signal_simple_error ("Unrecognized char table type", symbol);
1420 return CHAR_TABLE_TYPE_GENERIC; /* not reached */
1425 print_chartab_range (Emchar first, Emchar last, Lisp_Object val,
1426 Lisp_Object printcharfun)
1430 write_c_string (" (", printcharfun);
1431 print_internal (make_char (first), printcharfun, 0);
1432 write_c_string (" ", printcharfun);
1433 print_internal (make_char (last), printcharfun, 0);
1434 write_c_string (") ", printcharfun);
1438 write_c_string (" ", printcharfun);
1439 print_internal (make_char (first), printcharfun, 0);
1440 write_c_string (" ", printcharfun);
1442 print_internal (val, printcharfun, 1);
1446 #if defined(MULE)&&!defined(UTF2000)
1449 print_chartab_charset_row (Lisp_Object charset,
1451 Lisp_Char_Table_Entry *cte,
1452 Lisp_Object printcharfun)
1455 Lisp_Object cat = Qunbound;
1458 for (i = 32; i < 128; i++)
1460 Lisp_Object pam = cte->level2[i - 32];
1472 print_chartab_range (MAKE_CHAR (charset, first, 0),
1473 MAKE_CHAR (charset, i - 1, 0),
1476 print_chartab_range (MAKE_CHAR (charset, row, first),
1477 MAKE_CHAR (charset, row, i - 1),
1487 print_chartab_range (MAKE_CHAR (charset, first, 0),
1488 MAKE_CHAR (charset, i - 1, 0),
1491 print_chartab_range (MAKE_CHAR (charset, row, first),
1492 MAKE_CHAR (charset, row, i - 1),
1498 print_chartab_two_byte_charset (Lisp_Object charset,
1499 Lisp_Char_Table_Entry *cte,
1500 Lisp_Object printcharfun)
1504 for (i = 32; i < 128; i++)
1506 Lisp_Object jen = cte->level2[i - 32];
1508 if (!CHAR_TABLE_ENTRYP (jen))
1512 write_c_string (" [", printcharfun);
1513 print_internal (XCHARSET_NAME (charset), printcharfun, 0);
1514 sprintf (buf, " %d] ", i);
1515 write_c_string (buf, printcharfun);
1516 print_internal (jen, printcharfun, 0);
1519 print_chartab_charset_row (charset, i, XCHAR_TABLE_ENTRY (jen),
1527 print_char_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1529 Lisp_Char_Table *ct = XCHAR_TABLE (obj);
1532 struct gcpro gcpro1, gcpro2;
1533 GCPRO2 (obj, printcharfun);
1535 write_c_string ("#s(char-table ", printcharfun);
1536 write_c_string (" ", printcharfun);
1537 write_c_string (string_data
1539 (XSYMBOL (char_table_type_to_symbol (ct->type)))),
1541 write_c_string ("\n ", printcharfun);
1542 print_internal (ct->default_value, printcharfun, escapeflag);
1543 for (i = 0; i < 256; i++)
1545 Lisp_Object elt = get_byte_table (ct->table, i);
1546 if (i != 0) write_c_string ("\n ", printcharfun);
1547 if (EQ (elt, Qunbound))
1548 write_c_string ("void", printcharfun);
1550 print_internal (elt, printcharfun, escapeflag);
1553 #else /* non UTF2000 */
1556 sprintf (buf, "#s(char-table type %s data (",
1557 string_data (symbol_name (XSYMBOL
1558 (char_table_type_to_symbol (ct->type)))));
1559 write_c_string (buf, printcharfun);
1561 /* Now write out the ASCII/Control-1 stuff. */
1565 Lisp_Object val = Qunbound;
1567 for (i = 0; i < NUM_ASCII_CHARS; i++)
1576 if (!EQ (ct->ascii[i], val))
1578 print_chartab_range (first, i - 1, val, printcharfun);
1585 print_chartab_range (first, i - 1, val, printcharfun);
1592 for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES;
1595 Lisp_Object ann = ct->level1[i - MIN_LEADING_BYTE];
1596 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (i);
1598 if (!CHARSETP (charset) || i == LEADING_BYTE_ASCII
1599 || i == LEADING_BYTE_CONTROL_1)
1601 if (!CHAR_TABLE_ENTRYP (ann))
1603 write_c_string (" ", printcharfun);
1604 print_internal (XCHARSET_NAME (charset),
1606 write_c_string (" ", printcharfun);
1607 print_internal (ann, printcharfun, 0);
1611 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (ann);
1612 if (XCHARSET_DIMENSION (charset) == 1)
1613 print_chartab_charset_row (charset, -1, cte, printcharfun);
1615 print_chartab_two_byte_charset (charset, cte, printcharfun);
1620 #endif /* non UTF2000 */
1622 write_c_string ("))", printcharfun);
1626 char_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
1628 Lisp_Char_Table *ct1 = XCHAR_TABLE (obj1);
1629 Lisp_Char_Table *ct2 = XCHAR_TABLE (obj2);
1632 if (CHAR_TABLE_TYPE (ct1) != CHAR_TABLE_TYPE (ct2))
1636 for (i = 0; i < 256; i++)
1638 if (!internal_equal (get_byte_table (ct1->table, i),
1639 get_byte_table (ct2->table, i), 0))
1643 for (i = 0; i < NUM_ASCII_CHARS; i++)
1644 if (!internal_equal (ct1->ascii[i], ct2->ascii[i], depth + 1))
1648 for (i = 0; i < NUM_LEADING_BYTES; i++)
1649 if (!internal_equal (ct1->level1[i], ct2->level1[i], depth + 1))
1652 #endif /* non UTF2000 */
1657 static unsigned long
1658 char_table_hash (Lisp_Object obj, int depth)
1660 Lisp_Char_Table *ct = XCHAR_TABLE (obj);
1662 return byte_table_hash (ct->table, depth + 1);
1664 unsigned long hashval = internal_array_hash (ct->ascii, NUM_ASCII_CHARS,
1667 hashval = HASH2 (hashval,
1668 internal_array_hash (ct->level1, NUM_LEADING_BYTES, depth));
1674 static const struct lrecord_description char_table_description[] = {
1676 { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, table) },
1677 { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, default_value) },
1678 { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, name) },
1679 #ifndef HAVE_LIBCHISE
1680 { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, db) },
1683 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, ascii), NUM_ASCII_CHARS },
1685 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, level1), NUM_LEADING_BYTES },
1689 { XD_LISP_OBJECT, offsetof (Lisp_Char_Table, mirror_table) },
1691 { XD_LO_LINK, offsetof (Lisp_Char_Table, next_table) },
1695 DEFINE_LRECORD_IMPLEMENTATION ("char-table", char_table,
1696 mark_char_table, print_char_table, 0,
1697 char_table_equal, char_table_hash,
1698 char_table_description,
1701 DEFUN ("char-table-p", Fchar_table_p, 1, 1, 0, /*
1702 Return non-nil if OBJECT is a char table.
1704 A char table is a table that maps characters (or ranges of characters)
1705 to values. Char tables are specialized for characters, only allowing
1706 particular sorts of ranges to be assigned values. Although this
1707 loses in generality, it makes for extremely fast (constant-time)
1708 lookups, and thus is feasible for applications that do an extremely
1709 large number of lookups (e.g. scanning a buffer for a character in
1710 a particular syntax, where a lookup in the syntax table must occur
1711 once per character).
1713 When Mule support exists, the types of ranges that can be assigned
1717 -- an entire charset
1718 -- a single row in a two-octet charset
1719 -- a single character
1721 When Mule support is not present, the types of ranges that can be
1725 -- a single character
1727 To create a char table, use `make-char-table'.
1728 To modify a char table, use `put-char-table' or `remove-char-table'.
1729 To retrieve the value for a particular character, use `get-char-table'.
1730 See also `map-char-table', `clear-char-table', `copy-char-table',
1731 `valid-char-table-type-p', `char-table-type-list',
1732 `valid-char-table-value-p', and `check-char-table-value'.
1736 return CHAR_TABLEP (object) ? Qt : Qnil;
1739 DEFUN ("char-table-type-list", Fchar_table_type_list, 0, 0, 0, /*
1740 Return a list of the recognized char table types.
1741 See `valid-char-table-type-p'.
1746 return list5 (Qchar, Qcategory, Qdisplay, Qgeneric, Qsyntax);
1748 return list4 (Qchar, Qdisplay, Qgeneric, Qsyntax);
1752 DEFUN ("valid-char-table-type-p", Fvalid_char_table_type_p, 1, 1, 0, /*
1753 Return t if TYPE if a recognized char table type.
1755 Each char table type is used for a different purpose and allows different
1756 sorts of values. The different char table types are
1759 Used for category tables, which specify the regexp categories
1760 that a character is in. The valid values are nil or a
1761 bit vector of 95 elements. Higher-level Lisp functions are
1762 provided for working with category tables. Currently categories
1763 and category tables only exist when Mule support is present.
1765 A generalized char table, for mapping from one character to
1766 another. Used for case tables, syntax matching tables,
1767 `keyboard-translate-table', etc. The valid values are characters.
1769 An even more generalized char table, for mapping from a
1770 character to anything.
1772 Used for display tables, which specify how a particular character
1773 is to appear when displayed. #### Not yet implemented.
1775 Used for syntax tables, which specify the syntax of a particular
1776 character. Higher-level Lisp functions are provided for
1777 working with syntax tables. The valid values are integers.
1782 return (EQ (type, Qchar) ||
1784 EQ (type, Qcategory) ||
1786 EQ (type, Qdisplay) ||
1787 EQ (type, Qgeneric) ||
1788 EQ (type, Qsyntax)) ? Qt : Qnil;
1791 DEFUN ("char-table-type", Fchar_table_type, 1, 1, 0, /*
1792 Return the type of CHAR-TABLE.
1793 See `valid-char-table-type-p'.
1797 CHECK_CHAR_TABLE (char_table);
1798 return char_table_type_to_symbol (XCHAR_TABLE (char_table)->type);
1802 fill_char_table (Lisp_Char_Table *ct, Lisp_Object value)
1805 ct->table = Qunbound;
1806 ct->default_value = value;
1811 for (i = 0; i < NUM_ASCII_CHARS; i++)
1812 ct->ascii[i] = value;
1814 for (i = 0; i < NUM_LEADING_BYTES; i++)
1815 ct->level1[i] = value;
1820 if (ct->type == CHAR_TABLE_TYPE_SYNTAX)
1821 update_syntax_table (ct);
1825 DEFUN ("reset-char-table", Freset_char_table, 1, 1, 0, /*
1826 Reset CHAR-TABLE to its default state.
1830 Lisp_Char_Table *ct;
1832 CHECK_CHAR_TABLE (char_table);
1833 ct = XCHAR_TABLE (char_table);
1837 case CHAR_TABLE_TYPE_CHAR:
1838 fill_char_table (ct, make_char (0));
1840 case CHAR_TABLE_TYPE_DISPLAY:
1841 case CHAR_TABLE_TYPE_GENERIC:
1843 case CHAR_TABLE_TYPE_CATEGORY:
1845 fill_char_table (ct, Qnil);
1848 case CHAR_TABLE_TYPE_SYNTAX:
1849 fill_char_table (ct, make_int (Sinherit));
1859 DEFUN ("make-char-table", Fmake_char_table, 1, 1, 0, /*
1860 Return a new, empty char table of type TYPE.
1861 Currently recognized types are 'char, 'category, 'display, 'generic,
1862 and 'syntax. See `valid-char-table-type-p'.
1866 Lisp_Char_Table *ct;
1868 enum char_table_type ty = symbol_to_char_table_type (type);
1870 ct = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table);
1873 if (ty == CHAR_TABLE_TYPE_SYNTAX)
1875 ct->mirror_table = Fmake_char_table (Qgeneric);
1876 fill_char_table (XCHAR_TABLE (ct->mirror_table),
1880 ct->mirror_table = Qnil;
1883 #ifndef HAVE_LIBCHISE
1887 ct->next_table = Qnil;
1888 XSETCHAR_TABLE (obj, ct);
1889 if (ty == CHAR_TABLE_TYPE_SYNTAX)
1891 ct->next_table = Vall_syntax_tables;
1892 Vall_syntax_tables = obj;
1894 Freset_char_table (obj);
1898 #if defined(MULE)&&!defined(UTF2000)
1901 make_char_table_entry (Lisp_Object initval)
1905 Lisp_Char_Table_Entry *cte =
1906 alloc_lcrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry);
1908 for (i = 0; i < 96; i++)
1909 cte->level2[i] = initval;
1911 XSETCHAR_TABLE_ENTRY (obj, cte);
1916 copy_char_table_entry (Lisp_Object entry)
1918 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (entry);
1921 Lisp_Char_Table_Entry *ctenew =
1922 alloc_lcrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry);
1924 for (i = 0; i < 96; i++)
1926 Lisp_Object new = cte->level2[i];
1927 if (CHAR_TABLE_ENTRYP (new))
1928 ctenew->level2[i] = copy_char_table_entry (new);
1930 ctenew->level2[i] = new;
1933 XSETCHAR_TABLE_ENTRY (obj, ctenew);
1939 DEFUN ("copy-char-table", Fcopy_char_table, 1, 1, 0, /*
1940 Return a new char table which is a copy of CHAR-TABLE.
1941 It will contain the same values for the same characters and ranges
1942 as CHAR-TABLE. The values will not themselves be copied.
1946 Lisp_Char_Table *ct, *ctnew;
1952 CHECK_CHAR_TABLE (char_table);
1953 ct = XCHAR_TABLE (char_table);
1954 ctnew = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table);
1955 ctnew->type = ct->type;
1957 ctnew->default_value = ct->default_value;
1958 /* [tomo:2002-01-21] Perhaps this code seems wrong */
1959 ctnew->name = ct->name;
1960 #ifndef HAVE_LIBCHISE
1964 if (UINT8_BYTE_TABLE_P (ct->table))
1966 ctnew->table = copy_uint8_byte_table (ct->table);
1968 else if (UINT16_BYTE_TABLE_P (ct->table))
1970 ctnew->table = copy_uint16_byte_table (ct->table);
1972 else if (BYTE_TABLE_P (ct->table))
1974 ctnew->table = copy_byte_table (ct->table);
1976 else if (!UNBOUNDP (ct->table))
1977 ctnew->table = ct->table;
1978 #else /* non UTF2000 */
1980 for (i = 0; i < NUM_ASCII_CHARS; i++)
1982 Lisp_Object new = ct->ascii[i];
1984 assert (! (CHAR_TABLE_ENTRYP (new)));
1986 ctnew->ascii[i] = new;
1991 for (i = 0; i < NUM_LEADING_BYTES; i++)
1993 Lisp_Object new = ct->level1[i];
1994 if (CHAR_TABLE_ENTRYP (new))
1995 ctnew->level1[i] = copy_char_table_entry (new);
1997 ctnew->level1[i] = new;
2001 #endif /* non UTF2000 */
2004 if (CHAR_TABLEP (ct->mirror_table))
2005 ctnew->mirror_table = Fcopy_char_table (ct->mirror_table);
2007 ctnew->mirror_table = ct->mirror_table;
2009 ctnew->next_table = Qnil;
2010 XSETCHAR_TABLE (obj, ctnew);
2011 if (ctnew->type == CHAR_TABLE_TYPE_SYNTAX)
2013 ctnew->next_table = Vall_syntax_tables;
2014 Vall_syntax_tables = obj;
2019 INLINE_HEADER int XCHARSET_CELL_RANGE (Lisp_Object ccs);
2021 XCHARSET_CELL_RANGE (Lisp_Object ccs)
2023 switch (XCHARSET_CHARS (ccs))
2026 return (33 << 8) | 126;
2028 return (32 << 8) | 127;
2031 return (0 << 8) | 127;
2033 return (0 << 8) | 255;
2045 decode_char_table_range (Lisp_Object range, struct chartab_range *outrange)
2048 outrange->type = CHARTAB_RANGE_ALL;
2050 else if (EQ (range, Qnil))
2051 outrange->type = CHARTAB_RANGE_DEFAULT;
2053 else if (CHAR_OR_CHAR_INTP (range))
2055 outrange->type = CHARTAB_RANGE_CHAR;
2056 outrange->ch = XCHAR_OR_CHAR_INT (range);
2060 signal_simple_error ("Range must be t or a character", range);
2062 else if (VECTORP (range))
2064 Lisp_Vector *vec = XVECTOR (range);
2065 Lisp_Object *elts = vector_data (vec);
2066 int cell_min, cell_max;
2068 outrange->type = CHARTAB_RANGE_ROW;
2069 outrange->charset = Fget_charset (elts[0]);
2070 CHECK_INT (elts[1]);
2071 outrange->row = XINT (elts[1]);
2072 if (XCHARSET_DIMENSION (outrange->charset) < 2)
2073 signal_simple_error ("Charset in row vector must be multi-byte",
2077 int ret = XCHARSET_CELL_RANGE (outrange->charset);
2079 cell_min = ret >> 8;
2080 cell_max = ret & 0xFF;
2082 if (XCHARSET_DIMENSION (outrange->charset) == 2)
2083 check_int_range (outrange->row, cell_min, cell_max);
2085 else if (XCHARSET_DIMENSION (outrange->charset) == 3)
2087 check_int_range (outrange->row >> 8 , cell_min, cell_max);
2088 check_int_range (outrange->row & 0xFF, cell_min, cell_max);
2090 else if (XCHARSET_DIMENSION (outrange->charset) == 4)
2092 check_int_range ( outrange->row >> 16 , cell_min, cell_max);
2093 check_int_range ((outrange->row >> 8) & 0xFF, cell_min, cell_max);
2094 check_int_range ( outrange->row & 0xFF, cell_min, cell_max);
2102 if (!CHARSETP (range) && !SYMBOLP (range))
2104 ("Char table range must be t, charset, char, or vector", range);
2105 outrange->type = CHARTAB_RANGE_CHARSET;
2106 outrange->charset = Fget_charset (range);
2111 #if defined(MULE)&&!defined(UTF2000)
2113 /* called from CHAR_TABLE_VALUE(). */
2115 get_non_ascii_char_table_value (Lisp_Char_Table *ct, Charset_ID leading_byte,
2120 Lisp_Object charset;
2122 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (leading_byte);
2127 BREAKUP_CHAR (c, charset, byte1, byte2);
2129 BREAKUP_CHAR_1_UNSAFE (c, charset, byte1, byte2);
2131 val = ct->level1[leading_byte - MIN_LEADING_BYTE];
2132 if (CHAR_TABLE_ENTRYP (val))
2134 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
2135 val = cte->level2[byte1 - 32];
2136 if (CHAR_TABLE_ENTRYP (val))
2138 cte = XCHAR_TABLE_ENTRY (val);
2139 assert (byte2 >= 32);
2140 val = cte->level2[byte2 - 32];
2141 assert (!CHAR_TABLE_ENTRYP (val));
2151 get_char_table (Emchar ch, Lisp_Char_Table *ct)
2155 Lisp_Object ret = get_char_id_table (ct, ch);
2160 if (EQ (CHAR_TABLE_NAME (ct), Qdowncase))
2161 ret = Fchar_feature (make_char (ch), Q_lowercase, Qnil,
2163 else if (EQ (CHAR_TABLE_NAME (ct), Qflippedcase))
2164 ret = Fchar_feature (make_char (ch), Q_uppercase, Qnil,
2170 ret = Ffind_char (ret);
2178 Lisp_Object charset;
2182 BREAKUP_CHAR (ch, charset, byte1, byte2);
2184 if (EQ (charset, Vcharset_ascii))
2185 val = ct->ascii[byte1];
2186 else if (EQ (charset, Vcharset_control_1))
2187 val = ct->ascii[byte1 + 128];
2190 int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE;
2191 val = ct->level1[lb];
2192 if (CHAR_TABLE_ENTRYP (val))
2194 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
2195 val = cte->level2[byte1 - 32];
2196 if (CHAR_TABLE_ENTRYP (val))
2198 cte = XCHAR_TABLE_ENTRY (val);
2199 assert (byte2 >= 32);
2200 val = cte->level2[byte2 - 32];
2201 assert (!CHAR_TABLE_ENTRYP (val));
2208 #else /* not MULE */
2209 return ct->ascii[(unsigned char)ch];
2210 #endif /* not MULE */
2214 DEFUN ("get-char-table", Fget_char_table, 2, 2, 0, /*
2215 Find value for CHARACTER in CHAR-TABLE.
2217 (character, char_table))
2219 CHECK_CHAR_TABLE (char_table);
2220 CHECK_CHAR_COERCE_INT (character);
2222 return get_char_table (XCHAR (character), XCHAR_TABLE (char_table));
2225 DEFUN ("get-range-char-table", Fget_range_char_table, 2, 3, 0, /*
2226 Find value for a range in CHAR-TABLE.
2227 If there is more than one value, return MULTI (defaults to nil).
2229 (range, char_table, multi))
2231 Lisp_Char_Table *ct;
2232 struct chartab_range rainj;
2234 if (CHAR_OR_CHAR_INTP (range))
2235 return Fget_char_table (range, char_table);
2236 CHECK_CHAR_TABLE (char_table);
2237 ct = XCHAR_TABLE (char_table);
2239 decode_char_table_range (range, &rainj);
2242 case CHARTAB_RANGE_ALL:
2245 if (UINT8_BYTE_TABLE_P (ct->table))
2247 else if (UINT16_BYTE_TABLE_P (ct->table))
2249 else if (BYTE_TABLE_P (ct->table))
2253 #else /* non UTF2000 */
2255 Lisp_Object first = ct->ascii[0];
2257 for (i = 1; i < NUM_ASCII_CHARS; i++)
2258 if (!EQ (first, ct->ascii[i]))
2262 for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES;
2265 if (!CHARSETP (CHARSET_BY_LEADING_BYTE (i))
2266 || i == LEADING_BYTE_ASCII
2267 || i == LEADING_BYTE_CONTROL_1)
2269 if (!EQ (first, ct->level1[i - MIN_LEADING_BYTE]))
2275 #endif /* non UTF2000 */
2279 case CHARTAB_RANGE_CHARSET:
2283 if (EQ (rainj.charset, Vcharset_ascii))
2286 Lisp_Object first = ct->ascii[0];
2288 for (i = 1; i < 128; i++)
2289 if (!EQ (first, ct->ascii[i]))
2294 if (EQ (rainj.charset, Vcharset_control_1))
2297 Lisp_Object first = ct->ascii[128];
2299 for (i = 129; i < 160; i++)
2300 if (!EQ (first, ct->ascii[i]))
2306 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (rainj.charset) -
2308 if (CHAR_TABLE_ENTRYP (val))
2314 case CHARTAB_RANGE_ROW:
2319 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (rainj.charset) -
2321 if (!CHAR_TABLE_ENTRYP (val))
2323 val = XCHAR_TABLE_ENTRY (val)->level2[rainj.row - 32];
2324 if (CHAR_TABLE_ENTRYP (val))
2328 #endif /* not UTF2000 */
2329 #endif /* not MULE */
2332 case CHARTAB_RANGE_DEFAULT:
2333 return ct->default_value;
2334 #endif /* not UTF2000 */
2340 return Qnil; /* not reached */
2344 check_valid_char_table_value (Lisp_Object value, enum char_table_type type,
2345 Error_behavior errb)
2349 case CHAR_TABLE_TYPE_SYNTAX:
2350 if (!ERRB_EQ (errb, ERROR_ME))
2351 return INTP (value) || (CONSP (value) && INTP (XCAR (value))
2352 && CHAR_OR_CHAR_INTP (XCDR (value)));
2355 Lisp_Object cdr = XCDR (value);
2356 CHECK_INT (XCAR (value));
2357 CHECK_CHAR_COERCE_INT (cdr);
2364 case CHAR_TABLE_TYPE_CATEGORY:
2365 if (!ERRB_EQ (errb, ERROR_ME))
2366 return CATEGORY_TABLE_VALUEP (value);
2367 CHECK_CATEGORY_TABLE_VALUE (value);
2371 case CHAR_TABLE_TYPE_GENERIC:
2374 case CHAR_TABLE_TYPE_DISPLAY:
2376 maybe_signal_simple_error ("Display char tables not yet implemented",
2377 value, Qchar_table, errb);
2380 case CHAR_TABLE_TYPE_CHAR:
2381 if (!ERRB_EQ (errb, ERROR_ME))
2382 return CHAR_OR_CHAR_INTP (value);
2383 CHECK_CHAR_COERCE_INT (value);
2390 return 0; /* not reached */
2394 canonicalize_char_table_value (Lisp_Object value, enum char_table_type type)
2398 case CHAR_TABLE_TYPE_SYNTAX:
2401 Lisp_Object car = XCAR (value);
2402 Lisp_Object cdr = XCDR (value);
2403 CHECK_CHAR_COERCE_INT (cdr);
2404 return Fcons (car, cdr);
2407 case CHAR_TABLE_TYPE_CHAR:
2408 CHECK_CHAR_COERCE_INT (value);
2416 DEFUN ("valid-char-table-value-p", Fvalid_char_table_value_p, 2, 2, 0, /*
2417 Return non-nil if VALUE is a valid value for CHAR-TABLE-TYPE.
2419 (value, char_table_type))
2421 enum char_table_type type = symbol_to_char_table_type (char_table_type);
2423 return check_valid_char_table_value (value, type, ERROR_ME_NOT) ? Qt : Qnil;
2426 DEFUN ("check-valid-char-table-value", Fcheck_valid_char_table_value, 2, 2, 0, /*
2427 Signal an error if VALUE is not a valid value for CHAR-TABLE-TYPE.
2429 (value, char_table_type))
2431 enum char_table_type type = symbol_to_char_table_type (char_table_type);
2433 check_valid_char_table_value (value, type, ERROR_ME);
2438 Lisp_Char_Table* char_attribute_table_to_put;
2439 Lisp_Object Qput_char_table_map_function;
2440 Lisp_Object value_to_put;
2442 DEFUN ("put-char-table-map-function",
2443 Fput_char_table_map_function, 2, 2, 0, /*
2444 For internal use. Don't use it.
2448 put_char_id_table_0 (char_attribute_table_to_put,
2449 XCHAR (c), value_to_put);
2454 /* Assign VAL to all characters in RANGE in char table CT. */
2457 put_char_table (Lisp_Char_Table *ct, struct chartab_range *range,
2460 switch (range->type)
2462 case CHARTAB_RANGE_ALL:
2463 fill_char_table (ct, val);
2464 return; /* avoid the duplicate call to update_syntax_table() below,
2465 since fill_char_table() also did that. */
2468 case CHARTAB_RANGE_DEFAULT:
2469 ct->default_value = val;
2474 case CHARTAB_RANGE_CHARSET:
2477 Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (range->charset);
2479 if ( CHAR_TABLEP (encoding_table) )
2481 Lisp_Object mother = XCHARSET_MOTHER (range->charset);
2483 char_attribute_table_to_put = ct;
2485 Fmap_char_attribute (Qput_char_table_map_function,
2486 XCHAR_TABLE_NAME (encoding_table),
2488 if ( CHARSETP (mother) )
2490 struct chartab_range r;
2492 r.type = CHARTAB_RANGE_CHARSET;
2494 put_char_table (ct, &r, val);
2502 for (c = 0; c < 1 << 24; c++)
2504 if ( charset_code_point (range->charset, c) >= 0 )
2505 put_char_id_table_0 (ct, c, val);
2511 if (EQ (range->charset, Vcharset_ascii))
2514 for (i = 0; i < 128; i++)
2517 else if (EQ (range->charset, Vcharset_control_1))
2520 for (i = 128; i < 160; i++)
2525 int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE;
2526 ct->level1[lb] = val;
2531 case CHARTAB_RANGE_ROW:
2534 int cell_min, cell_max, i;
2536 i = XCHARSET_CELL_RANGE (range->charset);
2538 cell_max = i & 0xFF;
2539 for (i = cell_min; i <= cell_max; i++)
2542 = DECODE_CHAR (range->charset, (range->row << 8) | i, 0);
2544 if ( charset_code_point (range->charset, ch, 0) >= 0 )
2545 put_char_id_table_0 (ct, ch, val);
2550 Lisp_Char_Table_Entry *cte;
2551 int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE;
2552 /* make sure that there is a separate entry for the row. */
2553 if (!CHAR_TABLE_ENTRYP (ct->level1[lb]))
2554 ct->level1[lb] = make_char_table_entry (ct->level1[lb]);
2555 cte = XCHAR_TABLE_ENTRY (ct->level1[lb]);
2556 cte->level2[range->row - 32] = val;
2558 #endif /* not UTF2000 */
2562 case CHARTAB_RANGE_CHAR:
2564 put_char_id_table_0 (ct, range->ch, val);
2568 Lisp_Object charset;
2571 BREAKUP_CHAR (range->ch, charset, byte1, byte2);
2572 if (EQ (charset, Vcharset_ascii))
2573 ct->ascii[byte1] = val;
2574 else if (EQ (charset, Vcharset_control_1))
2575 ct->ascii[byte1 + 128] = val;
2578 Lisp_Char_Table_Entry *cte;
2579 int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE;
2580 /* make sure that there is a separate entry for the row. */
2581 if (!CHAR_TABLE_ENTRYP (ct->level1[lb]))
2582 ct->level1[lb] = make_char_table_entry (ct->level1[lb]);
2583 cte = XCHAR_TABLE_ENTRY (ct->level1[lb]);
2584 /* now CTE is a char table entry for the charset;
2585 each entry is for a single row (or character of
2586 a one-octet charset). */
2587 if (XCHARSET_DIMENSION (charset) == 1)
2588 cte->level2[byte1 - 32] = val;
2591 /* assigning to one character in a two-octet charset. */
2592 /* make sure that the charset row contains a separate
2593 entry for each character. */
2594 if (!CHAR_TABLE_ENTRYP (cte->level2[byte1 - 32]))
2595 cte->level2[byte1 - 32] =
2596 make_char_table_entry (cte->level2[byte1 - 32]);
2597 cte = XCHAR_TABLE_ENTRY (cte->level2[byte1 - 32]);
2598 cte->level2[byte2 - 32] = val;
2602 #else /* not MULE */
2603 ct->ascii[(unsigned char) (range->ch)] = val;
2605 #endif /* not MULE */
2609 if (ct->type == CHAR_TABLE_TYPE_SYNTAX)
2610 update_syntax_table (ct);
2614 DEFUN ("put-char-table", Fput_char_table, 3, 3, 0, /*
2615 Set the value for chars in RANGE to be VALUE in CHAR-TABLE.
2617 RANGE specifies one or more characters to be affected and should be
2618 one of the following:
2620 -- t (all characters are affected)
2621 -- A charset (only allowed when Mule support is present)
2622 -- A vector of two elements: a two-octet charset and a row number
2623 (only allowed when Mule support is present)
2624 -- A single character
2626 VALUE must be a value appropriate for the type of CHAR-TABLE.
2627 See `valid-char-table-type-p'.
2629 (range, value, char_table))
2631 Lisp_Char_Table *ct;
2632 struct chartab_range rainj;
2634 CHECK_CHAR_TABLE (char_table);
2635 ct = XCHAR_TABLE (char_table);
2636 check_valid_char_table_value (value, ct->type, ERROR_ME);
2637 decode_char_table_range (range, &rainj);
2638 value = canonicalize_char_table_value (value, ct->type);
2639 put_char_table (ct, &rainj, value);
2644 /* Map FN over the ASCII chars in CT. */
2647 map_over_charset_ascii (Lisp_Char_Table *ct,
2648 int (*fn) (struct chartab_range *range,
2649 Lisp_Object val, void *arg),
2652 struct chartab_range rainj;
2661 rainj.type = CHARTAB_RANGE_CHAR;
2663 for (i = start, retval = 0; i < stop && retval == 0; i++)
2665 rainj.ch = (Emchar) i;
2666 retval = (fn) (&rainj, ct->ascii[i], arg);
2674 /* Map FN over the Control-1 chars in CT. */
2677 map_over_charset_control_1 (Lisp_Char_Table *ct,
2678 int (*fn) (struct chartab_range *range,
2679 Lisp_Object val, void *arg),
2682 struct chartab_range rainj;
2685 int stop = start + 32;
2687 rainj.type = CHARTAB_RANGE_CHAR;
2689 for (i = start, retval = 0; i < stop && retval == 0; i++)
2691 rainj.ch = (Emchar) (i);
2692 retval = (fn) (&rainj, ct->ascii[i], arg);
2698 /* Map FN over the row ROW of two-byte charset CHARSET.
2699 There must be a separate value for that row in the char table.
2700 CTE specifies the char table entry for CHARSET. */
2703 map_over_charset_row (Lisp_Char_Table_Entry *cte,
2704 Lisp_Object charset, int row,
2705 int (*fn) (struct chartab_range *range,
2706 Lisp_Object val, void *arg),
2709 Lisp_Object val = cte->level2[row - 32];
2711 if (!CHAR_TABLE_ENTRYP (val))
2713 struct chartab_range rainj;
2715 rainj.type = CHARTAB_RANGE_ROW;
2716 rainj.charset = charset;
2718 return (fn) (&rainj, val, arg);
2722 struct chartab_range rainj;
2724 int charset94_p = (XCHARSET_CHARS (charset) == 94);
2725 int start = charset94_p ? 33 : 32;
2726 int stop = charset94_p ? 127 : 128;
2728 cte = XCHAR_TABLE_ENTRY (val);
2730 rainj.type = CHARTAB_RANGE_CHAR;
2732 for (i = start, retval = 0; i < stop && retval == 0; i++)
2734 rainj.ch = MAKE_CHAR (charset, row, i);
2735 retval = (fn) (&rainj, cte->level2[i - 32], arg);
2743 map_over_other_charset (Lisp_Char_Table *ct, Charset_ID lb,
2744 int (*fn) (struct chartab_range *range,
2745 Lisp_Object val, void *arg),
2748 Lisp_Object val = ct->level1[lb - MIN_LEADING_BYTE];
2749 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (lb);
2751 if (!CHARSETP (charset)
2752 || lb == LEADING_BYTE_ASCII
2753 || lb == LEADING_BYTE_CONTROL_1)
2756 if (!CHAR_TABLE_ENTRYP (val))
2758 struct chartab_range rainj;
2760 rainj.type = CHARTAB_RANGE_CHARSET;
2761 rainj.charset = charset;
2762 return (fn) (&rainj, val, arg);
2766 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
2767 int charset94_p = (XCHARSET_CHARS (charset) == 94);
2768 int start = charset94_p ? 33 : 32;
2769 int stop = charset94_p ? 127 : 128;
2772 if (XCHARSET_DIMENSION (charset) == 1)
2774 struct chartab_range rainj;
2775 rainj.type = CHARTAB_RANGE_CHAR;
2777 for (i = start, retval = 0; i < stop && retval == 0; i++)
2779 rainj.ch = MAKE_CHAR (charset, i, 0);
2780 retval = (fn) (&rainj, cte->level2[i - 32], arg);
2785 for (i = start, retval = 0; i < stop && retval == 0; i++)
2786 retval = map_over_charset_row (cte, charset, i, fn, arg);
2794 #endif /* not UTF2000 */
2797 struct map_char_table_for_charset_arg
2799 int (*fn) (struct chartab_range *range, Lisp_Object val, void *arg);
2800 Lisp_Char_Table *ct;
2805 map_char_table_for_charset_fun (struct chartab_range *range,
2806 Lisp_Object val, void *arg)
2808 struct map_char_table_for_charset_arg *closure =
2809 (struct map_char_table_for_charset_arg *) arg;
2812 switch (range->type)
2814 case CHARTAB_RANGE_ALL:
2817 case CHARTAB_RANGE_DEFAULT:
2820 case CHARTAB_RANGE_CHARSET:
2823 case CHARTAB_RANGE_ROW:
2826 case CHARTAB_RANGE_CHAR:
2827 ret = get_char_table (range->ch, closure->ct);
2828 if (!UNBOUNDP (ret))
2829 return (closure->fn) (range, ret, closure->arg);
2841 /* Map FN (with client data ARG) over range RANGE in char table CT.
2842 Mapping stops the first time FN returns non-zero, and that value
2843 becomes the return value of map_char_table(). */
2846 map_char_table (Lisp_Char_Table *ct,
2847 struct chartab_range *range,
2848 int (*fn) (struct chartab_range *range,
2849 Lisp_Object val, void *arg),
2852 switch (range->type)
2854 case CHARTAB_RANGE_ALL:
2856 if (!UNBOUNDP (ct->default_value))
2858 struct chartab_range rainj;
2861 rainj.type = CHARTAB_RANGE_DEFAULT;
2862 retval = (fn) (&rainj, ct->default_value, arg);
2866 if (UINT8_BYTE_TABLE_P (ct->table))
2867 return map_over_uint8_byte_table (XUINT8_BYTE_TABLE(ct->table), ct,
2869 else if (UINT16_BYTE_TABLE_P (ct->table))
2870 return map_over_uint16_byte_table (XUINT16_BYTE_TABLE(ct->table), ct,
2872 else if (BYTE_TABLE_P (ct->table))
2873 return map_over_byte_table (XBYTE_TABLE(ct->table), ct,
2875 else if (EQ (ct->table, Qunloaded))
2878 struct chartab_range rainj;
2881 Emchar c1 = c + unit;
2884 rainj.type = CHARTAB_RANGE_CHAR;
2886 for (retval = 0; c < c1 && retval == 0; c++)
2888 Lisp_Object ret = get_char_id_table (ct, c);
2890 if (!UNBOUNDP (ret))
2893 retval = (fn) (&rainj, ct->table, arg);
2898 ct->table = Qunbound;
2901 else if (!UNBOUNDP (ct->table))
2902 return (fn) (range, ct->table, arg);
2908 retval = map_over_charset_ascii (ct, fn, arg);
2912 retval = map_over_charset_control_1 (ct, fn, arg);
2917 Charset_ID start = MIN_LEADING_BYTE;
2918 Charset_ID stop = start + NUM_LEADING_BYTES;
2920 for (i = start, retval = 0; i < stop && retval == 0; i++)
2922 retval = map_over_other_charset (ct, i, fn, arg);
2931 case CHARTAB_RANGE_DEFAULT:
2932 if (!UNBOUNDP (ct->default_value))
2933 return (fn) (range, ct->default_value, arg);
2938 case CHARTAB_RANGE_CHARSET:
2941 Lisp_Object encoding_table
2942 = XCHARSET_ENCODING_TABLE (range->charset);
2944 if (!NILP (encoding_table))
2946 struct chartab_range rainj;
2947 struct map_char_table_for_charset_arg mcarg;
2950 if (XCHAR_TABLE_UNLOADED(encoding_table))
2951 Fload_char_attribute_table (XCHAR_TABLE_NAME (encoding_table));
2956 rainj.type = CHARTAB_RANGE_ALL;
2957 return map_char_table (XCHAR_TABLE(encoding_table),
2959 &map_char_table_for_charset_fun,
2965 return map_over_other_charset (ct,
2966 XCHARSET_LEADING_BYTE (range->charset),
2970 case CHARTAB_RANGE_ROW:
2973 int cell_min, cell_max, i;
2975 struct chartab_range rainj;
2977 i = XCHARSET_CELL_RANGE (range->charset);
2979 cell_max = i & 0xFF;
2980 rainj.type = CHARTAB_RANGE_CHAR;
2981 for (retval =0, i = cell_min; i <= cell_max && retval == 0; i++)
2984 = DECODE_CHAR (range->charset, (range->row << 8) | i, 0);
2986 if ( charset_code_point (range->charset, ch, 0) >= 0 )
2989 = get_byte_table (get_byte_table
2993 (unsigned char)(ch >> 24)),
2994 (unsigned char) (ch >> 16)),
2995 (unsigned char) (ch >> 8)),
2996 (unsigned char) ch);
2999 val = ct->default_value;
3001 retval = (fn) (&rainj, val, arg);
3008 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (range->charset)
3009 - MIN_LEADING_BYTE];
3010 if (!CHAR_TABLE_ENTRYP (val))
3012 struct chartab_range rainj;
3014 rainj.type = CHARTAB_RANGE_ROW;
3015 rainj.charset = range->charset;
3016 rainj.row = range->row;
3017 return (fn) (&rainj, val, arg);
3020 return map_over_charset_row (XCHAR_TABLE_ENTRY (val),
3021 range->charset, range->row,
3024 #endif /* not UTF2000 */
3027 case CHARTAB_RANGE_CHAR:
3029 Emchar ch = range->ch;
3030 Lisp_Object val = CHAR_TABLE_VALUE_UNSAFE (ct, ch);
3032 if (!UNBOUNDP (val))
3034 struct chartab_range rainj;
3036 rainj.type = CHARTAB_RANGE_CHAR;
3038 return (fn) (&rainj, val, arg);
3050 struct slow_map_char_table_arg
3052 Lisp_Object function;
3057 slow_map_char_table_fun (struct chartab_range *range,
3058 Lisp_Object val, void *arg)
3060 Lisp_Object ranjarg = Qnil;
3061 struct slow_map_char_table_arg *closure =
3062 (struct slow_map_char_table_arg *) arg;
3064 switch (range->type)
3066 case CHARTAB_RANGE_ALL:
3071 case CHARTAB_RANGE_DEFAULT:
3077 case CHARTAB_RANGE_CHARSET:
3078 ranjarg = XCHARSET_NAME (range->charset);
3081 case CHARTAB_RANGE_ROW:
3082 ranjarg = vector2 (XCHARSET_NAME (range->charset),
3083 make_int (range->row));
3086 case CHARTAB_RANGE_CHAR:
3087 ranjarg = make_char (range->ch);
3093 closure->retval = call2 (closure->function, ranjarg, val);
3094 return !NILP (closure->retval);
3097 DEFUN ("map-char-table", Fmap_char_table, 2, 3, 0, /*
3098 Map FUNCTION over entries in CHAR-TABLE, calling it with two args,
3099 each key and value in the table.
3101 RANGE specifies a subrange to map over and is in the same format as
3102 the RANGE argument to `put-range-table'. If omitted or t, it defaults to
3105 (function, char_table, range))
3107 Lisp_Char_Table *ct;
3108 struct slow_map_char_table_arg slarg;
3109 struct gcpro gcpro1, gcpro2;
3110 struct chartab_range rainj;
3112 CHECK_CHAR_TABLE (char_table);
3113 ct = XCHAR_TABLE (char_table);
3116 decode_char_table_range (range, &rainj);
3117 slarg.function = function;
3118 slarg.retval = Qnil;
3119 GCPRO2 (slarg.function, slarg.retval);
3120 map_char_table (ct, &rainj, slow_map_char_table_fun, &slarg);
3123 return slarg.retval;
3127 /************************************************************************/
3128 /* Character Attributes */
3129 /************************************************************************/
3133 Lisp_Object Vchar_attribute_hash_table;
3135 /* We store the char-attributes in hash tables with the names as the
3136 key and the actual char-id-table object as the value. Occasionally
3137 we need to use them in a list format. These routines provide us
3139 struct char_attribute_list_closure
3141 Lisp_Object *char_attribute_list;
3145 add_char_attribute_to_list_mapper (Lisp_Object key, Lisp_Object value,
3146 void *char_attribute_list_closure)
3148 /* This function can GC */
3149 struct char_attribute_list_closure *calcl
3150 = (struct char_attribute_list_closure*) char_attribute_list_closure;
3151 Lisp_Object *char_attribute_list = calcl->char_attribute_list;
3153 *char_attribute_list = Fcons (key, *char_attribute_list);
3157 #ifdef HAVE_LIBCHISE
3159 char_attribute_list_reset_map_func (CHISE_DS *ds, unsigned char *name)
3161 Fmount_char_attribute_table (intern (name));
3165 DEFUN ("char-attribute-list", Fchar_attribute_list, 0, 1, 0, /*
3166 Return the list of all existing character attributes except coded-charsets.
3170 DEFUN ("char-attribute-list", Fchar_attribute_list, 0, 0, 0, /*
3171 Return the list of all existing character attributes except coded-charsets.
3176 Lisp_Object char_attribute_list = Qnil;
3177 struct gcpro gcpro1;
3178 struct char_attribute_list_closure char_attribute_list_closure;
3180 #ifdef HAVE_LIBCHISE
3183 open_chise_data_source_maybe ();
3184 chise_ds_foreach_char_feature_name
3185 (default_chise_data_source, &char_attribute_list_reset_map_func);
3188 GCPRO1 (char_attribute_list);
3189 char_attribute_list_closure.char_attribute_list = &char_attribute_list;
3190 elisp_maphash (add_char_attribute_to_list_mapper,
3191 Vchar_attribute_hash_table,
3192 &char_attribute_list_closure);
3194 return char_attribute_list;
3197 DEFUN ("find-char-attribute-table", Ffind_char_attribute_table, 1, 1, 0, /*
3198 Return char-id-table corresponding to ATTRIBUTE.
3202 return Fgethash (attribute, Vchar_attribute_hash_table, Qnil);
3206 /* We store the char-id-tables in hash tables with the attributes as
3207 the key and the actual char-id-table object as the value. Each
3208 char-id-table stores values of an attribute corresponding with
3209 characters. Occasionally we need to get attributes of a character
3210 in a association-list format. These routines provide us with
3212 struct char_attribute_alist_closure
3215 Lisp_Object *char_attribute_alist;
3219 add_char_attribute_alist_mapper (Lisp_Object key, Lisp_Object value,
3220 void *char_attribute_alist_closure)
3222 /* This function can GC */
3223 struct char_attribute_alist_closure *caacl =
3224 (struct char_attribute_alist_closure*) char_attribute_alist_closure;
3226 = get_char_id_table (XCHAR_TABLE(value), caacl->char_id);
3227 if (!UNBOUNDP (ret))
3229 Lisp_Object *char_attribute_alist = caacl->char_attribute_alist;
3230 *char_attribute_alist
3231 = Fcons (Fcons (key, ret), *char_attribute_alist);
3236 DEFUN ("char-attribute-alist", Fchar_attribute_alist, 1, 1, 0, /*
3237 Return the alist of attributes of CHARACTER.
3241 struct gcpro gcpro1;
3242 struct char_attribute_alist_closure char_attribute_alist_closure;
3243 Lisp_Object alist = Qnil;
3245 CHECK_CHAR (character);
3248 char_attribute_alist_closure.char_id = XCHAR (character);
3249 char_attribute_alist_closure.char_attribute_alist = &alist;
3250 elisp_maphash (add_char_attribute_alist_mapper,
3251 Vchar_attribute_hash_table,
3252 &char_attribute_alist_closure);
3258 DEFUN ("get-char-attribute", Fget_char_attribute, 2, 3, 0, /*
3259 Return the value of CHARACTER's ATTRIBUTE.
3260 Return DEFAULT-VALUE if the value is not exist.
3262 (character, attribute, default_value))
3266 CHECK_CHAR (character);
3268 if (CHARSETP (attribute))
3269 attribute = XCHARSET_NAME (attribute);
3271 table = Fgethash (attribute, Vchar_attribute_hash_table,
3273 if (!UNBOUNDP (table))
3275 Lisp_Object ret = get_char_id_table (XCHAR_TABLE(table),
3277 if (!UNBOUNDP (ret))
3280 return default_value;
3284 find_char_feature_in_family (Lisp_Object character,
3285 Lisp_Object con_feature,
3286 Lisp_Object feature,
3287 Lisp_Object feature_rel_max)
3289 Lisp_Object ancestors
3290 = Fget_char_attribute (character, con_feature, Qnil);
3292 while (!NILP (ancestors))
3294 Lisp_Object ancestor = XCAR (ancestors);
3297 if (EQ (ancestor, character))
3300 ret = Fchar_feature (ancestor, feature, Qunbound,
3301 Qnil, make_int (0));
3302 if (!UNBOUNDP (ret))
3305 ancestors = XCDR (ancestors);
3307 ret = Fget_char_attribute (ancestor, Q_subsumptive_from, Qnil);
3309 ancestors = nconc2 (Fcopy_sequence (ancestors), ret);
3311 ret = Fget_char_attribute (ancestor, Q_denotational_from, Qnil);
3313 ancestors = nconc2 (Fcopy_sequence (ancestors), ret);
3318 DEFUN ("char-feature", Fchar_feature, 2, 5, 0, /*
3319 Return the value of CHARACTER's FEATURE.
3320 Return DEFAULT-VALUE if the value is not exist.
3322 (character, attribute, default_value,
3323 feature_rel_max, char_rel_max))
3326 = Fget_char_attribute (character, attribute, Qunbound);
3328 if (!UNBOUNDP (ret))
3331 if (NILP (feature_rel_max)
3332 || (INTP (feature_rel_max) &&
3333 XINT (feature_rel_max) > 0))
3335 Lisp_String* name = symbol_name (XSYMBOL (attribute));
3336 Bufbyte *name_str = string_data (name);
3338 if (name_str[0] == '=' && name_str[1] == '>')
3340 Bytecount length = string_length (name) - 1;
3341 Lisp_Object map_to = make_uninit_string (length);
3343 memcpy (XSTRING_DATA (map_to) + 1, name_str + 2, length - 1);
3344 XSTRING_DATA(map_to)[0] = '=';
3345 ret = Fchar_feature (character, Fintern (map_to, Qnil),
3347 NILP (feature_rel_max)
3349 : make_int (XINT (feature_rel_max) - 1),
3351 if (!UNBOUNDP (ret))
3356 if ( !(EQ (attribute, Q_identical)) &&
3357 !(EQ (attribute, Q_subsumptive_from)) &&
3358 !(EQ (attribute, Q_denotational_from)) &&
3359 ( (NILP (char_rel_max)
3360 || (INTP (char_rel_max) &&
3361 XINT (char_rel_max) > 0)) ) )
3363 Lisp_String* name = symbol_name (XSYMBOL (attribute));
3364 Bufbyte *name_str = string_data (name);
3366 if ( (name_str[0] != '=') || (name_str[1] == '>') )
3368 ret = find_char_feature_in_family (character, Q_identical,
3369 attribute, feature_rel_max);
3370 if (!UNBOUNDP (ret))
3373 ret = find_char_feature_in_family (character, Q_subsumptive_from,
3374 attribute, feature_rel_max);
3375 if (!UNBOUNDP (ret))
3378 ret = find_char_feature_in_family (character, Q_denotational_from,
3379 attribute, feature_rel_max);
3380 if (!UNBOUNDP (ret))
3384 return default_value;
3387 void put_char_composition (Lisp_Object character, Lisp_Object value);
3389 put_char_composition (Lisp_Object character, Lisp_Object value)
3392 signal_simple_error ("Invalid value for ->decomposition",
3395 if (CONSP (Fcdr (value)))
3397 if (NILP (Fcdr (Fcdr (value))))
3399 Lisp_Object base = Fcar (value);
3400 Lisp_Object modifier = Fcar (Fcdr (value));
3404 base = make_char (XINT (base));
3405 Fsetcar (value, base);
3407 if (INTP (modifier))
3409 modifier = make_char (XINT (modifier));
3410 Fsetcar (Fcdr (value), modifier);
3415 = Fchar_feature (base, Qcomposition, Qnil,
3417 Lisp_Object ret = Fassq (modifier, alist);
3420 Fput_char_attribute (base, Qcomposition,
3421 Fcons (Fcons (modifier, character),
3424 Fsetcdr (ret, character);
3430 Lisp_Object v = Fcar (value);
3434 Emchar c = DECODE_CHAR (Vcharset_ucs, XINT (v), 0);
3436 = Fchar_feature (make_char (c), Q_ucs_unified, Qnil,
3441 Fput_char_attribute (make_char (c), Q_ucs_unified,
3442 Fcons (character, Qnil));
3444 else if (NILP (Fmemq (character, ret)))
3446 Fput_char_attribute (make_char (c), Q_ucs_unified,
3447 Fcons (character, ret));
3454 put_char_attribute (Lisp_Object character, Lisp_Object attribute,
3457 Lisp_Object table = Fgethash (attribute,
3458 Vchar_attribute_hash_table,
3463 table = make_char_id_table (Qunbound);
3464 Fputhash (attribute, table, Vchar_attribute_hash_table);
3466 XCHAR_TABLE_NAME (table) = attribute;
3469 put_char_id_table (XCHAR_TABLE(table), character, value);
3473 DEFUN ("put-char-attribute", Fput_char_attribute, 3, 3, 0, /*
3474 Store CHARACTER's ATTRIBUTE with VALUE.
3476 (character, attribute, value))
3478 Lisp_Object ccs = Ffind_charset (attribute);
3480 CHECK_CHAR (character);
3484 value = put_char_ccs_code_point (character, ccs, value);
3485 attribute = XCHARSET_NAME (ccs);
3487 else if (EQ (attribute, Q_decomposition))
3488 put_char_composition (character, value);
3489 else if (EQ (attribute, Qto_ucs))
3495 signal_simple_error ("Invalid value for =>ucs", value);
3497 c = DECODE_CHAR (Vcharset_ucs, XINT (value), 0);
3499 ret = Fchar_feature (make_char (c), Q_ucs_unified, Qnil,
3502 put_char_attribute (make_char (c), Q_ucs_unified,
3504 else if (NILP (Fmemq (character, ret)))
3505 Fput_char_attribute (make_char (c), Q_ucs_unified,
3506 Fcons (character, ret));
3508 else if ( EQ (attribute, Q_subsumptive) ||
3509 EQ (attribute, Q_subsumptive_from) ||
3510 EQ (attribute, Q_denotational) ||
3511 EQ (attribute, Q_denotational_from) ||
3512 EQ (attribute, Q_identical) ||
3513 EQ (attribute, Q_identical_from) ||
3514 EQ (attribute, Q_component) ||
3515 EQ (attribute, Q_component_of) ||
3516 !NILP (Fstring_match
3517 (build_string ("^\\(<-\\|->\\)\\("
3518 "fullwidth\\|halfwidth"
3519 "\\|simplified\\|vulgar\\|wrong"
3520 "\\|same\\|original\\|ancient"
3521 "\\|Oracle-Bones\\)[^*]*$"),
3522 Fsymbol_name (attribute),
3525 Lisp_Object rest = value;
3527 Lisp_Object rev_feature = Qnil;
3528 struct gcpro gcpro1;
3529 GCPRO1 (rev_feature);
3531 if (EQ (attribute, Q_identical))
3532 rev_feature = Q_identical_from;
3533 else if (EQ (attribute, Q_identical_from))
3534 rev_feature = Q_identical;
3535 else if (EQ (attribute, Q_subsumptive))
3536 rev_feature = Q_subsumptive_from;
3537 else if (EQ (attribute, Q_subsumptive_from))
3538 rev_feature = Q_subsumptive;
3539 else if (EQ (attribute, Q_denotational))
3540 rev_feature = Q_denotational_from;
3541 else if (EQ (attribute, Q_denotational_from))
3542 rev_feature = Q_denotational;
3543 else if (EQ (attribute, Q_component))
3544 rev_feature = Q_component_of;
3545 else if (EQ (attribute, Q_component_of))
3546 rev_feature = Q_component;
3549 Lisp_String* name = symbol_name (XSYMBOL (attribute));
3550 Bufbyte *name_str = string_data (name);
3552 if ( (name_str[0] == '<' && name_str[1] == '-') ||
3553 (name_str[0] == '-' && name_str[1] == '>') )
3555 Bytecount length = string_length (name);
3556 Bufbyte *rev_name_str = alloca (length + 1);
3558 memcpy (rev_name_str + 2, name_str + 2, length - 2);
3559 if (name_str[0] == '<')
3561 rev_name_str[0] = '-';
3562 rev_name_str[1] = '>';
3566 rev_name_str[0] = '<';
3567 rev_name_str[1] = '-';
3569 rev_name_str[length] = 0;
3570 rev_feature = intern (rev_name_str);
3574 while (CONSP (rest))
3579 ret = Fdefine_char (ret);
3581 if ( !NILP (ret) && !EQ (ret, character) )
3585 ffv = Fget_char_attribute (ret, rev_feature, Qnil);
3587 put_char_attribute (ret, rev_feature, list1 (character));
3588 else if (NILP (Fmemq (character, ffv)))
3591 nconc2 (Fcopy_sequence (ffv), list1 (character)));
3592 Fsetcar (rest, ret);
3599 else if (EQ (attribute, Qideographic_structure))
3600 value = Fcopy_sequence (Fchar_refs_simplify_char_specs (value));
3602 return put_char_attribute (character, attribute, value);
3605 DEFUN ("remove-char-attribute", Fremove_char_attribute, 2, 2, 0, /*
3606 Remove CHARACTER's ATTRIBUTE.
3608 (character, attribute))
3612 CHECK_CHAR (character);
3613 ccs = Ffind_charset (attribute);
3616 return remove_char_ccs (character, ccs);
3620 Lisp_Object table = Fgethash (attribute,
3621 Vchar_attribute_hash_table,
3623 if (!UNBOUNDP (table))
3625 put_char_id_table (XCHAR_TABLE(table), character, Qunbound);
3634 int char_table_open_db_maybe (Lisp_Char_Table* cit);
3635 void char_table_close_db_maybe (Lisp_Char_Table* cit);
3636 Lisp_Object char_table_get_db (Lisp_Char_Table* cit, Emchar ch);
3638 #ifdef HAVE_LIBCHISE
3640 open_chise_data_source_maybe ()
3642 if (default_chise_data_source == NULL)
3644 Lisp_Object db_dir = Vdata_directory;
3645 int modemask = 0755; /* rwxr-xr-x */
3648 db_dir = build_string ("../etc");
3649 db_dir = Fexpand_file_name (build_string ("chise-db"), db_dir);
3651 default_chise_data_source
3652 = CHISE_DS_open (CHISE_DS_Berkeley_DB, XSTRING_DATA (db_dir),
3653 0 /* DB_HASH */, modemask);
3654 if (default_chise_data_source == NULL)
3657 chise_ds_set_make_string_function (default_chise_data_source,
3663 #endif /* HAVE_LIBCHISE */
3665 DEFUN ("close-char-data-source", Fclose_char_data_source, 0, 0, 0, /*
3666 Close data-source of CHISE.
3670 #ifdef HAVE_LIBCHISE
3671 int status = CHISE_DS_close (default_chise_data_source);
3673 default_chise_data_source = NULL;
3676 #endif /* HAVE_LIBCHISE */
3681 char_table_open_db_maybe (Lisp_Char_Table* cit)
3683 Lisp_Object attribute = CHAR_TABLE_NAME (cit);
3685 if (!NILP (attribute))
3687 #ifdef HAVE_LIBCHISE
3688 if ( open_chise_data_source_maybe () )
3690 #else /* HAVE_LIBCHISE */
3691 if (NILP (Fdatabase_live_p (cit->db)))
3694 = char_attribute_system_db_file (Qsystem_char_id, attribute, 0);
3696 cit->db = Fopen_database (db_file, Qnil, Qnil,
3697 build_string ("r"), Qnil);
3701 #endif /* not HAVE_LIBCHISE */
3709 char_table_close_db_maybe (Lisp_Char_Table* cit)
3711 #ifndef HAVE_LIBCHISE
3712 if (!NILP (cit->db))
3714 if (!NILP (Fdatabase_live_p (cit->db)))
3715 Fclose_database (cit->db);
3718 #endif /* not HAVE_LIBCHISE */
3722 char_table_get_db (Lisp_Char_Table* cit, Emchar ch)
3725 #ifdef HAVE_LIBCHISE
3728 = chise_ds_load_char_feature_value (default_chise_data_source, ch,
3729 XSTRING_DATA(Fsymbol_name
3736 val = Fread (make_string (chise_value_data (&value),
3737 chise_value_size (&value) ));
3739 val = read_from_c_string (chise_value_data (&value),
3740 chise_value_size (&value) );
3745 #else /* HAVE_LIBCHISE */
3746 val = Fget_database (Fprin1_to_string (make_char (ch), Qnil),
3748 if (!UNBOUNDP (val))
3752 #endif /* not HAVE_LIBCHISE */
3756 #ifndef HAVE_LIBCHISE
3758 char_attribute_system_db_file (Lisp_Object key_type, Lisp_Object attribute,
3761 Lisp_Object db_dir = Vdata_directory;
3764 db_dir = build_string ("../etc");
3766 db_dir = Fexpand_file_name (build_string ("chise-db"), db_dir);
3767 if (writing_mode && NILP (Ffile_exists_p (db_dir)))
3768 Fmake_directory_internal (db_dir);
3770 db_dir = Fexpand_file_name (Fsymbol_name (key_type), db_dir);
3771 if (writing_mode && NILP (Ffile_exists_p (db_dir)))
3772 Fmake_directory_internal (db_dir);
3775 Lisp_Object attribute_name = Fsymbol_name (attribute);
3776 Lisp_Object dest = Qnil, ret;
3778 struct gcpro gcpro1, gcpro2;
3779 int len = XSTRING_CHAR_LENGTH (attribute_name);
3783 for (i = 0; i < len; i++)
3785 Emchar c = string_char (XSTRING (attribute_name), i);
3787 if ( (c == '/') || (c == '%') )
3791 sprintf (str, "%%%02X", c);
3792 dest = concat3 (dest,
3793 Fsubstring (attribute_name,
3794 make_int (base), make_int (i)),
3795 build_string (str));
3799 ret = Fsubstring (attribute_name, make_int (base), make_int (len));
3800 dest = concat2 (dest, ret);
3802 return Fexpand_file_name (dest, db_dir);
3805 #endif /* not HAVE_LIBCHISE */
3807 DEFUN ("save-char-attribute-table", Fsave_char_attribute_table, 1, 1, 0, /*
3808 Save values of ATTRIBUTE into database file.
3812 Lisp_Object table = Fgethash (attribute,
3813 Vchar_attribute_hash_table, Qunbound);
3814 Lisp_Char_Table *ct;
3815 #ifdef HAVE_LIBCHISE
3816 CHISE_Feature feature;
3817 #else /* HAVE_LIBCHISE */
3818 Lisp_Object db_file;
3820 #endif /* not HAVE_LIBCHISE */
3822 if (CHAR_TABLEP (table))
3823 ct = XCHAR_TABLE (table);
3827 #ifdef HAVE_LIBCHISE
3828 if ( open_chise_data_source_maybe () )
3831 = chise_ds_get_feature (default_chise_data_source,
3832 XSTRING_DATA (Fsymbol_name (attribute)));
3833 #else /* HAVE_LIBCHISE */
3834 db_file = char_attribute_system_db_file (Qsystem_char_id, attribute, 1);
3835 db = Fopen_database (db_file, Qnil, Qnil, build_string ("w+"), Qnil);
3836 #endif /* not HAVE_LIBCHISE */
3838 #ifdef HAVE_LIBCHISE
3840 #else /* HAVE_LIBCHISE */
3842 #endif /* not HAVE_LIBCHISE */
3845 Lisp_Object (*filter)(Lisp_Object value);
3847 if ( !NILP (Ffind_charset (attribute)) )
3849 else if ( EQ (attribute, Qideographic_structure)
3850 || EQ (attribute, Q_identical)
3851 || EQ (attribute, Q_identical_from)
3852 || !NILP (Fstring_match
3853 (build_string ("^\\(<-\\|->\\)\\(simplified"
3854 "\\|same\\|vulgar\\|wrong"
3855 "\\|original\\|ancient"
3856 "\\|Oracle-Bones\\)[^*]*$"),
3857 Fsymbol_name (attribute),
3859 filter = &Fchar_refs_simplify_char_specs;
3863 if (UINT8_BYTE_TABLE_P (ct->table))
3864 save_uint8_byte_table (XUINT8_BYTE_TABLE(ct->table), ct,
3865 #ifdef HAVE_LIBCHISE
3867 #else /* HAVE_LIBCHISE */
3869 #endif /* not HAVE_LIBCHISE */
3871 else if (UINT16_BYTE_TABLE_P (ct->table))
3872 save_uint16_byte_table (XUINT16_BYTE_TABLE(ct->table), ct,
3873 #ifdef HAVE_LIBCHISE
3875 #else /* HAVE_LIBCHISE */
3877 #endif /* not HAVE_LIBCHISE */
3879 else if (BYTE_TABLE_P (ct->table))
3880 save_byte_table (XBYTE_TABLE(ct->table), ct,
3881 #ifdef HAVE_LIBCHISE
3883 #else /* HAVE_LIBCHISE */
3885 #endif /* not HAVE_LIBCHISE */
3887 #ifdef HAVE_LIBCHISE
3888 chise_feature_sync (feature);
3889 #else /* HAVE_LIBCHISE */
3890 Fclose_database (db);
3891 #endif /* not HAVE_LIBCHISE */
3898 DEFUN ("mount-char-attribute-table", Fmount_char_attribute_table, 1, 1, 0, /*
3899 Mount database file on char-attribute-table ATTRIBUTE.
3903 Lisp_Object table = Fgethash (attribute,
3904 Vchar_attribute_hash_table, Qunbound);
3906 if (UNBOUNDP (table))
3908 Lisp_Char_Table *ct;
3910 table = make_char_id_table (Qunbound);
3911 Fputhash (attribute, table, Vchar_attribute_hash_table);
3912 XCHAR_TABLE_NAME(table) = attribute;
3913 ct = XCHAR_TABLE (table);
3914 ct->table = Qunloaded;
3915 XCHAR_TABLE_UNLOADED(table) = 1;
3916 #ifndef HAVE_LIBCHISE
3918 #endif /* not HAVE_LIBCHISE */
3924 DEFUN ("close-char-attribute-table", Fclose_char_attribute_table, 1, 1, 0, /*
3925 Close database of ATTRIBUTE.
3929 Lisp_Object table = Fgethash (attribute,
3930 Vchar_attribute_hash_table, Qunbound);
3931 Lisp_Char_Table *ct;
3933 if (CHAR_TABLEP (table))
3934 ct = XCHAR_TABLE (table);
3937 char_table_close_db_maybe (ct);
3941 DEFUN ("reset-char-attribute-table", Freset_char_attribute_table, 1, 1, 0, /*
3942 Reset values of ATTRIBUTE with database file.
3946 #ifdef HAVE_LIBCHISE
3947 CHISE_Feature feature
3948 = chise_ds_get_feature (default_chise_data_source,
3949 XSTRING_DATA (Fsymbol_name
3952 if (feature == NULL)
3955 if (chise_feature_setup_db (feature, 0) == 0)
3957 Lisp_Object table = Fgethash (attribute,
3958 Vchar_attribute_hash_table, Qunbound);
3959 Lisp_Char_Table *ct;
3961 chise_feature_sync (feature);
3962 if (UNBOUNDP (table))
3964 table = make_char_id_table (Qunbound);
3965 Fputhash (attribute, table, Vchar_attribute_hash_table);
3966 XCHAR_TABLE_NAME(table) = attribute;
3968 ct = XCHAR_TABLE (table);
3969 ct->table = Qunloaded;
3970 char_table_close_db_maybe (ct);
3971 XCHAR_TABLE_UNLOADED(table) = 1;
3975 Lisp_Object table = Fgethash (attribute,
3976 Vchar_attribute_hash_table, Qunbound);
3977 Lisp_Char_Table *ct;
3979 = char_attribute_system_db_file (Qsystem_char_id, attribute, 0);
3981 if (!NILP (Ffile_exists_p (db_file)))
3983 if (UNBOUNDP (table))
3985 table = make_char_id_table (Qunbound);
3986 Fputhash (attribute, table, Vchar_attribute_hash_table);
3987 XCHAR_TABLE_NAME(table) = attribute;
3989 ct = XCHAR_TABLE (table);
3990 ct->table = Qunloaded;
3991 char_table_close_db_maybe (ct);
3992 XCHAR_TABLE_UNLOADED(table) = 1;
4000 load_char_attribute_maybe (Lisp_Char_Table* cit, Emchar ch)
4002 Lisp_Object attribute = CHAR_TABLE_NAME (cit);
4004 if (!NILP (attribute))
4008 if (char_table_open_db_maybe (cit))
4011 val = char_table_get_db (cit, ch);
4013 if (!NILP (Vchar_db_stingy_mode))
4014 char_table_close_db_maybe (cit);
4021 Lisp_Char_Table* char_attribute_table_to_load;
4023 #ifdef HAVE_LIBCHISE
4025 load_char_attribute_table_map_func (CHISE_Char_ID cid,
4026 CHISE_Feature feature,
4027 CHISE_Value *value);
4029 load_char_attribute_table_map_func (CHISE_Char_ID cid,
4030 CHISE_Feature feature,
4034 Lisp_Object ret = get_char_id_table_0 (char_attribute_table_to_load, code);
4036 if (EQ (ret, Qunloaded))
4037 put_char_id_table_0 (char_attribute_table_to_load, code,
4038 Fread (make_string ((Bufbyte *) value->data,
4042 #else /* HAVE_LIBCHISE */
4043 Lisp_Object Qload_char_attribute_table_map_function;
4045 DEFUN ("load-char-attribute-table-map-function",
4046 Fload_char_attribute_table_map_function, 2, 2, 0, /*
4047 For internal use. Don't use it.
4051 Lisp_Object c = Fread (key);
4052 Emchar code = XCHAR (c);
4053 Lisp_Object ret = get_char_id_table_0 (char_attribute_table_to_load, code);
4055 if (EQ (ret, Qunloaded))
4056 put_char_id_table_0 (char_attribute_table_to_load, code, Fread (value));
4059 #endif /* not HAVE_LIBCHISE */
4061 DEFUN ("load-char-attribute-table", Fload_char_attribute_table, 1, 1, 0, /*
4062 Load values of ATTRIBUTE into database file.
4066 Lisp_Object table = Fgethash (attribute,
4067 Vchar_attribute_hash_table,
4069 if (CHAR_TABLEP (table))
4071 Lisp_Char_Table *cit = XCHAR_TABLE (table);
4073 if (char_table_open_db_maybe (cit))
4076 char_attribute_table_to_load = XCHAR_TABLE (table);
4078 struct gcpro gcpro1;
4081 #ifdef HAVE_LIBCHISE
4082 chise_feature_foreach_char_with_value
4083 (chise_ds_get_feature (default_chise_data_source,
4084 XSTRING_DATA (Fsymbol_name (cit->name))),
4085 &load_char_attribute_table_map_func);
4086 #else /* HAVE_LIBCHISE */
4087 Fmap_database (Qload_char_attribute_table_map_function, cit->db);
4088 #endif /* not HAVE_LIBCHISE */
4091 char_table_close_db_maybe (cit);
4092 XCHAR_TABLE_UNLOADED(table) = 0;
4097 #endif /* HAVE_CHISE */
4099 DEFUN ("map-char-attribute", Fmap_char_attribute, 2, 3, 0, /*
4100 Map FUNCTION over entries in ATTRIBUTE, calling it with two args,
4101 each key and value in the table.
4103 RANGE specifies a subrange to map over and is in the same format as
4104 the RANGE argument to `put-range-table'. If omitted or t, it defaults to
4107 (function, attribute, range))
4110 Lisp_Char_Table *ct;
4111 struct slow_map_char_table_arg slarg;
4112 struct gcpro gcpro1, gcpro2;
4113 struct chartab_range rainj;
4115 if (!NILP (ccs = Ffind_charset (attribute)))
4117 Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (ccs);
4119 if (CHAR_TABLEP (encoding_table))
4120 ct = XCHAR_TABLE (encoding_table);
4126 Lisp_Object table = Fgethash (attribute,
4127 Vchar_attribute_hash_table,
4129 if (CHAR_TABLEP (table))
4130 ct = XCHAR_TABLE (table);
4136 decode_char_table_range (range, &rainj);
4138 if (CHAR_TABLE_UNLOADED(ct))
4139 Fload_char_attribute_table (attribute);
4141 slarg.function = function;
4142 slarg.retval = Qnil;
4143 GCPRO2 (slarg.function, slarg.retval);
4144 map_char_table (ct, &rainj, slow_map_char_table_fun, &slarg);
4147 return slarg.retval;
4150 DEFUN ("define-char", Fdefine_char, 1, 1, 0, /*
4151 Store character's ATTRIBUTES.
4156 Lisp_Object code = Fcdr (Fassq (Qmap_ucs, attributes));
4157 Lisp_Object character;
4160 code = Fcdr (Fassq (Qucs, attributes));
4165 while (CONSP (rest))
4167 Lisp_Object cell = Fcar (rest);
4170 if ( !LISTP (cell) )
4171 signal_simple_error ("Invalid argument", attributes);
4173 ccs = Ffind_charset (Fcar (cell));
4179 character = Fdecode_char (ccs, cell, Qt, Qt);
4180 if (!NILP (character))
4181 goto setup_attributes;
4183 if ( (XCHARSET_FINAL (ccs) != 0) ||
4184 (XCHARSET_MAX_CODE (ccs) > 0) ||
4185 (EQ (ccs, Vcharset_chinese_big5)) )
4189 = Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
4191 character = Fdecode_char (ccs, cell, Qnil, Qt);
4192 if (!NILP (character))
4193 goto setup_attributes;
4200 int cid = XINT (Vnext_defined_char_id);
4202 if (cid <= 0xE00000)
4204 character = make_char (cid);
4205 Vnext_defined_char_id = make_int (cid + 1);
4206 goto setup_attributes;
4210 if ( (!NILP (code = Fcdr (Fassq (Qto_ucs, attributes)))) )
4213 signal_simple_error ("Invalid argument", attributes);
4215 character = make_char (XINT (code) + 0x100000);
4216 goto setup_attributes;
4221 else if (!INTP (code))
4222 signal_simple_error ("Invalid argument", attributes);
4224 character = make_char (XINT (code));
4228 while (CONSP (rest))
4230 Lisp_Object cell = Fcar (rest);
4233 signal_simple_error ("Invalid argument", attributes);
4235 Fput_char_attribute (character, Fcar (cell), Fcdr (cell));
4241 DEFUN ("find-char", Ffind_char, 1, 1, 0, /*
4242 Retrieve the character of the given ATTRIBUTES.
4246 Lisp_Object rest = attributes;
4249 while (CONSP (rest))
4251 Lisp_Object cell = Fcar (rest);
4255 signal_simple_error ("Invalid argument", attributes);
4256 if (!NILP (ccs = Ffind_charset (Fcar (cell))))
4260 return Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
4262 return Fdecode_char (ccs, cell, Qnil, Qnil);
4266 if ( (!NILP (code = Fcdr (Fassq (Qto_ucs, attributes)))) )
4269 signal_simple_error ("Invalid argument", attributes);
4271 return make_char (XINT (code) + 0x100000);
4279 /************************************************************************/
4280 /* Char table read syntax */
4281 /************************************************************************/
4284 chartab_type_validate (Lisp_Object keyword, Lisp_Object value,
4285 Error_behavior errb)
4287 /* #### should deal with ERRB */
4288 symbol_to_char_table_type (value);
4293 chartab_data_validate (Lisp_Object keyword, Lisp_Object value,
4294 Error_behavior errb)
4298 /* #### should deal with ERRB */
4299 EXTERNAL_LIST_LOOP (rest, value)
4301 Lisp_Object range = XCAR (rest);
4302 struct chartab_range dummy;
4306 signal_simple_error ("Invalid list format", value);
4309 if (!CONSP (XCDR (range))
4310 || !NILP (XCDR (XCDR (range))))
4311 signal_simple_error ("Invalid range format", range);
4312 decode_char_table_range (XCAR (range), &dummy);
4313 decode_char_table_range (XCAR (XCDR (range)), &dummy);
4316 decode_char_table_range (range, &dummy);
4323 chartab_instantiate (Lisp_Object data)
4325 Lisp_Object chartab;
4326 Lisp_Object type = Qgeneric;
4327 Lisp_Object dataval = Qnil;
4329 while (!NILP (data))
4331 Lisp_Object keyw = Fcar (data);
4337 if (EQ (keyw, Qtype))
4339 else if (EQ (keyw, Qdata))
4343 chartab = Fmake_char_table (type);
4346 while (!NILP (data))
4348 Lisp_Object range = Fcar (data);
4349 Lisp_Object val = Fcar (Fcdr (data));
4351 data = Fcdr (Fcdr (data));
4354 if (CHAR_OR_CHAR_INTP (XCAR (range)))
4356 Emchar first = XCHAR_OR_CHAR_INT (Fcar (range));
4357 Emchar last = XCHAR_OR_CHAR_INT (Fcar (Fcdr (range)));
4360 for (i = first; i <= last; i++)
4361 Fput_char_table (make_char (i), val, chartab);
4367 Fput_char_table (range, val, chartab);
4376 /************************************************************************/
4377 /* Category Tables, specifically */
4378 /************************************************************************/
4380 DEFUN ("category-table-p", Fcategory_table_p, 1, 1, 0, /*
4381 Return t if OBJECT is a category table.
4382 A category table is a type of char table used for keeping track of
4383 categories. Categories are used for classifying characters for use
4384 in regexps -- you can refer to a category rather than having to use
4385 a complicated [] expression (and category lookups are significantly
4388 There are 95 different categories available, one for each printable
4389 character (including space) in the ASCII charset. Each category
4390 is designated by one such character, called a "category designator".
4391 They are specified in a regexp using the syntax "\\cX", where X is
4392 a category designator.
4394 A category table specifies, for each character, the categories that
4395 the character is in. Note that a character can be in more than one
4396 category. More specifically, a category table maps from a character
4397 to either the value nil (meaning the character is in no categories)
4398 or a 95-element bit vector, specifying for each of the 95 categories
4399 whether the character is in that category.
4401 Special Lisp functions are provided that abstract this, so you do not
4402 have to directly manipulate bit vectors.
4406 return (CHAR_TABLEP (object) &&
4407 XCHAR_TABLE_TYPE (object) == CHAR_TABLE_TYPE_CATEGORY) ?
4412 check_category_table (Lisp_Object object, Lisp_Object default_)
4416 while (NILP (Fcategory_table_p (object)))
4417 object = wrong_type_argument (Qcategory_table_p, object);
4422 check_category_char (Emchar ch, Lisp_Object table,
4423 unsigned int designator, unsigned int not_p)
4425 REGISTER Lisp_Object temp;
4426 Lisp_Char_Table *ctbl;
4427 #ifdef ERROR_CHECK_TYPECHECK
4428 if (NILP (Fcategory_table_p (table)))
4429 signal_simple_error ("Expected category table", table);
4431 ctbl = XCHAR_TABLE (table);
4432 temp = get_char_table (ch, ctbl);
4437 return bit_vector_bit (XBIT_VECTOR (temp), designator) ? !not_p : not_p;
4440 DEFUN ("check-category-at", Fcheck_category_at, 2, 4, 0, /*
4441 Return t if category of the character at POSITION includes DESIGNATOR.
4442 Optional third arg BUFFER specifies which buffer to use, and defaults
4443 to the current buffer.
4444 Optional fourth arg CATEGORY-TABLE specifies the category table to
4445 use, and defaults to BUFFER's category table.
4447 (position, designator, buffer, category_table))
4452 struct buffer *buf = decode_buffer (buffer, 0);
4454 CHECK_INT (position);
4455 CHECK_CATEGORY_DESIGNATOR (designator);
4456 des = XCHAR (designator);
4457 ctbl = check_category_table (category_table, Vstandard_category_table);
4458 ch = BUF_FETCH_CHAR (buf, XINT (position));
4459 return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil;
4462 DEFUN ("char-in-category-p", Fchar_in_category_p, 2, 3, 0, /*
4463 Return t if category of CHARACTER includes DESIGNATOR, else nil.
4464 Optional third arg CATEGORY-TABLE specifies the category table to use,
4465 and defaults to the standard category table.
4467 (character, designator, category_table))
4473 CHECK_CATEGORY_DESIGNATOR (designator);
4474 des = XCHAR (designator);
4475 CHECK_CHAR (character);
4476 ch = XCHAR (character);
4477 ctbl = check_category_table (category_table, Vstandard_category_table);
4478 return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil;
4481 DEFUN ("category-table", Fcategory_table, 0, 1, 0, /*
4482 Return BUFFER's current category table.
4483 BUFFER defaults to the current buffer.
4487 return decode_buffer (buffer, 0)->category_table;
4490 DEFUN ("standard-category-table", Fstandard_category_table, 0, 0, 0, /*
4491 Return the standard category table.
4492 This is the one used for new buffers.
4496 return Vstandard_category_table;
4499 DEFUN ("copy-category-table", Fcopy_category_table, 0, 1, 0, /*
4500 Return a new category table which is a copy of CATEGORY-TABLE.
4501 CATEGORY-TABLE defaults to the standard category table.
4505 if (NILP (Vstandard_category_table))
4506 return Fmake_char_table (Qcategory);
4509 check_category_table (category_table, Vstandard_category_table);
4510 return Fcopy_char_table (category_table);
4513 DEFUN ("set-category-table", Fset_category_table, 1, 2, 0, /*
4514 Select CATEGORY-TABLE as the new category table for BUFFER.
4515 BUFFER defaults to the current buffer if omitted.
4517 (category_table, buffer))
4519 struct buffer *buf = decode_buffer (buffer, 0);
4520 category_table = check_category_table (category_table, Qnil);
4521 buf->category_table = category_table;
4522 /* Indicate that this buffer now has a specified category table. */
4523 buf->local_var_flags |= XINT (buffer_local_flags.category_table);
4524 return category_table;
4527 DEFUN ("category-designator-p", Fcategory_designator_p, 1, 1, 0, /*
4528 Return t if OBJECT is a category designator (a char in the range ' ' to '~').
4532 return CATEGORY_DESIGNATORP (object) ? Qt : Qnil;
4535 DEFUN ("category-table-value-p", Fcategory_table_value_p, 1, 1, 0, /*
4536 Return t if OBJECT is a category table value.
4537 Valid values are nil or a bit vector of size 95.
4541 return CATEGORY_TABLE_VALUEP (object) ? Qt : Qnil;
4545 #define CATEGORYP(x) \
4546 (CHARP (x) && XCHAR (x) >= 0x20 && XCHAR (x) <= 0x7E)
4548 #define CATEGORY_SET(c) \
4549 (get_char_table(c, XCHAR_TABLE(current_buffer->category_table)))
4551 /* Return 1 if CATEGORY_SET contains CATEGORY, else return 0.
4552 The faster version of `!NILP (Faref (category_set, category))'. */
4553 #define CATEGORY_MEMBER(category, category_set) \
4554 (bit_vector_bit(XBIT_VECTOR (category_set), category - 32))
4556 /* Return 1 if there is a word boundary between two word-constituent
4557 characters C1 and C2 if they appear in this order, else return 0.
4558 Use the macro WORD_BOUNDARY_P instead of calling this function
4561 int word_boundary_p (Emchar c1, Emchar c2);
4563 word_boundary_p (Emchar c1, Emchar c2)
4565 Lisp_Object category_set1, category_set2;
4570 if (COMPOSITE_CHAR_P (c1))
4571 c1 = cmpchar_component (c1, 0, 1);
4572 if (COMPOSITE_CHAR_P (c2))
4573 c2 = cmpchar_component (c2, 0, 1);
4577 if (EQ (CHAR_CHARSET (c1), CHAR_CHARSET (c2)))
4580 tail = Vword_separating_categories;
4586 tail = Vword_combining_categories;
4591 category_set1 = CATEGORY_SET (c1);
4592 if (NILP (category_set1))
4593 return default_result;
4594 category_set2 = CATEGORY_SET (c2);
4595 if (NILP (category_set2))
4596 return default_result;
4598 for (; CONSP (tail); tail = XCONS (tail)->cdr)
4600 Lisp_Object elt = XCONS(tail)->car;
4603 && CATEGORYP (XCONS (elt)->car)
4604 && CATEGORYP (XCONS (elt)->cdr)
4605 && CATEGORY_MEMBER (XCHAR (XCONS (elt)->car), category_set1)
4606 && CATEGORY_MEMBER (XCHAR (XCONS (elt)->cdr), category_set2))
4607 return !default_result;
4609 return default_result;
4615 syms_of_chartab (void)
4618 INIT_LRECORD_IMPLEMENTATION (uint8_byte_table);
4619 INIT_LRECORD_IMPLEMENTATION (uint16_byte_table);
4620 INIT_LRECORD_IMPLEMENTATION (byte_table);
4622 defsymbol (&Qto_ucs, "=>ucs");
4623 defsymbol (&Q_ucs_unified, "->ucs-unified");
4624 defsymbol (&Q_subsumptive, "->subsumptive");
4625 defsymbol (&Q_subsumptive_from, "<-subsumptive");
4626 defsymbol (&Q_denotational, "->denotational");
4627 defsymbol (&Q_denotational_from, "<-denotational");
4628 defsymbol (&Q_identical, "->identical");
4629 defsymbol (&Q_identical_from, "<-identical");
4630 defsymbol (&Q_component, "->ideographic-component-forms");
4631 defsymbol (&Q_component_of, "<-ideographic-component-forms");
4632 defsymbol (&Qcomposition, "composition");
4633 defsymbol (&Q_decomposition, "->decomposition");
4634 defsymbol (&Qcompat, "compat");
4635 defsymbol (&Qisolated, "isolated");
4636 defsymbol (&Qinitial, "initial");
4637 defsymbol (&Qmedial, "medial");
4638 defsymbol (&Qfinal, "final");
4639 defsymbol (&Qvertical, "vertical");
4640 defsymbol (&QnoBreak, "noBreak");
4641 defsymbol (&Qfraction, "fraction");
4642 defsymbol (&Qsuper, "super");
4643 defsymbol (&Qsub, "sub");
4644 defsymbol (&Qcircle, "circle");
4645 defsymbol (&Qsquare, "square");
4646 defsymbol (&Qwide, "wide");
4647 defsymbol (&Qnarrow, "narrow");
4648 defsymbol (&Qsmall, "small");
4649 defsymbol (&Qfont, "font");
4651 DEFSUBR (Fchar_attribute_list);
4652 DEFSUBR (Ffind_char_attribute_table);
4653 defsymbol (&Qput_char_table_map_function, "put-char-table-map-function");
4654 DEFSUBR (Fput_char_table_map_function);
4656 DEFSUBR (Fsave_char_attribute_table);
4657 DEFSUBR (Fmount_char_attribute_table);
4658 DEFSUBR (Freset_char_attribute_table);
4659 DEFSUBR (Fclose_char_attribute_table);
4660 DEFSUBR (Fclose_char_data_source);
4661 #ifndef HAVE_LIBCHISE
4662 defsymbol (&Qload_char_attribute_table_map_function,
4663 "load-char-attribute-table-map-function");
4664 DEFSUBR (Fload_char_attribute_table_map_function);
4666 DEFSUBR (Fload_char_attribute_table);
4668 DEFSUBR (Fchar_feature);
4669 DEFSUBR (Fchar_attribute_alist);
4670 DEFSUBR (Fget_char_attribute);
4671 DEFSUBR (Fput_char_attribute);
4672 DEFSUBR (Fremove_char_attribute);
4673 DEFSUBR (Fmap_char_attribute);
4674 DEFSUBR (Fdefine_char);
4675 DEFSUBR (Ffind_char);
4676 DEFSUBR (Fchar_variants);
4678 DEFSUBR (Fget_composite_char);
4681 INIT_LRECORD_IMPLEMENTATION (char_table);
4685 INIT_LRECORD_IMPLEMENTATION (char_table_entry);
4688 defsymbol (&Qcategory_table_p, "category-table-p");
4689 defsymbol (&Qcategory_designator_p, "category-designator-p");
4690 defsymbol (&Qcategory_table_value_p, "category-table-value-p");
4693 defsymbol (&Qchar_table, "char-table");
4694 defsymbol (&Qchar_tablep, "char-table-p");
4696 DEFSUBR (Fchar_table_p);
4697 DEFSUBR (Fchar_table_type_list);
4698 DEFSUBR (Fvalid_char_table_type_p);
4699 DEFSUBR (Fchar_table_type);
4700 DEFSUBR (Freset_char_table);
4701 DEFSUBR (Fmake_char_table);
4702 DEFSUBR (Fcopy_char_table);
4703 DEFSUBR (Fget_char_table);
4704 DEFSUBR (Fget_range_char_table);
4705 DEFSUBR (Fvalid_char_table_value_p);
4706 DEFSUBR (Fcheck_valid_char_table_value);
4707 DEFSUBR (Fput_char_table);
4708 DEFSUBR (Fmap_char_table);
4711 DEFSUBR (Fcategory_table_p);
4712 DEFSUBR (Fcategory_table);
4713 DEFSUBR (Fstandard_category_table);
4714 DEFSUBR (Fcopy_category_table);
4715 DEFSUBR (Fset_category_table);
4716 DEFSUBR (Fcheck_category_at);
4717 DEFSUBR (Fchar_in_category_p);
4718 DEFSUBR (Fcategory_designator_p);
4719 DEFSUBR (Fcategory_table_value_p);
4725 vars_of_chartab (void)
4728 DEFVAR_LISP ("next-defined-char-id", &Vnext_defined_char_id /*
4730 Vnext_defined_char_id = make_int (0x0F0000);
4734 DEFVAR_LISP ("char-db-stingy-mode", &Vchar_db_stingy_mode /*
4736 Vchar_db_stingy_mode = Qt;
4738 #ifdef HAVE_LIBCHISE
4739 Vchise_db_directory = build_string(chise_db_dir);
4740 DEFVAR_LISP ("chise-db-directory", &Vchise_db_directory /*
4741 Directory of CHISE character databases.
4744 Vchise_system_db_directory = build_string(chise_system_db_dir);
4745 DEFVAR_LISP ("chise-system-db-directory", &Vchise_system_db_directory /*
4746 Directory of system character database of CHISE.
4750 #endif /* HAVE_CHISE */
4751 /* DO NOT staticpro this. It works just like Vweak_hash_tables. */
4752 Vall_syntax_tables = Qnil;
4753 dump_add_weak_object_chain (&Vall_syntax_tables);
4757 structure_type_create_chartab (void)
4759 struct structure_type *st;
4761 st = define_structure_type (Qchar_table, 0, chartab_instantiate);
4763 define_structure_type_keyword (st, Qtype, chartab_type_validate);
4764 define_structure_type_keyword (st, Qdata, chartab_data_validate);
4768 complex_vars_of_chartab (void)
4771 staticpro (&Vchar_attribute_hash_table);
4772 Vchar_attribute_hash_table
4773 = make_lisp_hash_table (16, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
4774 #endif /* UTF2000 */
4776 /* Set this now, so first buffer creation can refer to it. */
4777 /* Make it nil before calling copy-category-table
4778 so that copy-category-table will know not to try to copy from garbage */
4779 Vstandard_category_table = Qnil;
4780 Vstandard_category_table = Fcopy_category_table (Qnil);
4781 staticpro (&Vstandard_category_table);
4783 DEFVAR_LISP ("word-combining-categories", &Vword_combining_categories /*
4784 List of pair (cons) of categories to determine word boundary.
4786 Emacs treats a sequence of word constituent characters as a single
4787 word (i.e. finds no word boundary between them) iff they belongs to
4788 the same charset. But, exceptions are allowed in the following cases.
4790 \(1) The case that characters are in different charsets is controlled
4791 by the variable `word-combining-categories'.
4793 Emacs finds no word boundary between characters of different charsets
4794 if they have categories matching some element of this list.
4796 More precisely, if an element of this list is a cons of category CAT1
4797 and CAT2, and a multibyte character C1 which has CAT1 is followed by
4798 C2 which has CAT2, there's no word boundary between C1 and C2.
4800 For instance, to tell that ASCII characters and Latin-1 characters can
4801 form a single word, the element `(?l . ?l)' should be in this list
4802 because both characters have the category `l' (Latin characters).
4804 \(2) The case that character are in the same charset is controlled by
4805 the variable `word-separating-categories'.
4807 Emacs find a word boundary between characters of the same charset
4808 if they have categories matching some element of this list.
4810 More precisely, if an element of this list is a cons of category CAT1
4811 and CAT2, and a multibyte character C1 which has CAT1 is followed by
4812 C2 which has CAT2, there's a word boundary between C1 and C2.
4814 For instance, to tell that there's a word boundary between Japanese
4815 Hiragana and Japanese Kanji (both are in the same charset), the
4816 element `(?H . ?C) should be in this list.
4819 Vword_combining_categories = Qnil;
4821 DEFVAR_LISP ("word-separating-categories", &Vword_separating_categories /*
4822 List of pair (cons) of categories to determine word boundary.
4823 See the documentation of the variable `word-combining-categories'.
4826 Vword_separating_categories = Qnil;