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.
1240 CHECK_CHAR (character);
1241 ret = Fchar_feature (character, Q_ucs_unified, Qnil,
1244 return Fcopy_list (ret);
1252 /* A char table maps from ranges of characters to values.
1254 Implementing a general data structure that maps from arbitrary
1255 ranges of numbers to values is tricky to do efficiently. As it
1256 happens, it should suffice (and is usually more convenient, anyway)
1257 when dealing with characters to restrict the sorts of ranges that
1258 can be assigned values, as follows:
1261 2) All characters in a charset.
1262 3) All characters in a particular row of a charset, where a "row"
1263 means all characters with the same first byte.
1264 4) A particular character in a charset.
1266 We use char tables to generalize the 256-element vectors now
1267 littering the Emacs code.
1269 Possible uses (all should be converted at some point):
1275 5) keyboard-translate-table?
1278 abstract type to generalize the Emacs vectors and Mule
1279 vectors-of-vectors goo.
1282 /************************************************************************/
1283 /* Char Table object */
1284 /************************************************************************/
1286 #if defined(MULE)&&!defined(UTF2000)
1289 mark_char_table_entry (Lisp_Object obj)
1291 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj);
1294 for (i = 0; i < 96; i++)
1296 mark_object (cte->level2[i]);
1302 char_table_entry_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
1304 Lisp_Char_Table_Entry *cte1 = XCHAR_TABLE_ENTRY (obj1);
1305 Lisp_Char_Table_Entry *cte2 = XCHAR_TABLE_ENTRY (obj2);
1308 for (i = 0; i < 96; i++)
1309 if (!internal_equal (cte1->level2[i], cte2->level2[i], depth + 1))
1315 static unsigned long
1316 char_table_entry_hash (Lisp_Object obj, int depth)
1318 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj);
1320 return internal_array_hash (cte->level2, 96, depth);
1323 static const struct lrecord_description char_table_entry_description[] = {
1324 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table_Entry, level2), 96 },
1328 DEFINE_LRECORD_IMPLEMENTATION ("char-table-entry", char_table_entry,
1329 mark_char_table_entry, internal_object_printer,
1330 0, char_table_entry_equal,
1331 char_table_entry_hash,
1332 char_table_entry_description,
1333 Lisp_Char_Table_Entry);
1337 mark_char_table (Lisp_Object obj)
1339 Lisp_Char_Table *ct = XCHAR_TABLE (obj);
1342 mark_object (ct->table);
1343 mark_object (ct->name);
1344 #ifndef HAVE_LIBCHISE
1345 mark_object (ct->db);
1350 for (i = 0; i < NUM_ASCII_CHARS; i++)
1351 mark_object (ct->ascii[i]);
1353 for (i = 0; i < NUM_LEADING_BYTES; i++)
1354 mark_object (ct->level1[i]);
1358 return ct->default_value;
1360 return ct->mirror_table;
1364 /* WARNING: All functions of this nature need to be written extremely
1365 carefully to avoid crashes during GC. Cf. prune_specifiers()
1366 and prune_weak_hash_tables(). */
1369 prune_syntax_tables (void)
1371 Lisp_Object rest, prev = Qnil;
1373 for (rest = Vall_syntax_tables;
1375 rest = XCHAR_TABLE (rest)->next_table)
1377 if (! marked_p (rest))
1379 /* This table is garbage. Remove it from the list. */
1381 Vall_syntax_tables = XCHAR_TABLE (rest)->next_table;
1383 XCHAR_TABLE (prev)->next_table =
1384 XCHAR_TABLE (rest)->next_table;
1390 char_table_type_to_symbol (enum char_table_type type)
1395 case CHAR_TABLE_TYPE_GENERIC: return Qgeneric;
1396 case CHAR_TABLE_TYPE_SYNTAX: return Qsyntax;
1397 case CHAR_TABLE_TYPE_DISPLAY: return Qdisplay;
1398 case CHAR_TABLE_TYPE_CHAR: return Qchar;
1400 case CHAR_TABLE_TYPE_CATEGORY: return Qcategory;
1405 static enum char_table_type
1406 symbol_to_char_table_type (Lisp_Object symbol)
1408 CHECK_SYMBOL (symbol);
1410 if (EQ (symbol, Qgeneric)) return CHAR_TABLE_TYPE_GENERIC;
1411 if (EQ (symbol, Qsyntax)) return CHAR_TABLE_TYPE_SYNTAX;
1412 if (EQ (symbol, Qdisplay)) return CHAR_TABLE_TYPE_DISPLAY;
1413 if (EQ (symbol, Qchar)) return CHAR_TABLE_TYPE_CHAR;
1415 if (EQ (symbol, Qcategory)) return CHAR_TABLE_TYPE_CATEGORY;
1418 signal_simple_error ("Unrecognized char table type", symbol);
1419 return CHAR_TABLE_TYPE_GENERIC; /* not reached */
1424 print_chartab_range (Emchar first, Emchar last, Lisp_Object val,
1425 Lisp_Object printcharfun)
1429 write_c_string (" (", printcharfun);
1430 print_internal (make_char (first), printcharfun, 0);
1431 write_c_string (" ", printcharfun);
1432 print_internal (make_char (last), printcharfun, 0);
1433 write_c_string (") ", printcharfun);
1437 write_c_string (" ", printcharfun);
1438 print_internal (make_char (first), printcharfun, 0);
1439 write_c_string (" ", printcharfun);
1441 print_internal (val, printcharfun, 1);
1445 #if defined(MULE)&&!defined(UTF2000)
1448 print_chartab_charset_row (Lisp_Object charset,
1450 Lisp_Char_Table_Entry *cte,
1451 Lisp_Object printcharfun)
1454 Lisp_Object cat = Qunbound;
1457 for (i = 32; i < 128; i++)
1459 Lisp_Object pam = cte->level2[i - 32];
1471 print_chartab_range (MAKE_CHAR (charset, first, 0),
1472 MAKE_CHAR (charset, i - 1, 0),
1475 print_chartab_range (MAKE_CHAR (charset, row, first),
1476 MAKE_CHAR (charset, row, i - 1),
1486 print_chartab_range (MAKE_CHAR (charset, first, 0),
1487 MAKE_CHAR (charset, i - 1, 0),
1490 print_chartab_range (MAKE_CHAR (charset, row, first),
1491 MAKE_CHAR (charset, row, i - 1),
1497 print_chartab_two_byte_charset (Lisp_Object charset,
1498 Lisp_Char_Table_Entry *cte,
1499 Lisp_Object printcharfun)
1503 for (i = 32; i < 128; i++)
1505 Lisp_Object jen = cte->level2[i - 32];
1507 if (!CHAR_TABLE_ENTRYP (jen))
1511 write_c_string (" [", printcharfun);
1512 print_internal (XCHARSET_NAME (charset), printcharfun, 0);
1513 sprintf (buf, " %d] ", i);
1514 write_c_string (buf, printcharfun);
1515 print_internal (jen, printcharfun, 0);
1518 print_chartab_charset_row (charset, i, XCHAR_TABLE_ENTRY (jen),
1526 print_char_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1528 Lisp_Char_Table *ct = XCHAR_TABLE (obj);
1531 struct gcpro gcpro1, gcpro2;
1532 GCPRO2 (obj, printcharfun);
1534 write_c_string ("#s(char-table ", printcharfun);
1535 write_c_string (" ", printcharfun);
1536 write_c_string (string_data
1538 (XSYMBOL (char_table_type_to_symbol (ct->type)))),
1540 write_c_string ("\n ", printcharfun);
1541 print_internal (ct->default_value, printcharfun, escapeflag);
1542 for (i = 0; i < 256; i++)
1544 Lisp_Object elt = get_byte_table (ct->table, i);
1545 if (i != 0) write_c_string ("\n ", printcharfun);
1546 if (EQ (elt, Qunbound))
1547 write_c_string ("void", printcharfun);
1549 print_internal (elt, printcharfun, escapeflag);
1552 #else /* non UTF2000 */
1555 sprintf (buf, "#s(char-table type %s data (",
1556 string_data (symbol_name (XSYMBOL
1557 (char_table_type_to_symbol (ct->type)))));
1558 write_c_string (buf, printcharfun);
1560 /* Now write out the ASCII/Control-1 stuff. */
1564 Lisp_Object val = Qunbound;
1566 for (i = 0; i < NUM_ASCII_CHARS; i++)
1575 if (!EQ (ct->ascii[i], val))
1577 print_chartab_range (first, i - 1, val, printcharfun);
1584 print_chartab_range (first, i - 1, val, printcharfun);
1591 for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES;
1594 Lisp_Object ann = ct->level1[i - MIN_LEADING_BYTE];
1595 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (i);
1597 if (!CHARSETP (charset) || i == LEADING_BYTE_ASCII
1598 || i == LEADING_BYTE_CONTROL_1)
1600 if (!CHAR_TABLE_ENTRYP (ann))
1602 write_c_string (" ", printcharfun);
1603 print_internal (XCHARSET_NAME (charset),
1605 write_c_string (" ", printcharfun);
1606 print_internal (ann, printcharfun, 0);
1610 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (ann);
1611 if (XCHARSET_DIMENSION (charset) == 1)
1612 print_chartab_charset_row (charset, -1, cte, printcharfun);
1614 print_chartab_two_byte_charset (charset, cte, printcharfun);
1619 #endif /* non UTF2000 */
1621 write_c_string ("))", printcharfun);
1625 char_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
1627 Lisp_Char_Table *ct1 = XCHAR_TABLE (obj1);
1628 Lisp_Char_Table *ct2 = XCHAR_TABLE (obj2);
1631 if (CHAR_TABLE_TYPE (ct1) != CHAR_TABLE_TYPE (ct2))
1635 for (i = 0; i < 256; i++)
1637 if (!internal_equal (get_byte_table (ct1->table, i),
1638 get_byte_table (ct2->table, i), 0))
1642 for (i = 0; i < NUM_ASCII_CHARS; i++)
1643 if (!internal_equal (ct1->ascii[i], ct2->ascii[i], depth + 1))
1647 for (i = 0; i < NUM_LEADING_BYTES; i++)
1648 if (!internal_equal (ct1->level1[i], ct2->level1[i], depth + 1))
1651 #endif /* non UTF2000 */
1656 static unsigned long
1657 char_table_hash (Lisp_Object obj, int depth)
1659 Lisp_Char_Table *ct = XCHAR_TABLE (obj);
1661 return byte_table_hash (ct->table, depth + 1);
1663 unsigned long hashval = internal_array_hash (ct->ascii, NUM_ASCII_CHARS,
1666 hashval = HASH2 (hashval,
1667 internal_array_hash (ct->level1, NUM_LEADING_BYTES, depth));
1673 static const struct lrecord_description char_table_description[] = {
1675 { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, table) },
1676 { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, default_value) },
1677 { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, name) },
1678 #ifndef HAVE_LIBCHISE
1679 { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, db) },
1682 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, ascii), NUM_ASCII_CHARS },
1684 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, level1), NUM_LEADING_BYTES },
1688 { XD_LISP_OBJECT, offsetof (Lisp_Char_Table, mirror_table) },
1690 { XD_LO_LINK, offsetof (Lisp_Char_Table, next_table) },
1694 DEFINE_LRECORD_IMPLEMENTATION ("char-table", char_table,
1695 mark_char_table, print_char_table, 0,
1696 char_table_equal, char_table_hash,
1697 char_table_description,
1700 DEFUN ("char-table-p", Fchar_table_p, 1, 1, 0, /*
1701 Return non-nil if OBJECT is a char table.
1703 A char table is a table that maps characters (or ranges of characters)
1704 to values. Char tables are specialized for characters, only allowing
1705 particular sorts of ranges to be assigned values. Although this
1706 loses in generality, it makes for extremely fast (constant-time)
1707 lookups, and thus is feasible for applications that do an extremely
1708 large number of lookups (e.g. scanning a buffer for a character in
1709 a particular syntax, where a lookup in the syntax table must occur
1710 once per character).
1712 When Mule support exists, the types of ranges that can be assigned
1716 -- an entire charset
1717 -- a single row in a two-octet charset
1718 -- a single character
1720 When Mule support is not present, the types of ranges that can be
1724 -- a single character
1726 To create a char table, use `make-char-table'.
1727 To modify a char table, use `put-char-table' or `remove-char-table'.
1728 To retrieve the value for a particular character, use `get-char-table'.
1729 See also `map-char-table', `clear-char-table', `copy-char-table',
1730 `valid-char-table-type-p', `char-table-type-list',
1731 `valid-char-table-value-p', and `check-char-table-value'.
1735 return CHAR_TABLEP (object) ? Qt : Qnil;
1738 DEFUN ("char-table-type-list", Fchar_table_type_list, 0, 0, 0, /*
1739 Return a list of the recognized char table types.
1740 See `valid-char-table-type-p'.
1745 return list5 (Qchar, Qcategory, Qdisplay, Qgeneric, Qsyntax);
1747 return list4 (Qchar, Qdisplay, Qgeneric, Qsyntax);
1751 DEFUN ("valid-char-table-type-p", Fvalid_char_table_type_p, 1, 1, 0, /*
1752 Return t if TYPE if a recognized char table type.
1754 Each char table type is used for a different purpose and allows different
1755 sorts of values. The different char table types are
1758 Used for category tables, which specify the regexp categories
1759 that a character is in. The valid values are nil or a
1760 bit vector of 95 elements. Higher-level Lisp functions are
1761 provided for working with category tables. Currently categories
1762 and category tables only exist when Mule support is present.
1764 A generalized char table, for mapping from one character to
1765 another. Used for case tables, syntax matching tables,
1766 `keyboard-translate-table', etc. The valid values are characters.
1768 An even more generalized char table, for mapping from a
1769 character to anything.
1771 Used for display tables, which specify how a particular character
1772 is to appear when displayed. #### Not yet implemented.
1774 Used for syntax tables, which specify the syntax of a particular
1775 character. Higher-level Lisp functions are provided for
1776 working with syntax tables. The valid values are integers.
1781 return (EQ (type, Qchar) ||
1783 EQ (type, Qcategory) ||
1785 EQ (type, Qdisplay) ||
1786 EQ (type, Qgeneric) ||
1787 EQ (type, Qsyntax)) ? Qt : Qnil;
1790 DEFUN ("char-table-type", Fchar_table_type, 1, 1, 0, /*
1791 Return the type of CHAR-TABLE.
1792 See `valid-char-table-type-p'.
1796 CHECK_CHAR_TABLE (char_table);
1797 return char_table_type_to_symbol (XCHAR_TABLE (char_table)->type);
1801 fill_char_table (Lisp_Char_Table *ct, Lisp_Object value)
1804 ct->table = Qunbound;
1805 ct->default_value = value;
1810 for (i = 0; i < NUM_ASCII_CHARS; i++)
1811 ct->ascii[i] = value;
1813 for (i = 0; i < NUM_LEADING_BYTES; i++)
1814 ct->level1[i] = value;
1819 if (ct->type == CHAR_TABLE_TYPE_SYNTAX)
1820 update_syntax_table (ct);
1824 DEFUN ("reset-char-table", Freset_char_table, 1, 1, 0, /*
1825 Reset CHAR-TABLE to its default state.
1829 Lisp_Char_Table *ct;
1831 CHECK_CHAR_TABLE (char_table);
1832 ct = XCHAR_TABLE (char_table);
1836 case CHAR_TABLE_TYPE_CHAR:
1837 fill_char_table (ct, make_char (0));
1839 case CHAR_TABLE_TYPE_DISPLAY:
1840 case CHAR_TABLE_TYPE_GENERIC:
1842 case CHAR_TABLE_TYPE_CATEGORY:
1844 fill_char_table (ct, Qnil);
1847 case CHAR_TABLE_TYPE_SYNTAX:
1848 fill_char_table (ct, make_int (Sinherit));
1858 DEFUN ("make-char-table", Fmake_char_table, 1, 1, 0, /*
1859 Return a new, empty char table of type TYPE.
1860 Currently recognized types are 'char, 'category, 'display, 'generic,
1861 and 'syntax. See `valid-char-table-type-p'.
1865 Lisp_Char_Table *ct;
1867 enum char_table_type ty = symbol_to_char_table_type (type);
1869 ct = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table);
1872 if (ty == CHAR_TABLE_TYPE_SYNTAX)
1874 ct->mirror_table = Fmake_char_table (Qgeneric);
1875 fill_char_table (XCHAR_TABLE (ct->mirror_table),
1879 ct->mirror_table = Qnil;
1882 #ifndef HAVE_LIBCHISE
1886 ct->next_table = Qnil;
1887 XSETCHAR_TABLE (obj, ct);
1888 if (ty == CHAR_TABLE_TYPE_SYNTAX)
1890 ct->next_table = Vall_syntax_tables;
1891 Vall_syntax_tables = obj;
1893 Freset_char_table (obj);
1897 #if defined(MULE)&&!defined(UTF2000)
1900 make_char_table_entry (Lisp_Object initval)
1904 Lisp_Char_Table_Entry *cte =
1905 alloc_lcrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry);
1907 for (i = 0; i < 96; i++)
1908 cte->level2[i] = initval;
1910 XSETCHAR_TABLE_ENTRY (obj, cte);
1915 copy_char_table_entry (Lisp_Object entry)
1917 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (entry);
1920 Lisp_Char_Table_Entry *ctenew =
1921 alloc_lcrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry);
1923 for (i = 0; i < 96; i++)
1925 Lisp_Object new = cte->level2[i];
1926 if (CHAR_TABLE_ENTRYP (new))
1927 ctenew->level2[i] = copy_char_table_entry (new);
1929 ctenew->level2[i] = new;
1932 XSETCHAR_TABLE_ENTRY (obj, ctenew);
1938 DEFUN ("copy-char-table", Fcopy_char_table, 1, 1, 0, /*
1939 Return a new char table which is a copy of CHAR-TABLE.
1940 It will contain the same values for the same characters and ranges
1941 as CHAR-TABLE. The values will not themselves be copied.
1945 Lisp_Char_Table *ct, *ctnew;
1951 CHECK_CHAR_TABLE (char_table);
1952 ct = XCHAR_TABLE (char_table);
1953 ctnew = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table);
1954 ctnew->type = ct->type;
1956 ctnew->default_value = ct->default_value;
1957 /* [tomo:2002-01-21] Perhaps this code seems wrong */
1958 ctnew->name = ct->name;
1959 #ifndef HAVE_LIBCHISE
1963 if (UINT8_BYTE_TABLE_P (ct->table))
1965 ctnew->table = copy_uint8_byte_table (ct->table);
1967 else if (UINT16_BYTE_TABLE_P (ct->table))
1969 ctnew->table = copy_uint16_byte_table (ct->table);
1971 else if (BYTE_TABLE_P (ct->table))
1973 ctnew->table = copy_byte_table (ct->table);
1975 else if (!UNBOUNDP (ct->table))
1976 ctnew->table = ct->table;
1977 #else /* non UTF2000 */
1979 for (i = 0; i < NUM_ASCII_CHARS; i++)
1981 Lisp_Object new = ct->ascii[i];
1983 assert (! (CHAR_TABLE_ENTRYP (new)));
1985 ctnew->ascii[i] = new;
1990 for (i = 0; i < NUM_LEADING_BYTES; i++)
1992 Lisp_Object new = ct->level1[i];
1993 if (CHAR_TABLE_ENTRYP (new))
1994 ctnew->level1[i] = copy_char_table_entry (new);
1996 ctnew->level1[i] = new;
2000 #endif /* non UTF2000 */
2003 if (CHAR_TABLEP (ct->mirror_table))
2004 ctnew->mirror_table = Fcopy_char_table (ct->mirror_table);
2006 ctnew->mirror_table = ct->mirror_table;
2008 ctnew->next_table = Qnil;
2009 XSETCHAR_TABLE (obj, ctnew);
2010 if (ctnew->type == CHAR_TABLE_TYPE_SYNTAX)
2012 ctnew->next_table = Vall_syntax_tables;
2013 Vall_syntax_tables = obj;
2018 INLINE_HEADER int XCHARSET_CELL_RANGE (Lisp_Object ccs);
2020 XCHARSET_CELL_RANGE (Lisp_Object ccs)
2022 switch (XCHARSET_CHARS (ccs))
2025 return (33 << 8) | 126;
2027 return (32 << 8) | 127;
2030 return (0 << 8) | 127;
2032 return (0 << 8) | 255;
2044 decode_char_table_range (Lisp_Object range, struct chartab_range *outrange)
2047 outrange->type = CHARTAB_RANGE_ALL;
2049 else if (EQ (range, Qnil))
2050 outrange->type = CHARTAB_RANGE_DEFAULT;
2052 else if (CHAR_OR_CHAR_INTP (range))
2054 outrange->type = CHARTAB_RANGE_CHAR;
2055 outrange->ch = XCHAR_OR_CHAR_INT (range);
2059 signal_simple_error ("Range must be t or a character", range);
2061 else if (VECTORP (range))
2063 Lisp_Vector *vec = XVECTOR (range);
2064 Lisp_Object *elts = vector_data (vec);
2065 int cell_min, cell_max;
2067 outrange->type = CHARTAB_RANGE_ROW;
2068 outrange->charset = Fget_charset (elts[0]);
2069 CHECK_INT (elts[1]);
2070 outrange->row = XINT (elts[1]);
2071 if (XCHARSET_DIMENSION (outrange->charset) < 2)
2072 signal_simple_error ("Charset in row vector must be multi-byte",
2076 int ret = XCHARSET_CELL_RANGE (outrange->charset);
2078 cell_min = ret >> 8;
2079 cell_max = ret & 0xFF;
2081 if (XCHARSET_DIMENSION (outrange->charset) == 2)
2082 check_int_range (outrange->row, cell_min, cell_max);
2084 else if (XCHARSET_DIMENSION (outrange->charset) == 3)
2086 check_int_range (outrange->row >> 8 , cell_min, cell_max);
2087 check_int_range (outrange->row & 0xFF, cell_min, cell_max);
2089 else if (XCHARSET_DIMENSION (outrange->charset) == 4)
2091 check_int_range ( outrange->row >> 16 , cell_min, cell_max);
2092 check_int_range ((outrange->row >> 8) & 0xFF, cell_min, cell_max);
2093 check_int_range ( outrange->row & 0xFF, cell_min, cell_max);
2101 if (!CHARSETP (range) && !SYMBOLP (range))
2103 ("Char table range must be t, charset, char, or vector", range);
2104 outrange->type = CHARTAB_RANGE_CHARSET;
2105 outrange->charset = Fget_charset (range);
2110 #if defined(MULE)&&!defined(UTF2000)
2112 /* called from CHAR_TABLE_VALUE(). */
2114 get_non_ascii_char_table_value (Lisp_Char_Table *ct, Charset_ID leading_byte,
2119 Lisp_Object charset;
2121 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (leading_byte);
2126 BREAKUP_CHAR (c, charset, byte1, byte2);
2128 BREAKUP_CHAR_1_UNSAFE (c, charset, byte1, byte2);
2130 val = ct->level1[leading_byte - MIN_LEADING_BYTE];
2131 if (CHAR_TABLE_ENTRYP (val))
2133 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
2134 val = cte->level2[byte1 - 32];
2135 if (CHAR_TABLE_ENTRYP (val))
2137 cte = XCHAR_TABLE_ENTRY (val);
2138 assert (byte2 >= 32);
2139 val = cte->level2[byte2 - 32];
2140 assert (!CHAR_TABLE_ENTRYP (val));
2150 get_char_table (Emchar ch, Lisp_Char_Table *ct)
2154 Lisp_Object ret = get_char_id_table (ct, ch);
2159 if (EQ (CHAR_TABLE_NAME (ct), Qdowncase))
2160 ret = Fchar_feature (make_char (ch), Q_lowercase, Qnil,
2162 else if (EQ (CHAR_TABLE_NAME (ct), Qflippedcase))
2163 ret = Fchar_feature (make_char (ch), Q_uppercase, Qnil,
2169 ret = Ffind_char (ret);
2177 Lisp_Object charset;
2181 BREAKUP_CHAR (ch, charset, byte1, byte2);
2183 if (EQ (charset, Vcharset_ascii))
2184 val = ct->ascii[byte1];
2185 else if (EQ (charset, Vcharset_control_1))
2186 val = ct->ascii[byte1 + 128];
2189 int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE;
2190 val = ct->level1[lb];
2191 if (CHAR_TABLE_ENTRYP (val))
2193 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
2194 val = cte->level2[byte1 - 32];
2195 if (CHAR_TABLE_ENTRYP (val))
2197 cte = XCHAR_TABLE_ENTRY (val);
2198 assert (byte2 >= 32);
2199 val = cte->level2[byte2 - 32];
2200 assert (!CHAR_TABLE_ENTRYP (val));
2207 #else /* not MULE */
2208 return ct->ascii[(unsigned char)ch];
2209 #endif /* not MULE */
2213 DEFUN ("get-char-table", Fget_char_table, 2, 2, 0, /*
2214 Find value for CHARACTER in CHAR-TABLE.
2216 (character, char_table))
2218 CHECK_CHAR_TABLE (char_table);
2219 CHECK_CHAR_COERCE_INT (character);
2221 return get_char_table (XCHAR (character), XCHAR_TABLE (char_table));
2224 DEFUN ("get-range-char-table", Fget_range_char_table, 2, 3, 0, /*
2225 Find value for a range in CHAR-TABLE.
2226 If there is more than one value, return MULTI (defaults to nil).
2228 (range, char_table, multi))
2230 Lisp_Char_Table *ct;
2231 struct chartab_range rainj;
2233 if (CHAR_OR_CHAR_INTP (range))
2234 return Fget_char_table (range, char_table);
2235 CHECK_CHAR_TABLE (char_table);
2236 ct = XCHAR_TABLE (char_table);
2238 decode_char_table_range (range, &rainj);
2241 case CHARTAB_RANGE_ALL:
2244 if (UINT8_BYTE_TABLE_P (ct->table))
2246 else if (UINT16_BYTE_TABLE_P (ct->table))
2248 else if (BYTE_TABLE_P (ct->table))
2252 #else /* non UTF2000 */
2254 Lisp_Object first = ct->ascii[0];
2256 for (i = 1; i < NUM_ASCII_CHARS; i++)
2257 if (!EQ (first, ct->ascii[i]))
2261 for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES;
2264 if (!CHARSETP (CHARSET_BY_LEADING_BYTE (i))
2265 || i == LEADING_BYTE_ASCII
2266 || i == LEADING_BYTE_CONTROL_1)
2268 if (!EQ (first, ct->level1[i - MIN_LEADING_BYTE]))
2274 #endif /* non UTF2000 */
2278 case CHARTAB_RANGE_CHARSET:
2282 if (EQ (rainj.charset, Vcharset_ascii))
2285 Lisp_Object first = ct->ascii[0];
2287 for (i = 1; i < 128; i++)
2288 if (!EQ (first, ct->ascii[i]))
2293 if (EQ (rainj.charset, Vcharset_control_1))
2296 Lisp_Object first = ct->ascii[128];
2298 for (i = 129; i < 160; i++)
2299 if (!EQ (first, ct->ascii[i]))
2305 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (rainj.charset) -
2307 if (CHAR_TABLE_ENTRYP (val))
2313 case CHARTAB_RANGE_ROW:
2318 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (rainj.charset) -
2320 if (!CHAR_TABLE_ENTRYP (val))
2322 val = XCHAR_TABLE_ENTRY (val)->level2[rainj.row - 32];
2323 if (CHAR_TABLE_ENTRYP (val))
2327 #endif /* not UTF2000 */
2328 #endif /* not MULE */
2334 return Qnil; /* not reached */
2338 check_valid_char_table_value (Lisp_Object value, enum char_table_type type,
2339 Error_behavior errb)
2343 case CHAR_TABLE_TYPE_SYNTAX:
2344 if (!ERRB_EQ (errb, ERROR_ME))
2345 return INTP (value) || (CONSP (value) && INTP (XCAR (value))
2346 && CHAR_OR_CHAR_INTP (XCDR (value)));
2349 Lisp_Object cdr = XCDR (value);
2350 CHECK_INT (XCAR (value));
2351 CHECK_CHAR_COERCE_INT (cdr);
2358 case CHAR_TABLE_TYPE_CATEGORY:
2359 if (!ERRB_EQ (errb, ERROR_ME))
2360 return CATEGORY_TABLE_VALUEP (value);
2361 CHECK_CATEGORY_TABLE_VALUE (value);
2365 case CHAR_TABLE_TYPE_GENERIC:
2368 case CHAR_TABLE_TYPE_DISPLAY:
2370 maybe_signal_simple_error ("Display char tables not yet implemented",
2371 value, Qchar_table, errb);
2374 case CHAR_TABLE_TYPE_CHAR:
2375 if (!ERRB_EQ (errb, ERROR_ME))
2376 return CHAR_OR_CHAR_INTP (value);
2377 CHECK_CHAR_COERCE_INT (value);
2384 return 0; /* not reached */
2388 canonicalize_char_table_value (Lisp_Object value, enum char_table_type type)
2392 case CHAR_TABLE_TYPE_SYNTAX:
2395 Lisp_Object car = XCAR (value);
2396 Lisp_Object cdr = XCDR (value);
2397 CHECK_CHAR_COERCE_INT (cdr);
2398 return Fcons (car, cdr);
2401 case CHAR_TABLE_TYPE_CHAR:
2402 CHECK_CHAR_COERCE_INT (value);
2410 DEFUN ("valid-char-table-value-p", Fvalid_char_table_value_p, 2, 2, 0, /*
2411 Return non-nil if VALUE is a valid value for CHAR-TABLE-TYPE.
2413 (value, char_table_type))
2415 enum char_table_type type = symbol_to_char_table_type (char_table_type);
2417 return check_valid_char_table_value (value, type, ERROR_ME_NOT) ? Qt : Qnil;
2420 DEFUN ("check-valid-char-table-value", Fcheck_valid_char_table_value, 2, 2, 0, /*
2421 Signal an error if VALUE is not a valid value for CHAR-TABLE-TYPE.
2423 (value, char_table_type))
2425 enum char_table_type type = symbol_to_char_table_type (char_table_type);
2427 check_valid_char_table_value (value, type, ERROR_ME);
2432 Lisp_Char_Table* char_attribute_table_to_put;
2433 Lisp_Object Qput_char_table_map_function;
2434 Lisp_Object value_to_put;
2436 DEFUN ("put-char-table-map-function",
2437 Fput_char_table_map_function, 2, 2, 0, /*
2438 For internal use. Don't use it.
2442 put_char_id_table_0 (char_attribute_table_to_put,
2443 XCHAR (c), value_to_put);
2448 /* Assign VAL to all characters in RANGE in char table CT. */
2451 put_char_table (Lisp_Char_Table *ct, struct chartab_range *range,
2454 switch (range->type)
2456 case CHARTAB_RANGE_ALL:
2457 fill_char_table (ct, val);
2458 return; /* avoid the duplicate call to update_syntax_table() below,
2459 since fill_char_table() also did that. */
2462 case CHARTAB_RANGE_DEFAULT:
2463 ct->default_value = val;
2468 case CHARTAB_RANGE_CHARSET:
2471 Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (range->charset);
2473 if ( CHAR_TABLEP (encoding_table) )
2475 Lisp_Object mother = XCHARSET_MOTHER (range->charset);
2477 char_attribute_table_to_put = ct;
2479 Fmap_char_attribute (Qput_char_table_map_function,
2480 XCHAR_TABLE_NAME (encoding_table),
2482 if ( CHARSETP (mother) )
2484 struct chartab_range r;
2486 r.type = CHARTAB_RANGE_CHARSET;
2488 put_char_table (ct, &r, val);
2496 for (c = 0; c < 1 << 24; c++)
2498 if ( charset_code_point (range->charset, c) >= 0 )
2499 put_char_id_table_0 (ct, c, val);
2505 if (EQ (range->charset, Vcharset_ascii))
2508 for (i = 0; i < 128; i++)
2511 else if (EQ (range->charset, Vcharset_control_1))
2514 for (i = 128; i < 160; i++)
2519 int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE;
2520 ct->level1[lb] = val;
2525 case CHARTAB_RANGE_ROW:
2528 int cell_min, cell_max, i;
2530 i = XCHARSET_CELL_RANGE (range->charset);
2532 cell_max = i & 0xFF;
2533 for (i = cell_min; i <= cell_max; i++)
2536 = DECODE_CHAR (range->charset, (range->row << 8) | i, 0);
2538 if ( charset_code_point (range->charset, ch, 0) >= 0 )
2539 put_char_id_table_0 (ct, ch, val);
2544 Lisp_Char_Table_Entry *cte;
2545 int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE;
2546 /* make sure that there is a separate entry for the row. */
2547 if (!CHAR_TABLE_ENTRYP (ct->level1[lb]))
2548 ct->level1[lb] = make_char_table_entry (ct->level1[lb]);
2549 cte = XCHAR_TABLE_ENTRY (ct->level1[lb]);
2550 cte->level2[range->row - 32] = val;
2552 #endif /* not UTF2000 */
2556 case CHARTAB_RANGE_CHAR:
2558 put_char_id_table_0 (ct, range->ch, val);
2562 Lisp_Object charset;
2565 BREAKUP_CHAR (range->ch, charset, byte1, byte2);
2566 if (EQ (charset, Vcharset_ascii))
2567 ct->ascii[byte1] = val;
2568 else if (EQ (charset, Vcharset_control_1))
2569 ct->ascii[byte1 + 128] = val;
2572 Lisp_Char_Table_Entry *cte;
2573 int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE;
2574 /* make sure that there is a separate entry for the row. */
2575 if (!CHAR_TABLE_ENTRYP (ct->level1[lb]))
2576 ct->level1[lb] = make_char_table_entry (ct->level1[lb]);
2577 cte = XCHAR_TABLE_ENTRY (ct->level1[lb]);
2578 /* now CTE is a char table entry for the charset;
2579 each entry is for a single row (or character of
2580 a one-octet charset). */
2581 if (XCHARSET_DIMENSION (charset) == 1)
2582 cte->level2[byte1 - 32] = val;
2585 /* assigning to one character in a two-octet charset. */
2586 /* make sure that the charset row contains a separate
2587 entry for each character. */
2588 if (!CHAR_TABLE_ENTRYP (cte->level2[byte1 - 32]))
2589 cte->level2[byte1 - 32] =
2590 make_char_table_entry (cte->level2[byte1 - 32]);
2591 cte = XCHAR_TABLE_ENTRY (cte->level2[byte1 - 32]);
2592 cte->level2[byte2 - 32] = val;
2596 #else /* not MULE */
2597 ct->ascii[(unsigned char) (range->ch)] = val;
2599 #endif /* not MULE */
2603 if (ct->type == CHAR_TABLE_TYPE_SYNTAX)
2604 update_syntax_table (ct);
2608 DEFUN ("put-char-table", Fput_char_table, 3, 3, 0, /*
2609 Set the value for chars in RANGE to be VALUE in CHAR-TABLE.
2611 RANGE specifies one or more characters to be affected and should be
2612 one of the following:
2614 -- t (all characters are affected)
2615 -- A charset (only allowed when Mule support is present)
2616 -- A vector of two elements: a two-octet charset and a row number
2617 (only allowed when Mule support is present)
2618 -- A single character
2620 VALUE must be a value appropriate for the type of CHAR-TABLE.
2621 See `valid-char-table-type-p'.
2623 (range, value, char_table))
2625 Lisp_Char_Table *ct;
2626 struct chartab_range rainj;
2628 CHECK_CHAR_TABLE (char_table);
2629 ct = XCHAR_TABLE (char_table);
2630 check_valid_char_table_value (value, ct->type, ERROR_ME);
2631 decode_char_table_range (range, &rainj);
2632 value = canonicalize_char_table_value (value, ct->type);
2633 put_char_table (ct, &rainj, value);
2638 /* Map FN over the ASCII chars in CT. */
2641 map_over_charset_ascii (Lisp_Char_Table *ct,
2642 int (*fn) (struct chartab_range *range,
2643 Lisp_Object val, void *arg),
2646 struct chartab_range rainj;
2655 rainj.type = CHARTAB_RANGE_CHAR;
2657 for (i = start, retval = 0; i < stop && retval == 0; i++)
2659 rainj.ch = (Emchar) i;
2660 retval = (fn) (&rainj, ct->ascii[i], arg);
2668 /* Map FN over the Control-1 chars in CT. */
2671 map_over_charset_control_1 (Lisp_Char_Table *ct,
2672 int (*fn) (struct chartab_range *range,
2673 Lisp_Object val, void *arg),
2676 struct chartab_range rainj;
2679 int stop = start + 32;
2681 rainj.type = CHARTAB_RANGE_CHAR;
2683 for (i = start, retval = 0; i < stop && retval == 0; i++)
2685 rainj.ch = (Emchar) (i);
2686 retval = (fn) (&rainj, ct->ascii[i], arg);
2692 /* Map FN over the row ROW of two-byte charset CHARSET.
2693 There must be a separate value for that row in the char table.
2694 CTE specifies the char table entry for CHARSET. */
2697 map_over_charset_row (Lisp_Char_Table_Entry *cte,
2698 Lisp_Object charset, int row,
2699 int (*fn) (struct chartab_range *range,
2700 Lisp_Object val, void *arg),
2703 Lisp_Object val = cte->level2[row - 32];
2705 if (!CHAR_TABLE_ENTRYP (val))
2707 struct chartab_range rainj;
2709 rainj.type = CHARTAB_RANGE_ROW;
2710 rainj.charset = charset;
2712 return (fn) (&rainj, val, arg);
2716 struct chartab_range rainj;
2718 int charset94_p = (XCHARSET_CHARS (charset) == 94);
2719 int start = charset94_p ? 33 : 32;
2720 int stop = charset94_p ? 127 : 128;
2722 cte = XCHAR_TABLE_ENTRY (val);
2724 rainj.type = CHARTAB_RANGE_CHAR;
2726 for (i = start, retval = 0; i < stop && retval == 0; i++)
2728 rainj.ch = MAKE_CHAR (charset, row, i);
2729 retval = (fn) (&rainj, cte->level2[i - 32], arg);
2737 map_over_other_charset (Lisp_Char_Table *ct, Charset_ID lb,
2738 int (*fn) (struct chartab_range *range,
2739 Lisp_Object val, void *arg),
2742 Lisp_Object val = ct->level1[lb - MIN_LEADING_BYTE];
2743 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (lb);
2745 if (!CHARSETP (charset)
2746 || lb == LEADING_BYTE_ASCII
2747 || lb == LEADING_BYTE_CONTROL_1)
2750 if (!CHAR_TABLE_ENTRYP (val))
2752 struct chartab_range rainj;
2754 rainj.type = CHARTAB_RANGE_CHARSET;
2755 rainj.charset = charset;
2756 return (fn) (&rainj, val, arg);
2760 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
2761 int charset94_p = (XCHARSET_CHARS (charset) == 94);
2762 int start = charset94_p ? 33 : 32;
2763 int stop = charset94_p ? 127 : 128;
2766 if (XCHARSET_DIMENSION (charset) == 1)
2768 struct chartab_range rainj;
2769 rainj.type = CHARTAB_RANGE_CHAR;
2771 for (i = start, retval = 0; i < stop && retval == 0; i++)
2773 rainj.ch = MAKE_CHAR (charset, i, 0);
2774 retval = (fn) (&rainj, cte->level2[i - 32], arg);
2779 for (i = start, retval = 0; i < stop && retval == 0; i++)
2780 retval = map_over_charset_row (cte, charset, i, fn, arg);
2788 #endif /* not UTF2000 */
2791 struct map_char_table_for_charset_arg
2793 int (*fn) (struct chartab_range *range, Lisp_Object val, void *arg);
2794 Lisp_Char_Table *ct;
2799 map_char_table_for_charset_fun (struct chartab_range *range,
2800 Lisp_Object val, void *arg)
2802 struct map_char_table_for_charset_arg *closure =
2803 (struct map_char_table_for_charset_arg *) arg;
2806 switch (range->type)
2808 case CHARTAB_RANGE_ALL:
2811 case CHARTAB_RANGE_DEFAULT:
2814 case CHARTAB_RANGE_CHARSET:
2817 case CHARTAB_RANGE_ROW:
2820 case CHARTAB_RANGE_CHAR:
2821 ret = get_char_table (range->ch, closure->ct);
2822 if (!UNBOUNDP (ret))
2823 return (closure->fn) (range, ret, closure->arg);
2835 /* Map FN (with client data ARG) over range RANGE in char table CT.
2836 Mapping stops the first time FN returns non-zero, and that value
2837 becomes the return value of map_char_table(). */
2840 map_char_table (Lisp_Char_Table *ct,
2841 struct chartab_range *range,
2842 int (*fn) (struct chartab_range *range,
2843 Lisp_Object val, void *arg),
2846 switch (range->type)
2848 case CHARTAB_RANGE_ALL:
2850 if (!UNBOUNDP (ct->default_value))
2852 struct chartab_range rainj;
2855 rainj.type = CHARTAB_RANGE_DEFAULT;
2856 retval = (fn) (&rainj, ct->default_value, arg);
2860 if (UINT8_BYTE_TABLE_P (ct->table))
2861 return map_over_uint8_byte_table (XUINT8_BYTE_TABLE(ct->table), ct,
2863 else if (UINT16_BYTE_TABLE_P (ct->table))
2864 return map_over_uint16_byte_table (XUINT16_BYTE_TABLE(ct->table), ct,
2866 else if (BYTE_TABLE_P (ct->table))
2867 return map_over_byte_table (XBYTE_TABLE(ct->table), ct,
2869 else if (EQ (ct->table, Qunloaded))
2872 struct chartab_range rainj;
2875 Emchar c1 = c + unit;
2878 rainj.type = CHARTAB_RANGE_CHAR;
2880 for (retval = 0; c < c1 && retval == 0; c++)
2882 Lisp_Object ret = get_char_id_table (ct, c);
2884 if (!UNBOUNDP (ret))
2887 retval = (fn) (&rainj, ct->table, arg);
2892 ct->table = Qunbound;
2895 else if (!UNBOUNDP (ct->table))
2896 return (fn) (range, ct->table, arg);
2902 retval = map_over_charset_ascii (ct, fn, arg);
2906 retval = map_over_charset_control_1 (ct, fn, arg);
2911 Charset_ID start = MIN_LEADING_BYTE;
2912 Charset_ID stop = start + NUM_LEADING_BYTES;
2914 for (i = start, retval = 0; i < stop && retval == 0; i++)
2916 retval = map_over_other_charset (ct, i, fn, arg);
2925 case CHARTAB_RANGE_DEFAULT:
2926 if (!UNBOUNDP (ct->default_value))
2927 return (fn) (range, ct->default_value, arg);
2932 case CHARTAB_RANGE_CHARSET:
2935 Lisp_Object encoding_table
2936 = XCHARSET_ENCODING_TABLE (range->charset);
2938 if (!NILP (encoding_table))
2940 struct chartab_range rainj;
2941 struct map_char_table_for_charset_arg mcarg;
2944 if (XCHAR_TABLE_UNLOADED(encoding_table))
2945 Fload_char_attribute_table (XCHAR_TABLE_NAME (encoding_table));
2950 rainj.type = CHARTAB_RANGE_ALL;
2951 return map_char_table (XCHAR_TABLE(encoding_table),
2953 &map_char_table_for_charset_fun,
2959 return map_over_other_charset (ct,
2960 XCHARSET_LEADING_BYTE (range->charset),
2964 case CHARTAB_RANGE_ROW:
2967 int cell_min, cell_max, i;
2969 struct chartab_range rainj;
2971 i = XCHARSET_CELL_RANGE (range->charset);
2973 cell_max = i & 0xFF;
2974 rainj.type = CHARTAB_RANGE_CHAR;
2975 for (retval =0, i = cell_min; i <= cell_max && retval == 0; i++)
2978 = DECODE_CHAR (range->charset, (range->row << 8) | i, 0);
2980 if ( charset_code_point (range->charset, ch, 0) >= 0 )
2983 = get_byte_table (get_byte_table
2987 (unsigned char)(ch >> 24)),
2988 (unsigned char) (ch >> 16)),
2989 (unsigned char) (ch >> 8)),
2990 (unsigned char) ch);
2993 val = ct->default_value;
2995 retval = (fn) (&rainj, val, arg);
3002 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (range->charset)
3003 - MIN_LEADING_BYTE];
3004 if (!CHAR_TABLE_ENTRYP (val))
3006 struct chartab_range rainj;
3008 rainj.type = CHARTAB_RANGE_ROW;
3009 rainj.charset = range->charset;
3010 rainj.row = range->row;
3011 return (fn) (&rainj, val, arg);
3014 return map_over_charset_row (XCHAR_TABLE_ENTRY (val),
3015 range->charset, range->row,
3018 #endif /* not UTF2000 */
3021 case CHARTAB_RANGE_CHAR:
3023 Emchar ch = range->ch;
3024 Lisp_Object val = CHAR_TABLE_VALUE_UNSAFE (ct, ch);
3026 if (!UNBOUNDP (val))
3028 struct chartab_range rainj;
3030 rainj.type = CHARTAB_RANGE_CHAR;
3032 return (fn) (&rainj, val, arg);
3044 struct slow_map_char_table_arg
3046 Lisp_Object function;
3051 slow_map_char_table_fun (struct chartab_range *range,
3052 Lisp_Object val, void *arg)
3054 Lisp_Object ranjarg = Qnil;
3055 struct slow_map_char_table_arg *closure =
3056 (struct slow_map_char_table_arg *) arg;
3058 switch (range->type)
3060 case CHARTAB_RANGE_ALL:
3065 case CHARTAB_RANGE_DEFAULT:
3071 case CHARTAB_RANGE_CHARSET:
3072 ranjarg = XCHARSET_NAME (range->charset);
3075 case CHARTAB_RANGE_ROW:
3076 ranjarg = vector2 (XCHARSET_NAME (range->charset),
3077 make_int (range->row));
3080 case CHARTAB_RANGE_CHAR:
3081 ranjarg = make_char (range->ch);
3087 closure->retval = call2 (closure->function, ranjarg, val);
3088 return !NILP (closure->retval);
3091 DEFUN ("map-char-table", Fmap_char_table, 2, 3, 0, /*
3092 Map FUNCTION over entries in CHAR-TABLE, calling it with two args,
3093 each key and value in the table.
3095 RANGE specifies a subrange to map over and is in the same format as
3096 the RANGE argument to `put-range-table'. If omitted or t, it defaults to
3099 (function, char_table, range))
3101 Lisp_Char_Table *ct;
3102 struct slow_map_char_table_arg slarg;
3103 struct gcpro gcpro1, gcpro2;
3104 struct chartab_range rainj;
3106 CHECK_CHAR_TABLE (char_table);
3107 ct = XCHAR_TABLE (char_table);
3110 decode_char_table_range (range, &rainj);
3111 slarg.function = function;
3112 slarg.retval = Qnil;
3113 GCPRO2 (slarg.function, slarg.retval);
3114 map_char_table (ct, &rainj, slow_map_char_table_fun, &slarg);
3117 return slarg.retval;
3121 /************************************************************************/
3122 /* Character Attributes */
3123 /************************************************************************/
3127 Lisp_Object Vchar_attribute_hash_table;
3129 /* We store the char-attributes in hash tables with the names as the
3130 key and the actual char-id-table object as the value. Occasionally
3131 we need to use them in a list format. These routines provide us
3133 struct char_attribute_list_closure
3135 Lisp_Object *char_attribute_list;
3139 add_char_attribute_to_list_mapper (Lisp_Object key, Lisp_Object value,
3140 void *char_attribute_list_closure)
3142 /* This function can GC */
3143 struct char_attribute_list_closure *calcl
3144 = (struct char_attribute_list_closure*) char_attribute_list_closure;
3145 Lisp_Object *char_attribute_list = calcl->char_attribute_list;
3147 *char_attribute_list = Fcons (key, *char_attribute_list);
3151 #ifdef HAVE_LIBCHISE
3153 char_attribute_list_reset_map_func (CHISE_DS *ds, unsigned char *name)
3155 Fmount_char_attribute_table (intern (name));
3159 DEFUN ("char-attribute-list", Fchar_attribute_list, 0, 1, 0, /*
3160 Return the list of all existing character attributes except coded-charsets.
3164 DEFUN ("char-attribute-list", Fchar_attribute_list, 0, 0, 0, /*
3165 Return the list of all existing character attributes except coded-charsets.
3170 Lisp_Object char_attribute_list = Qnil;
3171 struct gcpro gcpro1;
3172 struct char_attribute_list_closure char_attribute_list_closure;
3174 #ifdef HAVE_LIBCHISE
3177 open_chise_data_source_maybe ();
3178 chise_ds_foreach_char_feature_name
3179 (default_chise_data_source, &char_attribute_list_reset_map_func);
3182 GCPRO1 (char_attribute_list);
3183 char_attribute_list_closure.char_attribute_list = &char_attribute_list;
3184 elisp_maphash (add_char_attribute_to_list_mapper,
3185 Vchar_attribute_hash_table,
3186 &char_attribute_list_closure);
3188 return char_attribute_list;
3191 DEFUN ("find-char-attribute-table", Ffind_char_attribute_table, 1, 1, 0, /*
3192 Return char-id-table corresponding to ATTRIBUTE.
3196 return Fgethash (attribute, Vchar_attribute_hash_table, Qnil);
3200 /* We store the char-id-tables in hash tables with the attributes as
3201 the key and the actual char-id-table object as the value. Each
3202 char-id-table stores values of an attribute corresponding with
3203 characters. Occasionally we need to get attributes of a character
3204 in a association-list format. These routines provide us with
3206 struct char_attribute_alist_closure
3209 Lisp_Object *char_attribute_alist;
3213 add_char_attribute_alist_mapper (Lisp_Object key, Lisp_Object value,
3214 void *char_attribute_alist_closure)
3216 /* This function can GC */
3217 struct char_attribute_alist_closure *caacl =
3218 (struct char_attribute_alist_closure*) char_attribute_alist_closure;
3220 = get_char_id_table (XCHAR_TABLE(value), caacl->char_id);
3221 if (!UNBOUNDP (ret))
3223 Lisp_Object *char_attribute_alist = caacl->char_attribute_alist;
3224 *char_attribute_alist
3225 = Fcons (Fcons (key, ret), *char_attribute_alist);
3230 DEFUN ("char-attribute-alist", Fchar_attribute_alist, 1, 1, 0, /*
3231 Return the alist of attributes of CHARACTER.
3235 struct gcpro gcpro1;
3236 struct char_attribute_alist_closure char_attribute_alist_closure;
3237 Lisp_Object alist = Qnil;
3239 CHECK_CHAR (character);
3242 char_attribute_alist_closure.char_id = XCHAR (character);
3243 char_attribute_alist_closure.char_attribute_alist = &alist;
3244 elisp_maphash (add_char_attribute_alist_mapper,
3245 Vchar_attribute_hash_table,
3246 &char_attribute_alist_closure);
3252 DEFUN ("get-char-attribute", Fget_char_attribute, 2, 3, 0, /*
3253 Return the value of CHARACTER's ATTRIBUTE.
3254 Return DEFAULT-VALUE if the value is not exist.
3256 (character, attribute, default_value))
3260 CHECK_CHAR (character);
3262 if (CHARSETP (attribute))
3263 attribute = XCHARSET_NAME (attribute);
3265 table = Fgethash (attribute, Vchar_attribute_hash_table,
3267 if (!UNBOUNDP (table))
3269 Lisp_Object ret = get_char_id_table (XCHAR_TABLE(table),
3271 if (!UNBOUNDP (ret))
3274 return default_value;
3278 find_char_feature_in_family (Lisp_Object character,
3279 Lisp_Object con_feature,
3280 Lisp_Object feature,
3281 Lisp_Object feature_rel_max)
3283 Lisp_Object ancestors
3284 = Fget_char_attribute (character, con_feature, Qnil);
3286 while (!NILP (ancestors))
3288 Lisp_Object ancestor = XCAR (ancestors);
3291 if (EQ (ancestor, character))
3294 ret = Fchar_feature (ancestor, feature, Qunbound,
3295 Qnil, make_int (0));
3296 if (!UNBOUNDP (ret))
3299 ancestors = XCDR (ancestors);
3301 ret = Fget_char_attribute (ancestor, Q_subsumptive_from, Qnil);
3303 ancestors = nconc2 (Fcopy_sequence (ancestors), ret);
3305 ret = Fget_char_attribute (ancestor, Q_denotational_from, Qnil);
3307 ancestors = nconc2 (Fcopy_sequence (ancestors), ret);
3312 DEFUN ("char-feature", Fchar_feature, 2, 5, 0, /*
3313 Return the value of CHARACTER's FEATURE.
3314 Return DEFAULT-VALUE if the value is not exist.
3316 (character, attribute, default_value,
3317 feature_rel_max, char_rel_max))
3320 = Fget_char_attribute (character, attribute, Qunbound);
3322 if (!UNBOUNDP (ret))
3325 if (NILP (feature_rel_max)
3326 || (INTP (feature_rel_max) &&
3327 XINT (feature_rel_max) > 0))
3329 Lisp_String* name = symbol_name (XSYMBOL (attribute));
3330 Bufbyte *name_str = string_data (name);
3332 if (name_str[0] == '=' && name_str[1] == '>')
3334 Bytecount length = string_length (name) - 1;
3335 Lisp_Object map_to = make_uninit_string (length);
3337 memcpy (XSTRING_DATA (map_to) + 1, name_str + 2, length - 1);
3338 XSTRING_DATA(map_to)[0] = '=';
3339 ret = Fchar_feature (character, Fintern (map_to, Qnil),
3341 NILP (feature_rel_max)
3343 : make_int (XINT (feature_rel_max) - 1),
3345 if (!UNBOUNDP (ret))
3350 if ( !(EQ (attribute, Q_identical)) &&
3351 !(EQ (attribute, Q_subsumptive_from)) &&
3352 !(EQ (attribute, Q_denotational_from)) &&
3353 ( (NILP (char_rel_max)
3354 || (INTP (char_rel_max) &&
3355 XINT (char_rel_max) > 0)) ) )
3357 Lisp_String* name = symbol_name (XSYMBOL (attribute));
3358 Bufbyte *name_str = string_data (name);
3360 if ( (name_str[0] != '=') || (name_str[1] == '>') )
3362 ret = find_char_feature_in_family (character, Q_identical,
3363 attribute, feature_rel_max);
3364 if (!UNBOUNDP (ret))
3367 ret = find_char_feature_in_family (character, Q_subsumptive_from,
3368 attribute, feature_rel_max);
3369 if (!UNBOUNDP (ret))
3372 ret = find_char_feature_in_family (character, Q_denotational_from,
3373 attribute, feature_rel_max);
3374 if (!UNBOUNDP (ret))
3378 return default_value;
3381 void put_char_composition (Lisp_Object character, Lisp_Object value);
3383 put_char_composition (Lisp_Object character, Lisp_Object value)
3386 signal_simple_error ("Invalid value for ->decomposition",
3389 if (CONSP (Fcdr (value)))
3391 if (NILP (Fcdr (Fcdr (value))))
3393 Lisp_Object base = Fcar (value);
3394 Lisp_Object modifier = Fcar (Fcdr (value));
3398 base = make_char (XINT (base));
3399 Fsetcar (value, base);
3401 if (INTP (modifier))
3403 modifier = make_char (XINT (modifier));
3404 Fsetcar (Fcdr (value), modifier);
3409 = Fchar_feature (base, Qcomposition, Qnil,
3411 Lisp_Object ret = Fassq (modifier, alist);
3414 Fput_char_attribute (base, Qcomposition,
3415 Fcons (Fcons (modifier, character),
3418 Fsetcdr (ret, character);
3424 Lisp_Object v = Fcar (value);
3428 Emchar c = DECODE_CHAR (Vcharset_ucs, XINT (v), 0);
3430 = Fchar_feature (make_char (c), Q_ucs_unified, Qnil,
3435 Fput_char_attribute (make_char (c), Q_ucs_unified,
3436 Fcons (character, Qnil));
3438 else if (NILP (Fmemq (character, ret)))
3440 Fput_char_attribute (make_char (c), Q_ucs_unified,
3441 Fcons (character, ret));
3448 put_char_attribute (Lisp_Object character, Lisp_Object attribute,
3451 Lisp_Object table = Fgethash (attribute,
3452 Vchar_attribute_hash_table,
3457 table = make_char_id_table (Qunbound);
3458 Fputhash (attribute, table, Vchar_attribute_hash_table);
3460 XCHAR_TABLE_NAME (table) = attribute;
3463 put_char_id_table (XCHAR_TABLE(table), character, value);
3467 DEFUN ("put-char-attribute", Fput_char_attribute, 3, 3, 0, /*
3468 Store CHARACTER's ATTRIBUTE with VALUE.
3470 (character, attribute, value))
3472 Lisp_Object ccs = Ffind_charset (attribute);
3474 CHECK_CHAR (character);
3478 value = put_char_ccs_code_point (character, ccs, value);
3479 attribute = XCHARSET_NAME (ccs);
3481 else if (EQ (attribute, Q_decomposition))
3482 put_char_composition (character, value);
3483 else if (EQ (attribute, Qto_ucs))
3489 signal_simple_error ("Invalid value for =>ucs", value);
3491 c = DECODE_CHAR (Vcharset_ucs, XINT (value), 0);
3493 ret = Fchar_feature (make_char (c), Q_ucs_unified, Qnil,
3496 put_char_attribute (make_char (c), Q_ucs_unified,
3498 else if (NILP (Fmemq (character, ret)))
3499 Fput_char_attribute (make_char (c), Q_ucs_unified,
3500 Fcons (character, ret));
3502 else if ( EQ (attribute, Q_subsumptive) ||
3503 EQ (attribute, Q_subsumptive_from) ||
3504 EQ (attribute, Q_denotational) ||
3505 EQ (attribute, Q_denotational_from) ||
3506 EQ (attribute, Q_identical) ||
3507 EQ (attribute, Q_identical_from) ||
3508 EQ (attribute, Q_component) ||
3509 EQ (attribute, Q_component_of) ||
3510 !NILP (Fstring_match
3511 (build_string ("^\\(<-\\|->\\)\\(simplified"
3512 "\\|same\\|vulgar\\|wrong"
3513 "\\|original\\|ancient"
3515 Fsymbol_name (attribute),
3518 Lisp_Object rest = value;
3520 Lisp_Object rev_feature = Qnil;
3521 struct gcpro gcpro1;
3522 GCPRO1 (rev_feature);
3524 if (EQ (attribute, Q_identical))
3525 rev_feature = Q_identical_from;
3526 else if (EQ (attribute, Q_identical_from))
3527 rev_feature = Q_identical;
3528 else if (EQ (attribute, Q_subsumptive))
3529 rev_feature = Q_subsumptive_from;
3530 else if (EQ (attribute, Q_subsumptive_from))
3531 rev_feature = Q_subsumptive;
3532 else if (EQ (attribute, Q_denotational))
3533 rev_feature = Q_denotational_from;
3534 else if (EQ (attribute, Q_denotational_from))
3535 rev_feature = Q_denotational;
3536 else if (EQ (attribute, Q_component))
3537 rev_feature = Q_component_of;
3538 else if (EQ (attribute, Q_component_of))
3539 rev_feature = Q_component;
3542 Lisp_String* name = symbol_name (XSYMBOL (attribute));
3543 Bufbyte *name_str = string_data (name);
3545 if ( (name_str[0] == '<' && name_str[1] == '-') ||
3546 (name_str[0] == '-' && name_str[1] == '>') )
3548 Bytecount length = string_length (name);
3549 Bufbyte *rev_name_str = alloca (length + 1);
3551 memcpy (rev_name_str + 2, name_str + 2, length - 2);
3552 if (name_str[0] == '<')
3554 rev_name_str[0] = '-';
3555 rev_name_str[1] = '>';
3559 rev_name_str[0] = '<';
3560 rev_name_str[1] = '-';
3562 rev_name_str[length] = 0;
3563 rev_feature = intern (rev_name_str);
3567 while (CONSP (rest))
3572 ret = Fdefine_char (ret);
3574 if ( !NILP (ret) && !EQ (ret, character) )
3578 ffv = Fget_char_attribute (ret, rev_feature, Qnil);
3580 put_char_attribute (ret, rev_feature, list1 (character));
3581 else if (NILP (Fmemq (character, ffv)))
3584 nconc2 (Fcopy_sequence (ffv), list1 (character)));
3585 Fsetcar (rest, ret);
3592 else if (EQ (attribute, Qideographic_structure))
3593 value = Fcopy_sequence (Fchar_refs_simplify_char_specs (value));
3595 return put_char_attribute (character, attribute, value);
3598 DEFUN ("remove-char-attribute", Fremove_char_attribute, 2, 2, 0, /*
3599 Remove CHARACTER's ATTRIBUTE.
3601 (character, attribute))
3605 CHECK_CHAR (character);
3606 ccs = Ffind_charset (attribute);
3609 return remove_char_ccs (character, ccs);
3613 Lisp_Object table = Fgethash (attribute,
3614 Vchar_attribute_hash_table,
3616 if (!UNBOUNDP (table))
3618 put_char_id_table (XCHAR_TABLE(table), character, Qunbound);
3627 int char_table_open_db_maybe (Lisp_Char_Table* cit);
3628 void char_table_close_db_maybe (Lisp_Char_Table* cit);
3629 Lisp_Object char_table_get_db (Lisp_Char_Table* cit, Emchar ch);
3631 #ifdef HAVE_LIBCHISE
3633 open_chise_data_source_maybe ()
3635 if (default_chise_data_source == NULL)
3637 Lisp_Object db_dir = Vdata_directory;
3638 int modemask = 0755; /* rwxr-xr-x */
3641 db_dir = build_string ("../etc");
3642 db_dir = Fexpand_file_name (build_string ("chise-db"), db_dir);
3644 default_chise_data_source
3645 = CHISE_DS_open (CHISE_DS_Berkeley_DB, XSTRING_DATA (db_dir),
3646 0 /* DB_HASH */, modemask);
3647 if (default_chise_data_source == NULL)
3652 #endif /* HAVE_LIBCHISE */
3654 DEFUN ("close-char-data-source", Fclose_char_data_source, 0, 0, 0, /*
3655 Close data-source of CHISE.
3659 #ifdef HAVE_LIBCHISE
3660 int status = CHISE_DS_close (default_chise_data_source);
3662 default_chise_data_source = NULL;
3665 #endif /* HAVE_LIBCHISE */
3670 char_table_open_db_maybe (Lisp_Char_Table* cit)
3672 Lisp_Object attribute = CHAR_TABLE_NAME (cit);
3674 if (!NILP (attribute))
3676 #ifdef HAVE_LIBCHISE
3677 if ( open_chise_data_source_maybe () )
3679 #else /* HAVE_LIBCHISE */
3680 if (NILP (Fdatabase_live_p (cit->db)))
3683 = char_attribute_system_db_file (Qsystem_char_id, attribute, 0);
3685 cit->db = Fopen_database (db_file, Qnil, Qnil,
3686 build_string ("r"), Qnil);
3690 #endif /* not HAVE_LIBCHISE */
3698 char_table_close_db_maybe (Lisp_Char_Table* cit)
3700 #ifndef HAVE_LIBCHISE
3701 if (!NILP (cit->db))
3703 if (!NILP (Fdatabase_live_p (cit->db)))
3704 Fclose_database (cit->db);
3707 #endif /* not HAVE_LIBCHISE */
3711 char_table_get_db (Lisp_Char_Table* cit, Emchar ch)
3714 #ifdef HAVE_LIBCHISE
3717 = chise_ds_load_char_feature_value (default_chise_data_source, ch,
3718 XSTRING_DATA(Fsymbol_name
3724 val = Fread (make_string (chise_value_data (&value),
3725 chise_value_size (&value) ));
3729 #else /* HAVE_LIBCHISE */
3730 val = Fget_database (Fprin1_to_string (make_char (ch), Qnil),
3732 if (!UNBOUNDP (val))
3736 #endif /* not HAVE_LIBCHISE */
3740 #ifndef HAVE_LIBCHISE
3742 char_attribute_system_db_file (Lisp_Object key_type, Lisp_Object attribute,
3745 Lisp_Object db_dir = Vdata_directory;
3748 db_dir = build_string ("../etc");
3750 db_dir = Fexpand_file_name (build_string ("chise-db"), db_dir);
3751 if (writing_mode && NILP (Ffile_exists_p (db_dir)))
3752 Fmake_directory_internal (db_dir);
3754 db_dir = Fexpand_file_name (Fsymbol_name (key_type), db_dir);
3755 if (writing_mode && NILP (Ffile_exists_p (db_dir)))
3756 Fmake_directory_internal (db_dir);
3759 Lisp_Object attribute_name = Fsymbol_name (attribute);
3760 Lisp_Object dest = Qnil, ret;
3762 struct gcpro gcpro1, gcpro2;
3763 int len = XSTRING_CHAR_LENGTH (attribute_name);
3767 for (i = 0; i < len; i++)
3769 Emchar c = string_char (XSTRING (attribute_name), i);
3771 if ( (c == '/') || (c == '%') )
3775 sprintf (str, "%%%02X", c);
3776 dest = concat3 (dest,
3777 Fsubstring (attribute_name,
3778 make_int (base), make_int (i)),
3779 build_string (str));
3783 ret = Fsubstring (attribute_name, make_int (base), make_int (len));
3784 dest = concat2 (dest, ret);
3786 return Fexpand_file_name (dest, db_dir);
3789 #endif /* not HAVE_LIBCHISE */
3791 DEFUN ("save-char-attribute-table", Fsave_char_attribute_table, 1, 1, 0, /*
3792 Save values of ATTRIBUTE into database file.
3796 Lisp_Object table = Fgethash (attribute,
3797 Vchar_attribute_hash_table, Qunbound);
3798 Lisp_Char_Table *ct;
3799 #ifdef HAVE_LIBCHISE
3800 CHISE_Feature feature;
3801 #else /* HAVE_LIBCHISE */
3802 Lisp_Object db_file;
3804 #endif /* not HAVE_LIBCHISE */
3806 if (CHAR_TABLEP (table))
3807 ct = XCHAR_TABLE (table);
3811 #ifdef HAVE_LIBCHISE
3812 if ( open_chise_data_source_maybe () )
3815 = chise_ds_get_feature (default_chise_data_source,
3816 XSTRING_DATA (Fsymbol_name (attribute)));
3817 #else /* HAVE_LIBCHISE */
3818 db_file = char_attribute_system_db_file (Qsystem_char_id, attribute, 1);
3819 db = Fopen_database (db_file, Qnil, Qnil, build_string ("w+"), Qnil);
3820 #endif /* not HAVE_LIBCHISE */
3822 #ifdef HAVE_LIBCHISE
3824 #else /* HAVE_LIBCHISE */
3826 #endif /* not HAVE_LIBCHISE */
3829 Lisp_Object (*filter)(Lisp_Object value);
3831 if ( !NILP (Ffind_charset (attribute)) )
3833 else if ( EQ (attribute, Qideographic_structure)
3834 || EQ (attribute, Q_identical)
3835 || EQ (attribute, Q_identical_from)
3836 || !NILP (Fstring_match
3837 (build_string ("^\\(<-\\|->\\)\\(simplified"
3838 "\\|same\\|vulgar\\|wrong"
3839 "\\|original\\|ancient"
3841 Fsymbol_name (attribute),
3843 filter = &Fchar_refs_simplify_char_specs;
3847 if (UINT8_BYTE_TABLE_P (ct->table))
3848 save_uint8_byte_table (XUINT8_BYTE_TABLE(ct->table), ct,
3849 #ifdef HAVE_LIBCHISE
3851 #else /* HAVE_LIBCHISE */
3853 #endif /* not HAVE_LIBCHISE */
3855 else if (UINT16_BYTE_TABLE_P (ct->table))
3856 save_uint16_byte_table (XUINT16_BYTE_TABLE(ct->table), ct,
3857 #ifdef HAVE_LIBCHISE
3859 #else /* HAVE_LIBCHISE */
3861 #endif /* not HAVE_LIBCHISE */
3863 else if (BYTE_TABLE_P (ct->table))
3864 save_byte_table (XBYTE_TABLE(ct->table), ct,
3865 #ifdef HAVE_LIBCHISE
3867 #else /* HAVE_LIBCHISE */
3869 #endif /* not HAVE_LIBCHISE */
3871 #ifdef HAVE_LIBCHISE
3872 chise_feature_sync (feature);
3873 #else /* HAVE_LIBCHISE */
3874 Fclose_database (db);
3875 #endif /* not HAVE_LIBCHISE */
3882 DEFUN ("mount-char-attribute-table", Fmount_char_attribute_table, 1, 1, 0, /*
3883 Mount database file on char-attribute-table ATTRIBUTE.
3887 Lisp_Object table = Fgethash (attribute,
3888 Vchar_attribute_hash_table, Qunbound);
3890 if (UNBOUNDP (table))
3892 Lisp_Char_Table *ct;
3894 table = make_char_id_table (Qunbound);
3895 Fputhash (attribute, table, Vchar_attribute_hash_table);
3896 XCHAR_TABLE_NAME(table) = attribute;
3897 ct = XCHAR_TABLE (table);
3898 ct->table = Qunloaded;
3899 XCHAR_TABLE_UNLOADED(table) = 1;
3900 #ifndef HAVE_LIBCHISE
3902 #endif /* not HAVE_LIBCHISE */
3908 DEFUN ("close-char-attribute-table", Fclose_char_attribute_table, 1, 1, 0, /*
3909 Close database of ATTRIBUTE.
3913 Lisp_Object table = Fgethash (attribute,
3914 Vchar_attribute_hash_table, Qunbound);
3915 Lisp_Char_Table *ct;
3917 if (CHAR_TABLEP (table))
3918 ct = XCHAR_TABLE (table);
3921 char_table_close_db_maybe (ct);
3925 DEFUN ("reset-char-attribute-table", Freset_char_attribute_table, 1, 1, 0, /*
3926 Reset values of ATTRIBUTE with database file.
3930 #ifdef HAVE_LIBCHISE
3931 CHISE_Feature feature
3932 = chise_ds_get_feature (default_chise_data_source,
3933 XSTRING_DATA (Fsymbol_name
3936 if (feature == NULL)
3939 if (chise_feature_setup_db (feature, 0) == 0)
3941 Lisp_Object table = Fgethash (attribute,
3942 Vchar_attribute_hash_table, Qunbound);
3943 Lisp_Char_Table *ct;
3945 chise_feature_sync (feature);
3946 if (UNBOUNDP (table))
3948 table = make_char_id_table (Qunbound);
3949 Fputhash (attribute, table, Vchar_attribute_hash_table);
3950 XCHAR_TABLE_NAME(table) = attribute;
3952 ct = XCHAR_TABLE (table);
3953 ct->table = Qunloaded;
3954 char_table_close_db_maybe (ct);
3955 XCHAR_TABLE_UNLOADED(table) = 1;
3959 Lisp_Object table = Fgethash (attribute,
3960 Vchar_attribute_hash_table, Qunbound);
3961 Lisp_Char_Table *ct;
3963 = char_attribute_system_db_file (Qsystem_char_id, attribute, 0);
3965 if (!NILP (Ffile_exists_p (db_file)))
3967 if (UNBOUNDP (table))
3969 table = make_char_id_table (Qunbound);
3970 Fputhash (attribute, table, Vchar_attribute_hash_table);
3971 XCHAR_TABLE_NAME(table) = attribute;
3973 ct = XCHAR_TABLE (table);
3974 ct->table = Qunloaded;
3975 char_table_close_db_maybe (ct);
3976 XCHAR_TABLE_UNLOADED(table) = 1;
3984 load_char_attribute_maybe (Lisp_Char_Table* cit, Emchar ch)
3986 Lisp_Object attribute = CHAR_TABLE_NAME (cit);
3988 if (!NILP (attribute))
3992 if (char_table_open_db_maybe (cit))
3995 val = char_table_get_db (cit, ch);
3997 if (!NILP (Vchar_db_stingy_mode))
3998 char_table_close_db_maybe (cit);
4005 Lisp_Char_Table* char_attribute_table_to_load;
4007 #ifdef HAVE_LIBCHISE
4009 load_char_attribute_table_map_func (CHISE_Char_ID cid,
4010 CHISE_Feature feature,
4011 CHISE_Value *value);
4013 load_char_attribute_table_map_func (CHISE_Char_ID cid,
4014 CHISE_Feature feature,
4018 Lisp_Object ret = get_char_id_table_0 (char_attribute_table_to_load, code);
4020 if (EQ (ret, Qunloaded))
4021 put_char_id_table_0 (char_attribute_table_to_load, code,
4022 Fread (make_string ((Bufbyte *) value->data,
4026 #else /* HAVE_LIBCHISE */
4027 Lisp_Object Qload_char_attribute_table_map_function;
4029 DEFUN ("load-char-attribute-table-map-function",
4030 Fload_char_attribute_table_map_function, 2, 2, 0, /*
4031 For internal use. Don't use it.
4035 Lisp_Object c = Fread (key);
4036 Emchar code = XCHAR (c);
4037 Lisp_Object ret = get_char_id_table_0 (char_attribute_table_to_load, code);
4039 if (EQ (ret, Qunloaded))
4040 put_char_id_table_0 (char_attribute_table_to_load, code, Fread (value));
4043 #endif /* not HAVE_LIBCHISE */
4045 DEFUN ("load-char-attribute-table", Fload_char_attribute_table, 1, 1, 0, /*
4046 Load values of ATTRIBUTE into database file.
4050 Lisp_Object table = Fgethash (attribute,
4051 Vchar_attribute_hash_table,
4053 if (CHAR_TABLEP (table))
4055 Lisp_Char_Table *cit = XCHAR_TABLE (table);
4057 if (char_table_open_db_maybe (cit))
4060 char_attribute_table_to_load = XCHAR_TABLE (table);
4062 struct gcpro gcpro1;
4065 #ifdef HAVE_LIBCHISE
4066 chise_feature_foreach_char_with_value
4067 (chise_ds_get_feature (default_chise_data_source,
4068 XSTRING_DATA (Fsymbol_name (cit->name))),
4069 &load_char_attribute_table_map_func);
4070 #else /* HAVE_LIBCHISE */
4071 Fmap_database (Qload_char_attribute_table_map_function, cit->db);
4072 #endif /* not HAVE_LIBCHISE */
4075 char_table_close_db_maybe (cit);
4076 XCHAR_TABLE_UNLOADED(table) = 0;
4081 #endif /* HAVE_CHISE */
4083 DEFUN ("map-char-attribute", Fmap_char_attribute, 2, 3, 0, /*
4084 Map FUNCTION over entries in ATTRIBUTE, calling it with two args,
4085 each key and value in the table.
4087 RANGE specifies a subrange to map over and is in the same format as
4088 the RANGE argument to `put-range-table'. If omitted or t, it defaults to
4091 (function, attribute, range))
4094 Lisp_Char_Table *ct;
4095 struct slow_map_char_table_arg slarg;
4096 struct gcpro gcpro1, gcpro2;
4097 struct chartab_range rainj;
4099 if (!NILP (ccs = Ffind_charset (attribute)))
4101 Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (ccs);
4103 if (CHAR_TABLEP (encoding_table))
4104 ct = XCHAR_TABLE (encoding_table);
4110 Lisp_Object table = Fgethash (attribute,
4111 Vchar_attribute_hash_table,
4113 if (CHAR_TABLEP (table))
4114 ct = XCHAR_TABLE (table);
4120 decode_char_table_range (range, &rainj);
4122 if (CHAR_TABLE_UNLOADED(ct))
4123 Fload_char_attribute_table (attribute);
4125 slarg.function = function;
4126 slarg.retval = Qnil;
4127 GCPRO2 (slarg.function, slarg.retval);
4128 map_char_table (ct, &rainj, slow_map_char_table_fun, &slarg);
4131 return slarg.retval;
4134 DEFUN ("define-char", Fdefine_char, 1, 1, 0, /*
4135 Store character's ATTRIBUTES.
4140 Lisp_Object code = Fcdr (Fassq (Qmap_ucs, attributes));
4141 Lisp_Object character;
4144 code = Fcdr (Fassq (Qucs, attributes));
4149 while (CONSP (rest))
4151 Lisp_Object cell = Fcar (rest);
4154 if ( !LISTP (cell) )
4155 signal_simple_error ("Invalid argument", attributes);
4157 ccs = Ffind_charset (Fcar (cell));
4163 character = Fdecode_char (ccs, cell, Qt, Qt);
4164 if (!NILP (character))
4165 goto setup_attributes;
4167 if ( (XCHARSET_FINAL (ccs) != 0) ||
4168 (XCHARSET_MAX_CODE (ccs) > 0) ||
4169 (EQ (ccs, Vcharset_chinese_big5)) )
4173 = Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
4175 character = Fdecode_char (ccs, cell, Qnil, Qt);
4176 if (!NILP (character))
4177 goto setup_attributes;
4184 int cid = XINT (Vnext_defined_char_id);
4186 if (cid <= 0xE00000)
4188 character = make_char (cid);
4189 Vnext_defined_char_id = make_int (cid + 1);
4190 goto setup_attributes;
4194 if ( (!NILP (code = Fcdr (Fassq (Qto_ucs, attributes)))) )
4197 signal_simple_error ("Invalid argument", attributes);
4199 character = make_char (XINT (code) + 0x100000);
4200 goto setup_attributes;
4205 else if (!INTP (code))
4206 signal_simple_error ("Invalid argument", attributes);
4208 character = make_char (XINT (code));
4212 while (CONSP (rest))
4214 Lisp_Object cell = Fcar (rest);
4217 signal_simple_error ("Invalid argument", attributes);
4219 Fput_char_attribute (character, Fcar (cell), Fcdr (cell));
4225 DEFUN ("find-char", Ffind_char, 1, 1, 0, /*
4226 Retrieve the character of the given ATTRIBUTES.
4230 Lisp_Object rest = attributes;
4233 while (CONSP (rest))
4235 Lisp_Object cell = Fcar (rest);
4239 signal_simple_error ("Invalid argument", attributes);
4240 if (!NILP (ccs = Ffind_charset (Fcar (cell))))
4244 return Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
4246 return Fdecode_char (ccs, cell, Qnil, Qnil);
4250 if ( (!NILP (code = Fcdr (Fassq (Qto_ucs, attributes)))) )
4253 signal_simple_error ("Invalid argument", attributes);
4255 return make_char (XINT (code) + 0x100000);
4263 /************************************************************************/
4264 /* Char table read syntax */
4265 /************************************************************************/
4268 chartab_type_validate (Lisp_Object keyword, Lisp_Object value,
4269 Error_behavior errb)
4271 /* #### should deal with ERRB */
4272 symbol_to_char_table_type (value);
4277 chartab_data_validate (Lisp_Object keyword, Lisp_Object value,
4278 Error_behavior errb)
4282 /* #### should deal with ERRB */
4283 EXTERNAL_LIST_LOOP (rest, value)
4285 Lisp_Object range = XCAR (rest);
4286 struct chartab_range dummy;
4290 signal_simple_error ("Invalid list format", value);
4293 if (!CONSP (XCDR (range))
4294 || !NILP (XCDR (XCDR (range))))
4295 signal_simple_error ("Invalid range format", range);
4296 decode_char_table_range (XCAR (range), &dummy);
4297 decode_char_table_range (XCAR (XCDR (range)), &dummy);
4300 decode_char_table_range (range, &dummy);
4307 chartab_instantiate (Lisp_Object data)
4309 Lisp_Object chartab;
4310 Lisp_Object type = Qgeneric;
4311 Lisp_Object dataval = Qnil;
4313 while (!NILP (data))
4315 Lisp_Object keyw = Fcar (data);
4321 if (EQ (keyw, Qtype))
4323 else if (EQ (keyw, Qdata))
4327 chartab = Fmake_char_table (type);
4330 while (!NILP (data))
4332 Lisp_Object range = Fcar (data);
4333 Lisp_Object val = Fcar (Fcdr (data));
4335 data = Fcdr (Fcdr (data));
4338 if (CHAR_OR_CHAR_INTP (XCAR (range)))
4340 Emchar first = XCHAR_OR_CHAR_INT (Fcar (range));
4341 Emchar last = XCHAR_OR_CHAR_INT (Fcar (Fcdr (range)));
4344 for (i = first; i <= last; i++)
4345 Fput_char_table (make_char (i), val, chartab);
4351 Fput_char_table (range, val, chartab);
4360 /************************************************************************/
4361 /* Category Tables, specifically */
4362 /************************************************************************/
4364 DEFUN ("category-table-p", Fcategory_table_p, 1, 1, 0, /*
4365 Return t if OBJECT is a category table.
4366 A category table is a type of char table used for keeping track of
4367 categories. Categories are used for classifying characters for use
4368 in regexps -- you can refer to a category rather than having to use
4369 a complicated [] expression (and category lookups are significantly
4372 There are 95 different categories available, one for each printable
4373 character (including space) in the ASCII charset. Each category
4374 is designated by one such character, called a "category designator".
4375 They are specified in a regexp using the syntax "\\cX", where X is
4376 a category designator.
4378 A category table specifies, for each character, the categories that
4379 the character is in. Note that a character can be in more than one
4380 category. More specifically, a category table maps from a character
4381 to either the value nil (meaning the character is in no categories)
4382 or a 95-element bit vector, specifying for each of the 95 categories
4383 whether the character is in that category.
4385 Special Lisp functions are provided that abstract this, so you do not
4386 have to directly manipulate bit vectors.
4390 return (CHAR_TABLEP (object) &&
4391 XCHAR_TABLE_TYPE (object) == CHAR_TABLE_TYPE_CATEGORY) ?
4396 check_category_table (Lisp_Object object, Lisp_Object default_)
4400 while (NILP (Fcategory_table_p (object)))
4401 object = wrong_type_argument (Qcategory_table_p, object);
4406 check_category_char (Emchar ch, Lisp_Object table,
4407 unsigned int designator, unsigned int not_p)
4409 REGISTER Lisp_Object temp;
4410 Lisp_Char_Table *ctbl;
4411 #ifdef ERROR_CHECK_TYPECHECK
4412 if (NILP (Fcategory_table_p (table)))
4413 signal_simple_error ("Expected category table", table);
4415 ctbl = XCHAR_TABLE (table);
4416 temp = get_char_table (ch, ctbl);
4421 return bit_vector_bit (XBIT_VECTOR (temp), designator) ? !not_p : not_p;
4424 DEFUN ("check-category-at", Fcheck_category_at, 2, 4, 0, /*
4425 Return t if category of the character at POSITION includes DESIGNATOR.
4426 Optional third arg BUFFER specifies which buffer to use, and defaults
4427 to the current buffer.
4428 Optional fourth arg CATEGORY-TABLE specifies the category table to
4429 use, and defaults to BUFFER's category table.
4431 (position, designator, buffer, category_table))
4436 struct buffer *buf = decode_buffer (buffer, 0);
4438 CHECK_INT (position);
4439 CHECK_CATEGORY_DESIGNATOR (designator);
4440 des = XCHAR (designator);
4441 ctbl = check_category_table (category_table, Vstandard_category_table);
4442 ch = BUF_FETCH_CHAR (buf, XINT (position));
4443 return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil;
4446 DEFUN ("char-in-category-p", Fchar_in_category_p, 2, 3, 0, /*
4447 Return t if category of CHARACTER includes DESIGNATOR, else nil.
4448 Optional third arg CATEGORY-TABLE specifies the category table to use,
4449 and defaults to the standard category table.
4451 (character, designator, category_table))
4457 CHECK_CATEGORY_DESIGNATOR (designator);
4458 des = XCHAR (designator);
4459 CHECK_CHAR (character);
4460 ch = XCHAR (character);
4461 ctbl = check_category_table (category_table, Vstandard_category_table);
4462 return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil;
4465 DEFUN ("category-table", Fcategory_table, 0, 1, 0, /*
4466 Return BUFFER's current category table.
4467 BUFFER defaults to the current buffer.
4471 return decode_buffer (buffer, 0)->category_table;
4474 DEFUN ("standard-category-table", Fstandard_category_table, 0, 0, 0, /*
4475 Return the standard category table.
4476 This is the one used for new buffers.
4480 return Vstandard_category_table;
4483 DEFUN ("copy-category-table", Fcopy_category_table, 0, 1, 0, /*
4484 Return a new category table which is a copy of CATEGORY-TABLE.
4485 CATEGORY-TABLE defaults to the standard category table.
4489 if (NILP (Vstandard_category_table))
4490 return Fmake_char_table (Qcategory);
4493 check_category_table (category_table, Vstandard_category_table);
4494 return Fcopy_char_table (category_table);
4497 DEFUN ("set-category-table", Fset_category_table, 1, 2, 0, /*
4498 Select CATEGORY-TABLE as the new category table for BUFFER.
4499 BUFFER defaults to the current buffer if omitted.
4501 (category_table, buffer))
4503 struct buffer *buf = decode_buffer (buffer, 0);
4504 category_table = check_category_table (category_table, Qnil);
4505 buf->category_table = category_table;
4506 /* Indicate that this buffer now has a specified category table. */
4507 buf->local_var_flags |= XINT (buffer_local_flags.category_table);
4508 return category_table;
4511 DEFUN ("category-designator-p", Fcategory_designator_p, 1, 1, 0, /*
4512 Return t if OBJECT is a category designator (a char in the range ' ' to '~').
4516 return CATEGORY_DESIGNATORP (object) ? Qt : Qnil;
4519 DEFUN ("category-table-value-p", Fcategory_table_value_p, 1, 1, 0, /*
4520 Return t if OBJECT is a category table value.
4521 Valid values are nil or a bit vector of size 95.
4525 return CATEGORY_TABLE_VALUEP (object) ? Qt : Qnil;
4529 #define CATEGORYP(x) \
4530 (CHARP (x) && XCHAR (x) >= 0x20 && XCHAR (x) <= 0x7E)
4532 #define CATEGORY_SET(c) \
4533 (get_char_table(c, XCHAR_TABLE(current_buffer->category_table)))
4535 /* Return 1 if CATEGORY_SET contains CATEGORY, else return 0.
4536 The faster version of `!NILP (Faref (category_set, category))'. */
4537 #define CATEGORY_MEMBER(category, category_set) \
4538 (bit_vector_bit(XBIT_VECTOR (category_set), category - 32))
4540 /* Return 1 if there is a word boundary between two word-constituent
4541 characters C1 and C2 if they appear in this order, else return 0.
4542 Use the macro WORD_BOUNDARY_P instead of calling this function
4545 int word_boundary_p (Emchar c1, Emchar c2);
4547 word_boundary_p (Emchar c1, Emchar c2)
4549 Lisp_Object category_set1, category_set2;
4554 if (COMPOSITE_CHAR_P (c1))
4555 c1 = cmpchar_component (c1, 0, 1);
4556 if (COMPOSITE_CHAR_P (c2))
4557 c2 = cmpchar_component (c2, 0, 1);
4561 if (EQ (CHAR_CHARSET (c1), CHAR_CHARSET (c2)))
4564 tail = Vword_separating_categories;
4570 tail = Vword_combining_categories;
4575 category_set1 = CATEGORY_SET (c1);
4576 if (NILP (category_set1))
4577 return default_result;
4578 category_set2 = CATEGORY_SET (c2);
4579 if (NILP (category_set2))
4580 return default_result;
4582 for (; CONSP (tail); tail = XCONS (tail)->cdr)
4584 Lisp_Object elt = XCONS(tail)->car;
4587 && CATEGORYP (XCONS (elt)->car)
4588 && CATEGORYP (XCONS (elt)->cdr)
4589 && CATEGORY_MEMBER (XCHAR (XCONS (elt)->car), category_set1)
4590 && CATEGORY_MEMBER (XCHAR (XCONS (elt)->cdr), category_set2))
4591 return !default_result;
4593 return default_result;
4599 syms_of_chartab (void)
4602 INIT_LRECORD_IMPLEMENTATION (uint8_byte_table);
4603 INIT_LRECORD_IMPLEMENTATION (uint16_byte_table);
4604 INIT_LRECORD_IMPLEMENTATION (byte_table);
4606 defsymbol (&Qto_ucs, "=>ucs");
4607 defsymbol (&Q_ucs_unified, "->ucs-unified");
4608 defsymbol (&Q_subsumptive, "->subsumptive");
4609 defsymbol (&Q_subsumptive_from, "<-subsumptive");
4610 defsymbol (&Q_denotational, "->denotational");
4611 defsymbol (&Q_denotational_from, "<-denotational");
4612 defsymbol (&Q_identical, "->identical");
4613 defsymbol (&Q_identical_from, "<-identical");
4614 defsymbol (&Q_component, "->ideographic-component-forms");
4615 defsymbol (&Q_component_of, "<-ideographic-component-forms");
4616 defsymbol (&Qcomposition, "composition");
4617 defsymbol (&Q_decomposition, "->decomposition");
4618 defsymbol (&Qcompat, "compat");
4619 defsymbol (&Qisolated, "isolated");
4620 defsymbol (&Qinitial, "initial");
4621 defsymbol (&Qmedial, "medial");
4622 defsymbol (&Qfinal, "final");
4623 defsymbol (&Qvertical, "vertical");
4624 defsymbol (&QnoBreak, "noBreak");
4625 defsymbol (&Qfraction, "fraction");
4626 defsymbol (&Qsuper, "super");
4627 defsymbol (&Qsub, "sub");
4628 defsymbol (&Qcircle, "circle");
4629 defsymbol (&Qsquare, "square");
4630 defsymbol (&Qwide, "wide");
4631 defsymbol (&Qnarrow, "narrow");
4632 defsymbol (&Qsmall, "small");
4633 defsymbol (&Qfont, "font");
4635 DEFSUBR (Fchar_attribute_list);
4636 DEFSUBR (Ffind_char_attribute_table);
4637 defsymbol (&Qput_char_table_map_function, "put-char-table-map-function");
4638 DEFSUBR (Fput_char_table_map_function);
4640 DEFSUBR (Fsave_char_attribute_table);
4641 DEFSUBR (Fmount_char_attribute_table);
4642 DEFSUBR (Freset_char_attribute_table);
4643 DEFSUBR (Fclose_char_attribute_table);
4644 DEFSUBR (Fclose_char_data_source);
4645 #ifndef HAVE_LIBCHISE
4646 defsymbol (&Qload_char_attribute_table_map_function,
4647 "load-char-attribute-table-map-function");
4648 DEFSUBR (Fload_char_attribute_table_map_function);
4650 DEFSUBR (Fload_char_attribute_table);
4652 DEFSUBR (Fchar_feature);
4653 DEFSUBR (Fchar_attribute_alist);
4654 DEFSUBR (Fget_char_attribute);
4655 DEFSUBR (Fput_char_attribute);
4656 DEFSUBR (Fremove_char_attribute);
4657 DEFSUBR (Fmap_char_attribute);
4658 DEFSUBR (Fdefine_char);
4659 DEFSUBR (Ffind_char);
4660 DEFSUBR (Fchar_variants);
4662 DEFSUBR (Fget_composite_char);
4665 INIT_LRECORD_IMPLEMENTATION (char_table);
4669 INIT_LRECORD_IMPLEMENTATION (char_table_entry);
4672 defsymbol (&Qcategory_table_p, "category-table-p");
4673 defsymbol (&Qcategory_designator_p, "category-designator-p");
4674 defsymbol (&Qcategory_table_value_p, "category-table-value-p");
4677 defsymbol (&Qchar_table, "char-table");
4678 defsymbol (&Qchar_tablep, "char-table-p");
4680 DEFSUBR (Fchar_table_p);
4681 DEFSUBR (Fchar_table_type_list);
4682 DEFSUBR (Fvalid_char_table_type_p);
4683 DEFSUBR (Fchar_table_type);
4684 DEFSUBR (Freset_char_table);
4685 DEFSUBR (Fmake_char_table);
4686 DEFSUBR (Fcopy_char_table);
4687 DEFSUBR (Fget_char_table);
4688 DEFSUBR (Fget_range_char_table);
4689 DEFSUBR (Fvalid_char_table_value_p);
4690 DEFSUBR (Fcheck_valid_char_table_value);
4691 DEFSUBR (Fput_char_table);
4692 DEFSUBR (Fmap_char_table);
4695 DEFSUBR (Fcategory_table_p);
4696 DEFSUBR (Fcategory_table);
4697 DEFSUBR (Fstandard_category_table);
4698 DEFSUBR (Fcopy_category_table);
4699 DEFSUBR (Fset_category_table);
4700 DEFSUBR (Fcheck_category_at);
4701 DEFSUBR (Fchar_in_category_p);
4702 DEFSUBR (Fcategory_designator_p);
4703 DEFSUBR (Fcategory_table_value_p);
4709 vars_of_chartab (void)
4712 DEFVAR_LISP ("next-defined-char-id", &Vnext_defined_char_id /*
4714 Vnext_defined_char_id = make_int (0x0F0000);
4718 DEFVAR_LISP ("char-db-stingy-mode", &Vchar_db_stingy_mode /*
4720 Vchar_db_stingy_mode = Qt;
4722 #ifdef HAVE_LIBCHISE
4723 Vchise_db_directory = build_string(chise_db_dir);
4724 DEFVAR_LISP ("chise-db-directory", &Vchise_db_directory /*
4725 Directory of CHISE character databases.
4728 Vchise_system_db_directory = build_string(chise_system_db_dir);
4729 DEFVAR_LISP ("chise-system-db-directory", &Vchise_system_db_directory /*
4730 Directory of system character database of CHISE.
4734 #endif /* HAVE_CHISE */
4735 /* DO NOT staticpro this. It works just like Vweak_hash_tables. */
4736 Vall_syntax_tables = Qnil;
4737 dump_add_weak_object_chain (&Vall_syntax_tables);
4741 structure_type_create_chartab (void)
4743 struct structure_type *st;
4745 st = define_structure_type (Qchar_table, 0, chartab_instantiate);
4747 define_structure_type_keyword (st, Qtype, chartab_type_validate);
4748 define_structure_type_keyword (st, Qdata, chartab_data_validate);
4752 complex_vars_of_chartab (void)
4755 staticpro (&Vchar_attribute_hash_table);
4756 Vchar_attribute_hash_table
4757 = make_lisp_hash_table (16, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
4758 #endif /* UTF2000 */
4760 /* Set this now, so first buffer creation can refer to it. */
4761 /* Make it nil before calling copy-category-table
4762 so that copy-category-table will know not to try to copy from garbage */
4763 Vstandard_category_table = Qnil;
4764 Vstandard_category_table = Fcopy_category_table (Qnil);
4765 staticpro (&Vstandard_category_table);
4767 DEFVAR_LISP ("word-combining-categories", &Vword_combining_categories /*
4768 List of pair (cons) of categories to determine word boundary.
4770 Emacs treats a sequence of word constituent characters as a single
4771 word (i.e. finds no word boundary between them) iff they belongs to
4772 the same charset. But, exceptions are allowed in the following cases.
4774 \(1) The case that characters are in different charsets is controlled
4775 by the variable `word-combining-categories'.
4777 Emacs finds no word boundary between characters of different charsets
4778 if they have categories matching some element of this list.
4780 More precisely, if an element of this list is a cons of category CAT1
4781 and CAT2, and a multibyte character C1 which has CAT1 is followed by
4782 C2 which has CAT2, there's no word boundary between C1 and C2.
4784 For instance, to tell that ASCII characters and Latin-1 characters can
4785 form a single word, the element `(?l . ?l)' should be in this list
4786 because both characters have the category `l' (Latin characters).
4788 \(2) The case that character are in the same charset is controlled by
4789 the variable `word-separating-categories'.
4791 Emacs find a word boundary between characters of the same charset
4792 if they have categories matching some element of this list.
4794 More precisely, if an element of this list is a cons of category CAT1
4795 and CAT2, and a multibyte character C1 which has CAT1 is followed by
4796 C2 which has CAT2, there's a word boundary between C1 and C2.
4798 For instance, to tell that there's a word boundary between Japanese
4799 Hiragana and Japanese Kanji (both are in the same charset), the
4800 element `(?H . ?C) should be in this list.
4803 Vword_combining_categories = Qnil;
4805 DEFVAR_LISP ("word-separating-categories", &Vword_separating_categories /*
4806 List of pair (cons) of categories to determine word boundary.
4807 See the documentation of the variable `word-combining-categories'.
4810 Vword_separating_categories = Qnil;