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 static const struct lrecord_description uint8_byte_table_description[] = {
197 DEFINE_LRECORD_IMPLEMENTATION ("uint8-byte-table", uint8_byte_table,
198 mark_uint8_byte_table,
199 print_uint8_byte_table,
200 0, uint8_byte_table_equal,
201 uint8_byte_table_hash,
202 uint8_byte_table_description,
203 Lisp_Uint8_Byte_Table);
206 make_uint8_byte_table (unsigned char initval)
210 Lisp_Uint8_Byte_Table *cte;
212 cte = alloc_lcrecord_type (Lisp_Uint8_Byte_Table,
213 &lrecord_uint8_byte_table);
215 for (i = 0; i < 256; i++)
216 cte->property[i] = initval;
218 XSETUINT8_BYTE_TABLE (obj, cte);
223 copy_uint8_byte_table (Lisp_Object entry)
225 Lisp_Uint8_Byte_Table *cte = XUINT8_BYTE_TABLE (entry);
228 Lisp_Uint8_Byte_Table *ctenew
229 = alloc_lcrecord_type (Lisp_Uint8_Byte_Table,
230 &lrecord_uint8_byte_table);
232 for (i = 0; i < 256; i++)
234 ctenew->property[i] = cte->property[i];
237 XSETUINT8_BYTE_TABLE (obj, ctenew);
242 uint8_byte_table_same_value_p (Lisp_Object obj)
244 Lisp_Uint8_Byte_Table *bte = XUINT8_BYTE_TABLE (obj);
245 unsigned char v0 = bte->property[0];
248 for (i = 1; i < 256; i++)
250 if (bte->property[i] != v0)
257 map_over_uint8_byte_table (Lisp_Uint8_Byte_Table *ct, Emchar ofs, int place,
258 int (*fn) (struct chartab_range *range,
259 Lisp_Object val, void *arg),
262 struct chartab_range rainj;
264 int unit = 1 << (8 * place);
268 rainj.type = CHARTAB_RANGE_CHAR;
270 for (i = 0, retval = 0; i < 256 && retval == 0; i++)
272 if (ct->property[i] != BT_UINT8_unbound)
275 for (; c < c1 && retval == 0; c++)
278 retval = (fn) (&rainj, UINT8_DECODE (ct->property[i]), arg);
287 #define BT_UINT16_MIN 0
288 #define BT_UINT16_MAX (USHRT_MAX - 3)
289 #define BT_UINT16_t (USHRT_MAX - 2)
290 #define BT_UINT16_nil (USHRT_MAX - 1)
291 #define BT_UINT16_unbound USHRT_MAX
293 INLINE_HEADER int INT_UINT16_P (Lisp_Object obj);
294 INLINE_HEADER int UINT16_VALUE_P (Lisp_Object obj);
295 INLINE_HEADER unsigned short UINT16_ENCODE (Lisp_Object obj);
296 INLINE_HEADER Lisp_Object UINT16_DECODE (unsigned short us);
299 INT_UINT16_P (Lisp_Object obj)
303 int num = XINT (obj);
305 return (BT_UINT16_MIN <= num) && (num <= BT_UINT16_MAX);
312 UINT16_VALUE_P (Lisp_Object obj)
314 return EQ (obj, Qunbound)
315 || EQ (obj, Qnil) || EQ (obj, Qt) || INT_UINT16_P (obj);
318 INLINE_HEADER unsigned short
319 UINT16_ENCODE (Lisp_Object obj)
321 if (EQ (obj, Qunbound))
322 return BT_UINT16_unbound;
323 else if (EQ (obj, Qnil))
324 return BT_UINT16_nil;
325 else if (EQ (obj, Qt))
331 INLINE_HEADER Lisp_Object
332 UINT16_DECODE (unsigned short n)
334 if (n == BT_UINT16_unbound)
336 else if (n == BT_UINT16_nil)
338 else if (n == BT_UINT16_t)
344 INLINE_HEADER unsigned short
345 UINT8_TO_UINT16 (unsigned char n)
347 if (n == BT_UINT8_unbound)
348 return BT_UINT16_unbound;
349 else if (n == BT_UINT8_nil)
350 return BT_UINT16_nil;
351 else if (n == BT_UINT8_t)
358 mark_uint16_byte_table (Lisp_Object obj)
364 print_uint16_byte_table (Lisp_Object obj,
365 Lisp_Object printcharfun, int escapeflag)
367 Lisp_Uint16_Byte_Table *bte = XUINT16_BYTE_TABLE (obj);
369 struct gcpro gcpro1, gcpro2;
370 GCPRO2 (obj, printcharfun);
372 write_c_string ("\n#<uint16-byte-table", printcharfun);
373 for (i = 0; i < 256; i++)
375 unsigned short n = bte->property[i];
377 write_c_string ("\n ", printcharfun);
378 write_c_string (" ", printcharfun);
379 if (n == BT_UINT16_unbound)
380 write_c_string ("void", printcharfun);
381 else if (n == BT_UINT16_nil)
382 write_c_string ("nil", printcharfun);
383 else if (n == BT_UINT16_t)
384 write_c_string ("t", printcharfun);
389 sprintf (buf, "%hd", n);
390 write_c_string (buf, printcharfun);
394 write_c_string (">", printcharfun);
398 uint16_byte_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
400 Lisp_Uint16_Byte_Table *te1 = XUINT16_BYTE_TABLE (obj1);
401 Lisp_Uint16_Byte_Table *te2 = XUINT16_BYTE_TABLE (obj2);
404 for (i = 0; i < 256; i++)
405 if (te1->property[i] != te2->property[i])
411 uint16_byte_table_hash (Lisp_Object obj, int depth)
413 Lisp_Uint16_Byte_Table *te = XUINT16_BYTE_TABLE (obj);
417 for (i = 0; i < 256; i++)
418 hash = HASH2 (hash, te->property[i]);
422 static const struct lrecord_description uint16_byte_table_description[] = {
426 DEFINE_LRECORD_IMPLEMENTATION ("uint16-byte-table", uint16_byte_table,
427 mark_uint16_byte_table,
428 print_uint16_byte_table,
429 0, uint16_byte_table_equal,
430 uint16_byte_table_hash,
431 uint16_byte_table_description,
432 Lisp_Uint16_Byte_Table);
435 make_uint16_byte_table (unsigned short initval)
439 Lisp_Uint16_Byte_Table *cte;
441 cte = alloc_lcrecord_type (Lisp_Uint16_Byte_Table,
442 &lrecord_uint16_byte_table);
444 for (i = 0; i < 256; i++)
445 cte->property[i] = initval;
447 XSETUINT16_BYTE_TABLE (obj, cte);
452 copy_uint16_byte_table (Lisp_Object entry)
454 Lisp_Uint16_Byte_Table *cte = XUINT16_BYTE_TABLE (entry);
457 Lisp_Uint16_Byte_Table *ctenew
458 = alloc_lcrecord_type (Lisp_Uint16_Byte_Table,
459 &lrecord_uint16_byte_table);
461 for (i = 0; i < 256; i++)
463 ctenew->property[i] = cte->property[i];
466 XSETUINT16_BYTE_TABLE (obj, ctenew);
471 expand_uint8_byte_table_to_uint16 (Lisp_Object table)
475 Lisp_Uint8_Byte_Table* bte = XUINT8_BYTE_TABLE(table);
476 Lisp_Uint16_Byte_Table* cte;
478 cte = alloc_lcrecord_type (Lisp_Uint16_Byte_Table,
479 &lrecord_uint16_byte_table);
480 for (i = 0; i < 256; i++)
482 cte->property[i] = UINT8_TO_UINT16 (bte->property[i]);
484 XSETUINT16_BYTE_TABLE (obj, cte);
489 uint16_byte_table_same_value_p (Lisp_Object obj)
491 Lisp_Uint16_Byte_Table *bte = XUINT16_BYTE_TABLE (obj);
492 unsigned short v0 = bte->property[0];
495 for (i = 1; i < 256; i++)
497 if (bte->property[i] != v0)
504 map_over_uint16_byte_table (Lisp_Uint16_Byte_Table *ct, Emchar ofs, int place,
505 int (*fn) (struct chartab_range *range,
506 Lisp_Object val, void *arg),
509 struct chartab_range rainj;
511 int unit = 1 << (8 * place);
515 rainj.type = CHARTAB_RANGE_CHAR;
517 for (i = 0, retval = 0; i < 256 && retval == 0; i++)
519 if (ct->property[i] != BT_UINT16_unbound)
522 for (; c < c1 && retval == 0; c++)
525 retval = (fn) (&rainj, UINT16_DECODE (ct->property[i]), arg);
536 mark_byte_table (Lisp_Object obj)
538 Lisp_Byte_Table *cte = XBYTE_TABLE (obj);
541 for (i = 0; i < 256; i++)
543 mark_object (cte->property[i]);
549 print_byte_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
551 Lisp_Byte_Table *bte = XBYTE_TABLE (obj);
553 struct gcpro gcpro1, gcpro2;
554 GCPRO2 (obj, printcharfun);
556 write_c_string ("\n#<byte-table", printcharfun);
557 for (i = 0; i < 256; i++)
559 Lisp_Object elt = bte->property[i];
561 write_c_string ("\n ", printcharfun);
562 write_c_string (" ", printcharfun);
563 if (EQ (elt, Qunbound))
564 write_c_string ("void", printcharfun);
566 print_internal (elt, printcharfun, escapeflag);
569 write_c_string (">", printcharfun);
573 byte_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
575 Lisp_Byte_Table *cte1 = XBYTE_TABLE (obj1);
576 Lisp_Byte_Table *cte2 = XBYTE_TABLE (obj2);
579 for (i = 0; i < 256; i++)
580 if (BYTE_TABLE_P (cte1->property[i]))
582 if (BYTE_TABLE_P (cte2->property[i]))
584 if (!byte_table_equal (cte1->property[i],
585 cte2->property[i], depth + 1))
592 if (!internal_equal (cte1->property[i], cte2->property[i], depth + 1))
598 byte_table_hash (Lisp_Object obj, int depth)
600 Lisp_Byte_Table *cte = XBYTE_TABLE (obj);
602 return internal_array_hash (cte->property, 256, depth);
605 static const struct lrecord_description byte_table_description[] = {
606 { XD_LISP_OBJECT_ARRAY, offsetof(Lisp_Byte_Table, property), 256 },
610 DEFINE_LRECORD_IMPLEMENTATION ("byte-table", byte_table,
615 byte_table_description,
619 make_byte_table (Lisp_Object initval)
623 Lisp_Byte_Table *cte;
625 cte = alloc_lcrecord_type (Lisp_Byte_Table, &lrecord_byte_table);
627 for (i = 0; i < 256; i++)
628 cte->property[i] = initval;
630 XSETBYTE_TABLE (obj, cte);
635 copy_byte_table (Lisp_Object entry)
637 Lisp_Byte_Table *cte = XBYTE_TABLE (entry);
640 Lisp_Byte_Table *ctnew
641 = alloc_lcrecord_type (Lisp_Byte_Table, &lrecord_byte_table);
643 for (i = 0; i < 256; i++)
645 if (UINT8_BYTE_TABLE_P (cte->property[i]))
647 ctnew->property[i] = copy_uint8_byte_table (cte->property[i]);
649 else if (UINT16_BYTE_TABLE_P (cte->property[i]))
651 ctnew->property[i] = copy_uint16_byte_table (cte->property[i]);
653 else if (BYTE_TABLE_P (cte->property[i]))
655 ctnew->property[i] = copy_byte_table (cte->property[i]);
658 ctnew->property[i] = cte->property[i];
661 XSETBYTE_TABLE (obj, ctnew);
666 byte_table_same_value_p (Lisp_Object obj)
668 Lisp_Byte_Table *bte = XBYTE_TABLE (obj);
669 Lisp_Object v0 = bte->property[0];
672 for (i = 1; i < 256; i++)
674 if (!internal_equal (bte->property[i], v0, 0))
681 map_over_byte_table (Lisp_Byte_Table *ct, Emchar ofs, int place,
682 int (*fn) (struct chartab_range *range,
683 Lisp_Object val, void *arg),
688 int unit = 1 << (8 * place);
691 for (i = 0, retval = 0; i < 256 && retval == 0; i++)
694 if (UINT8_BYTE_TABLE_P (v))
697 = map_over_uint8_byte_table (XUINT8_BYTE_TABLE(v),
698 c, place - 1, fn, arg);
701 else if (UINT16_BYTE_TABLE_P (v))
704 = map_over_uint16_byte_table (XUINT16_BYTE_TABLE(v),
705 c, place - 1, fn, arg);
708 else if (BYTE_TABLE_P (v))
710 retval = map_over_byte_table (XBYTE_TABLE(v),
711 c, place - 1, fn, arg);
714 else if (!UNBOUNDP (v))
716 struct chartab_range rainj;
717 Emchar c1 = c + unit;
719 rainj.type = CHARTAB_RANGE_CHAR;
721 for (; c < c1 && retval == 0; c++)
724 retval = (fn) (&rainj, v, arg);
735 get_byte_table (Lisp_Object table, unsigned char idx)
737 if (UINT8_BYTE_TABLE_P (table))
738 return UINT8_DECODE (XUINT8_BYTE_TABLE(table)->property[idx]);
739 else if (UINT16_BYTE_TABLE_P (table))
740 return UINT16_DECODE (XUINT16_BYTE_TABLE(table)->property[idx]);
741 else if (BYTE_TABLE_P (table))
742 return XBYTE_TABLE(table)->property[idx];
748 put_byte_table (Lisp_Object table, unsigned char idx, Lisp_Object value)
750 if (UINT8_BYTE_TABLE_P (table))
752 if (UINT8_VALUE_P (value))
754 XUINT8_BYTE_TABLE(table)->property[idx] = UINT8_ENCODE (value);
755 if (!UINT8_BYTE_TABLE_P (value) &&
756 !UINT16_BYTE_TABLE_P (value) && !BYTE_TABLE_P (value)
757 && uint8_byte_table_same_value_p (table))
762 else if (UINT16_VALUE_P (value))
764 Lisp_Object new = expand_uint8_byte_table_to_uint16 (table);
766 XUINT16_BYTE_TABLE(new)->property[idx] = UINT16_ENCODE (value);
771 Lisp_Object new = make_byte_table (Qnil);
774 for (i = 0; i < 256; i++)
776 XBYTE_TABLE(new)->property[i]
777 = UINT8_DECODE (XUINT8_BYTE_TABLE(table)->property[i]);
779 XBYTE_TABLE(new)->property[idx] = value;
783 else if (UINT16_BYTE_TABLE_P (table))
785 if (UINT16_VALUE_P (value))
787 XUINT16_BYTE_TABLE(table)->property[idx] = UINT16_ENCODE (value);
788 if (!UINT8_BYTE_TABLE_P (value) &&
789 !UINT16_BYTE_TABLE_P (value) && !BYTE_TABLE_P (value)
790 && uint16_byte_table_same_value_p (table))
797 Lisp_Object new = make_byte_table (Qnil);
800 for (i = 0; i < 256; i++)
802 XBYTE_TABLE(new)->property[i]
803 = UINT16_DECODE (XUINT16_BYTE_TABLE(table)->property[i]);
805 XBYTE_TABLE(new)->property[idx] = value;
809 else if (BYTE_TABLE_P (table))
811 XBYTE_TABLE(table)->property[idx] = value;
812 if (!UINT8_BYTE_TABLE_P (value) &&
813 !UINT16_BYTE_TABLE_P (value) && !BYTE_TABLE_P (value)
814 && byte_table_same_value_p (table))
819 else if (!internal_equal (table, value, 0))
821 if (UINT8_VALUE_P (table) && UINT8_VALUE_P (value))
823 table = make_uint8_byte_table (UINT8_ENCODE (table));
824 XUINT8_BYTE_TABLE(table)->property[idx] = UINT8_ENCODE (value);
826 else if (UINT16_VALUE_P (table) && UINT16_VALUE_P (value))
828 table = make_uint16_byte_table (UINT16_ENCODE (table));
829 XUINT16_BYTE_TABLE(table)->property[idx] = UINT16_ENCODE (value);
833 table = make_byte_table (table);
834 XBYTE_TABLE(table)->property[idx] = value;
842 make_char_id_table (Lisp_Object initval)
845 obj = Fmake_char_table (Qgeneric);
846 fill_char_table (XCHAR_TABLE (obj), initval);
851 Lisp_Object Vcharacter_composition_table;
852 Lisp_Object Vcharacter_variant_table;
855 Lisp_Object Q_decomposition;
859 Lisp_Object Qisolated;
860 Lisp_Object Qinitial;
863 Lisp_Object Qvertical;
864 Lisp_Object QnoBreak;
865 Lisp_Object Qfraction;
875 Emchar to_char_id (Lisp_Object v, char* err_msg, Lisp_Object err_arg);
878 to_char_id (Lisp_Object v, char* err_msg, Lisp_Object err_arg)
884 else if (EQ (v, Qcompat))
886 else if (EQ (v, Qisolated))
888 else if (EQ (v, Qinitial))
890 else if (EQ (v, Qmedial))
892 else if (EQ (v, Qfinal))
894 else if (EQ (v, Qvertical))
896 else if (EQ (v, QnoBreak))
898 else if (EQ (v, Qfraction))
900 else if (EQ (v, Qsuper))
902 else if (EQ (v, Qsub))
904 else if (EQ (v, Qcircle))
906 else if (EQ (v, Qsquare))
908 else if (EQ (v, Qwide))
910 else if (EQ (v, Qnarrow))
912 else if (EQ (v, Qsmall))
914 else if (EQ (v, Qfont))
917 signal_simple_error (err_msg, err_arg);
920 DEFUN ("get-composite-char", Fget_composite_char, 1, 1, 0, /*
921 Return character corresponding with list.
925 Lisp_Object table = Vcharacter_composition_table;
926 Lisp_Object rest = list;
930 Lisp_Object v = Fcar (rest);
932 Emchar c = to_char_id (v, "Invalid value for composition", list);
934 ret = get_char_id_table (XCHAR_TABLE(table), c);
939 if (!CHAR_TABLEP (ret))
944 else if (!CONSP (rest))
946 else if (CHAR_TABLEP (ret))
949 signal_simple_error ("Invalid table is found with", list);
951 signal_simple_error ("Invalid value for composition", list);
954 DEFUN ("char-variants", Fchar_variants, 1, 1, 0, /*
955 Return variants of CHARACTER.
959 CHECK_CHAR (character);
960 return Fcopy_list (get_char_id_table
961 (XCHAR_TABLE(Vcharacter_variant_table),
968 /* A char table maps from ranges of characters to values.
970 Implementing a general data structure that maps from arbitrary
971 ranges of numbers to values is tricky to do efficiently. As it
972 happens, it should suffice (and is usually more convenient, anyway)
973 when dealing with characters to restrict the sorts of ranges that
974 can be assigned values, as follows:
977 2) All characters in a charset.
978 3) All characters in a particular row of a charset, where a "row"
979 means all characters with the same first byte.
980 4) A particular character in a charset.
982 We use char tables to generalize the 256-element vectors now
983 littering the Emacs code.
985 Possible uses (all should be converted at some point):
991 5) keyboard-translate-table?
994 abstract type to generalize the Emacs vectors and Mule
995 vectors-of-vectors goo.
998 /************************************************************************/
999 /* Char Table object */
1000 /************************************************************************/
1002 #if defined(MULE)&&!defined(UTF2000)
1005 mark_char_table_entry (Lisp_Object obj)
1007 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj);
1010 for (i = 0; i < 96; i++)
1012 mark_object (cte->level2[i]);
1018 char_table_entry_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
1020 Lisp_Char_Table_Entry *cte1 = XCHAR_TABLE_ENTRY (obj1);
1021 Lisp_Char_Table_Entry *cte2 = XCHAR_TABLE_ENTRY (obj2);
1024 for (i = 0; i < 96; i++)
1025 if (!internal_equal (cte1->level2[i], cte2->level2[i], depth + 1))
1031 static unsigned long
1032 char_table_entry_hash (Lisp_Object obj, int depth)
1034 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj);
1036 return internal_array_hash (cte->level2, 96, depth);
1039 static const struct lrecord_description char_table_entry_description[] = {
1040 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table_Entry, level2), 96 },
1044 DEFINE_LRECORD_IMPLEMENTATION ("char-table-entry", char_table_entry,
1045 mark_char_table_entry, internal_object_printer,
1046 0, char_table_entry_equal,
1047 char_table_entry_hash,
1048 char_table_entry_description,
1049 Lisp_Char_Table_Entry);
1053 mark_char_table (Lisp_Object obj)
1055 Lisp_Char_Table *ct = XCHAR_TABLE (obj);
1058 mark_object (ct->table);
1062 for (i = 0; i < NUM_ASCII_CHARS; i++)
1063 mark_object (ct->ascii[i]);
1065 for (i = 0; i < NUM_LEADING_BYTES; i++)
1066 mark_object (ct->level1[i]);
1070 return ct->default_value;
1072 return ct->mirror_table;
1076 /* WARNING: All functions of this nature need to be written extremely
1077 carefully to avoid crashes during GC. Cf. prune_specifiers()
1078 and prune_weak_hash_tables(). */
1081 prune_syntax_tables (void)
1083 Lisp_Object rest, prev = Qnil;
1085 for (rest = Vall_syntax_tables;
1087 rest = XCHAR_TABLE (rest)->next_table)
1089 if (! marked_p (rest))
1091 /* This table is garbage. Remove it from the list. */
1093 Vall_syntax_tables = XCHAR_TABLE (rest)->next_table;
1095 XCHAR_TABLE (prev)->next_table =
1096 XCHAR_TABLE (rest)->next_table;
1102 char_table_type_to_symbol (enum char_table_type type)
1107 case CHAR_TABLE_TYPE_GENERIC: return Qgeneric;
1108 case CHAR_TABLE_TYPE_SYNTAX: return Qsyntax;
1109 case CHAR_TABLE_TYPE_DISPLAY: return Qdisplay;
1110 case CHAR_TABLE_TYPE_CHAR: return Qchar;
1112 case CHAR_TABLE_TYPE_CATEGORY: return Qcategory;
1117 static enum char_table_type
1118 symbol_to_char_table_type (Lisp_Object symbol)
1120 CHECK_SYMBOL (symbol);
1122 if (EQ (symbol, Qgeneric)) return CHAR_TABLE_TYPE_GENERIC;
1123 if (EQ (symbol, Qsyntax)) return CHAR_TABLE_TYPE_SYNTAX;
1124 if (EQ (symbol, Qdisplay)) return CHAR_TABLE_TYPE_DISPLAY;
1125 if (EQ (symbol, Qchar)) return CHAR_TABLE_TYPE_CHAR;
1127 if (EQ (symbol, Qcategory)) return CHAR_TABLE_TYPE_CATEGORY;
1130 signal_simple_error ("Unrecognized char table type", symbol);
1131 return CHAR_TABLE_TYPE_GENERIC; /* not reached */
1135 print_chartab_range (Emchar first, Emchar last, Lisp_Object val,
1136 Lisp_Object printcharfun)
1140 write_c_string (" (", printcharfun);
1141 print_internal (make_char (first), printcharfun, 0);
1142 write_c_string (" ", printcharfun);
1143 print_internal (make_char (last), printcharfun, 0);
1144 write_c_string (") ", printcharfun);
1148 write_c_string (" ", printcharfun);
1149 print_internal (make_char (first), printcharfun, 0);
1150 write_c_string (" ", printcharfun);
1152 print_internal (val, printcharfun, 1);
1155 #if defined(MULE)&&!defined(UTF2000)
1158 print_chartab_charset_row (Lisp_Object charset,
1160 Lisp_Char_Table_Entry *cte,
1161 Lisp_Object printcharfun)
1164 Lisp_Object cat = Qunbound;
1167 for (i = 32; i < 128; i++)
1169 Lisp_Object pam = cte->level2[i - 32];
1181 print_chartab_range (MAKE_CHAR (charset, first, 0),
1182 MAKE_CHAR (charset, i - 1, 0),
1185 print_chartab_range (MAKE_CHAR (charset, row, first),
1186 MAKE_CHAR (charset, row, i - 1),
1196 print_chartab_range (MAKE_CHAR (charset, first, 0),
1197 MAKE_CHAR (charset, i - 1, 0),
1200 print_chartab_range (MAKE_CHAR (charset, row, first),
1201 MAKE_CHAR (charset, row, i - 1),
1207 print_chartab_two_byte_charset (Lisp_Object charset,
1208 Lisp_Char_Table_Entry *cte,
1209 Lisp_Object printcharfun)
1213 for (i = 32; i < 128; i++)
1215 Lisp_Object jen = cte->level2[i - 32];
1217 if (!CHAR_TABLE_ENTRYP (jen))
1221 write_c_string (" [", printcharfun);
1222 print_internal (XCHARSET_NAME (charset), printcharfun, 0);
1223 sprintf (buf, " %d] ", i);
1224 write_c_string (buf, printcharfun);
1225 print_internal (jen, printcharfun, 0);
1228 print_chartab_charset_row (charset, i, XCHAR_TABLE_ENTRY (jen),
1236 print_char_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1238 Lisp_Char_Table *ct = XCHAR_TABLE (obj);
1241 struct gcpro gcpro1, gcpro2;
1242 GCPRO2 (obj, printcharfun);
1244 write_c_string ("#s(char-table ", printcharfun);
1245 write_c_string (" ", printcharfun);
1246 write_c_string (string_data
1248 (XSYMBOL (char_table_type_to_symbol (ct->type)))),
1250 write_c_string ("\n ", printcharfun);
1251 print_internal (ct->default_value, printcharfun, escapeflag);
1252 for (i = 0; i < 256; i++)
1254 Lisp_Object elt = get_byte_table (ct->table, i);
1255 if (i != 0) write_c_string ("\n ", printcharfun);
1256 if (EQ (elt, Qunbound))
1257 write_c_string ("void", printcharfun);
1259 print_internal (elt, printcharfun, escapeflag);
1262 #else /* non UTF2000 */
1265 sprintf (buf, "#s(char-table type %s data (",
1266 string_data (symbol_name (XSYMBOL
1267 (char_table_type_to_symbol (ct->type)))));
1268 write_c_string (buf, printcharfun);
1270 /* Now write out the ASCII/Control-1 stuff. */
1274 Lisp_Object val = Qunbound;
1276 for (i = 0; i < NUM_ASCII_CHARS; i++)
1285 if (!EQ (ct->ascii[i], val))
1287 print_chartab_range (first, i - 1, val, printcharfun);
1294 print_chartab_range (first, i - 1, val, printcharfun);
1301 for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES;
1304 Lisp_Object ann = ct->level1[i - MIN_LEADING_BYTE];
1305 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (i);
1307 if (!CHARSETP (charset) || i == LEADING_BYTE_ASCII
1308 || i == LEADING_BYTE_CONTROL_1)
1310 if (!CHAR_TABLE_ENTRYP (ann))
1312 write_c_string (" ", printcharfun);
1313 print_internal (XCHARSET_NAME (charset),
1315 write_c_string (" ", printcharfun);
1316 print_internal (ann, printcharfun, 0);
1320 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (ann);
1321 if (XCHARSET_DIMENSION (charset) == 1)
1322 print_chartab_charset_row (charset, -1, cte, printcharfun);
1324 print_chartab_two_byte_charset (charset, cte, printcharfun);
1329 #endif /* non UTF2000 */
1331 write_c_string ("))", printcharfun);
1335 char_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
1337 Lisp_Char_Table *ct1 = XCHAR_TABLE (obj1);
1338 Lisp_Char_Table *ct2 = XCHAR_TABLE (obj2);
1341 if (CHAR_TABLE_TYPE (ct1) != CHAR_TABLE_TYPE (ct2))
1345 for (i = 0; i < 256; i++)
1347 if (!internal_equal (get_byte_table (ct1->table, i),
1348 get_byte_table (ct2->table, i), 0))
1352 for (i = 0; i < NUM_ASCII_CHARS; i++)
1353 if (!internal_equal (ct1->ascii[i], ct2->ascii[i], depth + 1))
1357 for (i = 0; i < NUM_LEADING_BYTES; i++)
1358 if (!internal_equal (ct1->level1[i], ct2->level1[i], depth + 1))
1361 #endif /* non UTF2000 */
1366 static unsigned long
1367 char_table_hash (Lisp_Object obj, int depth)
1369 Lisp_Char_Table *ct = XCHAR_TABLE (obj);
1371 return byte_table_hash (ct->table, depth + 1);
1373 unsigned long hashval = internal_array_hash (ct->ascii, NUM_ASCII_CHARS,
1376 hashval = HASH2 (hashval,
1377 internal_array_hash (ct->level1, NUM_LEADING_BYTES, depth));
1383 static const struct lrecord_description char_table_description[] = {
1385 { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, table) },
1386 { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, default_value) },
1388 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, ascii), NUM_ASCII_CHARS },
1390 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, level1), NUM_LEADING_BYTES },
1394 { XD_LISP_OBJECT, offsetof (Lisp_Char_Table, mirror_table) },
1396 { XD_LO_LINK, offsetof (Lisp_Char_Table, next_table) },
1400 DEFINE_LRECORD_IMPLEMENTATION ("char-table", char_table,
1401 mark_char_table, print_char_table, 0,
1402 char_table_equal, char_table_hash,
1403 char_table_description,
1406 DEFUN ("char-table-p", Fchar_table_p, 1, 1, 0, /*
1407 Return non-nil if OBJECT is a char table.
1409 A char table is a table that maps characters (or ranges of characters)
1410 to values. Char tables are specialized for characters, only allowing
1411 particular sorts of ranges to be assigned values. Although this
1412 loses in generality, it makes for extremely fast (constant-time)
1413 lookups, and thus is feasible for applications that do an extremely
1414 large number of lookups (e.g. scanning a buffer for a character in
1415 a particular syntax, where a lookup in the syntax table must occur
1416 once per character).
1418 When Mule support exists, the types of ranges that can be assigned
1422 -- an entire charset
1423 -- a single row in a two-octet charset
1424 -- a single character
1426 When Mule support is not present, the types of ranges that can be
1430 -- a single character
1432 To create a char table, use `make-char-table'.
1433 To modify a char table, use `put-char-table' or `remove-char-table'.
1434 To retrieve the value for a particular character, use `get-char-table'.
1435 See also `map-char-table', `clear-char-table', `copy-char-table',
1436 `valid-char-table-type-p', `char-table-type-list',
1437 `valid-char-table-value-p', and `check-char-table-value'.
1441 return CHAR_TABLEP (object) ? Qt : Qnil;
1444 DEFUN ("char-table-type-list", Fchar_table_type_list, 0, 0, 0, /*
1445 Return a list of the recognized char table types.
1446 See `valid-char-table-type-p'.
1451 return list5 (Qchar, Qcategory, Qdisplay, Qgeneric, Qsyntax);
1453 return list4 (Qchar, Qdisplay, Qgeneric, Qsyntax);
1457 DEFUN ("valid-char-table-type-p", Fvalid_char_table_type_p, 1, 1, 0, /*
1458 Return t if TYPE if a recognized char table type.
1460 Each char table type is used for a different purpose and allows different
1461 sorts of values. The different char table types are
1464 Used for category tables, which specify the regexp categories
1465 that a character is in. The valid values are nil or a
1466 bit vector of 95 elements. Higher-level Lisp functions are
1467 provided for working with category tables. Currently categories
1468 and category tables only exist when Mule support is present.
1470 A generalized char table, for mapping from one character to
1471 another. Used for case tables, syntax matching tables,
1472 `keyboard-translate-table', etc. The valid values are characters.
1474 An even more generalized char table, for mapping from a
1475 character to anything.
1477 Used for display tables, which specify how a particular character
1478 is to appear when displayed. #### Not yet implemented.
1480 Used for syntax tables, which specify the syntax of a particular
1481 character. Higher-level Lisp functions are provided for
1482 working with syntax tables. The valid values are integers.
1487 return (EQ (type, Qchar) ||
1489 EQ (type, Qcategory) ||
1491 EQ (type, Qdisplay) ||
1492 EQ (type, Qgeneric) ||
1493 EQ (type, Qsyntax)) ? Qt : Qnil;
1496 DEFUN ("char-table-type", Fchar_table_type, 1, 1, 0, /*
1497 Return the type of CHAR-TABLE.
1498 See `valid-char-table-type-p'.
1502 CHECK_CHAR_TABLE (char_table);
1503 return char_table_type_to_symbol (XCHAR_TABLE (char_table)->type);
1507 fill_char_table (Lisp_Char_Table *ct, Lisp_Object value)
1510 ct->table = Qunbound;
1511 ct->default_value = value;
1515 for (i = 0; i < NUM_ASCII_CHARS; i++)
1516 ct->ascii[i] = value;
1518 for (i = 0; i < NUM_LEADING_BYTES; i++)
1519 ct->level1[i] = value;
1524 if (ct->type == CHAR_TABLE_TYPE_SYNTAX)
1525 update_syntax_table (ct);
1529 DEFUN ("reset-char-table", Freset_char_table, 1, 1, 0, /*
1530 Reset CHAR-TABLE to its default state.
1534 Lisp_Char_Table *ct;
1536 CHECK_CHAR_TABLE (char_table);
1537 ct = XCHAR_TABLE (char_table);
1541 case CHAR_TABLE_TYPE_CHAR:
1542 fill_char_table (ct, make_char (0));
1544 case CHAR_TABLE_TYPE_DISPLAY:
1545 case CHAR_TABLE_TYPE_GENERIC:
1547 case CHAR_TABLE_TYPE_CATEGORY:
1549 fill_char_table (ct, Qnil);
1552 case CHAR_TABLE_TYPE_SYNTAX:
1553 fill_char_table (ct, make_int (Sinherit));
1563 DEFUN ("make-char-table", Fmake_char_table, 1, 1, 0, /*
1564 Return a new, empty char table of type TYPE.
1565 Currently recognized types are 'char, 'category, 'display, 'generic,
1566 and 'syntax. See `valid-char-table-type-p'.
1570 Lisp_Char_Table *ct;
1572 enum char_table_type ty = symbol_to_char_table_type (type);
1574 ct = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table);
1577 if (ty == CHAR_TABLE_TYPE_SYNTAX)
1579 ct->mirror_table = Fmake_char_table (Qgeneric);
1580 fill_char_table (XCHAR_TABLE (ct->mirror_table),
1584 ct->mirror_table = Qnil;
1586 ct->next_table = Qnil;
1587 XSETCHAR_TABLE (obj, ct);
1588 if (ty == CHAR_TABLE_TYPE_SYNTAX)
1590 ct->next_table = Vall_syntax_tables;
1591 Vall_syntax_tables = obj;
1593 Freset_char_table (obj);
1597 #if defined(MULE)&&!defined(UTF2000)
1600 make_char_table_entry (Lisp_Object initval)
1604 Lisp_Char_Table_Entry *cte =
1605 alloc_lcrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry);
1607 for (i = 0; i < 96; i++)
1608 cte->level2[i] = initval;
1610 XSETCHAR_TABLE_ENTRY (obj, cte);
1615 copy_char_table_entry (Lisp_Object entry)
1617 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (entry);
1620 Lisp_Char_Table_Entry *ctenew =
1621 alloc_lcrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry);
1623 for (i = 0; i < 96; i++)
1625 Lisp_Object new = cte->level2[i];
1626 if (CHAR_TABLE_ENTRYP (new))
1627 ctenew->level2[i] = copy_char_table_entry (new);
1629 ctenew->level2[i] = new;
1632 XSETCHAR_TABLE_ENTRY (obj, ctenew);
1638 DEFUN ("copy-char-table", Fcopy_char_table, 1, 1, 0, /*
1639 Return a new char table which is a copy of CHAR-TABLE.
1640 It will contain the same values for the same characters and ranges
1641 as CHAR-TABLE. The values will not themselves be copied.
1645 Lisp_Char_Table *ct, *ctnew;
1651 CHECK_CHAR_TABLE (char_table);
1652 ct = XCHAR_TABLE (char_table);
1653 ctnew = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table);
1654 ctnew->type = ct->type;
1656 ctnew->default_value = ct->default_value;
1658 if (UINT8_BYTE_TABLE_P (ct->table))
1660 ctnew->table = copy_uint8_byte_table (ct->table);
1662 else if (UINT16_BYTE_TABLE_P (ct->table))
1664 ctnew->table = copy_uint16_byte_table (ct->table);
1666 else if (BYTE_TABLE_P (ct->table))
1668 ctnew->table = copy_byte_table (ct->table);
1670 else if (!UNBOUNDP (ct->table))
1671 ctnew->table = ct->table;
1672 #else /* non UTF2000 */
1674 for (i = 0; i < NUM_ASCII_CHARS; i++)
1676 Lisp_Object new = ct->ascii[i];
1678 assert (! (CHAR_TABLE_ENTRYP (new)));
1680 ctnew->ascii[i] = new;
1685 for (i = 0; i < NUM_LEADING_BYTES; i++)
1687 Lisp_Object new = ct->level1[i];
1688 if (CHAR_TABLE_ENTRYP (new))
1689 ctnew->level1[i] = copy_char_table_entry (new);
1691 ctnew->level1[i] = new;
1695 #endif /* non UTF2000 */
1698 if (CHAR_TABLEP (ct->mirror_table))
1699 ctnew->mirror_table = Fcopy_char_table (ct->mirror_table);
1701 ctnew->mirror_table = ct->mirror_table;
1703 ctnew->next_table = Qnil;
1704 XSETCHAR_TABLE (obj, ctnew);
1705 if (ctnew->type == CHAR_TABLE_TYPE_SYNTAX)
1707 ctnew->next_table = Vall_syntax_tables;
1708 Vall_syntax_tables = obj;
1713 INLINE_HEADER int XCHARSET_CELL_RANGE (Lisp_Object ccs);
1715 XCHARSET_CELL_RANGE (Lisp_Object ccs)
1717 switch (XCHARSET_CHARS (ccs))
1720 return (33 << 8) | 126;
1722 return (32 << 8) | 127;
1725 return (0 << 8) | 127;
1727 return (0 << 8) | 255;
1739 decode_char_table_range (Lisp_Object range, struct chartab_range *outrange)
1742 outrange->type = CHARTAB_RANGE_ALL;
1743 else if (EQ (range, Qnil))
1744 outrange->type = CHARTAB_RANGE_DEFAULT;
1745 else if (CHAR_OR_CHAR_INTP (range))
1747 outrange->type = CHARTAB_RANGE_CHAR;
1748 outrange->ch = XCHAR_OR_CHAR_INT (range);
1752 signal_simple_error ("Range must be t or a character", range);
1754 else if (VECTORP (range))
1756 Lisp_Vector *vec = XVECTOR (range);
1757 Lisp_Object *elts = vector_data (vec);
1758 int cell_min, cell_max;
1760 outrange->type = CHARTAB_RANGE_ROW;
1761 outrange->charset = Fget_charset (elts[0]);
1762 CHECK_INT (elts[1]);
1763 outrange->row = XINT (elts[1]);
1764 if (XCHARSET_DIMENSION (outrange->charset) < 2)
1765 signal_simple_error ("Charset in row vector must be multi-byte",
1769 int ret = XCHARSET_CELL_RANGE (outrange->charset);
1771 cell_min = ret >> 8;
1772 cell_max = ret & 0xFF;
1774 if (XCHARSET_DIMENSION (outrange->charset) == 2)
1775 check_int_range (outrange->row, cell_min, cell_max);
1777 else if (XCHARSET_DIMENSION (outrange->charset) == 3)
1779 check_int_range (outrange->row >> 8 , cell_min, cell_max);
1780 check_int_range (outrange->row & 0xFF, cell_min, cell_max);
1782 else if (XCHARSET_DIMENSION (outrange->charset) == 4)
1784 check_int_range ( outrange->row >> 16 , cell_min, cell_max);
1785 check_int_range ((outrange->row >> 8) & 0xFF, cell_min, cell_max);
1786 check_int_range ( outrange->row & 0xFF, cell_min, cell_max);
1794 if (!CHARSETP (range) && !SYMBOLP (range))
1796 ("Char table range must be t, charset, char, or vector", range);
1797 outrange->type = CHARTAB_RANGE_CHARSET;
1798 outrange->charset = Fget_charset (range);
1803 #if defined(MULE)&&!defined(UTF2000)
1805 /* called from CHAR_TABLE_VALUE(). */
1807 get_non_ascii_char_table_value (Lisp_Char_Table *ct, Charset_ID leading_byte,
1812 Lisp_Object charset;
1814 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (leading_byte);
1819 BREAKUP_CHAR (c, charset, byte1, byte2);
1821 BREAKUP_CHAR_1_UNSAFE (c, charset, byte1, byte2);
1823 val = ct->level1[leading_byte - MIN_LEADING_BYTE];
1824 if (CHAR_TABLE_ENTRYP (val))
1826 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
1827 val = cte->level2[byte1 - 32];
1828 if (CHAR_TABLE_ENTRYP (val))
1830 cte = XCHAR_TABLE_ENTRY (val);
1831 assert (byte2 >= 32);
1832 val = cte->level2[byte2 - 32];
1833 assert (!CHAR_TABLE_ENTRYP (val));
1843 get_char_table (Emchar ch, Lisp_Char_Table *ct)
1846 return get_char_id_table (ct, ch);
1849 Lisp_Object charset;
1853 BREAKUP_CHAR (ch, charset, byte1, byte2);
1855 if (EQ (charset, Vcharset_ascii))
1856 val = ct->ascii[byte1];
1857 else if (EQ (charset, Vcharset_control_1))
1858 val = ct->ascii[byte1 + 128];
1861 int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE;
1862 val = ct->level1[lb];
1863 if (CHAR_TABLE_ENTRYP (val))
1865 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
1866 val = cte->level2[byte1 - 32];
1867 if (CHAR_TABLE_ENTRYP (val))
1869 cte = XCHAR_TABLE_ENTRY (val);
1870 assert (byte2 >= 32);
1871 val = cte->level2[byte2 - 32];
1872 assert (!CHAR_TABLE_ENTRYP (val));
1879 #else /* not MULE */
1880 return ct->ascii[(unsigned char)ch];
1881 #endif /* not MULE */
1885 DEFUN ("get-char-table", Fget_char_table, 2, 2, 0, /*
1886 Find value for CHARACTER in CHAR-TABLE.
1888 (character, char_table))
1890 CHECK_CHAR_TABLE (char_table);
1891 CHECK_CHAR_COERCE_INT (character);
1893 return get_char_table (XCHAR (character), XCHAR_TABLE (char_table));
1896 DEFUN ("get-range-char-table", Fget_range_char_table, 2, 3, 0, /*
1897 Find value for a range in CHAR-TABLE.
1898 If there is more than one value, return MULTI (defaults to nil).
1900 (range, char_table, multi))
1902 Lisp_Char_Table *ct;
1903 struct chartab_range rainj;
1905 if (CHAR_OR_CHAR_INTP (range))
1906 return Fget_char_table (range, char_table);
1907 CHECK_CHAR_TABLE (char_table);
1908 ct = XCHAR_TABLE (char_table);
1910 decode_char_table_range (range, &rainj);
1913 case CHARTAB_RANGE_ALL:
1916 if (UINT8_BYTE_TABLE_P (ct->table))
1918 else if (UINT16_BYTE_TABLE_P (ct->table))
1920 else if (BYTE_TABLE_P (ct->table))
1924 #else /* non UTF2000 */
1926 Lisp_Object first = ct->ascii[0];
1928 for (i = 1; i < NUM_ASCII_CHARS; i++)
1929 if (!EQ (first, ct->ascii[i]))
1933 for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES;
1936 if (!CHARSETP (CHARSET_BY_LEADING_BYTE (i))
1937 || i == LEADING_BYTE_ASCII
1938 || i == LEADING_BYTE_CONTROL_1)
1940 if (!EQ (first, ct->level1[i - MIN_LEADING_BYTE]))
1946 #endif /* non UTF2000 */
1950 case CHARTAB_RANGE_CHARSET:
1954 if (EQ (rainj.charset, Vcharset_ascii))
1957 Lisp_Object first = ct->ascii[0];
1959 for (i = 1; i < 128; i++)
1960 if (!EQ (first, ct->ascii[i]))
1965 if (EQ (rainj.charset, Vcharset_control_1))
1968 Lisp_Object first = ct->ascii[128];
1970 for (i = 129; i < 160; i++)
1971 if (!EQ (first, ct->ascii[i]))
1977 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (rainj.charset) -
1979 if (CHAR_TABLE_ENTRYP (val))
1985 case CHARTAB_RANGE_ROW:
1990 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (rainj.charset) -
1992 if (!CHAR_TABLE_ENTRYP (val))
1994 val = XCHAR_TABLE_ENTRY (val)->level2[rainj.row - 32];
1995 if (CHAR_TABLE_ENTRYP (val))
1999 #endif /* not UTF2000 */
2000 #endif /* not MULE */
2006 return Qnil; /* not reached */
2010 check_valid_char_table_value (Lisp_Object value, enum char_table_type type,
2011 Error_behavior errb)
2015 case CHAR_TABLE_TYPE_SYNTAX:
2016 if (!ERRB_EQ (errb, ERROR_ME))
2017 return INTP (value) || (CONSP (value) && INTP (XCAR (value))
2018 && CHAR_OR_CHAR_INTP (XCDR (value)));
2021 Lisp_Object cdr = XCDR (value);
2022 CHECK_INT (XCAR (value));
2023 CHECK_CHAR_COERCE_INT (cdr);
2030 case CHAR_TABLE_TYPE_CATEGORY:
2031 if (!ERRB_EQ (errb, ERROR_ME))
2032 return CATEGORY_TABLE_VALUEP (value);
2033 CHECK_CATEGORY_TABLE_VALUE (value);
2037 case CHAR_TABLE_TYPE_GENERIC:
2040 case CHAR_TABLE_TYPE_DISPLAY:
2042 maybe_signal_simple_error ("Display char tables not yet implemented",
2043 value, Qchar_table, errb);
2046 case CHAR_TABLE_TYPE_CHAR:
2047 if (!ERRB_EQ (errb, ERROR_ME))
2048 return CHAR_OR_CHAR_INTP (value);
2049 CHECK_CHAR_COERCE_INT (value);
2056 return 0; /* not reached */
2060 canonicalize_char_table_value (Lisp_Object value, enum char_table_type type)
2064 case CHAR_TABLE_TYPE_SYNTAX:
2067 Lisp_Object car = XCAR (value);
2068 Lisp_Object cdr = XCDR (value);
2069 CHECK_CHAR_COERCE_INT (cdr);
2070 return Fcons (car, cdr);
2073 case CHAR_TABLE_TYPE_CHAR:
2074 CHECK_CHAR_COERCE_INT (value);
2082 DEFUN ("valid-char-table-value-p", Fvalid_char_table_value_p, 2, 2, 0, /*
2083 Return non-nil if VALUE is a valid value for CHAR-TABLE-TYPE.
2085 (value, char_table_type))
2087 enum char_table_type type = symbol_to_char_table_type (char_table_type);
2089 return check_valid_char_table_value (value, type, ERROR_ME_NOT) ? Qt : Qnil;
2092 DEFUN ("check-valid-char-table-value", Fcheck_valid_char_table_value, 2, 2, 0, /*
2093 Signal an error if VALUE is not a valid value for CHAR-TABLE-TYPE.
2095 (value, char_table_type))
2097 enum char_table_type type = symbol_to_char_table_type (char_table_type);
2099 check_valid_char_table_value (value, type, ERROR_ME);
2103 /* Assign VAL to all characters in RANGE in char table CT. */
2106 put_char_table (Lisp_Char_Table *ct, struct chartab_range *range,
2109 switch (range->type)
2111 case CHARTAB_RANGE_ALL:
2112 /* printf ("put-char-table: range = all\n"); */
2113 fill_char_table (ct, val);
2114 return; /* avoid the duplicate call to update_syntax_table() below,
2115 since fill_char_table() also did that. */
2118 case CHARTAB_RANGE_DEFAULT:
2119 ct->default_value = val;
2124 case CHARTAB_RANGE_CHARSET:
2128 Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (range->charset);
2130 /* printf ("put-char-table: range = charset: %d\n",
2131 XCHARSET_LEADING_BYTE (range->charset));
2133 if ( CHAR_TABLEP (encoding_table) )
2135 for (c = 0; c < 1 << 24; c++)
2137 if ( INTP (get_char_id_table (XCHAR_TABLE(encoding_table),
2139 put_char_id_table_0 (ct, c, val);
2144 for (c = 0; c < 1 << 24; c++)
2146 if ( charset_code_point (range->charset, c) >= 0 )
2147 put_char_id_table_0 (ct, c, val);
2152 if (EQ (range->charset, Vcharset_ascii))
2155 for (i = 0; i < 128; i++)
2158 else if (EQ (range->charset, Vcharset_control_1))
2161 for (i = 128; i < 160; i++)
2166 int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE;
2167 ct->level1[lb] = val;
2172 case CHARTAB_RANGE_ROW:
2175 int cell_min, cell_max, i;
2177 i = XCHARSET_CELL_RANGE (range->charset);
2179 cell_max = i & 0xFF;
2180 for (i = cell_min; i <= cell_max; i++)
2182 Emchar ch = DECODE_CHAR (range->charset, (range->row << 8) | i);
2184 if ( charset_code_point (range->charset, ch) >= 0 )
2185 put_char_id_table_0 (ct, ch, val);
2190 Lisp_Char_Table_Entry *cte;
2191 int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE;
2192 /* make sure that there is a separate entry for the row. */
2193 if (!CHAR_TABLE_ENTRYP (ct->level1[lb]))
2194 ct->level1[lb] = make_char_table_entry (ct->level1[lb]);
2195 cte = XCHAR_TABLE_ENTRY (ct->level1[lb]);
2196 cte->level2[range->row - 32] = val;
2198 #endif /* not UTF2000 */
2202 case CHARTAB_RANGE_CHAR:
2204 /* printf ("put-char-table: range = char: 0x%x\n", range->ch); */
2205 put_char_id_table_0 (ct, range->ch, val);
2209 Lisp_Object charset;
2212 BREAKUP_CHAR (range->ch, charset, byte1, byte2);
2213 if (EQ (charset, Vcharset_ascii))
2214 ct->ascii[byte1] = val;
2215 else if (EQ (charset, Vcharset_control_1))
2216 ct->ascii[byte1 + 128] = val;
2219 Lisp_Char_Table_Entry *cte;
2220 int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE;
2221 /* make sure that there is a separate entry for the row. */
2222 if (!CHAR_TABLE_ENTRYP (ct->level1[lb]))
2223 ct->level1[lb] = make_char_table_entry (ct->level1[lb]);
2224 cte = XCHAR_TABLE_ENTRY (ct->level1[lb]);
2225 /* now CTE is a char table entry for the charset;
2226 each entry is for a single row (or character of
2227 a one-octet charset). */
2228 if (XCHARSET_DIMENSION (charset) == 1)
2229 cte->level2[byte1 - 32] = val;
2232 /* assigning to one character in a two-octet charset. */
2233 /* make sure that the charset row contains a separate
2234 entry for each character. */
2235 if (!CHAR_TABLE_ENTRYP (cte->level2[byte1 - 32]))
2236 cte->level2[byte1 - 32] =
2237 make_char_table_entry (cte->level2[byte1 - 32]);
2238 cte = XCHAR_TABLE_ENTRY (cte->level2[byte1 - 32]);
2239 cte->level2[byte2 - 32] = val;
2243 #else /* not MULE */
2244 ct->ascii[(unsigned char) (range->ch)] = val;
2246 #endif /* not MULE */
2250 if (ct->type == CHAR_TABLE_TYPE_SYNTAX)
2251 update_syntax_table (ct);
2255 DEFUN ("put-char-table", Fput_char_table, 3, 3, 0, /*
2256 Set the value for chars in RANGE to be VALUE in CHAR-TABLE.
2258 RANGE specifies one or more characters to be affected and should be
2259 one of the following:
2261 -- t (all characters are affected)
2262 -- A charset (only allowed when Mule support is present)
2263 -- A vector of two elements: a two-octet charset and a row number
2264 (only allowed when Mule support is present)
2265 -- A single character
2267 VALUE must be a value appropriate for the type of CHAR-TABLE.
2268 See `valid-char-table-type-p'.
2270 (range, value, char_table))
2272 Lisp_Char_Table *ct;
2273 struct chartab_range rainj;
2275 CHECK_CHAR_TABLE (char_table);
2276 ct = XCHAR_TABLE (char_table);
2277 check_valid_char_table_value (value, ct->type, ERROR_ME);
2278 decode_char_table_range (range, &rainj);
2279 value = canonicalize_char_table_value (value, ct->type);
2280 put_char_table (ct, &rainj, value);
2285 /* Map FN over the ASCII chars in CT. */
2288 map_over_charset_ascii (Lisp_Char_Table *ct,
2289 int (*fn) (struct chartab_range *range,
2290 Lisp_Object val, void *arg),
2293 struct chartab_range rainj;
2302 rainj.type = CHARTAB_RANGE_CHAR;
2304 for (i = start, retval = 0; i < stop && retval == 0; i++)
2306 rainj.ch = (Emchar) i;
2307 retval = (fn) (&rainj, ct->ascii[i], arg);
2315 /* Map FN over the Control-1 chars in CT. */
2318 map_over_charset_control_1 (Lisp_Char_Table *ct,
2319 int (*fn) (struct chartab_range *range,
2320 Lisp_Object val, void *arg),
2323 struct chartab_range rainj;
2326 int stop = start + 32;
2328 rainj.type = CHARTAB_RANGE_CHAR;
2330 for (i = start, retval = 0; i < stop && retval == 0; i++)
2332 rainj.ch = (Emchar) (i);
2333 retval = (fn) (&rainj, ct->ascii[i], arg);
2339 /* Map FN over the row ROW of two-byte charset CHARSET.
2340 There must be a separate value for that row in the char table.
2341 CTE specifies the char table entry for CHARSET. */
2344 map_over_charset_row (Lisp_Char_Table_Entry *cte,
2345 Lisp_Object charset, int row,
2346 int (*fn) (struct chartab_range *range,
2347 Lisp_Object val, void *arg),
2350 Lisp_Object val = cte->level2[row - 32];
2352 if (!CHAR_TABLE_ENTRYP (val))
2354 struct chartab_range rainj;
2356 rainj.type = CHARTAB_RANGE_ROW;
2357 rainj.charset = charset;
2359 return (fn) (&rainj, val, arg);
2363 struct chartab_range rainj;
2365 int charset94_p = (XCHARSET_CHARS (charset) == 94);
2366 int start = charset94_p ? 33 : 32;
2367 int stop = charset94_p ? 127 : 128;
2369 cte = XCHAR_TABLE_ENTRY (val);
2371 rainj.type = CHARTAB_RANGE_CHAR;
2373 for (i = start, retval = 0; i < stop && retval == 0; i++)
2375 rainj.ch = MAKE_CHAR (charset, row, i);
2376 retval = (fn) (&rainj, cte->level2[i - 32], arg);
2384 map_over_other_charset (Lisp_Char_Table *ct, Charset_ID lb,
2385 int (*fn) (struct chartab_range *range,
2386 Lisp_Object val, void *arg),
2389 Lisp_Object val = ct->level1[lb - MIN_LEADING_BYTE];
2390 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (lb);
2392 if (!CHARSETP (charset)
2393 || lb == LEADING_BYTE_ASCII
2394 || lb == LEADING_BYTE_CONTROL_1)
2397 if (!CHAR_TABLE_ENTRYP (val))
2399 struct chartab_range rainj;
2401 rainj.type = CHARTAB_RANGE_CHARSET;
2402 rainj.charset = charset;
2403 return (fn) (&rainj, val, arg);
2407 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
2408 int charset94_p = (XCHARSET_CHARS (charset) == 94);
2409 int start = charset94_p ? 33 : 32;
2410 int stop = charset94_p ? 127 : 128;
2413 if (XCHARSET_DIMENSION (charset) == 1)
2415 struct chartab_range rainj;
2416 rainj.type = CHARTAB_RANGE_CHAR;
2418 for (i = start, retval = 0; i < stop && retval == 0; i++)
2420 rainj.ch = MAKE_CHAR (charset, i, 0);
2421 retval = (fn) (&rainj, cte->level2[i - 32], arg);
2426 for (i = start, retval = 0; i < stop && retval == 0; i++)
2427 retval = map_over_charset_row (cte, charset, i, fn, arg);
2435 #endif /* not UTF2000 */
2438 struct map_char_table_for_charset_arg
2440 int (*fn) (struct chartab_range *range, Lisp_Object val, void *arg);
2441 Lisp_Char_Table *ct;
2446 map_char_table_for_charset_fun (struct chartab_range *range,
2447 Lisp_Object val, void *arg)
2449 struct map_char_table_for_charset_arg *closure =
2450 (struct map_char_table_for_charset_arg *) arg;
2453 switch (range->type)
2455 case CHARTAB_RANGE_ALL:
2458 case CHARTAB_RANGE_DEFAULT:
2461 case CHARTAB_RANGE_CHARSET:
2464 case CHARTAB_RANGE_ROW:
2467 case CHARTAB_RANGE_CHAR:
2468 ret = get_char_table (range->ch, closure->ct);
2469 if (!UNBOUNDP (ret))
2470 return (closure->fn) (range, ret, closure->arg);
2481 /* Map FN (with client data ARG) over range RANGE in char table CT.
2482 Mapping stops the first time FN returns non-zero, and that value
2483 becomes the return value of map_char_table(). */
2486 map_char_table (Lisp_Char_Table *ct,
2487 struct chartab_range *range,
2488 int (*fn) (struct chartab_range *range,
2489 Lisp_Object val, void *arg),
2492 switch (range->type)
2494 case CHARTAB_RANGE_ALL:
2496 if (!UNBOUNDP (ct->default_value))
2498 struct chartab_range rainj;
2501 rainj.type = CHARTAB_RANGE_DEFAULT;
2502 retval = (fn) (&rainj, ct->default_value, arg);
2506 if (UINT8_BYTE_TABLE_P (ct->table))
2507 return map_over_uint8_byte_table (XUINT8_BYTE_TABLE(ct->table),
2509 else if (UINT16_BYTE_TABLE_P (ct->table))
2510 return map_over_uint16_byte_table (XUINT16_BYTE_TABLE(ct->table),
2512 else if (BYTE_TABLE_P (ct->table))
2513 return map_over_byte_table (XBYTE_TABLE(ct->table),
2515 else if (!UNBOUNDP (ct->table))
2518 struct chartab_range rainj;
2521 Emchar c1 = c + unit;
2524 rainj.type = CHARTAB_RANGE_CHAR;
2526 for (retval = 0; c < c1 && retval == 0; c++)
2529 retval = (fn) (&rainj, ct->table, arg);
2534 return (fn) (range, ct->table, arg);
2541 retval = map_over_charset_ascii (ct, fn, arg);
2545 retval = map_over_charset_control_1 (ct, fn, arg);
2550 Charset_ID start = MIN_LEADING_BYTE;
2551 Charset_ID stop = start + NUM_LEADING_BYTES;
2553 for (i = start, retval = 0; i < stop && retval == 0; i++)
2555 retval = map_over_other_charset (ct, i, fn, arg);
2564 case CHARTAB_RANGE_DEFAULT:
2565 if (!UNBOUNDP (ct->default_value))
2566 return (fn) (range, ct->default_value, arg);
2571 case CHARTAB_RANGE_CHARSET:
2574 Lisp_Object encoding_table
2575 = XCHARSET_ENCODING_TABLE (range->charset);
2577 if (!NILP (encoding_table))
2579 struct chartab_range rainj;
2580 struct map_char_table_for_charset_arg mcarg;
2585 rainj.type = CHARTAB_RANGE_ALL;
2586 return map_char_table (XCHAR_TABLE(encoding_table),
2588 &map_char_table_for_charset_fun,
2594 return map_over_other_charset (ct,
2595 XCHARSET_LEADING_BYTE (range->charset),
2599 case CHARTAB_RANGE_ROW:
2602 int cell_min, cell_max, i;
2604 struct chartab_range rainj;
2606 i = XCHARSET_CELL_RANGE (range->charset);
2608 cell_max = i & 0xFF;
2609 rainj.type = CHARTAB_RANGE_CHAR;
2610 for (retval =0, i = cell_min; i <= cell_max && retval == 0; i++)
2612 Emchar ch = DECODE_CHAR (range->charset, (range->row << 8) | i);
2614 if ( charset_code_point (range->charset, ch) >= 0 )
2617 = get_byte_table (get_byte_table
2621 (unsigned char)(ch >> 24)),
2622 (unsigned char) (ch >> 16)),
2623 (unsigned char) (ch >> 8)),
2624 (unsigned char) ch);
2627 val = ct->default_value;
2629 retval = (fn) (&rainj, val, arg);
2636 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (range->charset)
2637 - MIN_LEADING_BYTE];
2638 if (!CHAR_TABLE_ENTRYP (val))
2640 struct chartab_range rainj;
2642 rainj.type = CHARTAB_RANGE_ROW;
2643 rainj.charset = range->charset;
2644 rainj.row = range->row;
2645 return (fn) (&rainj, val, arg);
2648 return map_over_charset_row (XCHAR_TABLE_ENTRY (val),
2649 range->charset, range->row,
2652 #endif /* not UTF2000 */
2655 case CHARTAB_RANGE_CHAR:
2657 Emchar ch = range->ch;
2658 Lisp_Object val = CHAR_TABLE_VALUE_UNSAFE (ct, ch);
2660 if (!UNBOUNDP (val))
2662 struct chartab_range rainj;
2664 rainj.type = CHARTAB_RANGE_CHAR;
2666 return (fn) (&rainj, val, arg);
2678 struct slow_map_char_table_arg
2680 Lisp_Object function;
2685 slow_map_char_table_fun (struct chartab_range *range,
2686 Lisp_Object val, void *arg)
2688 Lisp_Object ranjarg = Qnil;
2689 struct slow_map_char_table_arg *closure =
2690 (struct slow_map_char_table_arg *) arg;
2692 switch (range->type)
2694 case CHARTAB_RANGE_ALL:
2699 case CHARTAB_RANGE_DEFAULT:
2705 case CHARTAB_RANGE_CHARSET:
2706 ranjarg = XCHARSET_NAME (range->charset);
2709 case CHARTAB_RANGE_ROW:
2710 ranjarg = vector2 (XCHARSET_NAME (range->charset),
2711 make_int (range->row));
2714 case CHARTAB_RANGE_CHAR:
2715 ranjarg = make_char (range->ch);
2721 closure->retval = call2 (closure->function, ranjarg, val);
2722 return !NILP (closure->retval);
2725 DEFUN ("map-char-table", Fmap_char_table, 2, 3, 0, /*
2726 Map FUNCTION over entries in CHAR-TABLE, calling it with two args,
2727 each key and value in the table.
2729 RANGE specifies a subrange to map over and is in the same format as
2730 the RANGE argument to `put-range-table'. If omitted or t, it defaults to
2733 (function, char_table, range))
2735 Lisp_Char_Table *ct;
2736 struct slow_map_char_table_arg slarg;
2737 struct gcpro gcpro1, gcpro2;
2738 struct chartab_range rainj;
2740 CHECK_CHAR_TABLE (char_table);
2741 ct = XCHAR_TABLE (char_table);
2744 decode_char_table_range (range, &rainj);
2745 slarg.function = function;
2746 slarg.retval = Qnil;
2747 GCPRO2 (slarg.function, slarg.retval);
2748 map_char_table (ct, &rainj, slow_map_char_table_fun, &slarg);
2751 return slarg.retval;
2755 /************************************************************************/
2756 /* Character Attributes */
2757 /************************************************************************/
2761 Lisp_Object Vchar_attribute_hash_table;
2763 /* We store the char-attributes in hash tables with the names as the
2764 key and the actual char-id-table object as the value. Occasionally
2765 we need to use them in a list format. These routines provide us
2767 struct char_attribute_list_closure
2769 Lisp_Object *char_attribute_list;
2773 add_char_attribute_to_list_mapper (Lisp_Object key, Lisp_Object value,
2774 void *char_attribute_list_closure)
2776 /* This function can GC */
2777 struct char_attribute_list_closure *calcl
2778 = (struct char_attribute_list_closure*) char_attribute_list_closure;
2779 Lisp_Object *char_attribute_list = calcl->char_attribute_list;
2781 *char_attribute_list = Fcons (key, *char_attribute_list);
2785 DEFUN ("char-attribute-list", Fchar_attribute_list, 0, 0, 0, /*
2786 Return the list of all existing character attributes except coded-charsets.
2790 Lisp_Object char_attribute_list = Qnil;
2791 struct gcpro gcpro1;
2792 struct char_attribute_list_closure char_attribute_list_closure;
2794 GCPRO1 (char_attribute_list);
2795 char_attribute_list_closure.char_attribute_list = &char_attribute_list;
2796 elisp_maphash (add_char_attribute_to_list_mapper,
2797 Vchar_attribute_hash_table,
2798 &char_attribute_list_closure);
2800 return char_attribute_list;
2803 DEFUN ("find-char-attribute-table", Ffind_char_attribute_table, 1, 1, 0, /*
2804 Return char-id-table corresponding to ATTRIBUTE.
2808 return Fgethash (attribute, Vchar_attribute_hash_table, Qnil);
2812 /* We store the char-id-tables in hash tables with the attributes as
2813 the key and the actual char-id-table object as the value. Each
2814 char-id-table stores values of an attribute corresponding with
2815 characters. Occasionally we need to get attributes of a character
2816 in a association-list format. These routines provide us with
2818 struct char_attribute_alist_closure
2821 Lisp_Object *char_attribute_alist;
2825 add_char_attribute_alist_mapper (Lisp_Object key, Lisp_Object value,
2826 void *char_attribute_alist_closure)
2828 /* This function can GC */
2829 struct char_attribute_alist_closure *caacl =
2830 (struct char_attribute_alist_closure*) char_attribute_alist_closure;
2832 = get_char_id_table (XCHAR_TABLE(value), caacl->char_id);
2833 if (!UNBOUNDP (ret))
2835 Lisp_Object *char_attribute_alist = caacl->char_attribute_alist;
2836 *char_attribute_alist
2837 = Fcons (Fcons (key, ret), *char_attribute_alist);
2842 DEFUN ("char-attribute-alist", Fchar_attribute_alist, 1, 1, 0, /*
2843 Return the alist of attributes of CHARACTER.
2847 Lisp_Object alist = Qnil;
2850 CHECK_CHAR (character);
2852 struct gcpro gcpro1;
2853 struct char_attribute_alist_closure char_attribute_alist_closure;
2856 char_attribute_alist_closure.char_id = XCHAR (character);
2857 char_attribute_alist_closure.char_attribute_alist = &alist;
2858 elisp_maphash (add_char_attribute_alist_mapper,
2859 Vchar_attribute_hash_table,
2860 &char_attribute_alist_closure);
2864 for (i = 0; i < countof (chlook->charset_by_leading_byte); i++)
2866 Lisp_Object ccs = chlook->charset_by_leading_byte[i];
2870 Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (ccs);
2873 if ( CHAR_TABLEP (encoding_table)
2875 = get_char_id_table (XCHAR_TABLE(encoding_table),
2876 XCHAR (character))) )
2878 alist = Fcons (Fcons (ccs, cpos), alist);
2885 DEFUN ("get-char-attribute", Fget_char_attribute, 2, 3, 0, /*
2886 Return the value of CHARACTER's ATTRIBUTE.
2887 Return DEFAULT-VALUE if the value is not exist.
2889 (character, attribute, default_value))
2893 CHECK_CHAR (character);
2894 if (!NILP (ccs = Ffind_charset (attribute)))
2896 Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (ccs);
2898 if (CHAR_TABLEP (encoding_table))
2899 return get_char_id_table (XCHAR_TABLE(encoding_table),
2904 Lisp_Object table = Fgethash (attribute,
2905 Vchar_attribute_hash_table,
2907 if (!UNBOUNDP (table))
2909 Lisp_Object ret = get_char_id_table (XCHAR_TABLE(table),
2911 if (!UNBOUNDP (ret))
2915 return default_value;
2918 DEFUN ("put-char-attribute", Fput_char_attribute, 3, 3, 0, /*
2919 Store CHARACTER's ATTRIBUTE with VALUE.
2921 (character, attribute, value))
2925 ccs = Ffind_charset (attribute);
2928 CHECK_CHAR (character);
2929 return put_char_ccs_code_point (character, ccs, value);
2931 else if (EQ (attribute, Q_decomposition))
2935 CHECK_CHAR (character);
2937 signal_simple_error ("Invalid value for ->decomposition",
2940 if (CONSP (Fcdr (value)))
2942 Lisp_Object rest = value;
2943 Lisp_Object table = Vcharacter_composition_table;
2947 GET_EXTERNAL_LIST_LENGTH (rest, len);
2948 seq = make_vector (len, Qnil);
2950 while (CONSP (rest))
2952 Lisp_Object v = Fcar (rest);
2955 = to_char_id (v, "Invalid value for ->decomposition", value);
2958 XVECTOR_DATA(seq)[i++] = v;
2960 XVECTOR_DATA(seq)[i++] = make_char (c);
2964 put_char_id_table (XCHAR_TABLE(table),
2965 make_char (c), character);
2970 ntable = get_char_id_table (XCHAR_TABLE(table), c);
2971 if (!CHAR_TABLEP (ntable))
2973 ntable = make_char_id_table (Qnil);
2974 put_char_id_table (XCHAR_TABLE(table),
2975 make_char (c), ntable);
2983 Lisp_Object v = Fcar (value);
2987 Emchar c = XINT (v);
2989 = get_char_id_table (XCHAR_TABLE(Vcharacter_variant_table),
2992 if (NILP (Fmemq (v, ret)))
2994 put_char_id_table (XCHAR_TABLE(Vcharacter_variant_table),
2995 make_char (c), Fcons (character, ret));
2998 seq = make_vector (1, v);
3002 else if (EQ (attribute, Qto_ucs) || EQ (attribute, Q_ucs))
3007 CHECK_CHAR (character);
3009 signal_simple_error ("Invalid value for ->ucs", value);
3013 ret = get_char_id_table (XCHAR_TABLE(Vcharacter_variant_table), c);
3014 if (NILP (Fmemq (character, ret)))
3016 put_char_id_table (XCHAR_TABLE(Vcharacter_variant_table),
3017 make_char (c), Fcons (character, ret));
3020 if (EQ (attribute, Q_ucs))
3021 attribute = Qto_ucs;
3025 Lisp_Object table = Fgethash (attribute,
3026 Vchar_attribute_hash_table,
3031 table = make_char_id_table (Qunbound);
3032 Fputhash (attribute, table, Vchar_attribute_hash_table);
3034 put_char_id_table (XCHAR_TABLE(table), character, value);
3039 DEFUN ("remove-char-attribute", Fremove_char_attribute, 2, 2, 0, /*
3040 Remove CHARACTER's ATTRIBUTE.
3042 (character, attribute))
3046 CHECK_CHAR (character);
3047 ccs = Ffind_charset (attribute);
3050 return remove_char_ccs (character, ccs);
3054 Lisp_Object table = Fgethash (attribute,
3055 Vchar_attribute_hash_table,
3057 if (!UNBOUNDP (table))
3059 put_char_id_table (XCHAR_TABLE(table), character, Qunbound);
3066 DEFUN ("map-char-attribute", Fmap_char_attribute, 2, 3, 0, /*
3067 Map FUNCTION over entries in ATTRIBUTE, calling it with two args,
3068 each key and value in the table.
3070 RANGE specifies a subrange to map over and is in the same format as
3071 the RANGE argument to `put-range-table'. If omitted or t, it defaults to
3074 (function, attribute, range))
3077 Lisp_Char_Table *ct;
3078 struct slow_map_char_table_arg slarg;
3079 struct gcpro gcpro1, gcpro2;
3080 struct chartab_range rainj;
3082 if (!NILP (ccs = Ffind_charset (attribute)))
3084 Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (ccs);
3086 if (CHAR_TABLEP (encoding_table))
3087 ct = XCHAR_TABLE (encoding_table);
3093 Lisp_Object table = Fgethash (attribute,
3094 Vchar_attribute_hash_table,
3096 if (CHAR_TABLEP (table))
3097 ct = XCHAR_TABLE (table);
3103 decode_char_table_range (range, &rainj);
3104 slarg.function = function;
3105 slarg.retval = Qnil;
3106 GCPRO2 (slarg.function, slarg.retval);
3107 map_char_table (ct, &rainj, slow_map_char_table_fun, &slarg);
3110 return slarg.retval;
3113 DEFUN ("define-char", Fdefine_char, 1, 1, 0, /*
3114 Store character's ATTRIBUTES.
3118 Lisp_Object rest = attributes;
3119 Lisp_Object code = Fcdr (Fassq (Qucs, attributes));
3120 Lisp_Object character;
3124 while (CONSP (rest))
3126 Lisp_Object cell = Fcar (rest);
3130 signal_simple_error ("Invalid argument", attributes);
3131 if (!NILP (ccs = Ffind_charset (Fcar (cell)))
3132 && ((XCHARSET_FINAL (ccs) != 0) ||
3133 (XCHARSET_UCS_MAX (ccs) > 0)) )
3137 character = Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
3139 character = Fdecode_char (ccs, cell, Qnil);
3140 if (!NILP (character))
3141 goto setup_attributes;
3145 if ( (!NILP (code = Fcdr (Fassq (Qto_ucs, attributes)))) ||
3146 (!NILP (code = Fcdr (Fassq (Q_ucs, attributes)))) )
3150 signal_simple_error ("Invalid argument", attributes);
3152 character = make_char (XINT (code) + 0x100000);
3153 goto setup_attributes;
3157 else if (!INTP (code))
3158 signal_simple_error ("Invalid argument", attributes);
3160 character = make_char (XINT (code));
3164 while (CONSP (rest))
3166 Lisp_Object cell = Fcar (rest);
3169 signal_simple_error ("Invalid argument", attributes);
3171 Fput_char_attribute (character, Fcar (cell), Fcdr (cell));
3177 DEFUN ("find-char", Ffind_char, 1, 1, 0, /*
3178 Retrieve the character of the given ATTRIBUTES.
3182 Lisp_Object rest = attributes;
3185 while (CONSP (rest))
3187 Lisp_Object cell = Fcar (rest);
3191 signal_simple_error ("Invalid argument", attributes);
3192 if (!NILP (ccs = Ffind_charset (Fcar (cell))))
3196 return Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
3198 return Fdecode_char (ccs, cell, Qnil);
3202 if ( (!NILP (code = Fcdr (Fassq (Qto_ucs, attributes)))) ||
3203 (!NILP (code = Fcdr (Fassq (Q_ucs, attributes)))) )
3206 signal_simple_error ("Invalid argument", attributes);
3208 return make_char (XINT (code) + 0x100000);
3216 /************************************************************************/
3217 /* Char table read syntax */
3218 /************************************************************************/
3221 chartab_type_validate (Lisp_Object keyword, Lisp_Object value,
3222 Error_behavior errb)
3224 /* #### should deal with ERRB */
3225 symbol_to_char_table_type (value);
3230 chartab_data_validate (Lisp_Object keyword, Lisp_Object value,
3231 Error_behavior errb)
3235 /* #### should deal with ERRB */
3236 EXTERNAL_LIST_LOOP (rest, value)
3238 Lisp_Object range = XCAR (rest);
3239 struct chartab_range dummy;
3243 signal_simple_error ("Invalid list format", value);
3246 if (!CONSP (XCDR (range))
3247 || !NILP (XCDR (XCDR (range))))
3248 signal_simple_error ("Invalid range format", range);
3249 decode_char_table_range (XCAR (range), &dummy);
3250 decode_char_table_range (XCAR (XCDR (range)), &dummy);
3253 decode_char_table_range (range, &dummy);
3260 chartab_instantiate (Lisp_Object data)
3262 Lisp_Object chartab;
3263 Lisp_Object type = Qgeneric;
3264 Lisp_Object dataval = Qnil;
3266 while (!NILP (data))
3268 Lisp_Object keyw = Fcar (data);
3274 if (EQ (keyw, Qtype))
3276 else if (EQ (keyw, Qdata))
3280 chartab = Fmake_char_table (type);
3283 while (!NILP (data))
3285 Lisp_Object range = Fcar (data);
3286 Lisp_Object val = Fcar (Fcdr (data));
3288 data = Fcdr (Fcdr (data));
3291 if (CHAR_OR_CHAR_INTP (XCAR (range)))
3293 Emchar first = XCHAR_OR_CHAR_INT (Fcar (range));
3294 Emchar last = XCHAR_OR_CHAR_INT (Fcar (Fcdr (range)));
3297 for (i = first; i <= last; i++)
3298 Fput_char_table (make_char (i), val, chartab);
3304 Fput_char_table (range, val, chartab);
3313 /************************************************************************/
3314 /* Category Tables, specifically */
3315 /************************************************************************/
3317 DEFUN ("category-table-p", Fcategory_table_p, 1, 1, 0, /*
3318 Return t if OBJECT is a category table.
3319 A category table is a type of char table used for keeping track of
3320 categories. Categories are used for classifying characters for use
3321 in regexps -- you can refer to a category rather than having to use
3322 a complicated [] expression (and category lookups are significantly
3325 There are 95 different categories available, one for each printable
3326 character (including space) in the ASCII charset. Each category
3327 is designated by one such character, called a "category designator".
3328 They are specified in a regexp using the syntax "\\cX", where X is
3329 a category designator.
3331 A category table specifies, for each character, the categories that
3332 the character is in. Note that a character can be in more than one
3333 category. More specifically, a category table maps from a character
3334 to either the value nil (meaning the character is in no categories)
3335 or a 95-element bit vector, specifying for each of the 95 categories
3336 whether the character is in that category.
3338 Special Lisp functions are provided that abstract this, so you do not
3339 have to directly manipulate bit vectors.
3343 return (CHAR_TABLEP (object) &&
3344 XCHAR_TABLE_TYPE (object) == CHAR_TABLE_TYPE_CATEGORY) ?
3349 check_category_table (Lisp_Object object, Lisp_Object default_)
3353 while (NILP (Fcategory_table_p (object)))
3354 object = wrong_type_argument (Qcategory_table_p, object);
3359 check_category_char (Emchar ch, Lisp_Object table,
3360 unsigned int designator, unsigned int not)
3362 REGISTER Lisp_Object temp;
3363 Lisp_Char_Table *ctbl;
3364 #ifdef ERROR_CHECK_TYPECHECK
3365 if (NILP (Fcategory_table_p (table)))
3366 signal_simple_error ("Expected category table", table);
3368 ctbl = XCHAR_TABLE (table);
3369 temp = get_char_table (ch, ctbl);
3374 return bit_vector_bit (XBIT_VECTOR (temp), designator) ? !not : not;
3377 DEFUN ("check-category-at", Fcheck_category_at, 2, 4, 0, /*
3378 Return t if category of the character at POSITION includes DESIGNATOR.
3379 Optional third arg BUFFER specifies which buffer to use, and defaults
3380 to the current buffer.
3381 Optional fourth arg CATEGORY-TABLE specifies the category table to
3382 use, and defaults to BUFFER's category table.
3384 (position, designator, buffer, category_table))
3389 struct buffer *buf = decode_buffer (buffer, 0);
3391 CHECK_INT (position);
3392 CHECK_CATEGORY_DESIGNATOR (designator);
3393 des = XCHAR (designator);
3394 ctbl = check_category_table (category_table, Vstandard_category_table);
3395 ch = BUF_FETCH_CHAR (buf, XINT (position));
3396 return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil;
3399 DEFUN ("char-in-category-p", Fchar_in_category_p, 2, 3, 0, /*
3400 Return t if category of CHARACTER includes DESIGNATOR, else nil.
3401 Optional third arg CATEGORY-TABLE specifies the category table to use,
3402 and defaults to the standard category table.
3404 (character, designator, category_table))
3410 CHECK_CATEGORY_DESIGNATOR (designator);
3411 des = XCHAR (designator);
3412 CHECK_CHAR (character);
3413 ch = XCHAR (character);
3414 ctbl = check_category_table (category_table, Vstandard_category_table);
3415 return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil;
3418 DEFUN ("category-table", Fcategory_table, 0, 1, 0, /*
3419 Return BUFFER's current category table.
3420 BUFFER defaults to the current buffer.
3424 return decode_buffer (buffer, 0)->category_table;
3427 DEFUN ("standard-category-table", Fstandard_category_table, 0, 0, 0, /*
3428 Return the standard category table.
3429 This is the one used for new buffers.
3433 return Vstandard_category_table;
3436 DEFUN ("copy-category-table", Fcopy_category_table, 0, 1, 0, /*
3437 Return a new category table which is a copy of CATEGORY-TABLE.
3438 CATEGORY-TABLE defaults to the standard category table.
3442 if (NILP (Vstandard_category_table))
3443 return Fmake_char_table (Qcategory);
3446 check_category_table (category_table, Vstandard_category_table);
3447 return Fcopy_char_table (category_table);
3450 DEFUN ("set-category-table", Fset_category_table, 1, 2, 0, /*
3451 Select CATEGORY-TABLE as the new category table for BUFFER.
3452 BUFFER defaults to the current buffer if omitted.
3454 (category_table, buffer))
3456 struct buffer *buf = decode_buffer (buffer, 0);
3457 category_table = check_category_table (category_table, Qnil);
3458 buf->category_table = category_table;
3459 /* Indicate that this buffer now has a specified category table. */
3460 buf->local_var_flags |= XINT (buffer_local_flags.category_table);
3461 return category_table;
3464 DEFUN ("category-designator-p", Fcategory_designator_p, 1, 1, 0, /*
3465 Return t if OBJECT is a category designator (a char in the range ' ' to '~').
3469 return CATEGORY_DESIGNATORP (object) ? Qt : Qnil;
3472 DEFUN ("category-table-value-p", Fcategory_table_value_p, 1, 1, 0, /*
3473 Return t if OBJECT is a category table value.
3474 Valid values are nil or a bit vector of size 95.
3478 return CATEGORY_TABLE_VALUEP (object) ? Qt : Qnil;
3482 #define CATEGORYP(x) \
3483 (CHARP (x) && XCHAR (x) >= 0x20 && XCHAR (x) <= 0x7E)
3485 #define CATEGORY_SET(c) \
3486 (get_char_table(c, XCHAR_TABLE(current_buffer->category_table)))
3488 /* Return 1 if CATEGORY_SET contains CATEGORY, else return 0.
3489 The faster version of `!NILP (Faref (category_set, category))'. */
3490 #define CATEGORY_MEMBER(category, category_set) \
3491 (bit_vector_bit(XBIT_VECTOR (category_set), category - 32))
3493 /* Return 1 if there is a word boundary between two word-constituent
3494 characters C1 and C2 if they appear in this order, else return 0.
3495 Use the macro WORD_BOUNDARY_P instead of calling this function
3498 int word_boundary_p (Emchar c1, Emchar c2);
3500 word_boundary_p (Emchar c1, Emchar c2)
3502 Lisp_Object category_set1, category_set2;
3507 if (COMPOSITE_CHAR_P (c1))
3508 c1 = cmpchar_component (c1, 0, 1);
3509 if (COMPOSITE_CHAR_P (c2))
3510 c2 = cmpchar_component (c2, 0, 1);
3513 if (EQ (CHAR_CHARSET (c1), CHAR_CHARSET (c2)))
3515 tail = Vword_separating_categories;
3520 tail = Vword_combining_categories;
3524 category_set1 = CATEGORY_SET (c1);
3525 if (NILP (category_set1))
3526 return default_result;
3527 category_set2 = CATEGORY_SET (c2);
3528 if (NILP (category_set2))
3529 return default_result;
3531 for (; CONSP (tail); tail = XCONS (tail)->cdr)
3533 Lisp_Object elt = XCONS(tail)->car;
3536 && CATEGORYP (XCONS (elt)->car)
3537 && CATEGORYP (XCONS (elt)->cdr)
3538 && CATEGORY_MEMBER (XCHAR (XCONS (elt)->car), category_set1)
3539 && CATEGORY_MEMBER (XCHAR (XCONS (elt)->cdr), category_set2))
3540 return !default_result;
3542 return default_result;
3548 syms_of_chartab (void)
3551 INIT_LRECORD_IMPLEMENTATION (uint8_byte_table);
3552 INIT_LRECORD_IMPLEMENTATION (uint16_byte_table);
3553 INIT_LRECORD_IMPLEMENTATION (byte_table);
3555 defsymbol (&Qto_ucs, "=>ucs");
3556 defsymbol (&Q_ucs, "->ucs");
3557 defsymbol (&Q_decomposition, "->decomposition");
3558 defsymbol (&Qcompat, "compat");
3559 defsymbol (&Qisolated, "isolated");
3560 defsymbol (&Qinitial, "initial");
3561 defsymbol (&Qmedial, "medial");
3562 defsymbol (&Qfinal, "final");
3563 defsymbol (&Qvertical, "vertical");
3564 defsymbol (&QnoBreak, "noBreak");
3565 defsymbol (&Qfraction, "fraction");
3566 defsymbol (&Qsuper, "super");
3567 defsymbol (&Qsub, "sub");
3568 defsymbol (&Qcircle, "circle");
3569 defsymbol (&Qsquare, "square");
3570 defsymbol (&Qwide, "wide");
3571 defsymbol (&Qnarrow, "narrow");
3572 defsymbol (&Qsmall, "small");
3573 defsymbol (&Qfont, "font");
3575 DEFSUBR (Fchar_attribute_list);
3576 DEFSUBR (Ffind_char_attribute_table);
3577 DEFSUBR (Fchar_attribute_alist);
3578 DEFSUBR (Fget_char_attribute);
3579 DEFSUBR (Fput_char_attribute);
3580 DEFSUBR (Fremove_char_attribute);
3581 DEFSUBR (Fmap_char_attribute);
3582 DEFSUBR (Fdefine_char);
3583 DEFSUBR (Ffind_char);
3584 DEFSUBR (Fchar_variants);
3586 DEFSUBR (Fget_composite_char);
3589 INIT_LRECORD_IMPLEMENTATION (char_table);
3593 INIT_LRECORD_IMPLEMENTATION (char_table_entry);
3596 defsymbol (&Qcategory_table_p, "category-table-p");
3597 defsymbol (&Qcategory_designator_p, "category-designator-p");
3598 defsymbol (&Qcategory_table_value_p, "category-table-value-p");
3601 defsymbol (&Qchar_table, "char-table");
3602 defsymbol (&Qchar_tablep, "char-table-p");
3604 DEFSUBR (Fchar_table_p);
3605 DEFSUBR (Fchar_table_type_list);
3606 DEFSUBR (Fvalid_char_table_type_p);
3607 DEFSUBR (Fchar_table_type);
3608 DEFSUBR (Freset_char_table);
3609 DEFSUBR (Fmake_char_table);
3610 DEFSUBR (Fcopy_char_table);
3611 DEFSUBR (Fget_char_table);
3612 DEFSUBR (Fget_range_char_table);
3613 DEFSUBR (Fvalid_char_table_value_p);
3614 DEFSUBR (Fcheck_valid_char_table_value);
3615 DEFSUBR (Fput_char_table);
3616 DEFSUBR (Fmap_char_table);
3619 DEFSUBR (Fcategory_table_p);
3620 DEFSUBR (Fcategory_table);
3621 DEFSUBR (Fstandard_category_table);
3622 DEFSUBR (Fcopy_category_table);
3623 DEFSUBR (Fset_category_table);
3624 DEFSUBR (Fcheck_category_at);
3625 DEFSUBR (Fchar_in_category_p);
3626 DEFSUBR (Fcategory_designator_p);
3627 DEFSUBR (Fcategory_table_value_p);
3633 vars_of_chartab (void)
3636 Vutf_2000_version = build_string("0.18 (Yamato-Koizumi)");
3637 DEFVAR_LISP ("utf-2000-version", &Vutf_2000_version /*
3638 Version number of XEmacs UTF-2000.
3641 staticpro (&Vcharacter_composition_table);
3642 Vcharacter_composition_table = make_char_id_table (Qnil);
3644 staticpro (&Vcharacter_variant_table);
3645 Vcharacter_variant_table = make_char_id_table (Qnil);
3647 /* DO NOT staticpro this. It works just like Vweak_hash_tables. */
3648 Vall_syntax_tables = Qnil;
3649 dump_add_weak_object_chain (&Vall_syntax_tables);
3653 structure_type_create_chartab (void)
3655 struct structure_type *st;
3657 st = define_structure_type (Qchar_table, 0, chartab_instantiate);
3659 define_structure_type_keyword (st, Qtype, chartab_type_validate);
3660 define_structure_type_keyword (st, Qdata, chartab_data_validate);
3664 complex_vars_of_chartab (void)
3667 staticpro (&Vchar_attribute_hash_table);
3668 Vchar_attribute_hash_table
3669 = make_lisp_hash_table (16, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
3670 #endif /* UTF2000 */
3672 /* Set this now, so first buffer creation can refer to it. */
3673 /* Make it nil before calling copy-category-table
3674 so that copy-category-table will know not to try to copy from garbage */
3675 Vstandard_category_table = Qnil;
3676 Vstandard_category_table = Fcopy_category_table (Qnil);
3677 staticpro (&Vstandard_category_table);
3679 DEFVAR_LISP ("word-combining-categories", &Vword_combining_categories /*
3680 List of pair (cons) of categories to determine word boundary.
3682 Emacs treats a sequence of word constituent characters as a single
3683 word (i.e. finds no word boundary between them) iff they belongs to
3684 the same charset. But, exceptions are allowed in the following cases.
3686 \(1) The case that characters are in different charsets is controlled
3687 by the variable `word-combining-categories'.
3689 Emacs finds no word boundary between characters of different charsets
3690 if they have categories matching some element of this list.
3692 More precisely, if an element of this list is a cons of category CAT1
3693 and CAT2, and a multibyte character C1 which has CAT1 is followed by
3694 C2 which has CAT2, there's no word boundary between C1 and C2.
3696 For instance, to tell that ASCII characters and Latin-1 characters can
3697 form a single word, the element `(?l . ?l)' should be in this list
3698 because both characters have the category `l' (Latin characters).
3700 \(2) The case that character are in the same charset is controlled by
3701 the variable `word-separating-categories'.
3703 Emacs find a word boundary between characters of the same charset
3704 if they have categories matching some element of this list.
3706 More precisely, if an element of this list is a cons of category CAT1
3707 and CAT2, and a multibyte character C1 which has CAT1 is followed by
3708 C2 which has CAT2, there's a word boundary between C1 and C2.
3710 For instance, to tell that there's a word boundary between Japanese
3711 Hiragana and Japanese Kanji (both are in the same charset), the
3712 element `(?H . ?C) should be in this list.
3715 Vword_combining_categories = Qnil;
3717 DEFVAR_LISP ("word-separating-categories", &Vword_separating_categories /*
3718 List of pair (cons) of categories to determine word boundary.
3719 See the documentation of the variable `word-combining-categories'.
3722 Vword_separating_categories = Qnil;