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 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
49 Lisp_Object Vutf_2000_version;
52 Lisp_Object Qchar_tablep, Qchar_table;
54 Lisp_Object Vall_syntax_tables;
57 Lisp_Object Qcategory_table_p;
58 Lisp_Object Qcategory_designator_p;
59 Lisp_Object Qcategory_table_value_p;
61 Lisp_Object Vstandard_category_table;
63 /* Variables to determine word boundary. */
64 Lisp_Object Vword_combining_categories, Vword_separating_categories;
70 #define BT_UINT8_MIN 0
71 #define BT_UINT8_MAX (UCHAR_MAX - 3)
72 #define BT_UINT8_t (UCHAR_MAX - 2)
73 #define BT_UINT8_nil (UCHAR_MAX - 1)
74 #define BT_UINT8_unbound UCHAR_MAX
76 INLINE_HEADER int INT_UINT8_P (Lisp_Object obj);
77 INLINE_HEADER int UINT8_VALUE_P (Lisp_Object obj);
78 INLINE_HEADER unsigned char UINT8_ENCODE (Lisp_Object obj);
79 INLINE_HEADER Lisp_Object UINT8_DECODE (unsigned char n);
80 INLINE_HEADER unsigned short UINT8_TO_UINT16 (unsigned char n);
83 INT_UINT8_P (Lisp_Object obj)
89 return (BT_UINT8_MIN <= num) && (num <= BT_UINT8_MAX);
96 UINT8_VALUE_P (Lisp_Object obj)
98 return EQ (obj, Qunbound)
99 || EQ (obj, Qnil) || EQ (obj, Qt) || INT_UINT8_P (obj);
102 INLINE_HEADER unsigned char
103 UINT8_ENCODE (Lisp_Object obj)
105 if (EQ (obj, Qunbound))
106 return BT_UINT8_unbound;
107 else if (EQ (obj, Qnil))
109 else if (EQ (obj, Qt))
115 INLINE_HEADER Lisp_Object
116 UINT8_DECODE (unsigned char n)
118 if (n == BT_UINT8_unbound)
120 else if (n == BT_UINT8_nil)
122 else if (n == BT_UINT8_t)
129 mark_uint8_byte_table (Lisp_Object obj)
135 print_uint8_byte_table (Lisp_Object obj,
136 Lisp_Object printcharfun, int escapeflag)
138 Lisp_Uint8_Byte_Table *bte = XUINT8_BYTE_TABLE (obj);
140 struct gcpro gcpro1, gcpro2;
141 GCPRO2 (obj, printcharfun);
143 write_c_string ("\n#<uint8-byte-table", printcharfun);
144 for (i = 0; i < 256; i++)
146 unsigned char n = bte->property[i];
148 write_c_string ("\n ", printcharfun);
149 write_c_string (" ", printcharfun);
150 if (n == BT_UINT8_unbound)
151 write_c_string ("void", printcharfun);
152 else if (n == BT_UINT8_nil)
153 write_c_string ("nil", printcharfun);
154 else if (n == BT_UINT8_t)
155 write_c_string ("t", printcharfun);
160 sprintf (buf, "%hd", n);
161 write_c_string (buf, printcharfun);
165 write_c_string (">", printcharfun);
169 uint8_byte_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
171 Lisp_Uint8_Byte_Table *te1 = XUINT8_BYTE_TABLE (obj1);
172 Lisp_Uint8_Byte_Table *te2 = XUINT8_BYTE_TABLE (obj2);
175 for (i = 0; i < 256; i++)
176 if (te1->property[i] != te2->property[i])
182 uint8_byte_table_hash (Lisp_Object obj, int depth)
184 Lisp_Uint8_Byte_Table *te = XUINT8_BYTE_TABLE (obj);
188 for (i = 0; i < 256; i++)
189 hash = HASH2 (hash, te->property[i]);
193 DEFINE_LRECORD_IMPLEMENTATION ("uint8-byte-table", uint8_byte_table,
194 mark_uint8_byte_table,
195 print_uint8_byte_table,
196 0, uint8_byte_table_equal,
197 uint8_byte_table_hash,
198 0 /* uint8_byte_table_description */,
199 Lisp_Uint8_Byte_Table);
202 make_uint8_byte_table (unsigned char initval)
206 Lisp_Uint8_Byte_Table *cte;
208 cte = alloc_lcrecord_type (Lisp_Uint8_Byte_Table,
209 &lrecord_uint8_byte_table);
211 for (i = 0; i < 256; i++)
212 cte->property[i] = initval;
214 XSETUINT8_BYTE_TABLE (obj, cte);
219 copy_uint8_byte_table (Lisp_Object entry)
221 Lisp_Uint8_Byte_Table *cte = XUINT8_BYTE_TABLE (entry);
224 Lisp_Uint8_Byte_Table *ctenew
225 = alloc_lcrecord_type (Lisp_Uint8_Byte_Table,
226 &lrecord_uint8_byte_table);
228 for (i = 0; i < 256; i++)
230 ctenew->property[i] = cte->property[i];
233 XSETUINT8_BYTE_TABLE (obj, ctenew);
238 uint8_byte_table_same_value_p (Lisp_Object obj)
240 Lisp_Uint8_Byte_Table *bte = XUINT8_BYTE_TABLE (obj);
241 unsigned char v0 = bte->property[0];
244 for (i = 1; i < 256; i++)
246 if (bte->property[i] != v0)
253 map_over_uint8_byte_table (Lisp_Uint8_Byte_Table *ct, Emchar ofs, int place,
254 int (*fn) (struct chartab_range *range,
255 Lisp_Object val, void *arg),
258 struct chartab_range rainj;
260 int unit = 1 << (8 * place);
264 rainj.type = CHARTAB_RANGE_CHAR;
266 for (i = 0, retval = 0; i < 256 && retval == 0; i++)
268 if (ct->property[i] != BT_UINT8_unbound)
271 for (; c < c1 && retval == 0; c++)
274 retval = (fn) (&rainj, UINT8_DECODE (ct->property[i]), arg);
283 #define BT_UINT16_MIN 0
284 #define BT_UINT16_MAX (USHRT_MAX - 3)
285 #define BT_UINT16_t (USHRT_MAX - 2)
286 #define BT_UINT16_nil (USHRT_MAX - 1)
287 #define BT_UINT16_unbound USHRT_MAX
289 INLINE_HEADER int INT_UINT16_P (Lisp_Object obj);
290 INLINE_HEADER int UINT16_VALUE_P (Lisp_Object obj);
291 INLINE_HEADER unsigned short UINT16_ENCODE (Lisp_Object obj);
292 INLINE_HEADER Lisp_Object UINT16_DECODE (unsigned short us);
295 INT_UINT16_P (Lisp_Object obj)
299 int num = XINT (obj);
301 return (BT_UINT16_MIN <= num) && (num <= BT_UINT16_MAX);
308 UINT16_VALUE_P (Lisp_Object obj)
310 return EQ (obj, Qunbound)
311 || EQ (obj, Qnil) || EQ (obj, Qt) || INT_UINT16_P (obj);
314 INLINE_HEADER unsigned short
315 UINT16_ENCODE (Lisp_Object obj)
317 if (EQ (obj, Qunbound))
318 return BT_UINT16_unbound;
319 else if (EQ (obj, Qnil))
320 return BT_UINT16_nil;
321 else if (EQ (obj, Qt))
327 INLINE_HEADER Lisp_Object
328 UINT16_DECODE (unsigned short n)
330 if (n == BT_UINT16_unbound)
332 else if (n == BT_UINT16_nil)
334 else if (n == BT_UINT16_t)
340 INLINE_HEADER unsigned short
341 UINT8_TO_UINT16 (unsigned char n)
343 if (n == BT_UINT8_unbound)
344 return BT_UINT16_unbound;
345 else if (n == BT_UINT8_nil)
346 return BT_UINT16_nil;
347 else if (n == BT_UINT8_t)
354 mark_uint16_byte_table (Lisp_Object obj)
360 print_uint16_byte_table (Lisp_Object obj,
361 Lisp_Object printcharfun, int escapeflag)
363 Lisp_Uint16_Byte_Table *bte = XUINT16_BYTE_TABLE (obj);
365 struct gcpro gcpro1, gcpro2;
366 GCPRO2 (obj, printcharfun);
368 write_c_string ("\n#<uint16-byte-table", printcharfun);
369 for (i = 0; i < 256; i++)
371 unsigned short n = bte->property[i];
373 write_c_string ("\n ", printcharfun);
374 write_c_string (" ", printcharfun);
375 if (n == BT_UINT16_unbound)
376 write_c_string ("void", printcharfun);
377 else if (n == BT_UINT16_nil)
378 write_c_string ("nil", printcharfun);
379 else if (n == BT_UINT16_t)
380 write_c_string ("t", printcharfun);
385 sprintf (buf, "%hd", n);
386 write_c_string (buf, printcharfun);
390 write_c_string (">", printcharfun);
394 uint16_byte_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
396 Lisp_Uint16_Byte_Table *te1 = XUINT16_BYTE_TABLE (obj1);
397 Lisp_Uint16_Byte_Table *te2 = XUINT16_BYTE_TABLE (obj2);
400 for (i = 0; i < 256; i++)
401 if (te1->property[i] != te2->property[i])
407 uint16_byte_table_hash (Lisp_Object obj, int depth)
409 Lisp_Uint16_Byte_Table *te = XUINT16_BYTE_TABLE (obj);
413 for (i = 0; i < 256; i++)
414 hash = HASH2 (hash, te->property[i]);
418 DEFINE_LRECORD_IMPLEMENTATION ("uint16-byte-table", uint16_byte_table,
419 mark_uint16_byte_table,
420 print_uint16_byte_table,
421 0, uint16_byte_table_equal,
422 uint16_byte_table_hash,
423 0 /* uint16_byte_table_description */,
424 Lisp_Uint16_Byte_Table);
427 make_uint16_byte_table (unsigned short initval)
431 Lisp_Uint16_Byte_Table *cte;
433 cte = alloc_lcrecord_type (Lisp_Uint16_Byte_Table,
434 &lrecord_uint16_byte_table);
436 for (i = 0; i < 256; i++)
437 cte->property[i] = initval;
439 XSETUINT16_BYTE_TABLE (obj, cte);
444 copy_uint16_byte_table (Lisp_Object entry)
446 Lisp_Uint16_Byte_Table *cte = XUINT16_BYTE_TABLE (entry);
449 Lisp_Uint16_Byte_Table *ctenew
450 = alloc_lcrecord_type (Lisp_Uint16_Byte_Table,
451 &lrecord_uint16_byte_table);
453 for (i = 0; i < 256; i++)
455 ctenew->property[i] = cte->property[i];
458 XSETUINT16_BYTE_TABLE (obj, ctenew);
463 expand_uint8_byte_table_to_uint16 (Lisp_Object table)
467 Lisp_Uint8_Byte_Table* bte = XUINT8_BYTE_TABLE(table);
468 Lisp_Uint16_Byte_Table* cte;
470 cte = alloc_lcrecord_type (Lisp_Uint16_Byte_Table,
471 &lrecord_uint16_byte_table);
472 for (i = 0; i < 256; i++)
474 cte->property[i] = UINT8_TO_UINT16 (bte->property[i]);
476 XSETUINT16_BYTE_TABLE (obj, cte);
481 uint16_byte_table_same_value_p (Lisp_Object obj)
483 Lisp_Uint16_Byte_Table *bte = XUINT16_BYTE_TABLE (obj);
484 unsigned short v0 = bte->property[0];
487 for (i = 1; i < 256; i++)
489 if (bte->property[i] != v0)
496 map_over_uint16_byte_table (Lisp_Uint16_Byte_Table *ct, Emchar ofs, int place,
497 int (*fn) (struct chartab_range *range,
498 Lisp_Object val, void *arg),
501 struct chartab_range rainj;
503 int unit = 1 << (8 * place);
507 rainj.type = CHARTAB_RANGE_CHAR;
509 for (i = 0, retval = 0; i < 256 && retval == 0; i++)
511 if (ct->property[i] != BT_UINT16_unbound)
514 for (; c < c1 && retval == 0; c++)
517 retval = (fn) (&rainj, UINT16_DECODE (ct->property[i]), arg);
528 mark_byte_table (Lisp_Object obj)
530 Lisp_Byte_Table *cte = XBYTE_TABLE (obj);
533 for (i = 0; i < 256; i++)
535 mark_object (cte->property[i]);
541 print_byte_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
543 Lisp_Byte_Table *bte = XBYTE_TABLE (obj);
545 struct gcpro gcpro1, gcpro2;
546 GCPRO2 (obj, printcharfun);
548 write_c_string ("\n#<byte-table", printcharfun);
549 for (i = 0; i < 256; i++)
551 Lisp_Object elt = bte->property[i];
553 write_c_string ("\n ", printcharfun);
554 write_c_string (" ", printcharfun);
555 if (EQ (elt, Qunbound))
556 write_c_string ("void", printcharfun);
558 print_internal (elt, printcharfun, escapeflag);
561 write_c_string (">", printcharfun);
565 byte_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
567 Lisp_Byte_Table *cte1 = XBYTE_TABLE (obj1);
568 Lisp_Byte_Table *cte2 = XBYTE_TABLE (obj2);
571 for (i = 0; i < 256; i++)
572 if (BYTE_TABLE_P (cte1->property[i]))
574 if (BYTE_TABLE_P (cte2->property[i]))
576 if (!byte_table_equal (cte1->property[i],
577 cte2->property[i], depth + 1))
584 if (!internal_equal (cte1->property[i], cte2->property[i], depth + 1))
590 byte_table_hash (Lisp_Object obj, int depth)
592 Lisp_Byte_Table *cte = XBYTE_TABLE (obj);
594 return internal_array_hash (cte->property, 256, depth);
597 static const struct lrecord_description byte_table_description[] = {
598 { XD_LISP_OBJECT_ARRAY, offsetof(Lisp_Byte_Table, property), 256 },
602 DEFINE_LRECORD_IMPLEMENTATION ("byte-table", byte_table,
607 byte_table_description,
611 make_byte_table (Lisp_Object initval)
615 Lisp_Byte_Table *cte;
617 cte = alloc_lcrecord_type (Lisp_Byte_Table, &lrecord_byte_table);
619 for (i = 0; i < 256; i++)
620 cte->property[i] = initval;
622 XSETBYTE_TABLE (obj, cte);
627 copy_byte_table (Lisp_Object entry)
629 Lisp_Byte_Table *cte = XBYTE_TABLE (entry);
632 Lisp_Byte_Table *ctnew
633 = alloc_lcrecord_type (Lisp_Byte_Table, &lrecord_byte_table);
635 for (i = 0; i < 256; i++)
637 if (UINT8_BYTE_TABLE_P (cte->property[i]))
639 ctnew->property[i] = copy_uint8_byte_table (cte->property[i]);
641 else if (UINT16_BYTE_TABLE_P (cte->property[i]))
643 ctnew->property[i] = copy_uint16_byte_table (cte->property[i]);
645 else if (BYTE_TABLE_P (cte->property[i]))
647 ctnew->property[i] = copy_byte_table (cte->property[i]);
650 ctnew->property[i] = cte->property[i];
653 XSETBYTE_TABLE (obj, ctnew);
658 byte_table_same_value_p (Lisp_Object obj)
660 Lisp_Byte_Table *bte = XBYTE_TABLE (obj);
661 Lisp_Object v0 = bte->property[0];
664 for (i = 1; i < 256; i++)
666 if (!internal_equal (bte->property[i], v0, 0))
673 map_over_byte_table (Lisp_Byte_Table *ct, Emchar ofs, int place,
674 int (*fn) (struct chartab_range *range,
675 Lisp_Object val, void *arg),
680 int unit = 1 << (8 * place);
683 for (i = 0, retval = 0; i < 256 && retval == 0; i++)
686 if (UINT8_BYTE_TABLE_P (v))
689 = map_over_uint8_byte_table (XUINT8_BYTE_TABLE(v),
690 c, place - 1, fn, arg);
693 else if (UINT16_BYTE_TABLE_P (v))
696 = map_over_uint16_byte_table (XUINT16_BYTE_TABLE(v),
697 c, place - 1, fn, arg);
700 else if (BYTE_TABLE_P (v))
702 retval = map_over_byte_table (XBYTE_TABLE(v),
703 c, place - 1, fn, arg);
706 else if (!UNBOUNDP (v))
708 struct chartab_range rainj;
709 Emchar c1 = c + unit;
711 rainj.type = CHARTAB_RANGE_CHAR;
713 for (; c < c1 && retval == 0; c++)
716 retval = (fn) (&rainj, v, arg);
727 get_byte_table (Lisp_Object table, unsigned char idx)
729 if (UINT8_BYTE_TABLE_P (table))
730 return UINT8_DECODE (XUINT8_BYTE_TABLE(table)->property[idx]);
731 else if (UINT16_BYTE_TABLE_P (table))
732 return UINT16_DECODE (XUINT16_BYTE_TABLE(table)->property[idx]);
733 else if (BYTE_TABLE_P (table))
734 return XBYTE_TABLE(table)->property[idx];
740 put_byte_table (Lisp_Object table, unsigned char idx, Lisp_Object value)
742 if (UINT8_BYTE_TABLE_P (table))
744 if (UINT8_VALUE_P (value))
746 XUINT8_BYTE_TABLE(table)->property[idx] = UINT8_ENCODE (value);
747 if (!UINT8_BYTE_TABLE_P (value) &&
748 !UINT16_BYTE_TABLE_P (value) && !BYTE_TABLE_P (value)
749 && uint8_byte_table_same_value_p (table))
754 else if (UINT16_VALUE_P (value))
756 Lisp_Object new = expand_uint8_byte_table_to_uint16 (table);
758 XUINT16_BYTE_TABLE(new)->property[idx] = UINT16_ENCODE (value);
763 Lisp_Object new = make_byte_table (Qnil);
766 for (i = 0; i < 256; i++)
768 XBYTE_TABLE(new)->property[i]
769 = UINT8_DECODE (XUINT8_BYTE_TABLE(table)->property[i]);
771 XBYTE_TABLE(new)->property[idx] = value;
775 else if (UINT16_BYTE_TABLE_P (table))
777 if (UINT16_VALUE_P (value))
779 XUINT16_BYTE_TABLE(table)->property[idx] = UINT16_ENCODE (value);
780 if (!UINT8_BYTE_TABLE_P (value) &&
781 !UINT16_BYTE_TABLE_P (value) && !BYTE_TABLE_P (value)
782 && uint16_byte_table_same_value_p (table))
789 Lisp_Object new = make_byte_table (Qnil);
792 for (i = 0; i < 256; i++)
794 XBYTE_TABLE(new)->property[i]
795 = UINT16_DECODE (XUINT16_BYTE_TABLE(table)->property[i]);
797 XBYTE_TABLE(new)->property[idx] = value;
801 else if (BYTE_TABLE_P (table))
803 XBYTE_TABLE(table)->property[idx] = value;
804 if (!UINT8_BYTE_TABLE_P (value) &&
805 !UINT16_BYTE_TABLE_P (value) && !BYTE_TABLE_P (value)
806 && byte_table_same_value_p (table))
811 else if (!internal_equal (table, value, 0))
813 if (UINT8_VALUE_P (table) && UINT8_VALUE_P (value))
815 table = make_uint8_byte_table (UINT8_ENCODE (table));
816 XUINT8_BYTE_TABLE(table)->property[idx] = UINT8_ENCODE (value);
818 else if (UINT16_VALUE_P (table) && UINT16_VALUE_P (value))
820 table = make_uint16_byte_table (UINT16_ENCODE (table));
821 XUINT16_BYTE_TABLE(table)->property[idx] = UINT16_ENCODE (value);
825 table = make_byte_table (table);
826 XBYTE_TABLE(table)->property[idx] = value;
834 make_char_id_table (Lisp_Object initval)
837 obj = Fmake_char_table (Qgeneric);
838 fill_char_table (XCHAR_TABLE (obj), initval);
843 Lisp_Object Vcharacter_composition_table;
844 Lisp_Object Vcharacter_variant_table;
847 Lisp_Object Q_decomposition;
851 Lisp_Object Qisolated;
852 Lisp_Object Qinitial;
855 Lisp_Object Qvertical;
856 Lisp_Object QnoBreak;
857 Lisp_Object Qfraction;
867 Emchar to_char_id (Lisp_Object v, char* err_msg, Lisp_Object err_arg);
870 to_char_id (Lisp_Object v, char* err_msg, Lisp_Object err_arg)
876 else if (EQ (v, Qcompat))
878 else if (EQ (v, Qisolated))
880 else if (EQ (v, Qinitial))
882 else if (EQ (v, Qmedial))
884 else if (EQ (v, Qfinal))
886 else if (EQ (v, Qvertical))
888 else if (EQ (v, QnoBreak))
890 else if (EQ (v, Qfraction))
892 else if (EQ (v, Qsuper))
894 else if (EQ (v, Qsub))
896 else if (EQ (v, Qcircle))
898 else if (EQ (v, Qsquare))
900 else if (EQ (v, Qwide))
902 else if (EQ (v, Qnarrow))
904 else if (EQ (v, Qsmall))
906 else if (EQ (v, Qfont))
909 signal_simple_error (err_msg, err_arg);
912 DEFUN ("get-composite-char", Fget_composite_char, 1, 1, 0, /*
913 Return character corresponding with list.
917 Lisp_Object table = Vcharacter_composition_table;
918 Lisp_Object rest = list;
922 Lisp_Object v = Fcar (rest);
924 Emchar c = to_char_id (v, "Invalid value for composition", list);
926 ret = get_char_id_table (XCHAR_TABLE(table), c);
931 if (!CHAR_TABLEP (ret))
936 else if (!CONSP (rest))
938 else if (CHAR_TABLEP (ret))
941 signal_simple_error ("Invalid table is found with", list);
943 signal_simple_error ("Invalid value for composition", list);
946 DEFUN ("char-variants", Fchar_variants, 1, 1, 0, /*
947 Return variants of CHARACTER.
951 CHECK_CHAR (character);
952 return Fcopy_list (get_char_id_table
953 (XCHAR_TABLE(Vcharacter_variant_table),
960 /* A char table maps from ranges of characters to values.
962 Implementing a general data structure that maps from arbitrary
963 ranges of numbers to values is tricky to do efficiently. As it
964 happens, it should suffice (and is usually more convenient, anyway)
965 when dealing with characters to restrict the sorts of ranges that
966 can be assigned values, as follows:
969 2) All characters in a charset.
970 3) All characters in a particular row of a charset, where a "row"
971 means all characters with the same first byte.
972 4) A particular character in a charset.
974 We use char tables to generalize the 256-element vectors now
975 littering the Emacs code.
977 Possible uses (all should be converted at some point):
983 5) keyboard-translate-table?
986 abstract type to generalize the Emacs vectors and Mule
987 vectors-of-vectors goo.
990 /************************************************************************/
991 /* Char Table object */
992 /************************************************************************/
994 #if defined(MULE)&&!defined(UTF2000)
997 mark_char_table_entry (Lisp_Object obj)
999 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj);
1002 for (i = 0; i < 96; i++)
1004 mark_object (cte->level2[i]);
1010 char_table_entry_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
1012 Lisp_Char_Table_Entry *cte1 = XCHAR_TABLE_ENTRY (obj1);
1013 Lisp_Char_Table_Entry *cte2 = XCHAR_TABLE_ENTRY (obj2);
1016 for (i = 0; i < 96; i++)
1017 if (!internal_equal (cte1->level2[i], cte2->level2[i], depth + 1))
1023 static unsigned long
1024 char_table_entry_hash (Lisp_Object obj, int depth)
1026 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj);
1028 return internal_array_hash (cte->level2, 96, depth);
1031 static const struct lrecord_description char_table_entry_description[] = {
1032 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table_Entry, level2), 96 },
1036 DEFINE_LRECORD_IMPLEMENTATION ("char-table-entry", char_table_entry,
1037 mark_char_table_entry, internal_object_printer,
1038 0, char_table_entry_equal,
1039 char_table_entry_hash,
1040 char_table_entry_description,
1041 Lisp_Char_Table_Entry);
1045 mark_char_table (Lisp_Object obj)
1047 Lisp_Char_Table *ct = XCHAR_TABLE (obj);
1050 mark_object (ct->table);
1054 for (i = 0; i < NUM_ASCII_CHARS; i++)
1055 mark_object (ct->ascii[i]);
1057 for (i = 0; i < NUM_LEADING_BYTES; i++)
1058 mark_object (ct->level1[i]);
1062 return ct->default_value;
1064 return ct->mirror_table;
1068 /* WARNING: All functions of this nature need to be written extremely
1069 carefully to avoid crashes during GC. Cf. prune_specifiers()
1070 and prune_weak_hash_tables(). */
1073 prune_syntax_tables (void)
1075 Lisp_Object rest, prev = Qnil;
1077 for (rest = Vall_syntax_tables;
1079 rest = XCHAR_TABLE (rest)->next_table)
1081 if (! marked_p (rest))
1083 /* This table is garbage. Remove it from the list. */
1085 Vall_syntax_tables = XCHAR_TABLE (rest)->next_table;
1087 XCHAR_TABLE (prev)->next_table =
1088 XCHAR_TABLE (rest)->next_table;
1094 char_table_type_to_symbol (enum char_table_type type)
1099 case CHAR_TABLE_TYPE_GENERIC: return Qgeneric;
1100 case CHAR_TABLE_TYPE_SYNTAX: return Qsyntax;
1101 case CHAR_TABLE_TYPE_DISPLAY: return Qdisplay;
1102 case CHAR_TABLE_TYPE_CHAR: return Qchar;
1104 case CHAR_TABLE_TYPE_CATEGORY: return Qcategory;
1109 static enum char_table_type
1110 symbol_to_char_table_type (Lisp_Object symbol)
1112 CHECK_SYMBOL (symbol);
1114 if (EQ (symbol, Qgeneric)) return CHAR_TABLE_TYPE_GENERIC;
1115 if (EQ (symbol, Qsyntax)) return CHAR_TABLE_TYPE_SYNTAX;
1116 if (EQ (symbol, Qdisplay)) return CHAR_TABLE_TYPE_DISPLAY;
1117 if (EQ (symbol, Qchar)) return CHAR_TABLE_TYPE_CHAR;
1119 if (EQ (symbol, Qcategory)) return CHAR_TABLE_TYPE_CATEGORY;
1122 signal_simple_error ("Unrecognized char table type", symbol);
1123 return CHAR_TABLE_TYPE_GENERIC; /* not reached */
1127 print_chartab_range (Emchar first, Emchar last, Lisp_Object val,
1128 Lisp_Object printcharfun)
1132 write_c_string (" (", printcharfun);
1133 print_internal (make_char (first), printcharfun, 0);
1134 write_c_string (" ", printcharfun);
1135 print_internal (make_char (last), printcharfun, 0);
1136 write_c_string (") ", printcharfun);
1140 write_c_string (" ", printcharfun);
1141 print_internal (make_char (first), printcharfun, 0);
1142 write_c_string (" ", printcharfun);
1144 print_internal (val, printcharfun, 1);
1147 #if defined(MULE)&&!defined(UTF2000)
1150 print_chartab_charset_row (Lisp_Object charset,
1152 Lisp_Char_Table_Entry *cte,
1153 Lisp_Object printcharfun)
1156 Lisp_Object cat = Qunbound;
1159 for (i = 32; i < 128; i++)
1161 Lisp_Object pam = cte->level2[i - 32];
1173 print_chartab_range (MAKE_CHAR (charset, first, 0),
1174 MAKE_CHAR (charset, i - 1, 0),
1177 print_chartab_range (MAKE_CHAR (charset, row, first),
1178 MAKE_CHAR (charset, row, i - 1),
1188 print_chartab_range (MAKE_CHAR (charset, first, 0),
1189 MAKE_CHAR (charset, i - 1, 0),
1192 print_chartab_range (MAKE_CHAR (charset, row, first),
1193 MAKE_CHAR (charset, row, i - 1),
1199 print_chartab_two_byte_charset (Lisp_Object charset,
1200 Lisp_Char_Table_Entry *cte,
1201 Lisp_Object printcharfun)
1205 for (i = 32; i < 128; i++)
1207 Lisp_Object jen = cte->level2[i - 32];
1209 if (!CHAR_TABLE_ENTRYP (jen))
1213 write_c_string (" [", printcharfun);
1214 print_internal (XCHARSET_NAME (charset), printcharfun, 0);
1215 sprintf (buf, " %d] ", i);
1216 write_c_string (buf, printcharfun);
1217 print_internal (jen, printcharfun, 0);
1220 print_chartab_charset_row (charset, i, XCHAR_TABLE_ENTRY (jen),
1228 print_char_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1230 Lisp_Char_Table *ct = XCHAR_TABLE (obj);
1233 struct gcpro gcpro1, gcpro2;
1234 GCPRO2 (obj, printcharfun);
1236 write_c_string ("#s(char-table ", printcharfun);
1237 write_c_string (" ", printcharfun);
1238 write_c_string (string_data
1240 (XSYMBOL (char_table_type_to_symbol (ct->type)))),
1242 write_c_string ("\n ", printcharfun);
1243 print_internal (ct->default_value, printcharfun, escapeflag);
1244 for (i = 0; i < 256; i++)
1246 Lisp_Object elt = get_byte_table (ct->table, i);
1247 if (i != 0) write_c_string ("\n ", printcharfun);
1248 if (EQ (elt, Qunbound))
1249 write_c_string ("void", printcharfun);
1251 print_internal (elt, printcharfun, escapeflag);
1254 #else /* non UTF2000 */
1257 sprintf (buf, "#s(char-table type %s data (",
1258 string_data (symbol_name (XSYMBOL
1259 (char_table_type_to_symbol (ct->type)))));
1260 write_c_string (buf, printcharfun);
1262 /* Now write out the ASCII/Control-1 stuff. */
1266 Lisp_Object val = Qunbound;
1268 for (i = 0; i < NUM_ASCII_CHARS; i++)
1277 if (!EQ (ct->ascii[i], val))
1279 print_chartab_range (first, i - 1, val, printcharfun);
1286 print_chartab_range (first, i - 1, val, printcharfun);
1293 for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES;
1296 Lisp_Object ann = ct->level1[i - MIN_LEADING_BYTE];
1297 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (i);
1299 if (!CHARSETP (charset) || i == LEADING_BYTE_ASCII
1300 || i == LEADING_BYTE_CONTROL_1)
1302 if (!CHAR_TABLE_ENTRYP (ann))
1304 write_c_string (" ", printcharfun);
1305 print_internal (XCHARSET_NAME (charset),
1307 write_c_string (" ", printcharfun);
1308 print_internal (ann, printcharfun, 0);
1312 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (ann);
1313 if (XCHARSET_DIMENSION (charset) == 1)
1314 print_chartab_charset_row (charset, -1, cte, printcharfun);
1316 print_chartab_two_byte_charset (charset, cte, printcharfun);
1321 #endif /* non UTF2000 */
1323 write_c_string ("))", printcharfun);
1327 char_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
1329 Lisp_Char_Table *ct1 = XCHAR_TABLE (obj1);
1330 Lisp_Char_Table *ct2 = XCHAR_TABLE (obj2);
1333 if (CHAR_TABLE_TYPE (ct1) != CHAR_TABLE_TYPE (ct2))
1337 for (i = 0; i < 256; i++)
1339 if (!internal_equal (get_byte_table (ct1->table, i),
1340 get_byte_table (ct2->table, i), 0))
1344 for (i = 0; i < NUM_ASCII_CHARS; i++)
1345 if (!internal_equal (ct1->ascii[i], ct2->ascii[i], depth + 1))
1349 for (i = 0; i < NUM_LEADING_BYTES; i++)
1350 if (!internal_equal (ct1->level1[i], ct2->level1[i], depth + 1))
1353 #endif /* non UTF2000 */
1358 static unsigned long
1359 char_table_hash (Lisp_Object obj, int depth)
1361 Lisp_Char_Table *ct = XCHAR_TABLE (obj);
1363 return byte_table_hash (ct->table, depth + 1);
1365 unsigned long hashval = internal_array_hash (ct->ascii, NUM_ASCII_CHARS,
1368 hashval = HASH2 (hashval,
1369 internal_array_hash (ct->level1, NUM_LEADING_BYTES, depth));
1375 static const struct lrecord_description char_table_description[] = {
1377 { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, table) },
1378 { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, default_value) },
1380 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, ascii), NUM_ASCII_CHARS },
1382 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, level1), NUM_LEADING_BYTES },
1386 { XD_LISP_OBJECT, offsetof (Lisp_Char_Table, mirror_table) },
1388 { XD_LO_LINK, offsetof (Lisp_Char_Table, next_table) },
1392 DEFINE_LRECORD_IMPLEMENTATION ("char-table", char_table,
1393 mark_char_table, print_char_table, 0,
1394 char_table_equal, char_table_hash,
1395 char_table_description,
1398 DEFUN ("char-table-p", Fchar_table_p, 1, 1, 0, /*
1399 Return non-nil if OBJECT is a char table.
1401 A char table is a table that maps characters (or ranges of characters)
1402 to values. Char tables are specialized for characters, only allowing
1403 particular sorts of ranges to be assigned values. Although this
1404 loses in generality, it makes for extremely fast (constant-time)
1405 lookups, and thus is feasible for applications that do an extremely
1406 large number of lookups (e.g. scanning a buffer for a character in
1407 a particular syntax, where a lookup in the syntax table must occur
1408 once per character).
1410 When Mule support exists, the types of ranges that can be assigned
1414 -- an entire charset
1415 -- a single row in a two-octet charset
1416 -- a single character
1418 When Mule support is not present, the types of ranges that can be
1422 -- a single character
1424 To create a char table, use `make-char-table'.
1425 To modify a char table, use `put-char-table' or `remove-char-table'.
1426 To retrieve the value for a particular character, use `get-char-table'.
1427 See also `map-char-table', `clear-char-table', `copy-char-table',
1428 `valid-char-table-type-p', `char-table-type-list',
1429 `valid-char-table-value-p', and `check-char-table-value'.
1433 return CHAR_TABLEP (object) ? Qt : Qnil;
1436 DEFUN ("char-table-type-list", Fchar_table_type_list, 0, 0, 0, /*
1437 Return a list of the recognized char table types.
1438 See `valid-char-table-type-p'.
1443 return list5 (Qchar, Qcategory, Qdisplay, Qgeneric, Qsyntax);
1445 return list4 (Qchar, Qdisplay, Qgeneric, Qsyntax);
1449 DEFUN ("valid-char-table-type-p", Fvalid_char_table_type_p, 1, 1, 0, /*
1450 Return t if TYPE if a recognized char table type.
1452 Each char table type is used for a different purpose and allows different
1453 sorts of values. The different char table types are
1456 Used for category tables, which specify the regexp categories
1457 that a character is in. The valid values are nil or a
1458 bit vector of 95 elements. Higher-level Lisp functions are
1459 provided for working with category tables. Currently categories
1460 and category tables only exist when Mule support is present.
1462 A generalized char table, for mapping from one character to
1463 another. Used for case tables, syntax matching tables,
1464 `keyboard-translate-table', etc. The valid values are characters.
1466 An even more generalized char table, for mapping from a
1467 character to anything.
1469 Used for display tables, which specify how a particular character
1470 is to appear when displayed. #### Not yet implemented.
1472 Used for syntax tables, which specify the syntax of a particular
1473 character. Higher-level Lisp functions are provided for
1474 working with syntax tables. The valid values are integers.
1479 return (EQ (type, Qchar) ||
1481 EQ (type, Qcategory) ||
1483 EQ (type, Qdisplay) ||
1484 EQ (type, Qgeneric) ||
1485 EQ (type, Qsyntax)) ? Qt : Qnil;
1488 DEFUN ("char-table-type", Fchar_table_type, 1, 1, 0, /*
1489 Return the type of CHAR-TABLE.
1490 See `valid-char-table-type-p'.
1494 CHECK_CHAR_TABLE (char_table);
1495 return char_table_type_to_symbol (XCHAR_TABLE (char_table)->type);
1499 fill_char_table (Lisp_Char_Table *ct, Lisp_Object value)
1502 ct->table = Qunbound;
1503 ct->default_value = value;
1507 for (i = 0; i < NUM_ASCII_CHARS; i++)
1508 ct->ascii[i] = value;
1510 for (i = 0; i < NUM_LEADING_BYTES; i++)
1511 ct->level1[i] = value;
1516 if (ct->type == CHAR_TABLE_TYPE_SYNTAX)
1517 update_syntax_table (ct);
1521 DEFUN ("reset-char-table", Freset_char_table, 1, 1, 0, /*
1522 Reset CHAR-TABLE to its default state.
1526 Lisp_Char_Table *ct;
1528 CHECK_CHAR_TABLE (char_table);
1529 ct = XCHAR_TABLE (char_table);
1533 case CHAR_TABLE_TYPE_CHAR:
1534 fill_char_table (ct, make_char (0));
1536 case CHAR_TABLE_TYPE_DISPLAY:
1537 case CHAR_TABLE_TYPE_GENERIC:
1539 case CHAR_TABLE_TYPE_CATEGORY:
1541 fill_char_table (ct, Qnil);
1544 case CHAR_TABLE_TYPE_SYNTAX:
1545 fill_char_table (ct, make_int (Sinherit));
1555 DEFUN ("make-char-table", Fmake_char_table, 1, 1, 0, /*
1556 Return a new, empty char table of type TYPE.
1557 Currently recognized types are 'char, 'category, 'display, 'generic,
1558 and 'syntax. See `valid-char-table-type-p'.
1562 Lisp_Char_Table *ct;
1564 enum char_table_type ty = symbol_to_char_table_type (type);
1566 ct = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table);
1569 if (ty == CHAR_TABLE_TYPE_SYNTAX)
1571 ct->mirror_table = Fmake_char_table (Qgeneric);
1572 fill_char_table (XCHAR_TABLE (ct->mirror_table),
1576 ct->mirror_table = Qnil;
1578 ct->next_table = Qnil;
1579 XSETCHAR_TABLE (obj, ct);
1580 if (ty == CHAR_TABLE_TYPE_SYNTAX)
1582 ct->next_table = Vall_syntax_tables;
1583 Vall_syntax_tables = obj;
1585 Freset_char_table (obj);
1589 #if defined(MULE)&&!defined(UTF2000)
1592 make_char_table_entry (Lisp_Object initval)
1596 Lisp_Char_Table_Entry *cte =
1597 alloc_lcrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry);
1599 for (i = 0; i < 96; i++)
1600 cte->level2[i] = initval;
1602 XSETCHAR_TABLE_ENTRY (obj, cte);
1607 copy_char_table_entry (Lisp_Object entry)
1609 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (entry);
1612 Lisp_Char_Table_Entry *ctenew =
1613 alloc_lcrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry);
1615 for (i = 0; i < 96; i++)
1617 Lisp_Object new = cte->level2[i];
1618 if (CHAR_TABLE_ENTRYP (new))
1619 ctenew->level2[i] = copy_char_table_entry (new);
1621 ctenew->level2[i] = new;
1624 XSETCHAR_TABLE_ENTRY (obj, ctenew);
1630 DEFUN ("copy-char-table", Fcopy_char_table, 1, 1, 0, /*
1631 Return a new char table which is a copy of CHAR-TABLE.
1632 It will contain the same values for the same characters and ranges
1633 as CHAR-TABLE. The values will not themselves be copied.
1637 Lisp_Char_Table *ct, *ctnew;
1643 CHECK_CHAR_TABLE (char_table);
1644 ct = XCHAR_TABLE (char_table);
1645 ctnew = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table);
1646 ctnew->type = ct->type;
1648 ctnew->default_value = ct->default_value;
1650 if (UINT8_BYTE_TABLE_P (ct->table))
1652 ctnew->table = copy_uint8_byte_table (ct->table);
1654 else if (UINT16_BYTE_TABLE_P (ct->table))
1656 ctnew->table = copy_uint16_byte_table (ct->table);
1658 else if (BYTE_TABLE_P (ct->table))
1660 ctnew->table = copy_byte_table (ct->table);
1662 else if (!UNBOUNDP (ct->table))
1663 ctnew->table = ct->table;
1664 #else /* non UTF2000 */
1666 for (i = 0; i < NUM_ASCII_CHARS; i++)
1668 Lisp_Object new = ct->ascii[i];
1670 assert (! (CHAR_TABLE_ENTRYP (new)));
1672 ctnew->ascii[i] = new;
1677 for (i = 0; i < NUM_LEADING_BYTES; i++)
1679 Lisp_Object new = ct->level1[i];
1680 if (CHAR_TABLE_ENTRYP (new))
1681 ctnew->level1[i] = copy_char_table_entry (new);
1683 ctnew->level1[i] = new;
1687 #endif /* non UTF2000 */
1690 if (CHAR_TABLEP (ct->mirror_table))
1691 ctnew->mirror_table = Fcopy_char_table (ct->mirror_table);
1693 ctnew->mirror_table = ct->mirror_table;
1695 ctnew->next_table = Qnil;
1696 XSETCHAR_TABLE (obj, ctnew);
1697 if (ctnew->type == CHAR_TABLE_TYPE_SYNTAX)
1699 ctnew->next_table = Vall_syntax_tables;
1700 Vall_syntax_tables = obj;
1705 INLINE_HEADER int XCHARSET_CELL_RANGE (Lisp_Object ccs);
1707 XCHARSET_CELL_RANGE (Lisp_Object ccs)
1709 switch (XCHARSET_CHARS (ccs))
1712 return (33 << 8) | 126;
1714 return (32 << 8) | 127;
1717 return (0 << 8) | 127;
1719 return (0 << 8) | 255;
1731 decode_char_table_range (Lisp_Object range, struct chartab_range *outrange)
1734 outrange->type = CHARTAB_RANGE_ALL;
1735 else if (EQ (range, Qnil))
1736 outrange->type = CHARTAB_RANGE_DEFAULT;
1737 else if (CHAR_OR_CHAR_INTP (range))
1739 outrange->type = CHARTAB_RANGE_CHAR;
1740 outrange->ch = XCHAR_OR_CHAR_INT (range);
1744 signal_simple_error ("Range must be t or a character", range);
1746 else if (VECTORP (range))
1748 Lisp_Vector *vec = XVECTOR (range);
1749 Lisp_Object *elts = vector_data (vec);
1750 int cell_min, cell_max;
1752 outrange->type = CHARTAB_RANGE_ROW;
1753 outrange->charset = Fget_charset (elts[0]);
1754 CHECK_INT (elts[1]);
1755 outrange->row = XINT (elts[1]);
1756 if (XCHARSET_DIMENSION (outrange->charset) < 2)
1757 signal_simple_error ("Charset in row vector must be multi-byte",
1761 int ret = XCHARSET_CELL_RANGE (outrange->charset);
1763 cell_min = ret >> 8;
1764 cell_max = ret & 0xFF;
1766 if (XCHARSET_DIMENSION (outrange->charset) == 2)
1767 check_int_range (outrange->row, cell_min, cell_max);
1769 else if (XCHARSET_DIMENSION (outrange->charset) == 3)
1771 check_int_range (outrange->row >> 8 , cell_min, cell_max);
1772 check_int_range (outrange->row & 0xFF, cell_min, cell_max);
1774 else if (XCHARSET_DIMENSION (outrange->charset) == 4)
1776 check_int_range ( outrange->row >> 16 , cell_min, cell_max);
1777 check_int_range ((outrange->row >> 8) & 0xFF, cell_min, cell_max);
1778 check_int_range ( outrange->row & 0xFF, cell_min, cell_max);
1786 if (!CHARSETP (range) && !SYMBOLP (range))
1788 ("Char table range must be t, charset, char, or vector", range);
1789 outrange->type = CHARTAB_RANGE_CHARSET;
1790 outrange->charset = Fget_charset (range);
1795 #if defined(MULE)&&!defined(UTF2000)
1797 /* called from CHAR_TABLE_VALUE(). */
1799 get_non_ascii_char_table_value (Lisp_Char_Table *ct, Charset_ID leading_byte,
1804 Lisp_Object charset;
1806 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (leading_byte);
1811 BREAKUP_CHAR (c, charset, byte1, byte2);
1813 BREAKUP_CHAR_1_UNSAFE (c, charset, byte1, byte2);
1815 val = ct->level1[leading_byte - MIN_LEADING_BYTE];
1816 if (CHAR_TABLE_ENTRYP (val))
1818 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
1819 val = cte->level2[byte1 - 32];
1820 if (CHAR_TABLE_ENTRYP (val))
1822 cte = XCHAR_TABLE_ENTRY (val);
1823 assert (byte2 >= 32);
1824 val = cte->level2[byte2 - 32];
1825 assert (!CHAR_TABLE_ENTRYP (val));
1835 get_char_table (Emchar ch, Lisp_Char_Table *ct)
1838 return get_char_id_table (ct, ch);
1841 Lisp_Object charset;
1845 BREAKUP_CHAR (ch, charset, byte1, byte2);
1847 if (EQ (charset, Vcharset_ascii))
1848 val = ct->ascii[byte1];
1849 else if (EQ (charset, Vcharset_control_1))
1850 val = ct->ascii[byte1 + 128];
1853 int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE;
1854 val = ct->level1[lb];
1855 if (CHAR_TABLE_ENTRYP (val))
1857 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
1858 val = cte->level2[byte1 - 32];
1859 if (CHAR_TABLE_ENTRYP (val))
1861 cte = XCHAR_TABLE_ENTRY (val);
1862 assert (byte2 >= 32);
1863 val = cte->level2[byte2 - 32];
1864 assert (!CHAR_TABLE_ENTRYP (val));
1871 #else /* not MULE */
1872 return ct->ascii[(unsigned char)ch];
1873 #endif /* not MULE */
1877 DEFUN ("get-char-table", Fget_char_table, 2, 2, 0, /*
1878 Find value for CHARACTER in CHAR-TABLE.
1880 (character, char_table))
1882 CHECK_CHAR_TABLE (char_table);
1883 CHECK_CHAR_COERCE_INT (character);
1885 return get_char_table (XCHAR (character), XCHAR_TABLE (char_table));
1888 DEFUN ("get-range-char-table", Fget_range_char_table, 2, 3, 0, /*
1889 Find value for a range in CHAR-TABLE.
1890 If there is more than one value, return MULTI (defaults to nil).
1892 (range, char_table, multi))
1894 Lisp_Char_Table *ct;
1895 struct chartab_range rainj;
1897 if (CHAR_OR_CHAR_INTP (range))
1898 return Fget_char_table (range, char_table);
1899 CHECK_CHAR_TABLE (char_table);
1900 ct = XCHAR_TABLE (char_table);
1902 decode_char_table_range (range, &rainj);
1905 case CHARTAB_RANGE_ALL:
1908 if (UINT8_BYTE_TABLE_P (ct->table))
1910 else if (UINT16_BYTE_TABLE_P (ct->table))
1912 else if (BYTE_TABLE_P (ct->table))
1916 #else /* non UTF2000 */
1918 Lisp_Object first = ct->ascii[0];
1920 for (i = 1; i < NUM_ASCII_CHARS; i++)
1921 if (!EQ (first, ct->ascii[i]))
1925 for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES;
1928 if (!CHARSETP (CHARSET_BY_LEADING_BYTE (i))
1929 || i == LEADING_BYTE_ASCII
1930 || i == LEADING_BYTE_CONTROL_1)
1932 if (!EQ (first, ct->level1[i - MIN_LEADING_BYTE]))
1938 #endif /* non UTF2000 */
1942 case CHARTAB_RANGE_CHARSET:
1946 if (EQ (rainj.charset, Vcharset_ascii))
1949 Lisp_Object first = ct->ascii[0];
1951 for (i = 1; i < 128; i++)
1952 if (!EQ (first, ct->ascii[i]))
1957 if (EQ (rainj.charset, Vcharset_control_1))
1960 Lisp_Object first = ct->ascii[128];
1962 for (i = 129; i < 160; i++)
1963 if (!EQ (first, ct->ascii[i]))
1969 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (rainj.charset) -
1971 if (CHAR_TABLE_ENTRYP (val))
1977 case CHARTAB_RANGE_ROW:
1982 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (rainj.charset) -
1984 if (!CHAR_TABLE_ENTRYP (val))
1986 val = XCHAR_TABLE_ENTRY (val)->level2[rainj.row - 32];
1987 if (CHAR_TABLE_ENTRYP (val))
1991 #endif /* not UTF2000 */
1992 #endif /* not MULE */
1998 return Qnil; /* not reached */
2002 check_valid_char_table_value (Lisp_Object value, enum char_table_type type,
2003 Error_behavior errb)
2007 case CHAR_TABLE_TYPE_SYNTAX:
2008 if (!ERRB_EQ (errb, ERROR_ME))
2009 return INTP (value) || (CONSP (value) && INTP (XCAR (value))
2010 && CHAR_OR_CHAR_INTP (XCDR (value)));
2013 Lisp_Object cdr = XCDR (value);
2014 CHECK_INT (XCAR (value));
2015 CHECK_CHAR_COERCE_INT (cdr);
2022 case CHAR_TABLE_TYPE_CATEGORY:
2023 if (!ERRB_EQ (errb, ERROR_ME))
2024 return CATEGORY_TABLE_VALUEP (value);
2025 CHECK_CATEGORY_TABLE_VALUE (value);
2029 case CHAR_TABLE_TYPE_GENERIC:
2032 case CHAR_TABLE_TYPE_DISPLAY:
2034 maybe_signal_simple_error ("Display char tables not yet implemented",
2035 value, Qchar_table, errb);
2038 case CHAR_TABLE_TYPE_CHAR:
2039 if (!ERRB_EQ (errb, ERROR_ME))
2040 return CHAR_OR_CHAR_INTP (value);
2041 CHECK_CHAR_COERCE_INT (value);
2048 return 0; /* not reached */
2052 canonicalize_char_table_value (Lisp_Object value, enum char_table_type type)
2056 case CHAR_TABLE_TYPE_SYNTAX:
2059 Lisp_Object car = XCAR (value);
2060 Lisp_Object cdr = XCDR (value);
2061 CHECK_CHAR_COERCE_INT (cdr);
2062 return Fcons (car, cdr);
2065 case CHAR_TABLE_TYPE_CHAR:
2066 CHECK_CHAR_COERCE_INT (value);
2074 DEFUN ("valid-char-table-value-p", Fvalid_char_table_value_p, 2, 2, 0, /*
2075 Return non-nil if VALUE is a valid value for CHAR-TABLE-TYPE.
2077 (value, char_table_type))
2079 enum char_table_type type = symbol_to_char_table_type (char_table_type);
2081 return check_valid_char_table_value (value, type, ERROR_ME_NOT) ? Qt : Qnil;
2084 DEFUN ("check-valid-char-table-value", Fcheck_valid_char_table_value, 2, 2, 0, /*
2085 Signal an error if VALUE is not a valid value for CHAR-TABLE-TYPE.
2087 (value, char_table_type))
2089 enum char_table_type type = symbol_to_char_table_type (char_table_type);
2091 check_valid_char_table_value (value, type, ERROR_ME);
2095 /* Assign VAL to all characters in RANGE in char table CT. */
2098 put_char_table (Lisp_Char_Table *ct, struct chartab_range *range,
2101 switch (range->type)
2103 case CHARTAB_RANGE_ALL:
2104 /* printf ("put-char-table: range = all\n"); */
2105 fill_char_table (ct, val);
2106 return; /* avoid the duplicate call to update_syntax_table() below,
2107 since fill_char_table() also did that. */
2110 case CHARTAB_RANGE_DEFAULT:
2111 ct->default_value = val;
2116 case CHARTAB_RANGE_CHARSET:
2120 Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (range->charset);
2122 /* printf ("put-char-table: range = charset: %d\n",
2123 XCHARSET_LEADING_BYTE (range->charset));
2125 if ( CHAR_TABLEP (encoding_table) )
2127 for (c = 0; c < 1 << 24; c++)
2129 if ( INTP (get_char_id_table (XCHAR_TABLE(encoding_table),
2131 put_char_id_table_0 (ct, c, val);
2136 for (c = 0; c < 1 << 24; c++)
2138 if ( charset_code_point (range->charset, c) >= 0 )
2139 put_char_id_table_0 (ct, c, val);
2144 if (EQ (range->charset, Vcharset_ascii))
2147 for (i = 0; i < 128; i++)
2150 else if (EQ (range->charset, Vcharset_control_1))
2153 for (i = 128; i < 160; i++)
2158 int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE;
2159 ct->level1[lb] = val;
2164 case CHARTAB_RANGE_ROW:
2167 int cell_min, cell_max, i;
2169 i = XCHARSET_CELL_RANGE (range->charset);
2171 cell_max = i & 0xFF;
2172 for (i = cell_min; i <= cell_max; i++)
2174 Emchar ch = DECODE_CHAR (range->charset, (range->row << 8) | i);
2176 if ( charset_code_point (range->charset, ch) >= 0 )
2177 put_char_id_table_0 (ct, ch, val);
2182 Lisp_Char_Table_Entry *cte;
2183 int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE;
2184 /* make sure that there is a separate entry for the row. */
2185 if (!CHAR_TABLE_ENTRYP (ct->level1[lb]))
2186 ct->level1[lb] = make_char_table_entry (ct->level1[lb]);
2187 cte = XCHAR_TABLE_ENTRY (ct->level1[lb]);
2188 cte->level2[range->row - 32] = val;
2190 #endif /* not UTF2000 */
2194 case CHARTAB_RANGE_CHAR:
2196 /* printf ("put-char-table: range = char: 0x%x\n", range->ch); */
2197 put_char_id_table_0 (ct, range->ch, val);
2201 Lisp_Object charset;
2204 BREAKUP_CHAR (range->ch, charset, byte1, byte2);
2205 if (EQ (charset, Vcharset_ascii))
2206 ct->ascii[byte1] = val;
2207 else if (EQ (charset, Vcharset_control_1))
2208 ct->ascii[byte1 + 128] = val;
2211 Lisp_Char_Table_Entry *cte;
2212 int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE;
2213 /* make sure that there is a separate entry for the row. */
2214 if (!CHAR_TABLE_ENTRYP (ct->level1[lb]))
2215 ct->level1[lb] = make_char_table_entry (ct->level1[lb]);
2216 cte = XCHAR_TABLE_ENTRY (ct->level1[lb]);
2217 /* now CTE is a char table entry for the charset;
2218 each entry is for a single row (or character of
2219 a one-octet charset). */
2220 if (XCHARSET_DIMENSION (charset) == 1)
2221 cte->level2[byte1 - 32] = val;
2224 /* assigning to one character in a two-octet charset. */
2225 /* make sure that the charset row contains a separate
2226 entry for each character. */
2227 if (!CHAR_TABLE_ENTRYP (cte->level2[byte1 - 32]))
2228 cte->level2[byte1 - 32] =
2229 make_char_table_entry (cte->level2[byte1 - 32]);
2230 cte = XCHAR_TABLE_ENTRY (cte->level2[byte1 - 32]);
2231 cte->level2[byte2 - 32] = val;
2235 #else /* not MULE */
2236 ct->ascii[(unsigned char) (range->ch)] = val;
2238 #endif /* not MULE */
2242 if (ct->type == CHAR_TABLE_TYPE_SYNTAX)
2243 update_syntax_table (ct);
2247 DEFUN ("put-char-table", Fput_char_table, 3, 3, 0, /*
2248 Set the value for chars in RANGE to be VALUE in CHAR-TABLE.
2250 RANGE specifies one or more characters to be affected and should be
2251 one of the following:
2253 -- t (all characters are affected)
2254 -- A charset (only allowed when Mule support is present)
2255 -- A vector of two elements: a two-octet charset and a row number
2256 (only allowed when Mule support is present)
2257 -- A single character
2259 VALUE must be a value appropriate for the type of CHAR-TABLE.
2260 See `valid-char-table-type-p'.
2262 (range, value, char_table))
2264 Lisp_Char_Table *ct;
2265 struct chartab_range rainj;
2267 CHECK_CHAR_TABLE (char_table);
2268 ct = XCHAR_TABLE (char_table);
2269 check_valid_char_table_value (value, ct->type, ERROR_ME);
2270 decode_char_table_range (range, &rainj);
2271 value = canonicalize_char_table_value (value, ct->type);
2272 put_char_table (ct, &rainj, value);
2277 /* Map FN over the ASCII chars in CT. */
2280 map_over_charset_ascii (Lisp_Char_Table *ct,
2281 int (*fn) (struct chartab_range *range,
2282 Lisp_Object val, void *arg),
2285 struct chartab_range rainj;
2294 rainj.type = CHARTAB_RANGE_CHAR;
2296 for (i = start, retval = 0; i < stop && retval == 0; i++)
2298 rainj.ch = (Emchar) i;
2299 retval = (fn) (&rainj, ct->ascii[i], arg);
2307 /* Map FN over the Control-1 chars in CT. */
2310 map_over_charset_control_1 (Lisp_Char_Table *ct,
2311 int (*fn) (struct chartab_range *range,
2312 Lisp_Object val, void *arg),
2315 struct chartab_range rainj;
2318 int stop = start + 32;
2320 rainj.type = CHARTAB_RANGE_CHAR;
2322 for (i = start, retval = 0; i < stop && retval == 0; i++)
2324 rainj.ch = (Emchar) (i);
2325 retval = (fn) (&rainj, ct->ascii[i], arg);
2331 /* Map FN over the row ROW of two-byte charset CHARSET.
2332 There must be a separate value for that row in the char table.
2333 CTE specifies the char table entry for CHARSET. */
2336 map_over_charset_row (Lisp_Char_Table_Entry *cte,
2337 Lisp_Object charset, int row,
2338 int (*fn) (struct chartab_range *range,
2339 Lisp_Object val, void *arg),
2342 Lisp_Object val = cte->level2[row - 32];
2344 if (!CHAR_TABLE_ENTRYP (val))
2346 struct chartab_range rainj;
2348 rainj.type = CHARTAB_RANGE_ROW;
2349 rainj.charset = charset;
2351 return (fn) (&rainj, val, arg);
2355 struct chartab_range rainj;
2357 int charset94_p = (XCHARSET_CHARS (charset) == 94);
2358 int start = charset94_p ? 33 : 32;
2359 int stop = charset94_p ? 127 : 128;
2361 cte = XCHAR_TABLE_ENTRY (val);
2363 rainj.type = CHARTAB_RANGE_CHAR;
2365 for (i = start, retval = 0; i < stop && retval == 0; i++)
2367 rainj.ch = MAKE_CHAR (charset, row, i);
2368 retval = (fn) (&rainj, cte->level2[i - 32], arg);
2376 map_over_other_charset (Lisp_Char_Table *ct, Charset_ID lb,
2377 int (*fn) (struct chartab_range *range,
2378 Lisp_Object val, void *arg),
2381 Lisp_Object val = ct->level1[lb - MIN_LEADING_BYTE];
2382 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (lb);
2384 if (!CHARSETP (charset)
2385 || lb == LEADING_BYTE_ASCII
2386 || lb == LEADING_BYTE_CONTROL_1)
2389 if (!CHAR_TABLE_ENTRYP (val))
2391 struct chartab_range rainj;
2393 rainj.type = CHARTAB_RANGE_CHARSET;
2394 rainj.charset = charset;
2395 return (fn) (&rainj, val, arg);
2399 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
2400 int charset94_p = (XCHARSET_CHARS (charset) == 94);
2401 int start = charset94_p ? 33 : 32;
2402 int stop = charset94_p ? 127 : 128;
2405 if (XCHARSET_DIMENSION (charset) == 1)
2407 struct chartab_range rainj;
2408 rainj.type = CHARTAB_RANGE_CHAR;
2410 for (i = start, retval = 0; i < stop && retval == 0; i++)
2412 rainj.ch = MAKE_CHAR (charset, i, 0);
2413 retval = (fn) (&rainj, cte->level2[i - 32], arg);
2418 for (i = start, retval = 0; i < stop && retval == 0; i++)
2419 retval = map_over_charset_row (cte, charset, i, fn, arg);
2427 #endif /* not UTF2000 */
2430 struct map_char_table_for_charset_arg
2432 int (*fn) (struct chartab_range *range, Lisp_Object val, void *arg);
2433 Lisp_Char_Table *ct;
2438 map_char_table_for_charset_fun (struct chartab_range *range,
2439 Lisp_Object val, void *arg)
2441 struct map_char_table_for_charset_arg *closure =
2442 (struct map_char_table_for_charset_arg *) arg;
2445 switch (range->type)
2447 case CHARTAB_RANGE_ALL:
2450 case CHARTAB_RANGE_DEFAULT:
2453 case CHARTAB_RANGE_CHARSET:
2456 case CHARTAB_RANGE_ROW:
2459 case CHARTAB_RANGE_CHAR:
2460 ret = get_char_table (range->ch, closure->ct);
2461 if (!UNBOUNDP (ret))
2462 return (closure->fn) (range, ret, closure->arg);
2473 /* Map FN (with client data ARG) over range RANGE in char table CT.
2474 Mapping stops the first time FN returns non-zero, and that value
2475 becomes the return value of map_char_table(). */
2478 map_char_table (Lisp_Char_Table *ct,
2479 struct chartab_range *range,
2480 int (*fn) (struct chartab_range *range,
2481 Lisp_Object val, void *arg),
2484 switch (range->type)
2486 case CHARTAB_RANGE_ALL:
2488 if (!UNBOUNDP (ct->default_value))
2490 struct chartab_range rainj;
2493 rainj.type = CHARTAB_RANGE_DEFAULT;
2494 retval = (fn) (&rainj, ct->default_value, arg);
2498 if (UINT8_BYTE_TABLE_P (ct->table))
2499 return map_over_uint8_byte_table (XUINT8_BYTE_TABLE(ct->table),
2501 else if (UINT16_BYTE_TABLE_P (ct->table))
2502 return map_over_uint16_byte_table (XUINT16_BYTE_TABLE(ct->table),
2504 else if (BYTE_TABLE_P (ct->table))
2505 return map_over_byte_table (XBYTE_TABLE(ct->table),
2507 else if (!UNBOUNDP (ct->table))
2510 struct chartab_range rainj;
2513 Emchar c1 = c + unit;
2516 rainj.type = CHARTAB_RANGE_CHAR;
2518 for (retval = 0; c < c1 && retval == 0; c++)
2521 retval = (fn) (&rainj, ct->table, arg);
2526 return (fn) (range, ct->table, arg);
2533 retval = map_over_charset_ascii (ct, fn, arg);
2537 retval = map_over_charset_control_1 (ct, fn, arg);
2542 Charset_ID start = MIN_LEADING_BYTE;
2543 Charset_ID stop = start + NUM_LEADING_BYTES;
2545 for (i = start, retval = 0; i < stop && retval == 0; i++)
2547 retval = map_over_other_charset (ct, i, fn, arg);
2556 case CHARTAB_RANGE_DEFAULT:
2557 if (!UNBOUNDP (ct->default_value))
2558 return (fn) (range, ct->default_value, arg);
2563 case CHARTAB_RANGE_CHARSET:
2566 Lisp_Object encoding_table
2567 = XCHARSET_ENCODING_TABLE (range->charset);
2569 if (!NILP (encoding_table))
2571 struct chartab_range rainj;
2572 struct map_char_table_for_charset_arg mcarg;
2577 rainj.type = CHARTAB_RANGE_ALL;
2578 return map_char_table (XCHAR_TABLE(encoding_table),
2580 &map_char_table_for_charset_fun,
2586 return map_over_other_charset (ct,
2587 XCHARSET_LEADING_BYTE (range->charset),
2591 case CHARTAB_RANGE_ROW:
2594 int cell_min, cell_max, i;
2596 struct chartab_range rainj;
2598 i = XCHARSET_CELL_RANGE (range->charset);
2600 cell_max = i & 0xFF;
2601 rainj.type = CHARTAB_RANGE_CHAR;
2602 for (retval =0, i = cell_min; i <= cell_max && retval == 0; i++)
2604 Emchar ch = DECODE_CHAR (range->charset, (range->row << 8) | i);
2606 if ( charset_code_point (range->charset, ch) >= 0 )
2609 = get_byte_table (get_byte_table
2613 (unsigned char)(ch >> 24)),
2614 (unsigned char) (ch >> 16)),
2615 (unsigned char) (ch >> 8)),
2616 (unsigned char) ch);
2619 val = ct->default_value;
2621 retval = (fn) (&rainj, val, arg);
2628 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (range->charset)
2629 - MIN_LEADING_BYTE];
2630 if (!CHAR_TABLE_ENTRYP (val))
2632 struct chartab_range rainj;
2634 rainj.type = CHARTAB_RANGE_ROW;
2635 rainj.charset = range->charset;
2636 rainj.row = range->row;
2637 return (fn) (&rainj, val, arg);
2640 return map_over_charset_row (XCHAR_TABLE_ENTRY (val),
2641 range->charset, range->row,
2644 #endif /* not UTF2000 */
2647 case CHARTAB_RANGE_CHAR:
2649 Emchar ch = range->ch;
2650 Lisp_Object val = CHAR_TABLE_VALUE_UNSAFE (ct, ch);
2652 if (!UNBOUNDP (val))
2654 struct chartab_range rainj;
2656 rainj.type = CHARTAB_RANGE_CHAR;
2658 return (fn) (&rainj, val, arg);
2670 struct slow_map_char_table_arg
2672 Lisp_Object function;
2677 slow_map_char_table_fun (struct chartab_range *range,
2678 Lisp_Object val, void *arg)
2680 Lisp_Object ranjarg = Qnil;
2681 struct slow_map_char_table_arg *closure =
2682 (struct slow_map_char_table_arg *) arg;
2684 switch (range->type)
2686 case CHARTAB_RANGE_ALL:
2691 case CHARTAB_RANGE_DEFAULT:
2697 case CHARTAB_RANGE_CHARSET:
2698 ranjarg = XCHARSET_NAME (range->charset);
2701 case CHARTAB_RANGE_ROW:
2702 ranjarg = vector2 (XCHARSET_NAME (range->charset),
2703 make_int (range->row));
2706 case CHARTAB_RANGE_CHAR:
2707 ranjarg = make_char (range->ch);
2713 closure->retval = call2 (closure->function, ranjarg, val);
2714 return !NILP (closure->retval);
2717 DEFUN ("map-char-table", Fmap_char_table, 2, 3, 0, /*
2718 Map FUNCTION over entries in CHAR-TABLE, calling it with two args,
2719 each key and value in the table.
2721 RANGE specifies a subrange to map over and is in the same format as
2722 the RANGE argument to `put-range-table'. If omitted or t, it defaults to
2725 (function, char_table, range))
2727 Lisp_Char_Table *ct;
2728 struct slow_map_char_table_arg slarg;
2729 struct gcpro gcpro1, gcpro2;
2730 struct chartab_range rainj;
2732 CHECK_CHAR_TABLE (char_table);
2733 ct = XCHAR_TABLE (char_table);
2736 decode_char_table_range (range, &rainj);
2737 slarg.function = function;
2738 slarg.retval = Qnil;
2739 GCPRO2 (slarg.function, slarg.retval);
2740 map_char_table (ct, &rainj, slow_map_char_table_fun, &slarg);
2743 return slarg.retval;
2747 /************************************************************************/
2748 /* Character Attributes */
2749 /************************************************************************/
2753 Lisp_Object Vchar_attribute_hash_table;
2755 /* We store the char-attributes in hash tables with the names as the
2756 key and the actual char-id-table object as the value. Occasionally
2757 we need to use them in a list format. These routines provide us
2759 struct char_attribute_list_closure
2761 Lisp_Object *char_attribute_list;
2765 add_char_attribute_to_list_mapper (Lisp_Object key, Lisp_Object value,
2766 void *char_attribute_list_closure)
2768 /* This function can GC */
2769 struct char_attribute_list_closure *calcl
2770 = (struct char_attribute_list_closure*) char_attribute_list_closure;
2771 Lisp_Object *char_attribute_list = calcl->char_attribute_list;
2773 *char_attribute_list = Fcons (key, *char_attribute_list);
2777 DEFUN ("char-attribute-list", Fchar_attribute_list, 0, 0, 0, /*
2778 Return the list of all existing character attributes except coded-charsets.
2782 Lisp_Object char_attribute_list = Qnil;
2783 struct gcpro gcpro1;
2784 struct char_attribute_list_closure char_attribute_list_closure;
2786 GCPRO1 (char_attribute_list);
2787 char_attribute_list_closure.char_attribute_list = &char_attribute_list;
2788 elisp_maphash (add_char_attribute_to_list_mapper,
2789 Vchar_attribute_hash_table,
2790 &char_attribute_list_closure);
2792 return char_attribute_list;
2795 DEFUN ("find-char-attribute-table", Ffind_char_attribute_table, 1, 1, 0, /*
2796 Return char-id-table corresponding to ATTRIBUTE.
2800 return Fgethash (attribute, Vchar_attribute_hash_table, Qnil);
2804 /* We store the char-id-tables in hash tables with the attributes as
2805 the key and the actual char-id-table object as the value. Each
2806 char-id-table stores values of an attribute corresponding with
2807 characters. Occasionally we need to get attributes of a character
2808 in a association-list format. These routines provide us with
2810 struct char_attribute_alist_closure
2813 Lisp_Object *char_attribute_alist;
2817 add_char_attribute_alist_mapper (Lisp_Object key, Lisp_Object value,
2818 void *char_attribute_alist_closure)
2820 /* This function can GC */
2821 struct char_attribute_alist_closure *caacl =
2822 (struct char_attribute_alist_closure*) char_attribute_alist_closure;
2824 = get_char_id_table (XCHAR_TABLE(value), caacl->char_id);
2825 if (!UNBOUNDP (ret))
2827 Lisp_Object *char_attribute_alist = caacl->char_attribute_alist;
2828 *char_attribute_alist
2829 = Fcons (Fcons (key, ret), *char_attribute_alist);
2834 DEFUN ("char-attribute-alist", Fchar_attribute_alist, 1, 1, 0, /*
2835 Return the alist of attributes of CHARACTER.
2839 Lisp_Object alist = Qnil;
2842 CHECK_CHAR (character);
2844 struct gcpro gcpro1;
2845 struct char_attribute_alist_closure char_attribute_alist_closure;
2848 char_attribute_alist_closure.char_id = XCHAR (character);
2849 char_attribute_alist_closure.char_attribute_alist = &alist;
2850 elisp_maphash (add_char_attribute_alist_mapper,
2851 Vchar_attribute_hash_table,
2852 &char_attribute_alist_closure);
2856 for (i = 0; i < countof (chlook->charset_by_leading_byte); i++)
2858 Lisp_Object ccs = chlook->charset_by_leading_byte[i];
2862 Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (ccs);
2865 if ( CHAR_TABLEP (encoding_table)
2867 = get_char_id_table (XCHAR_TABLE(encoding_table),
2868 XCHAR (character))) )
2870 alist = Fcons (Fcons (ccs, cpos), alist);
2877 DEFUN ("get-char-attribute", Fget_char_attribute, 2, 3, 0, /*
2878 Return the value of CHARACTER's ATTRIBUTE.
2879 Return DEFAULT-VALUE if the value is not exist.
2881 (character, attribute, default_value))
2885 CHECK_CHAR (character);
2886 if (!NILP (ccs = Ffind_charset (attribute)))
2888 Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (ccs);
2890 if (CHAR_TABLEP (encoding_table))
2891 return get_char_id_table (XCHAR_TABLE(encoding_table),
2896 Lisp_Object table = Fgethash (attribute,
2897 Vchar_attribute_hash_table,
2899 if (!UNBOUNDP (table))
2901 Lisp_Object ret = get_char_id_table (XCHAR_TABLE(table),
2903 if (!UNBOUNDP (ret))
2907 return default_value;
2910 DEFUN ("put-char-attribute", Fput_char_attribute, 3, 3, 0, /*
2911 Store CHARACTER's ATTRIBUTE with VALUE.
2913 (character, attribute, value))
2917 ccs = Ffind_charset (attribute);
2920 CHECK_CHAR (character);
2921 return put_char_ccs_code_point (character, ccs, value);
2923 else if (EQ (attribute, Q_decomposition))
2927 CHECK_CHAR (character);
2929 signal_simple_error ("Invalid value for ->decomposition",
2932 if (CONSP (Fcdr (value)))
2934 Lisp_Object rest = value;
2935 Lisp_Object table = Vcharacter_composition_table;
2939 GET_EXTERNAL_LIST_LENGTH (rest, len);
2940 seq = make_vector (len, Qnil);
2942 while (CONSP (rest))
2944 Lisp_Object v = Fcar (rest);
2947 = to_char_id (v, "Invalid value for ->decomposition", value);
2950 XVECTOR_DATA(seq)[i++] = v;
2952 XVECTOR_DATA(seq)[i++] = make_char (c);
2956 put_char_id_table (XCHAR_TABLE(table),
2957 make_char (c), character);
2962 ntable = get_char_id_table (XCHAR_TABLE(table), c);
2963 if (!CHAR_TABLEP (ntable))
2965 ntable = make_char_id_table (Qnil);
2966 put_char_id_table (XCHAR_TABLE(table),
2967 make_char (c), ntable);
2975 Lisp_Object v = Fcar (value);
2979 Emchar c = XINT (v);
2981 = get_char_id_table (XCHAR_TABLE(Vcharacter_variant_table),
2984 if (NILP (Fmemq (v, ret)))
2986 put_char_id_table (XCHAR_TABLE(Vcharacter_variant_table),
2987 make_char (c), Fcons (character, ret));
2990 seq = make_vector (1, v);
2994 else if (EQ (attribute, Qto_ucs) || EQ (attribute, Q_ucs))
2999 CHECK_CHAR (character);
3001 signal_simple_error ("Invalid value for ->ucs", value);
3005 ret = get_char_id_table (XCHAR_TABLE(Vcharacter_variant_table), c);
3006 if (NILP (Fmemq (character, ret)))
3008 put_char_id_table (XCHAR_TABLE(Vcharacter_variant_table),
3009 make_char (c), Fcons (character, ret));
3012 if (EQ (attribute, Q_ucs))
3013 attribute = Qto_ucs;
3017 Lisp_Object table = Fgethash (attribute,
3018 Vchar_attribute_hash_table,
3023 table = make_char_id_table (Qunbound);
3024 Fputhash (attribute, table, Vchar_attribute_hash_table);
3026 put_char_id_table (XCHAR_TABLE(table), character, value);
3031 DEFUN ("remove-char-attribute", Fremove_char_attribute, 2, 2, 0, /*
3032 Remove CHARACTER's ATTRIBUTE.
3034 (character, attribute))
3038 CHECK_CHAR (character);
3039 ccs = Ffind_charset (attribute);
3042 return remove_char_ccs (character, ccs);
3046 Lisp_Object table = Fgethash (attribute,
3047 Vchar_attribute_hash_table,
3049 if (!UNBOUNDP (table))
3051 put_char_id_table (XCHAR_TABLE(table), character, Qunbound);
3058 DEFUN ("map-char-attribute", Fmap_char_attribute, 2, 3, 0, /*
3059 Map FUNCTION over entries in ATTRIBUTE, calling it with two args,
3060 each key and value in the table.
3062 RANGE specifies a subrange to map over and is in the same format as
3063 the RANGE argument to `put-range-table'. If omitted or t, it defaults to
3066 (function, attribute, range))
3069 Lisp_Char_Table *ct;
3070 struct slow_map_char_table_arg slarg;
3071 struct gcpro gcpro1, gcpro2;
3072 struct chartab_range rainj;
3074 if (!NILP (ccs = Ffind_charset (attribute)))
3076 Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (ccs);
3078 if (CHAR_TABLEP (encoding_table))
3079 ct = XCHAR_TABLE (encoding_table);
3085 Lisp_Object table = Fgethash (attribute,
3086 Vchar_attribute_hash_table,
3088 if (CHAR_TABLEP (table))
3089 ct = XCHAR_TABLE (table);
3095 decode_char_table_range (range, &rainj);
3096 slarg.function = function;
3097 slarg.retval = Qnil;
3098 GCPRO2 (slarg.function, slarg.retval);
3099 map_char_table (ct, &rainj, slow_map_char_table_fun, &slarg);
3102 return slarg.retval;
3105 EXFUN (Fmake_char, 3);
3106 EXFUN (Fdecode_char, 2);
3108 DEFUN ("define-char", Fdefine_char, 1, 1, 0, /*
3109 Store character's ATTRIBUTES.
3113 Lisp_Object rest = attributes;
3114 Lisp_Object code = Fcdr (Fassq (Qucs, attributes));
3115 Lisp_Object character;
3119 while (CONSP (rest))
3121 Lisp_Object cell = Fcar (rest);
3125 signal_simple_error ("Invalid argument", attributes);
3126 if (!NILP (ccs = Ffind_charset (Fcar (cell)))
3127 && ((XCHARSET_FINAL (ccs) != 0) ||
3128 (XCHARSET_UCS_MAX (ccs) > 0)) )
3132 character = Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
3134 character = Fdecode_char (ccs, cell);
3135 if (!NILP (character))
3136 goto setup_attributes;
3140 if ( (!NILP (code = Fcdr (Fassq (Qto_ucs, attributes)))) ||
3141 (!NILP (code = Fcdr (Fassq (Q_ucs, attributes)))) )
3145 signal_simple_error ("Invalid argument", attributes);
3147 character = make_char (XINT (code) + 0x100000);
3148 goto setup_attributes;
3152 else if (!INTP (code))
3153 signal_simple_error ("Invalid argument", attributes);
3155 character = make_char (XINT (code));
3159 while (CONSP (rest))
3161 Lisp_Object cell = Fcar (rest);
3164 signal_simple_error ("Invalid argument", attributes);
3166 Fput_char_attribute (character, Fcar (cell), Fcdr (cell));
3172 DEFUN ("find-char", Ffind_char, 1, 1, 0, /*
3173 Retrieve the character of the given ATTRIBUTES.
3177 Lisp_Object rest = attributes;
3180 while (CONSP (rest))
3182 Lisp_Object cell = Fcar (rest);
3186 signal_simple_error ("Invalid argument", attributes);
3187 if (!NILP (ccs = Ffind_charset (Fcar (cell))))
3191 return Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
3193 return Fdecode_char (ccs, cell);
3197 if ( (!NILP (code = Fcdr (Fassq (Qto_ucs, attributes)))) ||
3198 (!NILP (code = Fcdr (Fassq (Q_ucs, attributes)))) )
3201 signal_simple_error ("Invalid argument", attributes);
3203 return make_char (XINT (code) + 0x100000);
3211 /************************************************************************/
3212 /* Char table read syntax */
3213 /************************************************************************/
3216 chartab_type_validate (Lisp_Object keyword, Lisp_Object value,
3217 Error_behavior errb)
3219 /* #### should deal with ERRB */
3220 symbol_to_char_table_type (value);
3225 chartab_data_validate (Lisp_Object keyword, Lisp_Object value,
3226 Error_behavior errb)
3230 /* #### should deal with ERRB */
3231 EXTERNAL_LIST_LOOP (rest, value)
3233 Lisp_Object range = XCAR (rest);
3234 struct chartab_range dummy;
3238 signal_simple_error ("Invalid list format", value);
3241 if (!CONSP (XCDR (range))
3242 || !NILP (XCDR (XCDR (range))))
3243 signal_simple_error ("Invalid range format", range);
3244 decode_char_table_range (XCAR (range), &dummy);
3245 decode_char_table_range (XCAR (XCDR (range)), &dummy);
3248 decode_char_table_range (range, &dummy);
3255 chartab_instantiate (Lisp_Object data)
3257 Lisp_Object chartab;
3258 Lisp_Object type = Qgeneric;
3259 Lisp_Object dataval = Qnil;
3261 while (!NILP (data))
3263 Lisp_Object keyw = Fcar (data);
3269 if (EQ (keyw, Qtype))
3271 else if (EQ (keyw, Qdata))
3275 chartab = Fmake_char_table (type);
3278 while (!NILP (data))
3280 Lisp_Object range = Fcar (data);
3281 Lisp_Object val = Fcar (Fcdr (data));
3283 data = Fcdr (Fcdr (data));
3286 if (CHAR_OR_CHAR_INTP (XCAR (range)))
3288 Emchar first = XCHAR_OR_CHAR_INT (Fcar (range));
3289 Emchar last = XCHAR_OR_CHAR_INT (Fcar (Fcdr (range)));
3292 for (i = first; i <= last; i++)
3293 Fput_char_table (make_char (i), val, chartab);
3299 Fput_char_table (range, val, chartab);
3308 /************************************************************************/
3309 /* Category Tables, specifically */
3310 /************************************************************************/
3312 DEFUN ("category-table-p", Fcategory_table_p, 1, 1, 0, /*
3313 Return t if OBJECT is a category table.
3314 A category table is a type of char table used for keeping track of
3315 categories. Categories are used for classifying characters for use
3316 in regexps -- you can refer to a category rather than having to use
3317 a complicated [] expression (and category lookups are significantly
3320 There are 95 different categories available, one for each printable
3321 character (including space) in the ASCII charset. Each category
3322 is designated by one such character, called a "category designator".
3323 They are specified in a regexp using the syntax "\\cX", where X is
3324 a category designator.
3326 A category table specifies, for each character, the categories that
3327 the character is in. Note that a character can be in more than one
3328 category. More specifically, a category table maps from a character
3329 to either the value nil (meaning the character is in no categories)
3330 or a 95-element bit vector, specifying for each of the 95 categories
3331 whether the character is in that category.
3333 Special Lisp functions are provided that abstract this, so you do not
3334 have to directly manipulate bit vectors.
3338 return (CHAR_TABLEP (object) &&
3339 XCHAR_TABLE_TYPE (object) == CHAR_TABLE_TYPE_CATEGORY) ?
3344 check_category_table (Lisp_Object object, Lisp_Object default_)
3348 while (NILP (Fcategory_table_p (object)))
3349 object = wrong_type_argument (Qcategory_table_p, object);
3354 check_category_char (Emchar ch, Lisp_Object table,
3355 unsigned int designator, unsigned int not)
3357 REGISTER Lisp_Object temp;
3358 Lisp_Char_Table *ctbl;
3359 #ifdef ERROR_CHECK_TYPECHECK
3360 if (NILP (Fcategory_table_p (table)))
3361 signal_simple_error ("Expected category table", table);
3363 ctbl = XCHAR_TABLE (table);
3364 temp = get_char_table (ch, ctbl);
3369 return bit_vector_bit (XBIT_VECTOR (temp), designator) ? !not : not;
3372 DEFUN ("check-category-at", Fcheck_category_at, 2, 4, 0, /*
3373 Return t if category of the character at POSITION includes DESIGNATOR.
3374 Optional third arg BUFFER specifies which buffer to use, and defaults
3375 to the current buffer.
3376 Optional fourth arg CATEGORY-TABLE specifies the category table to
3377 use, and defaults to BUFFER's category table.
3379 (position, designator, buffer, category_table))
3384 struct buffer *buf = decode_buffer (buffer, 0);
3386 CHECK_INT (position);
3387 CHECK_CATEGORY_DESIGNATOR (designator);
3388 des = XCHAR (designator);
3389 ctbl = check_category_table (category_table, Vstandard_category_table);
3390 ch = BUF_FETCH_CHAR (buf, XINT (position));
3391 return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil;
3394 DEFUN ("char-in-category-p", Fchar_in_category_p, 2, 3, 0, /*
3395 Return t if category of CHARACTER includes DESIGNATOR, else nil.
3396 Optional third arg CATEGORY-TABLE specifies the category table to use,
3397 and defaults to the standard category table.
3399 (character, designator, category_table))
3405 CHECK_CATEGORY_DESIGNATOR (designator);
3406 des = XCHAR (designator);
3407 CHECK_CHAR (character);
3408 ch = XCHAR (character);
3409 ctbl = check_category_table (category_table, Vstandard_category_table);
3410 return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil;
3413 DEFUN ("category-table", Fcategory_table, 0, 1, 0, /*
3414 Return BUFFER's current category table.
3415 BUFFER defaults to the current buffer.
3419 return decode_buffer (buffer, 0)->category_table;
3422 DEFUN ("standard-category-table", Fstandard_category_table, 0, 0, 0, /*
3423 Return the standard category table.
3424 This is the one used for new buffers.
3428 return Vstandard_category_table;
3431 DEFUN ("copy-category-table", Fcopy_category_table, 0, 1, 0, /*
3432 Return a new category table which is a copy of CATEGORY-TABLE.
3433 CATEGORY-TABLE defaults to the standard category table.
3437 if (NILP (Vstandard_category_table))
3438 return Fmake_char_table (Qcategory);
3441 check_category_table (category_table, Vstandard_category_table);
3442 return Fcopy_char_table (category_table);
3445 DEFUN ("set-category-table", Fset_category_table, 1, 2, 0, /*
3446 Select CATEGORY-TABLE as the new category table for BUFFER.
3447 BUFFER defaults to the current buffer if omitted.
3449 (category_table, buffer))
3451 struct buffer *buf = decode_buffer (buffer, 0);
3452 category_table = check_category_table (category_table, Qnil);
3453 buf->category_table = category_table;
3454 /* Indicate that this buffer now has a specified category table. */
3455 buf->local_var_flags |= XINT (buffer_local_flags.category_table);
3456 return category_table;
3459 DEFUN ("category-designator-p", Fcategory_designator_p, 1, 1, 0, /*
3460 Return t if OBJECT is a category designator (a char in the range ' ' to '~').
3464 return CATEGORY_DESIGNATORP (object) ? Qt : Qnil;
3467 DEFUN ("category-table-value-p", Fcategory_table_value_p, 1, 1, 0, /*
3468 Return t if OBJECT is a category table value.
3469 Valid values are nil or a bit vector of size 95.
3473 return CATEGORY_TABLE_VALUEP (object) ? Qt : Qnil;
3477 #define CATEGORYP(x) \
3478 (CHARP (x) && XCHAR (x) >= 0x20 && XCHAR (x) <= 0x7E)
3480 #define CATEGORY_SET(c) \
3481 (get_char_table(c, XCHAR_TABLE(current_buffer->category_table)))
3483 /* Return 1 if CATEGORY_SET contains CATEGORY, else return 0.
3484 The faster version of `!NILP (Faref (category_set, category))'. */
3485 #define CATEGORY_MEMBER(category, category_set) \
3486 (bit_vector_bit(XBIT_VECTOR (category_set), category - 32))
3488 /* Return 1 if there is a word boundary between two word-constituent
3489 characters C1 and C2 if they appear in this order, else return 0.
3490 Use the macro WORD_BOUNDARY_P instead of calling this function
3493 int word_boundary_p (Emchar c1, Emchar c2);
3495 word_boundary_p (Emchar c1, Emchar c2)
3497 Lisp_Object category_set1, category_set2;
3502 if (COMPOSITE_CHAR_P (c1))
3503 c1 = cmpchar_component (c1, 0, 1);
3504 if (COMPOSITE_CHAR_P (c2))
3505 c2 = cmpchar_component (c2, 0, 1);
3508 if (EQ (CHAR_CHARSET (c1), CHAR_CHARSET (c2)))
3510 tail = Vword_separating_categories;
3515 tail = Vword_combining_categories;
3519 category_set1 = CATEGORY_SET (c1);
3520 if (NILP (category_set1))
3521 return default_result;
3522 category_set2 = CATEGORY_SET (c2);
3523 if (NILP (category_set2))
3524 return default_result;
3526 for (; CONSP (tail); tail = XCONS (tail)->cdr)
3528 Lisp_Object elt = XCONS(tail)->car;
3531 && CATEGORYP (XCONS (elt)->car)
3532 && CATEGORYP (XCONS (elt)->cdr)
3533 && CATEGORY_MEMBER (XCHAR (XCONS (elt)->car), category_set1)
3534 && CATEGORY_MEMBER (XCHAR (XCONS (elt)->cdr), category_set2))
3535 return !default_result;
3537 return default_result;
3543 syms_of_chartab (void)
3546 INIT_LRECORD_IMPLEMENTATION (uint8_byte_table);
3547 INIT_LRECORD_IMPLEMENTATION (uint16_byte_table);
3548 INIT_LRECORD_IMPLEMENTATION (byte_table);
3550 defsymbol (&Qto_ucs, "=>ucs");
3551 defsymbol (&Q_ucs, "->ucs");
3552 defsymbol (&Q_decomposition, "->decomposition");
3553 defsymbol (&Qcompat, "compat");
3554 defsymbol (&Qisolated, "isolated");
3555 defsymbol (&Qinitial, "initial");
3556 defsymbol (&Qmedial, "medial");
3557 defsymbol (&Qfinal, "final");
3558 defsymbol (&Qvertical, "vertical");
3559 defsymbol (&QnoBreak, "noBreak");
3560 defsymbol (&Qfraction, "fraction");
3561 defsymbol (&Qsuper, "super");
3562 defsymbol (&Qsub, "sub");
3563 defsymbol (&Qcircle, "circle");
3564 defsymbol (&Qsquare, "square");
3565 defsymbol (&Qwide, "wide");
3566 defsymbol (&Qnarrow, "narrow");
3567 defsymbol (&Qsmall, "small");
3568 defsymbol (&Qfont, "font");
3570 DEFSUBR (Fchar_attribute_list);
3571 DEFSUBR (Ffind_char_attribute_table);
3572 DEFSUBR (Fchar_attribute_alist);
3573 DEFSUBR (Fget_char_attribute);
3574 DEFSUBR (Fput_char_attribute);
3575 DEFSUBR (Fremove_char_attribute);
3576 DEFSUBR (Fmap_char_attribute);
3577 DEFSUBR (Fdefine_char);
3578 DEFSUBR (Ffind_char);
3579 DEFSUBR (Fchar_variants);
3581 DEFSUBR (Fget_composite_char);
3584 INIT_LRECORD_IMPLEMENTATION (char_table);
3588 INIT_LRECORD_IMPLEMENTATION (char_table_entry);
3591 defsymbol (&Qcategory_table_p, "category-table-p");
3592 defsymbol (&Qcategory_designator_p, "category-designator-p");
3593 defsymbol (&Qcategory_table_value_p, "category-table-value-p");
3596 defsymbol (&Qchar_table, "char-table");
3597 defsymbol (&Qchar_tablep, "char-table-p");
3599 DEFSUBR (Fchar_table_p);
3600 DEFSUBR (Fchar_table_type_list);
3601 DEFSUBR (Fvalid_char_table_type_p);
3602 DEFSUBR (Fchar_table_type);
3603 DEFSUBR (Freset_char_table);
3604 DEFSUBR (Fmake_char_table);
3605 DEFSUBR (Fcopy_char_table);
3606 DEFSUBR (Fget_char_table);
3607 DEFSUBR (Fget_range_char_table);
3608 DEFSUBR (Fvalid_char_table_value_p);
3609 DEFSUBR (Fcheck_valid_char_table_value);
3610 DEFSUBR (Fput_char_table);
3611 DEFSUBR (Fmap_char_table);
3614 DEFSUBR (Fcategory_table_p);
3615 DEFSUBR (Fcategory_table);
3616 DEFSUBR (Fstandard_category_table);
3617 DEFSUBR (Fcopy_category_table);
3618 DEFSUBR (Fset_category_table);
3619 DEFSUBR (Fcheck_category_at);
3620 DEFSUBR (Fchar_in_category_p);
3621 DEFSUBR (Fcategory_designator_p);
3622 DEFSUBR (Fcategory_table_value_p);
3628 vars_of_chartab (void)
3631 Vutf_2000_version = build_string("0.18 (Yamato-Koizumi)");
3632 DEFVAR_LISP ("utf-2000-version", &Vutf_2000_version /*
3633 Version number of XEmacs UTF-2000.
3636 staticpro (&Vcharacter_composition_table);
3637 Vcharacter_composition_table = make_char_id_table (Qnil);
3639 staticpro (&Vcharacter_variant_table);
3640 Vcharacter_variant_table = make_char_id_table (Qnil);
3642 /* DO NOT staticpro this. It works just like Vweak_hash_tables. */
3643 Vall_syntax_tables = Qnil;
3644 dump_add_weak_object_chain (&Vall_syntax_tables);
3648 structure_type_create_chartab (void)
3650 struct structure_type *st;
3652 st = define_structure_type (Qchar_table, 0, chartab_instantiate);
3654 define_structure_type_keyword (st, Qtype, chartab_type_validate);
3655 define_structure_type_keyword (st, Qdata, chartab_data_validate);
3659 complex_vars_of_chartab (void)
3662 staticpro (&Vchar_attribute_hash_table);
3663 Vchar_attribute_hash_table
3664 = make_lisp_hash_table (16, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
3665 #endif /* UTF2000 */
3667 /* Set this now, so first buffer creation can refer to it. */
3668 /* Make it nil before calling copy-category-table
3669 so that copy-category-table will know not to try to copy from garbage */
3670 Vstandard_category_table = Qnil;
3671 Vstandard_category_table = Fcopy_category_table (Qnil);
3672 staticpro (&Vstandard_category_table);
3674 DEFVAR_LISP ("word-combining-categories", &Vword_combining_categories /*
3675 List of pair (cons) of categories to determine word boundary.
3677 Emacs treats a sequence of word constituent characters as a single
3678 word (i.e. finds no word boundary between them) iff they belongs to
3679 the same charset. But, exceptions are allowed in the following cases.
3681 \(1) The case that characters are in different charsets is controlled
3682 by the variable `word-combining-categories'.
3684 Emacs finds no word boundary between characters of different charsets
3685 if they have categories matching some element of this list.
3687 More precisely, if an element of this list is a cons of category CAT1
3688 and CAT2, and a multibyte character C1 which has CAT1 is followed by
3689 C2 which has CAT2, there's no word boundary between C1 and C2.
3691 For instance, to tell that ASCII characters and Latin-1 characters can
3692 form a single word, the element `(?l . ?l)' should be in this list
3693 because both characters have the category `l' (Latin characters).
3695 \(2) The case that character are in the same charset is controlled by
3696 the variable `word-separating-categories'.
3698 Emacs find a word boundary between characters of the same charset
3699 if they have categories matching some element of this list.
3701 More precisely, if an element of this list is a cons of category CAT1
3702 and CAT2, and a multibyte character C1 which has CAT1 is followed by
3703 C2 which has CAT2, there's a word boundary between C1 and C2.
3705 For instance, to tell that there's a word boundary between Japanese
3706 Hiragana and Japanese Kanji (both are in the same charset), the
3707 element `(?H . ?C) should be in this list.
3710 Vword_combining_categories = Qnil;
3712 DEFVAR_LISP ("word-separating-categories", &Vword_separating_categories /*
3713 List of pair (cons) of categories to determine word boundary.
3714 See the documentation of the variable `word-combining-categories'.
3717 Vword_separating_categories = Qnil;