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;
1744 else if (EQ (range, Qnil))
1745 outrange->type = CHARTAB_RANGE_DEFAULT;
1747 else if (CHAR_OR_CHAR_INTP (range))
1749 outrange->type = CHARTAB_RANGE_CHAR;
1750 outrange->ch = XCHAR_OR_CHAR_INT (range);
1754 signal_simple_error ("Range must be t or a character", range);
1756 else if (VECTORP (range))
1758 Lisp_Vector *vec = XVECTOR (range);
1759 Lisp_Object *elts = vector_data (vec);
1760 int cell_min, cell_max;
1762 outrange->type = CHARTAB_RANGE_ROW;
1763 outrange->charset = Fget_charset (elts[0]);
1764 CHECK_INT (elts[1]);
1765 outrange->row = XINT (elts[1]);
1766 if (XCHARSET_DIMENSION (outrange->charset) < 2)
1767 signal_simple_error ("Charset in row vector must be multi-byte",
1771 int ret = XCHARSET_CELL_RANGE (outrange->charset);
1773 cell_min = ret >> 8;
1774 cell_max = ret & 0xFF;
1776 if (XCHARSET_DIMENSION (outrange->charset) == 2)
1777 check_int_range (outrange->row, cell_min, cell_max);
1779 else if (XCHARSET_DIMENSION (outrange->charset) == 3)
1781 check_int_range (outrange->row >> 8 , cell_min, cell_max);
1782 check_int_range (outrange->row & 0xFF, cell_min, cell_max);
1784 else if (XCHARSET_DIMENSION (outrange->charset) == 4)
1786 check_int_range ( outrange->row >> 16 , cell_min, cell_max);
1787 check_int_range ((outrange->row >> 8) & 0xFF, cell_min, cell_max);
1788 check_int_range ( outrange->row & 0xFF, cell_min, cell_max);
1796 if (!CHARSETP (range) && !SYMBOLP (range))
1798 ("Char table range must be t, charset, char, or vector", range);
1799 outrange->type = CHARTAB_RANGE_CHARSET;
1800 outrange->charset = Fget_charset (range);
1805 #if defined(MULE)&&!defined(UTF2000)
1807 /* called from CHAR_TABLE_VALUE(). */
1809 get_non_ascii_char_table_value (Lisp_Char_Table *ct, Charset_ID leading_byte,
1814 Lisp_Object charset;
1816 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (leading_byte);
1821 BREAKUP_CHAR (c, charset, byte1, byte2);
1823 BREAKUP_CHAR_1_UNSAFE (c, charset, byte1, byte2);
1825 val = ct->level1[leading_byte - MIN_LEADING_BYTE];
1826 if (CHAR_TABLE_ENTRYP (val))
1828 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
1829 val = cte->level2[byte1 - 32];
1830 if (CHAR_TABLE_ENTRYP (val))
1832 cte = XCHAR_TABLE_ENTRY (val);
1833 assert (byte2 >= 32);
1834 val = cte->level2[byte2 - 32];
1835 assert (!CHAR_TABLE_ENTRYP (val));
1845 get_char_table (Emchar ch, Lisp_Char_Table *ct)
1848 return get_char_id_table (ct, ch);
1851 Lisp_Object charset;
1855 BREAKUP_CHAR (ch, charset, byte1, byte2);
1857 if (EQ (charset, Vcharset_ascii))
1858 val = ct->ascii[byte1];
1859 else if (EQ (charset, Vcharset_control_1))
1860 val = ct->ascii[byte1 + 128];
1863 int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE;
1864 val = ct->level1[lb];
1865 if (CHAR_TABLE_ENTRYP (val))
1867 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
1868 val = cte->level2[byte1 - 32];
1869 if (CHAR_TABLE_ENTRYP (val))
1871 cte = XCHAR_TABLE_ENTRY (val);
1872 assert (byte2 >= 32);
1873 val = cte->level2[byte2 - 32];
1874 assert (!CHAR_TABLE_ENTRYP (val));
1881 #else /* not MULE */
1882 return ct->ascii[(unsigned char)ch];
1883 #endif /* not MULE */
1887 DEFUN ("get-char-table", Fget_char_table, 2, 2, 0, /*
1888 Find value for CHARACTER in CHAR-TABLE.
1890 (character, char_table))
1892 CHECK_CHAR_TABLE (char_table);
1893 CHECK_CHAR_COERCE_INT (character);
1895 return get_char_table (XCHAR (character), XCHAR_TABLE (char_table));
1898 DEFUN ("get-range-char-table", Fget_range_char_table, 2, 3, 0, /*
1899 Find value for a range in CHAR-TABLE.
1900 If there is more than one value, return MULTI (defaults to nil).
1902 (range, char_table, multi))
1904 Lisp_Char_Table *ct;
1905 struct chartab_range rainj;
1907 if (CHAR_OR_CHAR_INTP (range))
1908 return Fget_char_table (range, char_table);
1909 CHECK_CHAR_TABLE (char_table);
1910 ct = XCHAR_TABLE (char_table);
1912 decode_char_table_range (range, &rainj);
1915 case CHARTAB_RANGE_ALL:
1918 if (UINT8_BYTE_TABLE_P (ct->table))
1920 else if (UINT16_BYTE_TABLE_P (ct->table))
1922 else if (BYTE_TABLE_P (ct->table))
1926 #else /* non UTF2000 */
1928 Lisp_Object first = ct->ascii[0];
1930 for (i = 1; i < NUM_ASCII_CHARS; i++)
1931 if (!EQ (first, ct->ascii[i]))
1935 for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES;
1938 if (!CHARSETP (CHARSET_BY_LEADING_BYTE (i))
1939 || i == LEADING_BYTE_ASCII
1940 || i == LEADING_BYTE_CONTROL_1)
1942 if (!EQ (first, ct->level1[i - MIN_LEADING_BYTE]))
1948 #endif /* non UTF2000 */
1952 case CHARTAB_RANGE_CHARSET:
1956 if (EQ (rainj.charset, Vcharset_ascii))
1959 Lisp_Object first = ct->ascii[0];
1961 for (i = 1; i < 128; i++)
1962 if (!EQ (first, ct->ascii[i]))
1967 if (EQ (rainj.charset, Vcharset_control_1))
1970 Lisp_Object first = ct->ascii[128];
1972 for (i = 129; i < 160; i++)
1973 if (!EQ (first, ct->ascii[i]))
1979 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (rainj.charset) -
1981 if (CHAR_TABLE_ENTRYP (val))
1987 case CHARTAB_RANGE_ROW:
1992 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (rainj.charset) -
1994 if (!CHAR_TABLE_ENTRYP (val))
1996 val = XCHAR_TABLE_ENTRY (val)->level2[rainj.row - 32];
1997 if (CHAR_TABLE_ENTRYP (val))
2001 #endif /* not UTF2000 */
2002 #endif /* not MULE */
2008 return Qnil; /* not reached */
2012 check_valid_char_table_value (Lisp_Object value, enum char_table_type type,
2013 Error_behavior errb)
2017 case CHAR_TABLE_TYPE_SYNTAX:
2018 if (!ERRB_EQ (errb, ERROR_ME))
2019 return INTP (value) || (CONSP (value) && INTP (XCAR (value))
2020 && CHAR_OR_CHAR_INTP (XCDR (value)));
2023 Lisp_Object cdr = XCDR (value);
2024 CHECK_INT (XCAR (value));
2025 CHECK_CHAR_COERCE_INT (cdr);
2032 case CHAR_TABLE_TYPE_CATEGORY:
2033 if (!ERRB_EQ (errb, ERROR_ME))
2034 return CATEGORY_TABLE_VALUEP (value);
2035 CHECK_CATEGORY_TABLE_VALUE (value);
2039 case CHAR_TABLE_TYPE_GENERIC:
2042 case CHAR_TABLE_TYPE_DISPLAY:
2044 maybe_signal_simple_error ("Display char tables not yet implemented",
2045 value, Qchar_table, errb);
2048 case CHAR_TABLE_TYPE_CHAR:
2049 if (!ERRB_EQ (errb, ERROR_ME))
2050 return CHAR_OR_CHAR_INTP (value);
2051 CHECK_CHAR_COERCE_INT (value);
2058 return 0; /* not reached */
2062 canonicalize_char_table_value (Lisp_Object value, enum char_table_type type)
2066 case CHAR_TABLE_TYPE_SYNTAX:
2069 Lisp_Object car = XCAR (value);
2070 Lisp_Object cdr = XCDR (value);
2071 CHECK_CHAR_COERCE_INT (cdr);
2072 return Fcons (car, cdr);
2075 case CHAR_TABLE_TYPE_CHAR:
2076 CHECK_CHAR_COERCE_INT (value);
2084 DEFUN ("valid-char-table-value-p", Fvalid_char_table_value_p, 2, 2, 0, /*
2085 Return non-nil if VALUE is 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 return check_valid_char_table_value (value, type, ERROR_ME_NOT) ? Qt : Qnil;
2094 DEFUN ("check-valid-char-table-value", Fcheck_valid_char_table_value, 2, 2, 0, /*
2095 Signal an error if VALUE is not a valid value for CHAR-TABLE-TYPE.
2097 (value, char_table_type))
2099 enum char_table_type type = symbol_to_char_table_type (char_table_type);
2101 check_valid_char_table_value (value, type, ERROR_ME);
2105 /* Assign VAL to all characters in RANGE in char table CT. */
2108 put_char_table (Lisp_Char_Table *ct, struct chartab_range *range,
2111 switch (range->type)
2113 case CHARTAB_RANGE_ALL:
2114 /* printf ("put-char-table: range = all\n"); */
2115 fill_char_table (ct, val);
2116 return; /* avoid the duplicate call to update_syntax_table() below,
2117 since fill_char_table() also did that. */
2120 case CHARTAB_RANGE_DEFAULT:
2121 ct->default_value = val;
2126 case CHARTAB_RANGE_CHARSET:
2130 Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (range->charset);
2132 /* printf ("put-char-table: range = charset: %d\n",
2133 XCHARSET_LEADING_BYTE (range->charset));
2135 if ( CHAR_TABLEP (encoding_table) )
2137 for (c = 0; c < 1 << 24; c++)
2139 if ( INTP (get_char_id_table (XCHAR_TABLE(encoding_table),
2141 put_char_id_table_0 (ct, c, val);
2146 for (c = 0; c < 1 << 24; c++)
2148 if ( charset_code_point (range->charset, c, 0) >= 0 )
2149 put_char_id_table_0 (ct, c, val);
2154 if (EQ (range->charset, Vcharset_ascii))
2157 for (i = 0; i < 128; i++)
2160 else if (EQ (range->charset, Vcharset_control_1))
2163 for (i = 128; i < 160; i++)
2168 int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE;
2169 ct->level1[lb] = val;
2174 case CHARTAB_RANGE_ROW:
2177 int cell_min, cell_max, i;
2179 i = XCHARSET_CELL_RANGE (range->charset);
2181 cell_max = i & 0xFF;
2182 for (i = cell_min; i <= cell_max; i++)
2184 Emchar ch = DECODE_CHAR (range->charset, (range->row << 8) | i);
2186 if ( charset_code_point (range->charset, ch, 0) >= 0 )
2187 put_char_id_table_0 (ct, ch, val);
2192 Lisp_Char_Table_Entry *cte;
2193 int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE;
2194 /* make sure that there is a separate entry for the row. */
2195 if (!CHAR_TABLE_ENTRYP (ct->level1[lb]))
2196 ct->level1[lb] = make_char_table_entry (ct->level1[lb]);
2197 cte = XCHAR_TABLE_ENTRY (ct->level1[lb]);
2198 cte->level2[range->row - 32] = val;
2200 #endif /* not UTF2000 */
2204 case CHARTAB_RANGE_CHAR:
2206 /* printf ("put-char-table: range = char: 0x%x\n", range->ch); */
2207 put_char_id_table_0 (ct, range->ch, val);
2211 Lisp_Object charset;
2214 BREAKUP_CHAR (range->ch, charset, byte1, byte2);
2215 if (EQ (charset, Vcharset_ascii))
2216 ct->ascii[byte1] = val;
2217 else if (EQ (charset, Vcharset_control_1))
2218 ct->ascii[byte1 + 128] = val;
2221 Lisp_Char_Table_Entry *cte;
2222 int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE;
2223 /* make sure that there is a separate entry for the row. */
2224 if (!CHAR_TABLE_ENTRYP (ct->level1[lb]))
2225 ct->level1[lb] = make_char_table_entry (ct->level1[lb]);
2226 cte = XCHAR_TABLE_ENTRY (ct->level1[lb]);
2227 /* now CTE is a char table entry for the charset;
2228 each entry is for a single row (or character of
2229 a one-octet charset). */
2230 if (XCHARSET_DIMENSION (charset) == 1)
2231 cte->level2[byte1 - 32] = val;
2234 /* assigning to one character in a two-octet charset. */
2235 /* make sure that the charset row contains a separate
2236 entry for each character. */
2237 if (!CHAR_TABLE_ENTRYP (cte->level2[byte1 - 32]))
2238 cte->level2[byte1 - 32] =
2239 make_char_table_entry (cte->level2[byte1 - 32]);
2240 cte = XCHAR_TABLE_ENTRY (cte->level2[byte1 - 32]);
2241 cte->level2[byte2 - 32] = val;
2245 #else /* not MULE */
2246 ct->ascii[(unsigned char) (range->ch)] = val;
2248 #endif /* not MULE */
2252 if (ct->type == CHAR_TABLE_TYPE_SYNTAX)
2253 update_syntax_table (ct);
2257 DEFUN ("put-char-table", Fput_char_table, 3, 3, 0, /*
2258 Set the value for chars in RANGE to be VALUE in CHAR-TABLE.
2260 RANGE specifies one or more characters to be affected and should be
2261 one of the following:
2263 -- t (all characters are affected)
2264 -- A charset (only allowed when Mule support is present)
2265 -- A vector of two elements: a two-octet charset and a row number
2266 (only allowed when Mule support is present)
2267 -- A single character
2269 VALUE must be a value appropriate for the type of CHAR-TABLE.
2270 See `valid-char-table-type-p'.
2272 (range, value, char_table))
2274 Lisp_Char_Table *ct;
2275 struct chartab_range rainj;
2277 CHECK_CHAR_TABLE (char_table);
2278 ct = XCHAR_TABLE (char_table);
2279 check_valid_char_table_value (value, ct->type, ERROR_ME);
2280 decode_char_table_range (range, &rainj);
2281 value = canonicalize_char_table_value (value, ct->type);
2282 put_char_table (ct, &rainj, value);
2287 /* Map FN over the ASCII chars in CT. */
2290 map_over_charset_ascii (Lisp_Char_Table *ct,
2291 int (*fn) (struct chartab_range *range,
2292 Lisp_Object val, void *arg),
2295 struct chartab_range rainj;
2304 rainj.type = CHARTAB_RANGE_CHAR;
2306 for (i = start, retval = 0; i < stop && retval == 0; i++)
2308 rainj.ch = (Emchar) i;
2309 retval = (fn) (&rainj, ct->ascii[i], arg);
2317 /* Map FN over the Control-1 chars in CT. */
2320 map_over_charset_control_1 (Lisp_Char_Table *ct,
2321 int (*fn) (struct chartab_range *range,
2322 Lisp_Object val, void *arg),
2325 struct chartab_range rainj;
2328 int stop = start + 32;
2330 rainj.type = CHARTAB_RANGE_CHAR;
2332 for (i = start, retval = 0; i < stop && retval == 0; i++)
2334 rainj.ch = (Emchar) (i);
2335 retval = (fn) (&rainj, ct->ascii[i], arg);
2341 /* Map FN over the row ROW of two-byte charset CHARSET.
2342 There must be a separate value for that row in the char table.
2343 CTE specifies the char table entry for CHARSET. */
2346 map_over_charset_row (Lisp_Char_Table_Entry *cte,
2347 Lisp_Object charset, int row,
2348 int (*fn) (struct chartab_range *range,
2349 Lisp_Object val, void *arg),
2352 Lisp_Object val = cte->level2[row - 32];
2354 if (!CHAR_TABLE_ENTRYP (val))
2356 struct chartab_range rainj;
2358 rainj.type = CHARTAB_RANGE_ROW;
2359 rainj.charset = charset;
2361 return (fn) (&rainj, val, arg);
2365 struct chartab_range rainj;
2367 int charset94_p = (XCHARSET_CHARS (charset) == 94);
2368 int start = charset94_p ? 33 : 32;
2369 int stop = charset94_p ? 127 : 128;
2371 cte = XCHAR_TABLE_ENTRY (val);
2373 rainj.type = CHARTAB_RANGE_CHAR;
2375 for (i = start, retval = 0; i < stop && retval == 0; i++)
2377 rainj.ch = MAKE_CHAR (charset, row, i);
2378 retval = (fn) (&rainj, cte->level2[i - 32], arg);
2386 map_over_other_charset (Lisp_Char_Table *ct, Charset_ID lb,
2387 int (*fn) (struct chartab_range *range,
2388 Lisp_Object val, void *arg),
2391 Lisp_Object val = ct->level1[lb - MIN_LEADING_BYTE];
2392 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (lb);
2394 if (!CHARSETP (charset)
2395 || lb == LEADING_BYTE_ASCII
2396 || lb == LEADING_BYTE_CONTROL_1)
2399 if (!CHAR_TABLE_ENTRYP (val))
2401 struct chartab_range rainj;
2403 rainj.type = CHARTAB_RANGE_CHARSET;
2404 rainj.charset = charset;
2405 return (fn) (&rainj, val, arg);
2409 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
2410 int charset94_p = (XCHARSET_CHARS (charset) == 94);
2411 int start = charset94_p ? 33 : 32;
2412 int stop = charset94_p ? 127 : 128;
2415 if (XCHARSET_DIMENSION (charset) == 1)
2417 struct chartab_range rainj;
2418 rainj.type = CHARTAB_RANGE_CHAR;
2420 for (i = start, retval = 0; i < stop && retval == 0; i++)
2422 rainj.ch = MAKE_CHAR (charset, i, 0);
2423 retval = (fn) (&rainj, cte->level2[i - 32], arg);
2428 for (i = start, retval = 0; i < stop && retval == 0; i++)
2429 retval = map_over_charset_row (cte, charset, i, fn, arg);
2437 #endif /* not UTF2000 */
2440 struct map_char_table_for_charset_arg
2442 int (*fn) (struct chartab_range *range, Lisp_Object val, void *arg);
2443 Lisp_Char_Table *ct;
2448 map_char_table_for_charset_fun (struct chartab_range *range,
2449 Lisp_Object val, void *arg)
2451 struct map_char_table_for_charset_arg *closure =
2452 (struct map_char_table_for_charset_arg *) arg;
2455 switch (range->type)
2457 case CHARTAB_RANGE_ALL:
2460 case CHARTAB_RANGE_DEFAULT:
2463 case CHARTAB_RANGE_CHARSET:
2466 case CHARTAB_RANGE_ROW:
2469 case CHARTAB_RANGE_CHAR:
2470 ret = get_char_table (range->ch, closure->ct);
2471 if (!UNBOUNDP (ret))
2472 return (closure->fn) (range, ret, closure->arg);
2483 /* Map FN (with client data ARG) over range RANGE in char table CT.
2484 Mapping stops the first time FN returns non-zero, and that value
2485 becomes the return value of map_char_table(). */
2488 map_char_table (Lisp_Char_Table *ct,
2489 struct chartab_range *range,
2490 int (*fn) (struct chartab_range *range,
2491 Lisp_Object val, void *arg),
2494 switch (range->type)
2496 case CHARTAB_RANGE_ALL:
2498 if (!UNBOUNDP (ct->default_value))
2500 struct chartab_range rainj;
2503 rainj.type = CHARTAB_RANGE_DEFAULT;
2504 retval = (fn) (&rainj, ct->default_value, arg);
2508 if (UINT8_BYTE_TABLE_P (ct->table))
2509 return map_over_uint8_byte_table (XUINT8_BYTE_TABLE(ct->table),
2511 else if (UINT16_BYTE_TABLE_P (ct->table))
2512 return map_over_uint16_byte_table (XUINT16_BYTE_TABLE(ct->table),
2514 else if (BYTE_TABLE_P (ct->table))
2515 return map_over_byte_table (XBYTE_TABLE(ct->table),
2517 else if (!UNBOUNDP (ct->table))
2520 struct chartab_range rainj;
2523 Emchar c1 = c + unit;
2526 rainj.type = CHARTAB_RANGE_CHAR;
2528 for (retval = 0; c < c1 && retval == 0; c++)
2531 retval = (fn) (&rainj, ct->table, arg);
2536 return (fn) (range, ct->table, arg);
2543 retval = map_over_charset_ascii (ct, fn, arg);
2547 retval = map_over_charset_control_1 (ct, fn, arg);
2552 Charset_ID start = MIN_LEADING_BYTE;
2553 Charset_ID stop = start + NUM_LEADING_BYTES;
2555 for (i = start, retval = 0; i < stop && retval == 0; i++)
2557 retval = map_over_other_charset (ct, i, fn, arg);
2566 case CHARTAB_RANGE_DEFAULT:
2567 if (!UNBOUNDP (ct->default_value))
2568 return (fn) (range, ct->default_value, arg);
2573 case CHARTAB_RANGE_CHARSET:
2576 Lisp_Object encoding_table
2577 = XCHARSET_ENCODING_TABLE (range->charset);
2579 if (!NILP (encoding_table))
2581 struct chartab_range rainj;
2582 struct map_char_table_for_charset_arg mcarg;
2587 rainj.type = CHARTAB_RANGE_ALL;
2588 return map_char_table (XCHAR_TABLE(encoding_table),
2590 &map_char_table_for_charset_fun,
2596 return map_over_other_charset (ct,
2597 XCHARSET_LEADING_BYTE (range->charset),
2601 case CHARTAB_RANGE_ROW:
2604 int cell_min, cell_max, i;
2606 struct chartab_range rainj;
2608 i = XCHARSET_CELL_RANGE (range->charset);
2610 cell_max = i & 0xFF;
2611 rainj.type = CHARTAB_RANGE_CHAR;
2612 for (retval =0, i = cell_min; i <= cell_max && retval == 0; i++)
2614 Emchar ch = DECODE_CHAR (range->charset, (range->row << 8) | i);
2616 if ( charset_code_point (range->charset, ch, 0) >= 0 )
2619 = get_byte_table (get_byte_table
2623 (unsigned char)(ch >> 24)),
2624 (unsigned char) (ch >> 16)),
2625 (unsigned char) (ch >> 8)),
2626 (unsigned char) ch);
2629 val = ct->default_value;
2631 retval = (fn) (&rainj, val, arg);
2638 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (range->charset)
2639 - MIN_LEADING_BYTE];
2640 if (!CHAR_TABLE_ENTRYP (val))
2642 struct chartab_range rainj;
2644 rainj.type = CHARTAB_RANGE_ROW;
2645 rainj.charset = range->charset;
2646 rainj.row = range->row;
2647 return (fn) (&rainj, val, arg);
2650 return map_over_charset_row (XCHAR_TABLE_ENTRY (val),
2651 range->charset, range->row,
2654 #endif /* not UTF2000 */
2657 case CHARTAB_RANGE_CHAR:
2659 Emchar ch = range->ch;
2660 Lisp_Object val = CHAR_TABLE_VALUE_UNSAFE (ct, ch);
2662 if (!UNBOUNDP (val))
2664 struct chartab_range rainj;
2666 rainj.type = CHARTAB_RANGE_CHAR;
2668 return (fn) (&rainj, val, arg);
2680 struct slow_map_char_table_arg
2682 Lisp_Object function;
2687 slow_map_char_table_fun (struct chartab_range *range,
2688 Lisp_Object val, void *arg)
2690 Lisp_Object ranjarg = Qnil;
2691 struct slow_map_char_table_arg *closure =
2692 (struct slow_map_char_table_arg *) arg;
2694 switch (range->type)
2696 case CHARTAB_RANGE_ALL:
2701 case CHARTAB_RANGE_DEFAULT:
2707 case CHARTAB_RANGE_CHARSET:
2708 ranjarg = XCHARSET_NAME (range->charset);
2711 case CHARTAB_RANGE_ROW:
2712 ranjarg = vector2 (XCHARSET_NAME (range->charset),
2713 make_int (range->row));
2716 case CHARTAB_RANGE_CHAR:
2717 ranjarg = make_char (range->ch);
2723 closure->retval = call2 (closure->function, ranjarg, val);
2724 return !NILP (closure->retval);
2727 DEFUN ("map-char-table", Fmap_char_table, 2, 3, 0, /*
2728 Map FUNCTION over entries in CHAR-TABLE, calling it with two args,
2729 each key and value in the table.
2731 RANGE specifies a subrange to map over and is in the same format as
2732 the RANGE argument to `put-range-table'. If omitted or t, it defaults to
2735 (function, char_table, range))
2737 Lisp_Char_Table *ct;
2738 struct slow_map_char_table_arg slarg;
2739 struct gcpro gcpro1, gcpro2;
2740 struct chartab_range rainj;
2742 CHECK_CHAR_TABLE (char_table);
2743 ct = XCHAR_TABLE (char_table);
2746 decode_char_table_range (range, &rainj);
2747 slarg.function = function;
2748 slarg.retval = Qnil;
2749 GCPRO2 (slarg.function, slarg.retval);
2750 map_char_table (ct, &rainj, slow_map_char_table_fun, &slarg);
2753 return slarg.retval;
2757 /************************************************************************/
2758 /* Character Attributes */
2759 /************************************************************************/
2763 Lisp_Object Vchar_attribute_hash_table;
2765 /* We store the char-attributes in hash tables with the names as the
2766 key and the actual char-id-table object as the value. Occasionally
2767 we need to use them in a list format. These routines provide us
2769 struct char_attribute_list_closure
2771 Lisp_Object *char_attribute_list;
2775 add_char_attribute_to_list_mapper (Lisp_Object key, Lisp_Object value,
2776 void *char_attribute_list_closure)
2778 /* This function can GC */
2779 struct char_attribute_list_closure *calcl
2780 = (struct char_attribute_list_closure*) char_attribute_list_closure;
2781 Lisp_Object *char_attribute_list = calcl->char_attribute_list;
2783 *char_attribute_list = Fcons (key, *char_attribute_list);
2787 DEFUN ("char-attribute-list", Fchar_attribute_list, 0, 0, 0, /*
2788 Return the list of all existing character attributes except coded-charsets.
2792 Lisp_Object char_attribute_list = Qnil;
2793 struct gcpro gcpro1;
2794 struct char_attribute_list_closure char_attribute_list_closure;
2796 GCPRO1 (char_attribute_list);
2797 char_attribute_list_closure.char_attribute_list = &char_attribute_list;
2798 elisp_maphash (add_char_attribute_to_list_mapper,
2799 Vchar_attribute_hash_table,
2800 &char_attribute_list_closure);
2802 return char_attribute_list;
2805 DEFUN ("find-char-attribute-table", Ffind_char_attribute_table, 1, 1, 0, /*
2806 Return char-id-table corresponding to ATTRIBUTE.
2810 return Fgethash (attribute, Vchar_attribute_hash_table, Qnil);
2814 /* We store the char-id-tables in hash tables with the attributes as
2815 the key and the actual char-id-table object as the value. Each
2816 char-id-table stores values of an attribute corresponding with
2817 characters. Occasionally we need to get attributes of a character
2818 in a association-list format. These routines provide us with
2820 struct char_attribute_alist_closure
2823 Lisp_Object *char_attribute_alist;
2827 add_char_attribute_alist_mapper (Lisp_Object key, Lisp_Object value,
2828 void *char_attribute_alist_closure)
2830 /* This function can GC */
2831 struct char_attribute_alist_closure *caacl =
2832 (struct char_attribute_alist_closure*) char_attribute_alist_closure;
2834 = get_char_id_table (XCHAR_TABLE(value), caacl->char_id);
2835 if (!UNBOUNDP (ret))
2837 Lisp_Object *char_attribute_alist = caacl->char_attribute_alist;
2838 *char_attribute_alist
2839 = Fcons (Fcons (key, ret), *char_attribute_alist);
2844 DEFUN ("char-attribute-alist", Fchar_attribute_alist, 1, 1, 0, /*
2845 Return the alist of attributes of CHARACTER.
2849 struct gcpro gcpro1;
2850 struct char_attribute_alist_closure char_attribute_alist_closure;
2851 Lisp_Object alist = Qnil;
2853 CHECK_CHAR (character);
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);
2866 DEFUN ("get-char-attribute", Fget_char_attribute, 2, 3, 0, /*
2867 Return the value of CHARACTER's ATTRIBUTE.
2868 Return DEFAULT-VALUE if the value is not exist.
2870 (character, attribute, default_value))
2874 CHECK_CHAR (character);
2876 if (CHARSETP (attribute))
2877 attribute = XCHARSET_NAME (attribute);
2879 table = Fgethash (attribute, Vchar_attribute_hash_table,
2881 if (!UNBOUNDP (table))
2883 Lisp_Object ret = get_char_id_table (XCHAR_TABLE(table),
2885 if (!UNBOUNDP (ret))
2888 return default_value;
2891 DEFUN ("put-char-attribute", Fput_char_attribute, 3, 3, 0, /*
2892 Store CHARACTER's ATTRIBUTE with VALUE.
2894 (character, attribute, value))
2896 Lisp_Object ccs = Ffind_charset (attribute);
2900 CHECK_CHAR (character);
2901 value = put_char_ccs_code_point (character, ccs, value);
2902 attribute = XCHARSET_NAME (ccs);
2904 else if (EQ (attribute, Q_decomposition))
2908 CHECK_CHAR (character);
2910 signal_simple_error ("Invalid value for ->decomposition",
2913 if (CONSP (Fcdr (value)))
2915 Lisp_Object rest = value;
2916 Lisp_Object table = Vcharacter_composition_table;
2920 GET_EXTERNAL_LIST_LENGTH (rest, len);
2921 seq = make_vector (len, Qnil);
2923 while (CONSP (rest))
2925 Lisp_Object v = Fcar (rest);
2928 = to_char_id (v, "Invalid value for ->decomposition", value);
2931 XVECTOR_DATA(seq)[i++] = v;
2933 XVECTOR_DATA(seq)[i++] = make_char (c);
2937 put_char_id_table (XCHAR_TABLE(table),
2938 make_char (c), character);
2943 ntable = get_char_id_table (XCHAR_TABLE(table), c);
2944 if (!CHAR_TABLEP (ntable))
2946 ntable = make_char_id_table (Qnil);
2947 put_char_id_table (XCHAR_TABLE(table),
2948 make_char (c), ntable);
2956 Lisp_Object v = Fcar (value);
2960 Emchar c = XINT (v);
2962 = get_char_id_table (XCHAR_TABLE(Vcharacter_variant_table),
2965 if (NILP (Fmemq (v, ret)))
2967 put_char_id_table (XCHAR_TABLE(Vcharacter_variant_table),
2968 make_char (c), Fcons (character, ret));
2971 seq = make_vector (1, v);
2975 else if (EQ (attribute, Qto_ucs) || EQ (attribute, Q_ucs))
2980 CHECK_CHAR (character);
2982 signal_simple_error ("Invalid value for ->ucs", value);
2986 ret = get_char_id_table (XCHAR_TABLE(Vcharacter_variant_table), c);
2987 if (NILP (Fmemq (character, ret)))
2989 put_char_id_table (XCHAR_TABLE(Vcharacter_variant_table),
2990 make_char (c), Fcons (character, ret));
2993 if (EQ (attribute, Q_ucs))
2994 attribute = Qto_ucs;
2998 Lisp_Object table = Fgethash (attribute,
2999 Vchar_attribute_hash_table,
3004 table = make_char_id_table (Qunbound);
3005 Fputhash (attribute, table, Vchar_attribute_hash_table);
3007 put_char_id_table (XCHAR_TABLE(table), character, value);
3012 DEFUN ("remove-char-attribute", Fremove_char_attribute, 2, 2, 0, /*
3013 Remove CHARACTER's ATTRIBUTE.
3015 (character, attribute))
3019 CHECK_CHAR (character);
3020 ccs = Ffind_charset (attribute);
3023 return remove_char_ccs (character, ccs);
3027 Lisp_Object table = Fgethash (attribute,
3028 Vchar_attribute_hash_table,
3030 if (!UNBOUNDP (table))
3032 put_char_id_table (XCHAR_TABLE(table), character, Qunbound);
3039 DEFUN ("map-char-attribute", Fmap_char_attribute, 2, 3, 0, /*
3040 Map FUNCTION over entries in ATTRIBUTE, calling it with two args,
3041 each key and value in the table.
3043 RANGE specifies a subrange to map over and is in the same format as
3044 the RANGE argument to `put-range-table'. If omitted or t, it defaults to
3047 (function, attribute, range))
3050 Lisp_Char_Table *ct;
3051 struct slow_map_char_table_arg slarg;
3052 struct gcpro gcpro1, gcpro2;
3053 struct chartab_range rainj;
3055 if (!NILP (ccs = Ffind_charset (attribute)))
3057 Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (ccs);
3059 if (CHAR_TABLEP (encoding_table))
3060 ct = XCHAR_TABLE (encoding_table);
3066 Lisp_Object table = Fgethash (attribute,
3067 Vchar_attribute_hash_table,
3069 if (CHAR_TABLEP (table))
3070 ct = XCHAR_TABLE (table);
3076 decode_char_table_range (range, &rainj);
3077 slarg.function = function;
3078 slarg.retval = Qnil;
3079 GCPRO2 (slarg.function, slarg.retval);
3080 map_char_table (ct, &rainj, slow_map_char_table_fun, &slarg);
3083 return slarg.retval;
3086 DEFUN ("define-char", Fdefine_char, 1, 1, 0, /*
3087 Store character's ATTRIBUTES.
3091 Lisp_Object rest = attributes;
3092 Lisp_Object code = Fcdr (Fassq (Qmap_ucs, attributes));
3093 Lisp_Object character;
3096 code = Fcdr (Fassq (Qucs, attributes));
3099 while (CONSP (rest))
3101 Lisp_Object cell = Fcar (rest);
3105 signal_simple_error ("Invalid argument", attributes);
3106 if (!NILP (ccs = Ffind_charset (Fcar (cell)))
3107 && ((XCHARSET_FINAL (ccs) != 0) ||
3108 (XCHARSET_MAX_CODE (ccs) > 0) ||
3109 (EQ (ccs, Vcharset_chinese_big5))) )
3113 character = Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
3115 character = Fdecode_char (ccs, cell, Qnil);
3116 if (!NILP (character))
3117 goto setup_attributes;
3121 if ( (!NILP (code = Fcdr (Fassq (Qto_ucs, attributes)))) ||
3122 (!NILP (code = Fcdr (Fassq (Q_ucs, attributes)))) )
3126 signal_simple_error ("Invalid argument", attributes);
3128 character = make_char (XINT (code) + 0x100000);
3129 goto setup_attributes;
3133 else if (!INTP (code))
3134 signal_simple_error ("Invalid argument", attributes);
3136 character = make_char (XINT (code));
3140 while (CONSP (rest))
3142 Lisp_Object cell = Fcar (rest);
3145 signal_simple_error ("Invalid argument", attributes);
3147 Fput_char_attribute (character, Fcar (cell), Fcdr (cell));
3153 DEFUN ("find-char", Ffind_char, 1, 1, 0, /*
3154 Retrieve the character of the given ATTRIBUTES.
3158 Lisp_Object rest = attributes;
3161 while (CONSP (rest))
3163 Lisp_Object cell = Fcar (rest);
3167 signal_simple_error ("Invalid argument", attributes);
3168 if (!NILP (ccs = Ffind_charset (Fcar (cell))))
3172 return Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
3174 return Fdecode_char (ccs, cell, Qnil);
3178 if ( (!NILP (code = Fcdr (Fassq (Qto_ucs, attributes)))) ||
3179 (!NILP (code = Fcdr (Fassq (Q_ucs, attributes)))) )
3182 signal_simple_error ("Invalid argument", attributes);
3184 return make_char (XINT (code) + 0x100000);
3192 /************************************************************************/
3193 /* Char table read syntax */
3194 /************************************************************************/
3197 chartab_type_validate (Lisp_Object keyword, Lisp_Object value,
3198 Error_behavior errb)
3200 /* #### should deal with ERRB */
3201 symbol_to_char_table_type (value);
3206 chartab_data_validate (Lisp_Object keyword, Lisp_Object value,
3207 Error_behavior errb)
3211 /* #### should deal with ERRB */
3212 EXTERNAL_LIST_LOOP (rest, value)
3214 Lisp_Object range = XCAR (rest);
3215 struct chartab_range dummy;
3219 signal_simple_error ("Invalid list format", value);
3222 if (!CONSP (XCDR (range))
3223 || !NILP (XCDR (XCDR (range))))
3224 signal_simple_error ("Invalid range format", range);
3225 decode_char_table_range (XCAR (range), &dummy);
3226 decode_char_table_range (XCAR (XCDR (range)), &dummy);
3229 decode_char_table_range (range, &dummy);
3236 chartab_instantiate (Lisp_Object data)
3238 Lisp_Object chartab;
3239 Lisp_Object type = Qgeneric;
3240 Lisp_Object dataval = Qnil;
3242 while (!NILP (data))
3244 Lisp_Object keyw = Fcar (data);
3250 if (EQ (keyw, Qtype))
3252 else if (EQ (keyw, Qdata))
3256 chartab = Fmake_char_table (type);
3259 while (!NILP (data))
3261 Lisp_Object range = Fcar (data);
3262 Lisp_Object val = Fcar (Fcdr (data));
3264 data = Fcdr (Fcdr (data));
3267 if (CHAR_OR_CHAR_INTP (XCAR (range)))
3269 Emchar first = XCHAR_OR_CHAR_INT (Fcar (range));
3270 Emchar last = XCHAR_OR_CHAR_INT (Fcar (Fcdr (range)));
3273 for (i = first; i <= last; i++)
3274 Fput_char_table (make_char (i), val, chartab);
3280 Fput_char_table (range, val, chartab);
3289 /************************************************************************/
3290 /* Category Tables, specifically */
3291 /************************************************************************/
3293 DEFUN ("category-table-p", Fcategory_table_p, 1, 1, 0, /*
3294 Return t if OBJECT is a category table.
3295 A category table is a type of char table used for keeping track of
3296 categories. Categories are used for classifying characters for use
3297 in regexps -- you can refer to a category rather than having to use
3298 a complicated [] expression (and category lookups are significantly
3301 There are 95 different categories available, one for each printable
3302 character (including space) in the ASCII charset. Each category
3303 is designated by one such character, called a "category designator".
3304 They are specified in a regexp using the syntax "\\cX", where X is
3305 a category designator.
3307 A category table specifies, for each character, the categories that
3308 the character is in. Note that a character can be in more than one
3309 category. More specifically, a category table maps from a character
3310 to either the value nil (meaning the character is in no categories)
3311 or a 95-element bit vector, specifying for each of the 95 categories
3312 whether the character is in that category.
3314 Special Lisp functions are provided that abstract this, so you do not
3315 have to directly manipulate bit vectors.
3319 return (CHAR_TABLEP (object) &&
3320 XCHAR_TABLE_TYPE (object) == CHAR_TABLE_TYPE_CATEGORY) ?
3325 check_category_table (Lisp_Object object, Lisp_Object default_)
3329 while (NILP (Fcategory_table_p (object)))
3330 object = wrong_type_argument (Qcategory_table_p, object);
3335 check_category_char (Emchar ch, Lisp_Object table,
3336 unsigned int designator, unsigned int not_p)
3338 REGISTER Lisp_Object temp;
3339 Lisp_Char_Table *ctbl;
3340 #ifdef ERROR_CHECK_TYPECHECK
3341 if (NILP (Fcategory_table_p (table)))
3342 signal_simple_error ("Expected category table", table);
3344 ctbl = XCHAR_TABLE (table);
3345 temp = get_char_table (ch, ctbl);
3350 return bit_vector_bit (XBIT_VECTOR (temp), designator) ? !not_p : not_p;
3353 DEFUN ("check-category-at", Fcheck_category_at, 2, 4, 0, /*
3354 Return t if category of the character at POSITION includes DESIGNATOR.
3355 Optional third arg BUFFER specifies which buffer to use, and defaults
3356 to the current buffer.
3357 Optional fourth arg CATEGORY-TABLE specifies the category table to
3358 use, and defaults to BUFFER's category table.
3360 (position, designator, buffer, category_table))
3365 struct buffer *buf = decode_buffer (buffer, 0);
3367 CHECK_INT (position);
3368 CHECK_CATEGORY_DESIGNATOR (designator);
3369 des = XCHAR (designator);
3370 ctbl = check_category_table (category_table, Vstandard_category_table);
3371 ch = BUF_FETCH_CHAR (buf, XINT (position));
3372 return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil;
3375 DEFUN ("char-in-category-p", Fchar_in_category_p, 2, 3, 0, /*
3376 Return t if category of CHARACTER includes DESIGNATOR, else nil.
3377 Optional third arg CATEGORY-TABLE specifies the category table to use,
3378 and defaults to the standard category table.
3380 (character, designator, category_table))
3386 CHECK_CATEGORY_DESIGNATOR (designator);
3387 des = XCHAR (designator);
3388 CHECK_CHAR (character);
3389 ch = XCHAR (character);
3390 ctbl = check_category_table (category_table, Vstandard_category_table);
3391 return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil;
3394 DEFUN ("category-table", Fcategory_table, 0, 1, 0, /*
3395 Return BUFFER's current category table.
3396 BUFFER defaults to the current buffer.
3400 return decode_buffer (buffer, 0)->category_table;
3403 DEFUN ("standard-category-table", Fstandard_category_table, 0, 0, 0, /*
3404 Return the standard category table.
3405 This is the one used for new buffers.
3409 return Vstandard_category_table;
3412 DEFUN ("copy-category-table", Fcopy_category_table, 0, 1, 0, /*
3413 Return a new category table which is a copy of CATEGORY-TABLE.
3414 CATEGORY-TABLE defaults to the standard category table.
3418 if (NILP (Vstandard_category_table))
3419 return Fmake_char_table (Qcategory);
3422 check_category_table (category_table, Vstandard_category_table);
3423 return Fcopy_char_table (category_table);
3426 DEFUN ("set-category-table", Fset_category_table, 1, 2, 0, /*
3427 Select CATEGORY-TABLE as the new category table for BUFFER.
3428 BUFFER defaults to the current buffer if omitted.
3430 (category_table, buffer))
3432 struct buffer *buf = decode_buffer (buffer, 0);
3433 category_table = check_category_table (category_table, Qnil);
3434 buf->category_table = category_table;
3435 /* Indicate that this buffer now has a specified category table. */
3436 buf->local_var_flags |= XINT (buffer_local_flags.category_table);
3437 return category_table;
3440 DEFUN ("category-designator-p", Fcategory_designator_p, 1, 1, 0, /*
3441 Return t if OBJECT is a category designator (a char in the range ' ' to '~').
3445 return CATEGORY_DESIGNATORP (object) ? Qt : Qnil;
3448 DEFUN ("category-table-value-p", Fcategory_table_value_p, 1, 1, 0, /*
3449 Return t if OBJECT is a category table value.
3450 Valid values are nil or a bit vector of size 95.
3454 return CATEGORY_TABLE_VALUEP (object) ? Qt : Qnil;
3458 #define CATEGORYP(x) \
3459 (CHARP (x) && XCHAR (x) >= 0x20 && XCHAR (x) <= 0x7E)
3461 #define CATEGORY_SET(c) \
3462 (get_char_table(c, XCHAR_TABLE(current_buffer->category_table)))
3464 /* Return 1 if CATEGORY_SET contains CATEGORY, else return 0.
3465 The faster version of `!NILP (Faref (category_set, category))'. */
3466 #define CATEGORY_MEMBER(category, category_set) \
3467 (bit_vector_bit(XBIT_VECTOR (category_set), category - 32))
3469 /* Return 1 if there is a word boundary between two word-constituent
3470 characters C1 and C2 if they appear in this order, else return 0.
3471 Use the macro WORD_BOUNDARY_P instead of calling this function
3474 int word_boundary_p (Emchar c1, Emchar c2);
3476 word_boundary_p (Emchar c1, Emchar c2)
3478 Lisp_Object category_set1, category_set2;
3483 if (COMPOSITE_CHAR_P (c1))
3484 c1 = cmpchar_component (c1, 0, 1);
3485 if (COMPOSITE_CHAR_P (c2))
3486 c2 = cmpchar_component (c2, 0, 1);
3489 if (EQ (CHAR_CHARSET (c1), CHAR_CHARSET (c2)))
3491 tail = Vword_separating_categories;
3496 tail = Vword_combining_categories;
3500 category_set1 = CATEGORY_SET (c1);
3501 if (NILP (category_set1))
3502 return default_result;
3503 category_set2 = CATEGORY_SET (c2);
3504 if (NILP (category_set2))
3505 return default_result;
3507 for (; CONSP (tail); tail = XCONS (tail)->cdr)
3509 Lisp_Object elt = XCONS(tail)->car;
3512 && CATEGORYP (XCONS (elt)->car)
3513 && CATEGORYP (XCONS (elt)->cdr)
3514 && CATEGORY_MEMBER (XCHAR (XCONS (elt)->car), category_set1)
3515 && CATEGORY_MEMBER (XCHAR (XCONS (elt)->cdr), category_set2))
3516 return !default_result;
3518 return default_result;
3524 syms_of_chartab (void)
3527 INIT_LRECORD_IMPLEMENTATION (uint8_byte_table);
3528 INIT_LRECORD_IMPLEMENTATION (uint16_byte_table);
3529 INIT_LRECORD_IMPLEMENTATION (byte_table);
3531 defsymbol (&Qto_ucs, "=>ucs");
3532 defsymbol (&Q_ucs, "->ucs");
3533 defsymbol (&Q_decomposition, "->decomposition");
3534 defsymbol (&Qcompat, "compat");
3535 defsymbol (&Qisolated, "isolated");
3536 defsymbol (&Qinitial, "initial");
3537 defsymbol (&Qmedial, "medial");
3538 defsymbol (&Qfinal, "final");
3539 defsymbol (&Qvertical, "vertical");
3540 defsymbol (&QnoBreak, "noBreak");
3541 defsymbol (&Qfraction, "fraction");
3542 defsymbol (&Qsuper, "super");
3543 defsymbol (&Qsub, "sub");
3544 defsymbol (&Qcircle, "circle");
3545 defsymbol (&Qsquare, "square");
3546 defsymbol (&Qwide, "wide");
3547 defsymbol (&Qnarrow, "narrow");
3548 defsymbol (&Qsmall, "small");
3549 defsymbol (&Qfont, "font");
3551 DEFSUBR (Fchar_attribute_list);
3552 DEFSUBR (Ffind_char_attribute_table);
3553 DEFSUBR (Fchar_attribute_alist);
3554 DEFSUBR (Fget_char_attribute);
3555 DEFSUBR (Fput_char_attribute);
3556 DEFSUBR (Fremove_char_attribute);
3557 DEFSUBR (Fmap_char_attribute);
3558 DEFSUBR (Fdefine_char);
3559 DEFSUBR (Ffind_char);
3560 DEFSUBR (Fchar_variants);
3562 DEFSUBR (Fget_composite_char);
3565 INIT_LRECORD_IMPLEMENTATION (char_table);
3569 INIT_LRECORD_IMPLEMENTATION (char_table_entry);
3572 defsymbol (&Qcategory_table_p, "category-table-p");
3573 defsymbol (&Qcategory_designator_p, "category-designator-p");
3574 defsymbol (&Qcategory_table_value_p, "category-table-value-p");
3577 defsymbol (&Qchar_table, "char-table");
3578 defsymbol (&Qchar_tablep, "char-table-p");
3580 DEFSUBR (Fchar_table_p);
3581 DEFSUBR (Fchar_table_type_list);
3582 DEFSUBR (Fvalid_char_table_type_p);
3583 DEFSUBR (Fchar_table_type);
3584 DEFSUBR (Freset_char_table);
3585 DEFSUBR (Fmake_char_table);
3586 DEFSUBR (Fcopy_char_table);
3587 DEFSUBR (Fget_char_table);
3588 DEFSUBR (Fget_range_char_table);
3589 DEFSUBR (Fvalid_char_table_value_p);
3590 DEFSUBR (Fcheck_valid_char_table_value);
3591 DEFSUBR (Fput_char_table);
3592 DEFSUBR (Fmap_char_table);
3595 DEFSUBR (Fcategory_table_p);
3596 DEFSUBR (Fcategory_table);
3597 DEFSUBR (Fstandard_category_table);
3598 DEFSUBR (Fcopy_category_table);
3599 DEFSUBR (Fset_category_table);
3600 DEFSUBR (Fcheck_category_at);
3601 DEFSUBR (Fchar_in_category_p);
3602 DEFSUBR (Fcategory_designator_p);
3603 DEFSUBR (Fcategory_table_value_p);
3609 vars_of_chartab (void)
3612 Vutf_2000_version = build_string("0.18 (Yamato-Koizumi)");
3613 DEFVAR_LISP ("utf-2000-version", &Vutf_2000_version /*
3614 Version number of XEmacs UTF-2000.
3617 staticpro (&Vcharacter_composition_table);
3618 Vcharacter_composition_table = make_char_id_table (Qnil);
3620 staticpro (&Vcharacter_variant_table);
3621 Vcharacter_variant_table = make_char_id_table (Qnil);
3623 /* DO NOT staticpro this. It works just like Vweak_hash_tables. */
3624 Vall_syntax_tables = Qnil;
3625 dump_add_weak_object_chain (&Vall_syntax_tables);
3629 structure_type_create_chartab (void)
3631 struct structure_type *st;
3633 st = define_structure_type (Qchar_table, 0, chartab_instantiate);
3635 define_structure_type_keyword (st, Qtype, chartab_type_validate);
3636 define_structure_type_keyword (st, Qdata, chartab_data_validate);
3640 complex_vars_of_chartab (void)
3643 staticpro (&Vchar_attribute_hash_table);
3644 Vchar_attribute_hash_table
3645 = make_lisp_hash_table (16, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
3646 #endif /* UTF2000 */
3648 /* Set this now, so first buffer creation can refer to it. */
3649 /* Make it nil before calling copy-category-table
3650 so that copy-category-table will know not to try to copy from garbage */
3651 Vstandard_category_table = Qnil;
3652 Vstandard_category_table = Fcopy_category_table (Qnil);
3653 staticpro (&Vstandard_category_table);
3655 DEFVAR_LISP ("word-combining-categories", &Vword_combining_categories /*
3656 List of pair (cons) of categories to determine word boundary.
3658 Emacs treats a sequence of word constituent characters as a single
3659 word (i.e. finds no word boundary between them) iff they belongs to
3660 the same charset. But, exceptions are allowed in the following cases.
3662 \(1) The case that characters are in different charsets is controlled
3663 by the variable `word-combining-categories'.
3665 Emacs finds no word boundary between characters of different charsets
3666 if they have categories matching some element of this list.
3668 More precisely, if an element of this list is a cons of category CAT1
3669 and CAT2, and a multibyte character C1 which has CAT1 is followed by
3670 C2 which has CAT2, there's no word boundary between C1 and C2.
3672 For instance, to tell that ASCII characters and Latin-1 characters can
3673 form a single word, the element `(?l . ?l)' should be in this list
3674 because both characters have the category `l' (Latin characters).
3676 \(2) The case that character are in the same charset is controlled by
3677 the variable `word-separating-categories'.
3679 Emacs find a word boundary between characters of the same charset
3680 if they have categories matching some element of this list.
3682 More precisely, if an element of this list is a cons of category CAT1
3683 and CAT2, and a multibyte character C1 which has CAT1 is followed by
3684 C2 which has CAT2, there's a word boundary between C1 and C2.
3686 For instance, to tell that there's a word boundary between Japanese
3687 Hiragana and Japanese Kanji (both are in the same charset), the
3688 element `(?H . ?C) should be in this list.
3691 Vword_combining_categories = Qnil;
3693 DEFVAR_LISP ("word-separating-categories", &Vword_separating_categories /*
3694 List of pair (cons) of categories to determine word boundary.
3695 See the documentation of the variable `word-combining-categories'.
3698 Vword_separating_categories = Qnil;