1 /* XEmacs routines to deal with char tables.
2 Copyright (C) 1992, 1995 Free Software Foundation, Inc.
3 Copyright (C) 1995 Sun Microsystems, Inc.
4 Copyright (C) 1995, 1996 Ben Wing.
5 Copyright (C) 1995, 1997, 1999 Electrotechnical Laboratory, JAPAN.
6 Licensed to the Free Software Foundation.
7 Copyright (C) 1999,2000,2001 MORIOKA Tomohiko
9 This file is part of XEmacs.
11 XEmacs is free software; you can redistribute it and/or modify it
12 under the terms of the GNU General Public License as published by the
13 Free Software Foundation; either version 2, or (at your option) any
16 XEmacs is distributed in the hope that it will be useful, but WITHOUT
17 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
18 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
21 You should have received a copy of the GNU General Public License
22 along with XEmacs; see the file COPYING. If not, write to
23 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 Boston, MA 02111-1307, USA. */
26 /* Synched up with: Mule 2.3. Not synched with FSF.
28 This file was written independently of the FSF implementation,
29 and is not compatible. */
33 Ben Wing: wrote, for 19.13 (Mule). Some category table stuff
34 loosely based on the original Mule.
35 Jareth Hein: fixed a couple of bugs in the implementation, and
36 added regex support for categories with check_category_at
49 Lisp_Object Vutf_2000_version;
52 Lisp_Object Qchar_tablep, Qchar_table;
54 Lisp_Object Vall_syntax_tables;
57 Lisp_Object Qcategory_table_p;
58 Lisp_Object Qcategory_designator_p;
59 Lisp_Object Qcategory_table_value_p;
61 Lisp_Object Vstandard_category_table;
63 /* Variables to determine word boundary. */
64 Lisp_Object Vword_combining_categories, Vword_separating_categories;
70 #define BT_UINT8_MIN 0
71 #define BT_UINT8_MAX (UCHAR_MAX - 3)
72 #define BT_UINT8_t (UCHAR_MAX - 2)
73 #define BT_UINT8_nil (UCHAR_MAX - 1)
74 #define BT_UINT8_unbound UCHAR_MAX
76 INLINE_HEADER int INT_UINT8_P (Lisp_Object obj);
77 INLINE_HEADER int UINT8_VALUE_P (Lisp_Object obj);
78 INLINE_HEADER unsigned char UINT8_ENCODE (Lisp_Object obj);
79 INLINE_HEADER Lisp_Object UINT8_DECODE (unsigned char n);
80 INLINE_HEADER unsigned short UINT8_TO_UINT16 (unsigned char n);
83 INT_UINT8_P (Lisp_Object obj)
89 return (BT_UINT8_MIN <= num) && (num <= BT_UINT8_MAX);
96 UINT8_VALUE_P (Lisp_Object obj)
98 return EQ (obj, Qunbound)
99 || EQ (obj, Qnil) || EQ (obj, Qt) || INT_UINT8_P (obj);
102 INLINE_HEADER unsigned char
103 UINT8_ENCODE (Lisp_Object obj)
105 if (EQ (obj, Qunbound))
106 return BT_UINT8_unbound;
107 else if (EQ (obj, Qnil))
109 else if (EQ (obj, Qt))
115 INLINE_HEADER Lisp_Object
116 UINT8_DECODE (unsigned char n)
118 if (n == BT_UINT8_unbound)
120 else if (n == BT_UINT8_nil)
122 else if (n == BT_UINT8_t)
129 mark_uint8_byte_table (Lisp_Object obj)
135 print_uint8_byte_table (Lisp_Object obj,
136 Lisp_Object printcharfun, int escapeflag)
138 Lisp_Uint8_Byte_Table *bte = XUINT8_BYTE_TABLE (obj);
140 struct gcpro gcpro1, gcpro2;
141 GCPRO2 (obj, printcharfun);
143 write_c_string ("\n#<uint8-byte-table", printcharfun);
144 for (i = 0; i < 256; i++)
146 unsigned char n = bte->property[i];
148 write_c_string ("\n ", printcharfun);
149 write_c_string (" ", printcharfun);
150 if (n == BT_UINT8_unbound)
151 write_c_string ("void", printcharfun);
152 else if (n == BT_UINT8_nil)
153 write_c_string ("nil", printcharfun);
154 else if (n == BT_UINT8_t)
155 write_c_string ("t", printcharfun);
160 sprintf (buf, "%hd", n);
161 write_c_string (buf, printcharfun);
165 write_c_string (">", printcharfun);
169 uint8_byte_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
171 Lisp_Uint8_Byte_Table *te1 = XUINT8_BYTE_TABLE (obj1);
172 Lisp_Uint8_Byte_Table *te2 = XUINT8_BYTE_TABLE (obj2);
175 for (i = 0; i < 256; i++)
176 if (te1->property[i] != te2->property[i])
182 uint8_byte_table_hash (Lisp_Object obj, int depth)
184 Lisp_Uint8_Byte_Table *te = XUINT8_BYTE_TABLE (obj);
188 for (i = 0; i < 256; i++)
189 hash = HASH2 (hash, te->property[i]);
193 DEFINE_LRECORD_IMPLEMENTATION ("uint8-byte-table", uint8_byte_table,
194 mark_uint8_byte_table,
195 print_uint8_byte_table,
196 0, uint8_byte_table_equal,
197 uint8_byte_table_hash,
198 0 /* uint8_byte_table_description */,
199 Lisp_Uint8_Byte_Table);
202 make_uint8_byte_table (unsigned char initval)
206 Lisp_Uint8_Byte_Table *cte;
208 cte = alloc_lcrecord_type (Lisp_Uint8_Byte_Table,
209 &lrecord_uint8_byte_table);
211 for (i = 0; i < 256; i++)
212 cte->property[i] = initval;
214 XSETUINT8_BYTE_TABLE (obj, cte);
219 copy_uint8_byte_table (Lisp_Object entry)
221 Lisp_Uint8_Byte_Table *cte = XUINT8_BYTE_TABLE (entry);
224 Lisp_Uint8_Byte_Table *ctenew
225 = alloc_lcrecord_type (Lisp_Uint8_Byte_Table,
226 &lrecord_uint8_byte_table);
228 for (i = 0; i < 256; i++)
230 ctenew->property[i] = cte->property[i];
233 XSETUINT8_BYTE_TABLE (obj, ctenew);
238 uint8_byte_table_same_value_p (Lisp_Object obj)
240 Lisp_Uint8_Byte_Table *bte = XUINT8_BYTE_TABLE (obj);
241 unsigned char v0 = bte->property[0];
244 for (i = 1; i < 256; i++)
246 if (bte->property[i] != v0)
253 map_over_uint8_byte_table (Lisp_Uint8_Byte_Table *ct, Emchar ofs, int place,
254 int (*fn) (struct chartab_range *range,
255 Lisp_Object val, void *arg),
258 struct chartab_range rainj;
260 int unit = 1 << (8 * place);
264 rainj.type = CHARTAB_RANGE_CHAR;
266 for (i = 0, retval = 0; i < 256 && retval == 0; i++)
268 if (ct->property[i] != BT_UINT8_unbound)
271 for (; c < c1 && retval == 0; c++)
274 retval = (fn) (&rainj, UINT8_DECODE (ct->property[i]), arg);
283 #define BT_UINT16_MIN 0
284 #define BT_UINT16_MAX (USHRT_MAX - 3)
285 #define BT_UINT16_t (USHRT_MAX - 2)
286 #define BT_UINT16_nil (USHRT_MAX - 1)
287 #define BT_UINT16_unbound USHRT_MAX
289 INLINE_HEADER int INT_UINT16_P (Lisp_Object obj);
290 INLINE_HEADER int UINT16_VALUE_P (Lisp_Object obj);
291 INLINE_HEADER unsigned short UINT16_ENCODE (Lisp_Object obj);
292 INLINE_HEADER Lisp_Object UINT16_DECODE (unsigned short us);
295 INT_UINT16_P (Lisp_Object obj)
299 int num = XINT (obj);
301 return (BT_UINT16_MIN <= num) && (num <= BT_UINT16_MAX);
308 UINT16_VALUE_P (Lisp_Object obj)
310 return EQ (obj, Qunbound)
311 || EQ (obj, Qnil) || EQ (obj, Qt) || INT_UINT16_P (obj);
314 INLINE_HEADER unsigned short
315 UINT16_ENCODE (Lisp_Object obj)
317 if (EQ (obj, Qunbound))
318 return BT_UINT16_unbound;
319 else if (EQ (obj, Qnil))
320 return BT_UINT16_nil;
321 else if (EQ (obj, Qt))
327 INLINE_HEADER Lisp_Object
328 UINT16_DECODE (unsigned short n)
330 if (n == BT_UINT16_unbound)
332 else if (n == BT_UINT16_nil)
334 else if (n == BT_UINT16_t)
340 INLINE_HEADER unsigned short
341 UINT8_TO_UINT16 (unsigned char n)
343 if (n == BT_UINT8_unbound)
344 return BT_UINT16_unbound;
345 else if (n == BT_UINT8_nil)
346 return BT_UINT16_nil;
347 else if (n == BT_UINT8_t)
354 mark_uint16_byte_table (Lisp_Object obj)
360 print_uint16_byte_table (Lisp_Object obj,
361 Lisp_Object printcharfun, int escapeflag)
363 Lisp_Uint16_Byte_Table *bte = XUINT16_BYTE_TABLE (obj);
365 struct gcpro gcpro1, gcpro2;
366 GCPRO2 (obj, printcharfun);
368 write_c_string ("\n#<uint16-byte-table", printcharfun);
369 for (i = 0; i < 256; i++)
371 unsigned short n = bte->property[i];
373 write_c_string ("\n ", printcharfun);
374 write_c_string (" ", printcharfun);
375 if (n == BT_UINT16_unbound)
376 write_c_string ("void", printcharfun);
377 else if (n == BT_UINT16_nil)
378 write_c_string ("nil", printcharfun);
379 else if (n == BT_UINT16_t)
380 write_c_string ("t", printcharfun);
385 sprintf (buf, "%hd", n);
386 write_c_string (buf, printcharfun);
390 write_c_string (">", printcharfun);
394 uint16_byte_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
396 Lisp_Uint16_Byte_Table *te1 = XUINT16_BYTE_TABLE (obj1);
397 Lisp_Uint16_Byte_Table *te2 = XUINT16_BYTE_TABLE (obj2);
400 for (i = 0; i < 256; i++)
401 if (te1->property[i] != te2->property[i])
407 uint16_byte_table_hash (Lisp_Object obj, int depth)
409 Lisp_Uint16_Byte_Table *te = XUINT16_BYTE_TABLE (obj);
413 for (i = 0; i < 256; i++)
414 hash = HASH2 (hash, te->property[i]);
418 DEFINE_LRECORD_IMPLEMENTATION ("uint16-byte-table", uint16_byte_table,
419 mark_uint16_byte_table,
420 print_uint16_byte_table,
421 0, uint16_byte_table_equal,
422 uint16_byte_table_hash,
423 0 /* uint16_byte_table_description */,
424 Lisp_Uint16_Byte_Table);
427 make_uint16_byte_table (unsigned short initval)
431 Lisp_Uint16_Byte_Table *cte;
433 cte = alloc_lcrecord_type (Lisp_Uint16_Byte_Table,
434 &lrecord_uint16_byte_table);
436 for (i = 0; i < 256; i++)
437 cte->property[i] = initval;
439 XSETUINT16_BYTE_TABLE (obj, cte);
444 copy_uint16_byte_table (Lisp_Object entry)
446 Lisp_Uint16_Byte_Table *cte = XUINT16_BYTE_TABLE (entry);
449 Lisp_Uint16_Byte_Table *ctenew
450 = alloc_lcrecord_type (Lisp_Uint16_Byte_Table,
451 &lrecord_uint16_byte_table);
453 for (i = 0; i < 256; i++)
455 ctenew->property[i] = cte->property[i];
458 XSETUINT16_BYTE_TABLE (obj, ctenew);
463 expand_uint8_byte_table_to_uint16 (Lisp_Object table)
467 Lisp_Uint8_Byte_Table* bte = XUINT8_BYTE_TABLE(table);
468 Lisp_Uint16_Byte_Table* cte;
470 cte = alloc_lcrecord_type (Lisp_Uint16_Byte_Table,
471 &lrecord_uint16_byte_table);
472 for (i = 0; i < 256; i++)
474 cte->property[i] = UINT8_TO_UINT16 (bte->property[i]);
476 XSETUINT16_BYTE_TABLE (obj, cte);
481 uint16_byte_table_same_value_p (Lisp_Object obj)
483 Lisp_Uint16_Byte_Table *bte = XUINT16_BYTE_TABLE (obj);
484 unsigned short v0 = bte->property[0];
487 for (i = 1; i < 256; i++)
489 if (bte->property[i] != v0)
496 map_over_uint16_byte_table (Lisp_Uint16_Byte_Table *ct, Emchar ofs, int place,
497 int (*fn) (struct chartab_range *range,
498 Lisp_Object val, void *arg),
501 struct chartab_range rainj;
503 int unit = 1 << (8 * place);
507 rainj.type = CHARTAB_RANGE_CHAR;
509 for (i = 0, retval = 0; i < 256 && retval == 0; i++)
511 if (ct->property[i] != BT_UINT16_unbound)
514 for (; c < c1 && retval == 0; c++)
517 retval = (fn) (&rainj, UINT16_DECODE (ct->property[i]), arg);
528 mark_byte_table (Lisp_Object obj)
530 Lisp_Byte_Table *cte = XBYTE_TABLE (obj);
533 for (i = 0; i < 256; i++)
535 mark_object (cte->property[i]);
541 print_byte_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
543 Lisp_Byte_Table *bte = XBYTE_TABLE (obj);
545 struct gcpro gcpro1, gcpro2;
546 GCPRO2 (obj, printcharfun);
548 write_c_string ("\n#<byte-table", printcharfun);
549 for (i = 0; i < 256; i++)
551 Lisp_Object elt = bte->property[i];
553 write_c_string ("\n ", printcharfun);
554 write_c_string (" ", printcharfun);
555 if (EQ (elt, Qunbound))
556 write_c_string ("void", printcharfun);
558 print_internal (elt, printcharfun, escapeflag);
561 write_c_string (">", printcharfun);
565 byte_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
567 Lisp_Byte_Table *cte1 = XBYTE_TABLE (obj1);
568 Lisp_Byte_Table *cte2 = XBYTE_TABLE (obj2);
571 for (i = 0; i < 256; i++)
572 if (BYTE_TABLE_P (cte1->property[i]))
574 if (BYTE_TABLE_P (cte2->property[i]))
576 if (!byte_table_equal (cte1->property[i],
577 cte2->property[i], depth + 1))
584 if (!internal_equal (cte1->property[i], cte2->property[i], depth + 1))
590 byte_table_hash (Lisp_Object obj, int depth)
592 Lisp_Byte_Table *cte = XBYTE_TABLE (obj);
594 return internal_array_hash (cte->property, 256, depth);
597 static const struct lrecord_description byte_table_description[] = {
598 { XD_LISP_OBJECT_ARRAY, offsetof(Lisp_Byte_Table, property), 256 },
602 DEFINE_LRECORD_IMPLEMENTATION ("byte-table", byte_table,
607 byte_table_description,
611 make_byte_table (Lisp_Object initval)
615 Lisp_Byte_Table *cte;
617 cte = alloc_lcrecord_type (Lisp_Byte_Table, &lrecord_byte_table);
619 for (i = 0; i < 256; i++)
620 cte->property[i] = initval;
622 XSETBYTE_TABLE (obj, cte);
627 copy_byte_table (Lisp_Object entry)
629 Lisp_Byte_Table *cte = XBYTE_TABLE (entry);
632 Lisp_Byte_Table *ctnew
633 = alloc_lcrecord_type (Lisp_Byte_Table, &lrecord_byte_table);
635 for (i = 0; i < 256; i++)
637 if (UINT8_BYTE_TABLE_P (cte->property[i]))
639 ctnew->property[i] = copy_uint8_byte_table (cte->property[i]);
641 else if (UINT16_BYTE_TABLE_P (cte->property[i]))
643 ctnew->property[i] = copy_uint16_byte_table (cte->property[i]);
645 else if (BYTE_TABLE_P (cte->property[i]))
647 ctnew->property[i] = copy_byte_table (cte->property[i]);
650 ctnew->property[i] = cte->property[i];
653 XSETBYTE_TABLE (obj, ctnew);
658 byte_table_same_value_p (Lisp_Object obj)
660 Lisp_Byte_Table *bte = XBYTE_TABLE (obj);
661 Lisp_Object v0 = bte->property[0];
664 for (i = 1; i < 256; i++)
666 if (!internal_equal (bte->property[i], v0, 0))
673 map_over_byte_table (Lisp_Byte_Table *ct, Emchar ofs, int place,
674 int (*fn) (struct chartab_range *range,
675 Lisp_Object val, void *arg),
680 int unit = 1 << (8 * place);
683 for (i = 0, retval = 0; i < 256 && retval == 0; i++)
686 if (UINT8_BYTE_TABLE_P (v))
689 = map_over_uint8_byte_table (XUINT8_BYTE_TABLE(v),
690 c, place - 1, fn, arg);
693 else if (UINT16_BYTE_TABLE_P (v))
696 = map_over_uint16_byte_table (XUINT16_BYTE_TABLE(v),
697 c, place - 1, fn, arg);
700 else if (BYTE_TABLE_P (v))
702 retval = map_over_byte_table (XBYTE_TABLE(v),
703 c, place - 1, fn, arg);
706 else if (!UNBOUNDP (v))
708 struct chartab_range rainj;
709 Emchar c1 = c + unit;
711 rainj.type = CHARTAB_RANGE_CHAR;
713 for (; c < c1 && retval == 0; c++)
716 retval = (fn) (&rainj, v, arg);
727 get_byte_table (Lisp_Object table, unsigned char idx)
729 if (UINT8_BYTE_TABLE_P (table))
730 return UINT8_DECODE (XUINT8_BYTE_TABLE(table)->property[idx]);
731 else if (UINT16_BYTE_TABLE_P (table))
732 return UINT16_DECODE (XUINT16_BYTE_TABLE(table)->property[idx]);
733 else if (BYTE_TABLE_P (table))
734 return XBYTE_TABLE(table)->property[idx];
740 put_byte_table (Lisp_Object table, unsigned char idx, Lisp_Object value)
742 if (UINT8_BYTE_TABLE_P (table))
744 if (UINT8_VALUE_P (value))
746 XUINT8_BYTE_TABLE(table)->property[idx] = UINT8_ENCODE (value);
747 if (!UINT8_BYTE_TABLE_P (value) &&
748 !UINT16_BYTE_TABLE_P (value) && !BYTE_TABLE_P (value)
749 && uint8_byte_table_same_value_p (table))
754 else if (UINT16_VALUE_P (value))
756 Lisp_Object new = expand_uint8_byte_table_to_uint16 (table);
758 XUINT16_BYTE_TABLE(new)->property[idx] = UINT16_ENCODE (value);
763 Lisp_Object new = make_byte_table (Qnil);
766 for (i = 0; i < 256; i++)
768 XBYTE_TABLE(new)->property[i]
769 = UINT8_DECODE (XUINT8_BYTE_TABLE(table)->property[i]);
771 XBYTE_TABLE(new)->property[idx] = value;
775 else if (UINT16_BYTE_TABLE_P (table))
777 if (UINT16_VALUE_P (value))
779 XUINT16_BYTE_TABLE(table)->property[idx] = UINT16_ENCODE (value);
780 if (!UINT8_BYTE_TABLE_P (value) &&
781 !UINT16_BYTE_TABLE_P (value) && !BYTE_TABLE_P (value)
782 && uint16_byte_table_same_value_p (table))
789 Lisp_Object new = make_byte_table (Qnil);
792 for (i = 0; i < 256; i++)
794 XBYTE_TABLE(new)->property[i]
795 = UINT16_DECODE (XUINT16_BYTE_TABLE(table)->property[i]);
797 XBYTE_TABLE(new)->property[idx] = value;
801 else if (BYTE_TABLE_P (table))
803 XBYTE_TABLE(table)->property[idx] = value;
804 if (!UINT8_BYTE_TABLE_P (value) &&
805 !UINT16_BYTE_TABLE_P (value) && !BYTE_TABLE_P (value)
806 && byte_table_same_value_p (table))
811 else if (!internal_equal (table, value, 0))
813 if (UINT8_VALUE_P (table) && UINT8_VALUE_P (value))
815 table = make_uint8_byte_table (UINT8_ENCODE (table));
816 XUINT8_BYTE_TABLE(table)->property[idx] = UINT8_ENCODE (value);
818 else if (UINT16_VALUE_P (table) && UINT16_VALUE_P (value))
820 table = make_uint16_byte_table (UINT16_ENCODE (table));
821 XUINT16_BYTE_TABLE(table)->property[idx] = UINT16_ENCODE (value);
825 table = make_byte_table (table);
826 XBYTE_TABLE(table)->property[idx] = value;
834 make_char_id_table (Lisp_Object initval)
837 obj = Fmake_char_table (Qgeneric);
838 fill_char_table (XCHAR_TABLE (obj), initval);
843 Lisp_Object Vcharacter_composition_table;
844 Lisp_Object Vcharacter_variant_table;
847 Lisp_Object Q_decomposition;
851 Lisp_Object Qisolated;
852 Lisp_Object Qinitial;
855 Lisp_Object Qvertical;
856 Lisp_Object QnoBreak;
857 Lisp_Object Qfraction;
867 Emchar to_char_id (Lisp_Object v, char* err_msg, Lisp_Object err_arg);
870 to_char_id (Lisp_Object v, char* err_msg, Lisp_Object err_arg)
876 else if (EQ (v, Qcompat))
878 else if (EQ (v, Qisolated))
880 else if (EQ (v, Qinitial))
882 else if (EQ (v, Qmedial))
884 else if (EQ (v, Qfinal))
886 else if (EQ (v, Qvertical))
888 else if (EQ (v, QnoBreak))
890 else if (EQ (v, Qfraction))
892 else if (EQ (v, Qsuper))
894 else if (EQ (v, Qsub))
896 else if (EQ (v, Qcircle))
898 else if (EQ (v, Qsquare))
900 else if (EQ (v, Qwide))
902 else if (EQ (v, Qnarrow))
904 else if (EQ (v, Qsmall))
906 else if (EQ (v, Qfont))
909 signal_simple_error (err_msg, err_arg);
912 DEFUN ("get-composite-char", Fget_composite_char, 1, 1, 0, /*
913 Return character corresponding with list.
917 Lisp_Object table = Vcharacter_composition_table;
918 Lisp_Object rest = list;
922 Lisp_Object v = Fcar (rest);
924 Emchar c = to_char_id (v, "Invalid value for composition", list);
926 ret = get_char_id_table (XCHAR_TABLE(table), c);
931 if (!CHAR_TABLEP (ret))
936 else if (!CONSP (rest))
938 else if (CHAR_TABLEP (ret))
941 signal_simple_error ("Invalid table is found with", list);
943 signal_simple_error ("Invalid value for composition", list);
946 DEFUN ("char-variants", Fchar_variants, 1, 1, 0, /*
947 Return variants of CHARACTER.
951 CHECK_CHAR (character);
952 return Fcopy_list (get_char_id_table
953 (XCHAR_TABLE(Vcharacter_variant_table),
960 /* A char table maps from ranges of characters to values.
962 Implementing a general data structure that maps from arbitrary
963 ranges of numbers to values is tricky to do efficiently. As it
964 happens, it should suffice (and is usually more convenient, anyway)
965 when dealing with characters to restrict the sorts of ranges that
966 can be assigned values, as follows:
969 2) All characters in a charset.
970 3) All characters in a particular row of a charset, where a "row"
971 means all characters with the same first byte.
972 4) A particular character in a charset.
974 We use char tables to generalize the 256-element vectors now
975 littering the Emacs code.
977 Possible uses (all should be converted at some point):
983 5) keyboard-translate-table?
986 abstract type to generalize the Emacs vectors and Mule
987 vectors-of-vectors goo.
990 /************************************************************************/
991 /* Char Table object */
992 /************************************************************************/
994 #if defined(MULE)&&!defined(UTF2000)
997 mark_char_table_entry (Lisp_Object obj)
999 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj);
1002 for (i = 0; i < 96; i++)
1004 mark_object (cte->level2[i]);
1010 char_table_entry_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
1012 Lisp_Char_Table_Entry *cte1 = XCHAR_TABLE_ENTRY (obj1);
1013 Lisp_Char_Table_Entry *cte2 = XCHAR_TABLE_ENTRY (obj2);
1016 for (i = 0; i < 96; i++)
1017 if (!internal_equal (cte1->level2[i], cte2->level2[i], depth + 1))
1023 static unsigned long
1024 char_table_entry_hash (Lisp_Object obj, int depth)
1026 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj);
1028 return internal_array_hash (cte->level2, 96, depth);
1031 static const struct lrecord_description char_table_entry_description[] = {
1032 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table_Entry, level2), 96 },
1036 DEFINE_LRECORD_IMPLEMENTATION ("char-table-entry", char_table_entry,
1037 mark_char_table_entry, internal_object_printer,
1038 0, char_table_entry_equal,
1039 char_table_entry_hash,
1040 char_table_entry_description,
1041 Lisp_Char_Table_Entry);
1045 mark_char_table (Lisp_Object obj)
1047 Lisp_Char_Table *ct = XCHAR_TABLE (obj);
1050 mark_object (ct->table);
1054 for (i = 0; i < NUM_ASCII_CHARS; i++)
1055 mark_object (ct->ascii[i]);
1057 for (i = 0; i < NUM_LEADING_BYTES; i++)
1058 mark_object (ct->level1[i]);
1062 return ct->default_value;
1064 return ct->mirror_table;
1068 /* WARNING: All functions of this nature need to be written extremely
1069 carefully to avoid crashes during GC. Cf. prune_specifiers()
1070 and prune_weak_hash_tables(). */
1073 prune_syntax_tables (void)
1075 Lisp_Object rest, prev = Qnil;
1077 for (rest = Vall_syntax_tables;
1079 rest = XCHAR_TABLE (rest)->next_table)
1081 if (! marked_p (rest))
1083 /* This table is garbage. Remove it from the list. */
1085 Vall_syntax_tables = XCHAR_TABLE (rest)->next_table;
1087 XCHAR_TABLE (prev)->next_table =
1088 XCHAR_TABLE (rest)->next_table;
1094 char_table_type_to_symbol (enum char_table_type type)
1099 case CHAR_TABLE_TYPE_GENERIC: return Qgeneric;
1100 case CHAR_TABLE_TYPE_SYNTAX: return Qsyntax;
1101 case CHAR_TABLE_TYPE_DISPLAY: return Qdisplay;
1102 case CHAR_TABLE_TYPE_CHAR: return Qchar;
1104 case CHAR_TABLE_TYPE_CATEGORY: return Qcategory;
1109 static enum char_table_type
1110 symbol_to_char_table_type (Lisp_Object symbol)
1112 CHECK_SYMBOL (symbol);
1114 if (EQ (symbol, Qgeneric)) return CHAR_TABLE_TYPE_GENERIC;
1115 if (EQ (symbol, Qsyntax)) return CHAR_TABLE_TYPE_SYNTAX;
1116 if (EQ (symbol, Qdisplay)) return CHAR_TABLE_TYPE_DISPLAY;
1117 if (EQ (symbol, Qchar)) return CHAR_TABLE_TYPE_CHAR;
1119 if (EQ (symbol, Qcategory)) return CHAR_TABLE_TYPE_CATEGORY;
1122 signal_simple_error ("Unrecognized char table type", symbol);
1123 return CHAR_TABLE_TYPE_GENERIC; /* not reached */
1127 print_chartab_range (Emchar first, Emchar last, Lisp_Object val,
1128 Lisp_Object printcharfun)
1132 write_c_string (" (", printcharfun);
1133 print_internal (make_char (first), printcharfun, 0);
1134 write_c_string (" ", printcharfun);
1135 print_internal (make_char (last), printcharfun, 0);
1136 write_c_string (") ", printcharfun);
1140 write_c_string (" ", printcharfun);
1141 print_internal (make_char (first), printcharfun, 0);
1142 write_c_string (" ", printcharfun);
1144 print_internal (val, printcharfun, 1);
1147 #if defined(MULE)&&!defined(UTF2000)
1150 print_chartab_charset_row (Lisp_Object charset,
1152 Lisp_Char_Table_Entry *cte,
1153 Lisp_Object printcharfun)
1156 Lisp_Object cat = Qunbound;
1159 for (i = 32; i < 128; i++)
1161 Lisp_Object pam = cte->level2[i - 32];
1173 print_chartab_range (MAKE_CHAR (charset, first, 0),
1174 MAKE_CHAR (charset, i - 1, 0),
1177 print_chartab_range (MAKE_CHAR (charset, row, first),
1178 MAKE_CHAR (charset, row, i - 1),
1188 print_chartab_range (MAKE_CHAR (charset, first, 0),
1189 MAKE_CHAR (charset, i - 1, 0),
1192 print_chartab_range (MAKE_CHAR (charset, row, first),
1193 MAKE_CHAR (charset, row, i - 1),
1199 print_chartab_two_byte_charset (Lisp_Object charset,
1200 Lisp_Char_Table_Entry *cte,
1201 Lisp_Object printcharfun)
1205 for (i = 32; i < 128; i++)
1207 Lisp_Object jen = cte->level2[i - 32];
1209 if (!CHAR_TABLE_ENTRYP (jen))
1213 write_c_string (" [", printcharfun);
1214 print_internal (XCHARSET_NAME (charset), printcharfun, 0);
1215 sprintf (buf, " %d] ", i);
1216 write_c_string (buf, printcharfun);
1217 print_internal (jen, printcharfun, 0);
1220 print_chartab_charset_row (charset, i, XCHAR_TABLE_ENTRY (jen),
1228 print_char_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1230 Lisp_Char_Table *ct = XCHAR_TABLE (obj);
1233 struct gcpro gcpro1, gcpro2;
1234 GCPRO2 (obj, printcharfun);
1236 write_c_string ("#s(char-table ", printcharfun);
1237 write_c_string (" ", printcharfun);
1238 write_c_string (string_data
1240 (XSYMBOL (char_table_type_to_symbol (ct->type)))),
1242 write_c_string ("\n ", printcharfun);
1243 print_internal (ct->default_value, printcharfun, escapeflag);
1244 for (i = 0; i < 256; i++)
1246 Lisp_Object elt = get_byte_table (ct->table, i);
1247 if (i != 0) write_c_string ("\n ", printcharfun);
1248 if (EQ (elt, Qunbound))
1249 write_c_string ("void", printcharfun);
1251 print_internal (elt, printcharfun, escapeflag);
1254 #else /* non UTF2000 */
1257 sprintf (buf, "#s(char-table type %s data (",
1258 string_data (symbol_name (XSYMBOL
1259 (char_table_type_to_symbol (ct->type)))));
1260 write_c_string (buf, printcharfun);
1262 /* Now write out the ASCII/Control-1 stuff. */
1266 Lisp_Object val = Qunbound;
1268 for (i = 0; i < NUM_ASCII_CHARS; i++)
1277 if (!EQ (ct->ascii[i], val))
1279 print_chartab_range (first, i - 1, val, printcharfun);
1286 print_chartab_range (first, i - 1, val, printcharfun);
1293 for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES;
1296 Lisp_Object ann = ct->level1[i - MIN_LEADING_BYTE];
1297 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (i);
1299 if (!CHARSETP (charset) || i == LEADING_BYTE_ASCII
1300 || i == LEADING_BYTE_CONTROL_1)
1302 if (!CHAR_TABLE_ENTRYP (ann))
1304 write_c_string (" ", printcharfun);
1305 print_internal (XCHARSET_NAME (charset),
1307 write_c_string (" ", printcharfun);
1308 print_internal (ann, printcharfun, 0);
1312 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (ann);
1313 if (XCHARSET_DIMENSION (charset) == 1)
1314 print_chartab_charset_row (charset, -1, cte, printcharfun);
1316 print_chartab_two_byte_charset (charset, cte, printcharfun);
1321 #endif /* non UTF2000 */
1323 write_c_string ("))", printcharfun);
1327 char_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
1329 Lisp_Char_Table *ct1 = XCHAR_TABLE (obj1);
1330 Lisp_Char_Table *ct2 = XCHAR_TABLE (obj2);
1333 if (CHAR_TABLE_TYPE (ct1) != CHAR_TABLE_TYPE (ct2))
1337 for (i = 0; i < 256; i++)
1339 if (!internal_equal (get_byte_table (ct1->table, i),
1340 get_byte_table (ct2->table, i), 0))
1344 for (i = 0; i < NUM_ASCII_CHARS; i++)
1345 if (!internal_equal (ct1->ascii[i], ct2->ascii[i], depth + 1))
1349 for (i = 0; i < NUM_LEADING_BYTES; i++)
1350 if (!internal_equal (ct1->level1[i], ct2->level1[i], depth + 1))
1353 #endif /* non UTF2000 */
1358 static unsigned long
1359 char_table_hash (Lisp_Object obj, int depth)
1361 Lisp_Char_Table *ct = XCHAR_TABLE (obj);
1363 return byte_table_hash (ct->table, depth + 1);
1365 unsigned long hashval = internal_array_hash (ct->ascii, NUM_ASCII_CHARS,
1368 hashval = HASH2 (hashval,
1369 internal_array_hash (ct->level1, NUM_LEADING_BYTES, depth));
1375 static const struct lrecord_description char_table_description[] = {
1377 { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, table) },
1378 { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, default_value) },
1380 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, ascii), NUM_ASCII_CHARS },
1382 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, level1), NUM_LEADING_BYTES },
1386 { XD_LISP_OBJECT, offsetof (Lisp_Char_Table, mirror_table) },
1388 { XD_LO_LINK, offsetof (Lisp_Char_Table, next_table) },
1392 DEFINE_LRECORD_IMPLEMENTATION ("char-table", char_table,
1393 mark_char_table, print_char_table, 0,
1394 char_table_equal, char_table_hash,
1395 char_table_description,
1398 DEFUN ("char-table-p", Fchar_table_p, 1, 1, 0, /*
1399 Return non-nil if OBJECT is a char table.
1401 A char table is a table that maps characters (or ranges of characters)
1402 to values. Char tables are specialized for characters, only allowing
1403 particular sorts of ranges to be assigned values. Although this
1404 loses in generality, it makes for extremely fast (constant-time)
1405 lookups, and thus is feasible for applications that do an extremely
1406 large number of lookups (e.g. scanning a buffer for a character in
1407 a particular syntax, where a lookup in the syntax table must occur
1408 once per character).
1410 When Mule support exists, the types of ranges that can be assigned
1414 -- an entire charset
1415 -- a single row in a two-octet charset
1416 -- a single character
1418 When Mule support is not present, the types of ranges that can be
1422 -- a single character
1424 To create a char table, use `make-char-table'.
1425 To modify a char table, use `put-char-table' or `remove-char-table'.
1426 To retrieve the value for a particular character, use `get-char-table'.
1427 See also `map-char-table', `clear-char-table', `copy-char-table',
1428 `valid-char-table-type-p', `char-table-type-list',
1429 `valid-char-table-value-p', and `check-char-table-value'.
1433 return CHAR_TABLEP (object) ? Qt : Qnil;
1436 DEFUN ("char-table-type-list", Fchar_table_type_list, 0, 0, 0, /*
1437 Return a list of the recognized char table types.
1438 See `valid-char-table-type-p'.
1443 return list5 (Qchar, Qcategory, Qdisplay, Qgeneric, Qsyntax);
1445 return list4 (Qchar, Qdisplay, Qgeneric, Qsyntax);
1449 DEFUN ("valid-char-table-type-p", Fvalid_char_table_type_p, 1, 1, 0, /*
1450 Return t if TYPE if a recognized char table type.
1452 Each char table type is used for a different purpose and allows different
1453 sorts of values. The different char table types are
1456 Used for category tables, which specify the regexp categories
1457 that a character is in. The valid values are nil or a
1458 bit vector of 95 elements. Higher-level Lisp functions are
1459 provided for working with category tables. Currently categories
1460 and category tables only exist when Mule support is present.
1462 A generalized char table, for mapping from one character to
1463 another. Used for case tables, syntax matching tables,
1464 `keyboard-translate-table', etc. The valid values are characters.
1466 An even more generalized char table, for mapping from a
1467 character to anything.
1469 Used for display tables, which specify how a particular character
1470 is to appear when displayed. #### Not yet implemented.
1472 Used for syntax tables, which specify the syntax of a particular
1473 character. Higher-level Lisp functions are provided for
1474 working with syntax tables. The valid values are integers.
1479 return (EQ (type, Qchar) ||
1481 EQ (type, Qcategory) ||
1483 EQ (type, Qdisplay) ||
1484 EQ (type, Qgeneric) ||
1485 EQ (type, Qsyntax)) ? Qt : Qnil;
1488 DEFUN ("char-table-type", Fchar_table_type, 1, 1, 0, /*
1489 Return the type of CHAR-TABLE.
1490 See `valid-char-table-type-p'.
1494 CHECK_CHAR_TABLE (char_table);
1495 return char_table_type_to_symbol (XCHAR_TABLE (char_table)->type);
1499 fill_char_table (Lisp_Char_Table *ct, Lisp_Object value)
1502 ct->table = Qunbound;
1503 ct->default_value = value;
1507 for (i = 0; i < NUM_ASCII_CHARS; i++)
1508 ct->ascii[i] = value;
1510 for (i = 0; i < NUM_LEADING_BYTES; i++)
1511 ct->level1[i] = value;
1516 if (ct->type == CHAR_TABLE_TYPE_SYNTAX)
1517 update_syntax_table (ct);
1521 DEFUN ("reset-char-table", Freset_char_table, 1, 1, 0, /*
1522 Reset CHAR-TABLE to its default state.
1526 Lisp_Char_Table *ct;
1528 CHECK_CHAR_TABLE (char_table);
1529 ct = XCHAR_TABLE (char_table);
1533 case CHAR_TABLE_TYPE_CHAR:
1534 fill_char_table (ct, make_char (0));
1536 case CHAR_TABLE_TYPE_DISPLAY:
1537 case CHAR_TABLE_TYPE_GENERIC:
1539 case CHAR_TABLE_TYPE_CATEGORY:
1541 fill_char_table (ct, Qnil);
1544 case CHAR_TABLE_TYPE_SYNTAX:
1545 fill_char_table (ct, make_int (Sinherit));
1555 DEFUN ("make-char-table", Fmake_char_table, 1, 1, 0, /*
1556 Return a new, empty char table of type TYPE.
1557 Currently recognized types are 'char, 'category, 'display, 'generic,
1558 and 'syntax. See `valid-char-table-type-p'.
1562 Lisp_Char_Table *ct;
1564 enum char_table_type ty = symbol_to_char_table_type (type);
1566 ct = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table);
1569 if (ty == CHAR_TABLE_TYPE_SYNTAX)
1571 ct->mirror_table = Fmake_char_table (Qgeneric);
1572 fill_char_table (XCHAR_TABLE (ct->mirror_table),
1576 ct->mirror_table = Qnil;
1578 ct->next_table = Qnil;
1579 XSETCHAR_TABLE (obj, ct);
1580 if (ty == CHAR_TABLE_TYPE_SYNTAX)
1582 ct->next_table = Vall_syntax_tables;
1583 Vall_syntax_tables = obj;
1585 Freset_char_table (obj);
1589 #if defined(MULE)&&!defined(UTF2000)
1592 make_char_table_entry (Lisp_Object initval)
1596 Lisp_Char_Table_Entry *cte =
1597 alloc_lcrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry);
1599 for (i = 0; i < 96; i++)
1600 cte->level2[i] = initval;
1602 XSETCHAR_TABLE_ENTRY (obj, cte);
1607 copy_char_table_entry (Lisp_Object entry)
1609 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (entry);
1612 Lisp_Char_Table_Entry *ctenew =
1613 alloc_lcrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry);
1615 for (i = 0; i < 96; i++)
1617 Lisp_Object new = cte->level2[i];
1618 if (CHAR_TABLE_ENTRYP (new))
1619 ctenew->level2[i] = copy_char_table_entry (new);
1621 ctenew->level2[i] = new;
1624 XSETCHAR_TABLE_ENTRY (obj, ctenew);
1630 DEFUN ("copy-char-table", Fcopy_char_table, 1, 1, 0, /*
1631 Return a new char table which is a copy of CHAR-TABLE.
1632 It will contain the same values for the same characters and ranges
1633 as CHAR-TABLE. The values will not themselves be copied.
1637 Lisp_Char_Table *ct, *ctnew;
1643 CHECK_CHAR_TABLE (char_table);
1644 ct = XCHAR_TABLE (char_table);
1645 ctnew = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table);
1646 ctnew->type = ct->type;
1648 ctnew->default_value = ct->default_value;
1650 if (UINT8_BYTE_TABLE_P (ct->table))
1652 ctnew->table = copy_uint8_byte_table (ct->table);
1654 else if (UINT16_BYTE_TABLE_P (ct->table))
1656 ctnew->table = copy_uint16_byte_table (ct->table);
1658 else if (BYTE_TABLE_P (ct->table))
1660 ctnew->table = copy_byte_table (ct->table);
1662 else if (!UNBOUNDP (ct->table))
1663 ctnew->table = ct->table;
1664 #else /* non UTF2000 */
1666 for (i = 0; i < NUM_ASCII_CHARS; i++)
1668 Lisp_Object new = ct->ascii[i];
1670 assert (! (CHAR_TABLE_ENTRYP (new)));
1672 ctnew->ascii[i] = new;
1677 for (i = 0; i < NUM_LEADING_BYTES; i++)
1679 Lisp_Object new = ct->level1[i];
1680 if (CHAR_TABLE_ENTRYP (new))
1681 ctnew->level1[i] = copy_char_table_entry (new);
1683 ctnew->level1[i] = new;
1687 #endif /* non UTF2000 */
1690 if (CHAR_TABLEP (ct->mirror_table))
1691 ctnew->mirror_table = Fcopy_char_table (ct->mirror_table);
1693 ctnew->mirror_table = ct->mirror_table;
1695 ctnew->next_table = Qnil;
1696 XSETCHAR_TABLE (obj, ctnew);
1697 if (ctnew->type == CHAR_TABLE_TYPE_SYNTAX)
1699 ctnew->next_table = Vall_syntax_tables;
1700 Vall_syntax_tables = obj;
1709 decode_char_table_range (Lisp_Object range, struct chartab_range *outrange)
1712 outrange->type = CHARTAB_RANGE_ALL;
1713 else if (EQ (range, Qnil))
1714 outrange->type = CHARTAB_RANGE_DEFAULT;
1715 else if (CHAR_OR_CHAR_INTP (range))
1717 outrange->type = CHARTAB_RANGE_CHAR;
1718 outrange->ch = XCHAR_OR_CHAR_INT (range);
1722 signal_simple_error ("Range must be t or a character", range);
1724 else if (VECTORP (range))
1726 Lisp_Vector *vec = XVECTOR (range);
1727 Lisp_Object *elts = vector_data (vec);
1728 if (vector_length (vec) != 2)
1729 signal_simple_error ("Length of charset row vector must be 2",
1731 outrange->type = CHARTAB_RANGE_ROW;
1732 outrange->charset = Fget_charset (elts[0]);
1733 CHECK_INT (elts[1]);
1734 outrange->row = XINT (elts[1]);
1735 if (XCHARSET_DIMENSION (outrange->charset) >= 2)
1737 switch (XCHARSET_CHARS (outrange->charset))
1740 check_int_range (outrange->row, 33, 126);
1743 check_int_range (outrange->row, 32, 127);
1750 signal_simple_error ("Charset in row vector must be multi-byte",
1755 if (!CHARSETP (range) && !SYMBOLP (range))
1757 ("Char table range must be t, charset, char, or vector", range);
1758 outrange->type = CHARTAB_RANGE_CHARSET;
1759 outrange->charset = Fget_charset (range);
1764 #if defined(MULE)&&!defined(UTF2000)
1766 /* called from CHAR_TABLE_VALUE(). */
1768 get_non_ascii_char_table_value (Lisp_Char_Table *ct, Charset_ID leading_byte,
1773 Lisp_Object charset;
1775 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (leading_byte);
1780 BREAKUP_CHAR (c, charset, byte1, byte2);
1782 BREAKUP_CHAR_1_UNSAFE (c, charset, byte1, byte2);
1784 val = ct->level1[leading_byte - MIN_LEADING_BYTE];
1785 if (CHAR_TABLE_ENTRYP (val))
1787 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
1788 val = cte->level2[byte1 - 32];
1789 if (CHAR_TABLE_ENTRYP (val))
1791 cte = XCHAR_TABLE_ENTRY (val);
1792 assert (byte2 >= 32);
1793 val = cte->level2[byte2 - 32];
1794 assert (!CHAR_TABLE_ENTRYP (val));
1804 get_char_table (Emchar ch, Lisp_Char_Table *ct)
1807 return get_char_id_table (ct, ch);
1810 Lisp_Object charset;
1814 BREAKUP_CHAR (ch, charset, byte1, byte2);
1816 if (EQ (charset, Vcharset_ascii))
1817 val = ct->ascii[byte1];
1818 else if (EQ (charset, Vcharset_control_1))
1819 val = ct->ascii[byte1 + 128];
1822 int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE;
1823 val = ct->level1[lb];
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));
1840 #else /* not MULE */
1841 return ct->ascii[(unsigned char)ch];
1842 #endif /* not MULE */
1846 DEFUN ("get-char-table", Fget_char_table, 2, 2, 0, /*
1847 Find value for CHARACTER in CHAR-TABLE.
1849 (character, char_table))
1851 CHECK_CHAR_TABLE (char_table);
1852 CHECK_CHAR_COERCE_INT (character);
1854 return get_char_table (XCHAR (character), XCHAR_TABLE (char_table));
1857 DEFUN ("get-range-char-table", Fget_range_char_table, 2, 3, 0, /*
1858 Find value for a range in CHAR-TABLE.
1859 If there is more than one value, return MULTI (defaults to nil).
1861 (range, char_table, multi))
1863 Lisp_Char_Table *ct;
1864 struct chartab_range rainj;
1866 if (CHAR_OR_CHAR_INTP (range))
1867 return Fget_char_table (range, char_table);
1868 CHECK_CHAR_TABLE (char_table);
1869 ct = XCHAR_TABLE (char_table);
1871 decode_char_table_range (range, &rainj);
1874 case CHARTAB_RANGE_ALL:
1877 if (UINT8_BYTE_TABLE_P (ct->table))
1879 else if (UINT16_BYTE_TABLE_P (ct->table))
1881 else if (BYTE_TABLE_P (ct->table))
1885 #else /* non UTF2000 */
1887 Lisp_Object first = ct->ascii[0];
1889 for (i = 1; i < NUM_ASCII_CHARS; i++)
1890 if (!EQ (first, ct->ascii[i]))
1894 for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES;
1897 if (!CHARSETP (CHARSET_BY_LEADING_BYTE (i))
1898 || i == LEADING_BYTE_ASCII
1899 || i == LEADING_BYTE_CONTROL_1)
1901 if (!EQ (first, ct->level1[i - MIN_LEADING_BYTE]))
1907 #endif /* non UTF2000 */
1911 case CHARTAB_RANGE_CHARSET:
1915 if (EQ (rainj.charset, Vcharset_ascii))
1918 Lisp_Object first = ct->ascii[0];
1920 for (i = 1; i < 128; i++)
1921 if (!EQ (first, ct->ascii[i]))
1926 if (EQ (rainj.charset, Vcharset_control_1))
1929 Lisp_Object first = ct->ascii[128];
1931 for (i = 129; i < 160; i++)
1932 if (!EQ (first, ct->ascii[i]))
1938 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (rainj.charset) -
1940 if (CHAR_TABLE_ENTRYP (val))
1946 case CHARTAB_RANGE_ROW:
1951 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (rainj.charset) -
1953 if (!CHAR_TABLE_ENTRYP (val))
1955 val = XCHAR_TABLE_ENTRY (val)->level2[rainj.row - 32];
1956 if (CHAR_TABLE_ENTRYP (val))
1960 #endif /* not UTF2000 */
1961 #endif /* not MULE */
1967 return Qnil; /* not reached */
1971 check_valid_char_table_value (Lisp_Object value, enum char_table_type type,
1972 Error_behavior errb)
1976 case CHAR_TABLE_TYPE_SYNTAX:
1977 if (!ERRB_EQ (errb, ERROR_ME))
1978 return INTP (value) || (CONSP (value) && INTP (XCAR (value))
1979 && CHAR_OR_CHAR_INTP (XCDR (value)));
1982 Lisp_Object cdr = XCDR (value);
1983 CHECK_INT (XCAR (value));
1984 CHECK_CHAR_COERCE_INT (cdr);
1991 case CHAR_TABLE_TYPE_CATEGORY:
1992 if (!ERRB_EQ (errb, ERROR_ME))
1993 return CATEGORY_TABLE_VALUEP (value);
1994 CHECK_CATEGORY_TABLE_VALUE (value);
1998 case CHAR_TABLE_TYPE_GENERIC:
2001 case CHAR_TABLE_TYPE_DISPLAY:
2003 maybe_signal_simple_error ("Display char tables not yet implemented",
2004 value, Qchar_table, errb);
2007 case CHAR_TABLE_TYPE_CHAR:
2008 if (!ERRB_EQ (errb, ERROR_ME))
2009 return CHAR_OR_CHAR_INTP (value);
2010 CHECK_CHAR_COERCE_INT (value);
2017 return 0; /* not reached */
2021 canonicalize_char_table_value (Lisp_Object value, enum char_table_type type)
2025 case CHAR_TABLE_TYPE_SYNTAX:
2028 Lisp_Object car = XCAR (value);
2029 Lisp_Object cdr = XCDR (value);
2030 CHECK_CHAR_COERCE_INT (cdr);
2031 return Fcons (car, cdr);
2034 case CHAR_TABLE_TYPE_CHAR:
2035 CHECK_CHAR_COERCE_INT (value);
2043 DEFUN ("valid-char-table-value-p", Fvalid_char_table_value_p, 2, 2, 0, /*
2044 Return non-nil if VALUE is a valid value for CHAR-TABLE-TYPE.
2046 (value, char_table_type))
2048 enum char_table_type type = symbol_to_char_table_type (char_table_type);
2050 return check_valid_char_table_value (value, type, ERROR_ME_NOT) ? Qt : Qnil;
2053 DEFUN ("check-valid-char-table-value", Fcheck_valid_char_table_value, 2, 2, 0, /*
2054 Signal an error if VALUE is not a valid value for CHAR-TABLE-TYPE.
2056 (value, char_table_type))
2058 enum char_table_type type = symbol_to_char_table_type (char_table_type);
2060 check_valid_char_table_value (value, type, ERROR_ME);
2064 /* Assign VAL to all characters in RANGE in char table CT. */
2067 put_char_table (Lisp_Char_Table *ct, struct chartab_range *range,
2070 switch (range->type)
2072 case CHARTAB_RANGE_ALL:
2073 /* printf ("put-char-table: range = all\n"); */
2074 fill_char_table (ct, val);
2075 return; /* avoid the duplicate call to update_syntax_table() below,
2076 since fill_char_table() also did that. */
2079 case CHARTAB_RANGE_DEFAULT:
2080 ct->default_value = val;
2085 case CHARTAB_RANGE_CHARSET:
2089 Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (range->charset);
2091 /* printf ("put-char-table: range = charset: %d\n",
2092 XCHARSET_LEADING_BYTE (range->charset));
2094 if ( CHAR_TABLEP (encoding_table) )
2096 for (c = 0; c < 1 << 24; c++)
2098 if ( INTP (get_char_id_table (XCHAR_TABLE(encoding_table),
2100 put_char_id_table_0 (ct, c, val);
2105 for (c = 0; c < 1 << 24; c++)
2107 if ( charset_code_point (range->charset, c) >= 0 )
2108 put_char_id_table_0 (ct, c, val);
2113 if (EQ (range->charset, Vcharset_ascii))
2116 for (i = 0; i < 128; i++)
2119 else if (EQ (range->charset, Vcharset_control_1))
2122 for (i = 128; i < 160; i++)
2127 int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE;
2128 ct->level1[lb] = val;
2133 case CHARTAB_RANGE_ROW:
2136 int cell_min, cell_max, i;
2138 /* printf ("put-char-table: range = charset-row: %d, 0x%x\n",
2139 XCHARSET_LEADING_BYTE (range->charset), range->row); */
2140 if (XCHARSET_DIMENSION (range->charset) < 2)
2141 signal_simple_error ("Charset in row vector must be multi-byte",
2145 switch (XCHARSET_CHARS (range->charset))
2148 cell_min = 33; cell_max = 126;
2151 cell_min = 32; cell_max = 127;
2154 cell_min = 0; cell_max = 127;
2157 cell_min = 0; cell_max = 255;
2163 if (XCHARSET_DIMENSION (range->charset) == 2)
2164 check_int_range (range->row, cell_min, cell_max);
2165 else if (XCHARSET_DIMENSION (range->charset) == 3)
2167 check_int_range (range->row >> 8 , cell_min, cell_max);
2168 check_int_range (range->row & 0xFF, cell_min, cell_max);
2170 else if (XCHARSET_DIMENSION (range->charset) == 4)
2172 check_int_range ( range->row >> 16 , cell_min, cell_max);
2173 check_int_range ((range->row >> 8) & 0xFF, cell_min, cell_max);
2174 check_int_range ( range->row & 0xFF, cell_min, cell_max);
2179 for (i = cell_min; i <= cell_max; i++)
2181 Emchar ch = DECODE_CHAR (range->charset, (range->row << 8) | i);
2182 if ( charset_code_point (range->charset, ch) >= 0 )
2183 put_char_id_table_0 (ct, ch, val);
2188 Lisp_Char_Table_Entry *cte;
2189 int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE;
2190 /* make sure that there is a separate entry for the row. */
2191 if (!CHAR_TABLE_ENTRYP (ct->level1[lb]))
2192 ct->level1[lb] = make_char_table_entry (ct->level1[lb]);
2193 cte = XCHAR_TABLE_ENTRY (ct->level1[lb]);
2194 cte->level2[range->row - 32] = val;
2196 #endif /* not UTF2000 */
2200 case CHARTAB_RANGE_CHAR:
2202 /* printf ("put-char-table: range = char: 0x%x\n", range->ch); */
2203 put_char_id_table_0 (ct, range->ch, val);
2207 Lisp_Object charset;
2210 BREAKUP_CHAR (range->ch, charset, byte1, byte2);
2211 if (EQ (charset, Vcharset_ascii))
2212 ct->ascii[byte1] = val;
2213 else if (EQ (charset, Vcharset_control_1))
2214 ct->ascii[byte1 + 128] = val;
2217 Lisp_Char_Table_Entry *cte;
2218 int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE;
2219 /* make sure that there is a separate entry for the row. */
2220 if (!CHAR_TABLE_ENTRYP (ct->level1[lb]))
2221 ct->level1[lb] = make_char_table_entry (ct->level1[lb]);
2222 cte = XCHAR_TABLE_ENTRY (ct->level1[lb]);
2223 /* now CTE is a char table entry for the charset;
2224 each entry is for a single row (or character of
2225 a one-octet charset). */
2226 if (XCHARSET_DIMENSION (charset) == 1)
2227 cte->level2[byte1 - 32] = val;
2230 /* assigning to one character in a two-octet charset. */
2231 /* make sure that the charset row contains a separate
2232 entry for each character. */
2233 if (!CHAR_TABLE_ENTRYP (cte->level2[byte1 - 32]))
2234 cte->level2[byte1 - 32] =
2235 make_char_table_entry (cte->level2[byte1 - 32]);
2236 cte = XCHAR_TABLE_ENTRY (cte->level2[byte1 - 32]);
2237 cte->level2[byte2 - 32] = val;
2241 #else /* not MULE */
2242 ct->ascii[(unsigned char) (range->ch)] = val;
2244 #endif /* not MULE */
2248 if (ct->type == CHAR_TABLE_TYPE_SYNTAX)
2249 update_syntax_table (ct);
2253 DEFUN ("put-char-table", Fput_char_table, 3, 3, 0, /*
2254 Set the value for chars in RANGE to be VALUE in CHAR-TABLE.
2256 RANGE specifies one or more characters to be affected and should be
2257 one of the following:
2259 -- t (all characters are affected)
2260 -- A charset (only allowed when Mule support is present)
2261 -- A vector of two elements: a two-octet charset and a row number
2262 (only allowed when Mule support is present)
2263 -- A single character
2265 VALUE must be a value appropriate for the type of CHAR-TABLE.
2266 See `valid-char-table-type-p'.
2268 (range, value, char_table))
2270 Lisp_Char_Table *ct;
2271 struct chartab_range rainj;
2273 CHECK_CHAR_TABLE (char_table);
2274 ct = XCHAR_TABLE (char_table);
2275 check_valid_char_table_value (value, ct->type, ERROR_ME);
2276 decode_char_table_range (range, &rainj);
2277 value = canonicalize_char_table_value (value, ct->type);
2278 put_char_table (ct, &rainj, value);
2283 /* Map FN over the ASCII chars in CT. */
2286 map_over_charset_ascii (Lisp_Char_Table *ct,
2287 int (*fn) (struct chartab_range *range,
2288 Lisp_Object val, void *arg),
2291 struct chartab_range rainj;
2300 rainj.type = CHARTAB_RANGE_CHAR;
2302 for (i = start, retval = 0; i < stop && retval == 0; i++)
2304 rainj.ch = (Emchar) i;
2305 retval = (fn) (&rainj, ct->ascii[i], arg);
2313 /* Map FN over the Control-1 chars in CT. */
2316 map_over_charset_control_1 (Lisp_Char_Table *ct,
2317 int (*fn) (struct chartab_range *range,
2318 Lisp_Object val, void *arg),
2321 struct chartab_range rainj;
2324 int stop = start + 32;
2326 rainj.type = CHARTAB_RANGE_CHAR;
2328 for (i = start, retval = 0; i < stop && retval == 0; i++)
2330 rainj.ch = (Emchar) (i);
2331 retval = (fn) (&rainj, ct->ascii[i], arg);
2337 /* Map FN over the row ROW of two-byte charset CHARSET.
2338 There must be a separate value for that row in the char table.
2339 CTE specifies the char table entry for CHARSET. */
2342 map_over_charset_row (Lisp_Char_Table_Entry *cte,
2343 Lisp_Object charset, int row,
2344 int (*fn) (struct chartab_range *range,
2345 Lisp_Object val, void *arg),
2348 Lisp_Object val = cte->level2[row - 32];
2350 if (!CHAR_TABLE_ENTRYP (val))
2352 struct chartab_range rainj;
2354 rainj.type = CHARTAB_RANGE_ROW;
2355 rainj.charset = charset;
2357 return (fn) (&rainj, val, arg);
2361 struct chartab_range rainj;
2363 int charset94_p = (XCHARSET_CHARS (charset) == 94);
2364 int start = charset94_p ? 33 : 32;
2365 int stop = charset94_p ? 127 : 128;
2367 cte = XCHAR_TABLE_ENTRY (val);
2369 rainj.type = CHARTAB_RANGE_CHAR;
2371 for (i = start, retval = 0; i < stop && retval == 0; i++)
2373 rainj.ch = MAKE_CHAR (charset, row, i);
2374 retval = (fn) (&rainj, cte->level2[i - 32], arg);
2382 map_over_other_charset (Lisp_Char_Table *ct, Charset_ID lb,
2383 int (*fn) (struct chartab_range *range,
2384 Lisp_Object val, void *arg),
2387 Lisp_Object val = ct->level1[lb - MIN_LEADING_BYTE];
2388 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (lb);
2390 if (!CHARSETP (charset)
2391 || lb == LEADING_BYTE_ASCII
2392 || lb == LEADING_BYTE_CONTROL_1)
2395 if (!CHAR_TABLE_ENTRYP (val))
2397 struct chartab_range rainj;
2399 rainj.type = CHARTAB_RANGE_CHARSET;
2400 rainj.charset = charset;
2401 return (fn) (&rainj, val, arg);
2405 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
2406 int charset94_p = (XCHARSET_CHARS (charset) == 94);
2407 int start = charset94_p ? 33 : 32;
2408 int stop = charset94_p ? 127 : 128;
2411 if (XCHARSET_DIMENSION (charset) == 1)
2413 struct chartab_range rainj;
2414 rainj.type = CHARTAB_RANGE_CHAR;
2416 for (i = start, retval = 0; i < stop && retval == 0; i++)
2418 rainj.ch = MAKE_CHAR (charset, i, 0);
2419 retval = (fn) (&rainj, cte->level2[i - 32], arg);
2424 for (i = start, retval = 0; i < stop && retval == 0; i++)
2425 retval = map_over_charset_row (cte, charset, i, fn, arg);
2433 #endif /* not UTF2000 */
2436 struct map_char_table_for_charset_arg
2438 int (*fn) (struct chartab_range *range, Lisp_Object val, void *arg);
2439 Lisp_Char_Table *ct;
2444 map_char_table_for_charset_fun (struct chartab_range *range,
2445 Lisp_Object val, void *arg)
2447 struct map_char_table_for_charset_arg *closure =
2448 (struct map_char_table_for_charset_arg *) arg;
2451 switch (range->type)
2453 case CHARTAB_RANGE_ALL:
2456 case CHARTAB_RANGE_DEFAULT:
2459 case CHARTAB_RANGE_CHARSET:
2462 case CHARTAB_RANGE_ROW:
2465 case CHARTAB_RANGE_CHAR:
2466 ret = get_char_table (range->ch, closure->ct);
2467 if (!UNBOUNDP (ret))
2468 return (closure->fn) (range, ret, closure->arg);
2479 /* Map FN (with client data ARG) over range RANGE in char table CT.
2480 Mapping stops the first time FN returns non-zero, and that value
2481 becomes the return value of map_char_table(). */
2484 map_char_table (Lisp_Char_Table *ct,
2485 struct chartab_range *range,
2486 int (*fn) (struct chartab_range *range,
2487 Lisp_Object val, void *arg),
2490 switch (range->type)
2492 case CHARTAB_RANGE_ALL:
2494 if (!UNBOUNDP (ct->default_value))
2496 struct chartab_range rainj;
2499 rainj.type = CHARTAB_RANGE_DEFAULT;
2500 retval = (fn) (&rainj, ct->default_value, arg);
2504 if (UINT8_BYTE_TABLE_P (ct->table))
2505 return map_over_uint8_byte_table (XUINT8_BYTE_TABLE(ct->table),
2507 else if (UINT16_BYTE_TABLE_P (ct->table))
2508 return map_over_uint16_byte_table (XUINT16_BYTE_TABLE(ct->table),
2510 else if (BYTE_TABLE_P (ct->table))
2511 return map_over_byte_table (XBYTE_TABLE(ct->table),
2513 else if (!UNBOUNDP (ct->table))
2516 struct chartab_range rainj;
2519 Emchar c1 = c + unit;
2522 rainj.type = CHARTAB_RANGE_CHAR;
2524 for (retval = 0; c < c1 && retval == 0; c++)
2527 retval = (fn) (&rainj, ct->table, arg);
2532 return (fn) (range, ct->table, arg);
2539 retval = map_over_charset_ascii (ct, fn, arg);
2543 retval = map_over_charset_control_1 (ct, fn, arg);
2548 Charset_ID start = MIN_LEADING_BYTE;
2549 Charset_ID stop = start + NUM_LEADING_BYTES;
2551 for (i = start, retval = 0; i < stop && retval == 0; i++)
2553 retval = map_over_other_charset (ct, i, fn, arg);
2562 case CHARTAB_RANGE_DEFAULT:
2563 if (!UNBOUNDP (ct->default_value))
2564 return (fn) (range, ct->default_value, arg);
2569 case CHARTAB_RANGE_CHARSET:
2572 Lisp_Object encoding_table
2573 = XCHARSET_ENCODING_TABLE (range->charset);
2575 if (!NILP (encoding_table))
2577 struct chartab_range rainj;
2578 struct map_char_table_for_charset_arg mcarg;
2583 rainj.type = CHARTAB_RANGE_ALL;
2584 return map_char_table (XCHAR_TABLE(encoding_table),
2586 &map_char_table_for_charset_fun,
2592 return map_over_other_charset (ct,
2593 XCHARSET_LEADING_BYTE (range->charset),
2597 case CHARTAB_RANGE_ROW:
2600 int cell_min, cell_max, i;
2602 struct chartab_range rainj;
2604 if (XCHARSET_DIMENSION (range->charset) < 2)
2605 signal_simple_error ("Charset in row vector must be multi-byte",
2609 switch (XCHARSET_CHARS (range->charset))
2612 cell_min = 33; cell_max = 126;
2615 cell_min = 32; cell_max = 127;
2618 cell_min = 0; cell_max = 127;
2621 cell_min = 0; cell_max = 255;
2627 if (XCHARSET_DIMENSION (range->charset) == 2)
2628 check_int_range (range->row, cell_min, cell_max);
2629 else if (XCHARSET_DIMENSION (range->charset) == 3)
2631 check_int_range (range->row >> 8 , cell_min, cell_max);
2632 check_int_range (range->row & 0xFF, cell_min, cell_max);
2634 else if (XCHARSET_DIMENSION (range->charset) == 4)
2636 check_int_range ( range->row >> 16 , cell_min, cell_max);
2637 check_int_range ((range->row >> 8) & 0xFF, cell_min, cell_max);
2638 check_int_range ( range->row & 0xFF, cell_min, cell_max);
2643 rainj.type = CHARTAB_RANGE_CHAR;
2644 for (retval =0, i = cell_min; i <= cell_max && retval == 0; i++)
2646 Emchar ch = DECODE_CHAR (range->charset, (range->row << 8) | i);
2648 if ( charset_code_point (range->charset, ch) >= 0 )
2651 = get_byte_table (get_byte_table
2655 (unsigned char)(ch >> 24)),
2656 (unsigned char) (ch >> 16)),
2657 (unsigned char) (ch >> 8)),
2658 (unsigned char) ch);
2661 val = ct->default_value;
2663 retval = (fn) (&rainj, val, arg);
2670 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (range->charset)
2671 - MIN_LEADING_BYTE];
2672 if (!CHAR_TABLE_ENTRYP (val))
2674 struct chartab_range rainj;
2676 rainj.type = CHARTAB_RANGE_ROW;
2677 rainj.charset = range->charset;
2678 rainj.row = range->row;
2679 return (fn) (&rainj, val, arg);
2682 return map_over_charset_row (XCHAR_TABLE_ENTRY (val),
2683 range->charset, range->row,
2686 #endif /* not UTF2000 */
2689 case CHARTAB_RANGE_CHAR:
2691 Emchar ch = range->ch;
2692 Lisp_Object val = CHAR_TABLE_VALUE_UNSAFE (ct, ch);
2694 if (!UNBOUNDP (val))
2696 struct chartab_range rainj;
2698 rainj.type = CHARTAB_RANGE_CHAR;
2700 return (fn) (&rainj, val, arg);
2712 struct slow_map_char_table_arg
2714 Lisp_Object function;
2719 slow_map_char_table_fun (struct chartab_range *range,
2720 Lisp_Object val, void *arg)
2722 Lisp_Object ranjarg = Qnil;
2723 struct slow_map_char_table_arg *closure =
2724 (struct slow_map_char_table_arg *) arg;
2726 switch (range->type)
2728 case CHARTAB_RANGE_ALL:
2733 case CHARTAB_RANGE_DEFAULT:
2739 case CHARTAB_RANGE_CHARSET:
2740 ranjarg = XCHARSET_NAME (range->charset);
2743 case CHARTAB_RANGE_ROW:
2744 ranjarg = vector2 (XCHARSET_NAME (range->charset),
2745 make_int (range->row));
2748 case CHARTAB_RANGE_CHAR:
2749 ranjarg = make_char (range->ch);
2755 closure->retval = call2 (closure->function, ranjarg, val);
2756 return !NILP (closure->retval);
2759 DEFUN ("map-char-table", Fmap_char_table, 2, 3, 0, /*
2760 Map FUNCTION over entries in CHAR-TABLE, calling it with two args,
2761 each key and value in the table.
2763 RANGE specifies a subrange to map over and is in the same format as
2764 the RANGE argument to `put-range-table'. If omitted or t, it defaults to
2767 (function, char_table, range))
2769 Lisp_Char_Table *ct;
2770 struct slow_map_char_table_arg slarg;
2771 struct gcpro gcpro1, gcpro2;
2772 struct chartab_range rainj;
2774 CHECK_CHAR_TABLE (char_table);
2775 ct = XCHAR_TABLE (char_table);
2778 decode_char_table_range (range, &rainj);
2779 slarg.function = function;
2780 slarg.retval = Qnil;
2781 GCPRO2 (slarg.function, slarg.retval);
2782 map_char_table (ct, &rainj, slow_map_char_table_fun, &slarg);
2785 return slarg.retval;
2789 /************************************************************************/
2790 /* Character Attributes */
2791 /************************************************************************/
2795 Lisp_Object Vchar_attribute_hash_table;
2797 /* We store the char-attributes in hash tables with the names as the
2798 key and the actual char-id-table object as the value. Occasionally
2799 we need to use them in a list format. These routines provide us
2801 struct char_attribute_list_closure
2803 Lisp_Object *char_attribute_list;
2807 add_char_attribute_to_list_mapper (Lisp_Object key, Lisp_Object value,
2808 void *char_attribute_list_closure)
2810 /* This function can GC */
2811 struct char_attribute_list_closure *calcl
2812 = (struct char_attribute_list_closure*) char_attribute_list_closure;
2813 Lisp_Object *char_attribute_list = calcl->char_attribute_list;
2815 *char_attribute_list = Fcons (key, *char_attribute_list);
2819 DEFUN ("char-attribute-list", Fchar_attribute_list, 0, 0, 0, /*
2820 Return the list of all existing character attributes except coded-charsets.
2824 Lisp_Object char_attribute_list = Qnil;
2825 struct gcpro gcpro1;
2826 struct char_attribute_list_closure char_attribute_list_closure;
2828 GCPRO1 (char_attribute_list);
2829 char_attribute_list_closure.char_attribute_list = &char_attribute_list;
2830 elisp_maphash (add_char_attribute_to_list_mapper,
2831 Vchar_attribute_hash_table,
2832 &char_attribute_list_closure);
2834 return char_attribute_list;
2837 DEFUN ("find-char-attribute-table", Ffind_char_attribute_table, 1, 1, 0, /*
2838 Return char-id-table corresponding to ATTRIBUTE.
2842 return Fgethash (attribute, Vchar_attribute_hash_table, Qnil);
2846 /* We store the char-id-tables in hash tables with the attributes as
2847 the key and the actual char-id-table object as the value. Each
2848 char-id-table stores values of an attribute corresponding with
2849 characters. Occasionally we need to get attributes of a character
2850 in a association-list format. These routines provide us with
2852 struct char_attribute_alist_closure
2855 Lisp_Object *char_attribute_alist;
2859 add_char_attribute_alist_mapper (Lisp_Object key, Lisp_Object value,
2860 void *char_attribute_alist_closure)
2862 /* This function can GC */
2863 struct char_attribute_alist_closure *caacl =
2864 (struct char_attribute_alist_closure*) char_attribute_alist_closure;
2866 = get_char_id_table (XCHAR_TABLE(value), caacl->char_id);
2867 if (!UNBOUNDP (ret))
2869 Lisp_Object *char_attribute_alist = caacl->char_attribute_alist;
2870 *char_attribute_alist
2871 = Fcons (Fcons (key, ret), *char_attribute_alist);
2876 DEFUN ("char-attribute-alist", Fchar_attribute_alist, 1, 1, 0, /*
2877 Return the alist of attributes of CHARACTER.
2881 Lisp_Object alist = Qnil;
2884 CHECK_CHAR (character);
2886 struct gcpro gcpro1;
2887 struct char_attribute_alist_closure char_attribute_alist_closure;
2890 char_attribute_alist_closure.char_id = XCHAR (character);
2891 char_attribute_alist_closure.char_attribute_alist = &alist;
2892 elisp_maphash (add_char_attribute_alist_mapper,
2893 Vchar_attribute_hash_table,
2894 &char_attribute_alist_closure);
2898 for (i = 0; i < countof (chlook->charset_by_leading_byte); i++)
2900 Lisp_Object ccs = chlook->charset_by_leading_byte[i];
2904 Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (ccs);
2907 if ( CHAR_TABLEP (encoding_table)
2909 = get_char_id_table (XCHAR_TABLE(encoding_table),
2910 XCHAR (character))) )
2912 alist = Fcons (Fcons (ccs, cpos), alist);
2919 DEFUN ("get-char-attribute", Fget_char_attribute, 2, 3, 0, /*
2920 Return the value of CHARACTER's ATTRIBUTE.
2921 Return DEFAULT-VALUE if the value is not exist.
2923 (character, attribute, default_value))
2927 CHECK_CHAR (character);
2928 if (!NILP (ccs = Ffind_charset (attribute)))
2930 Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (ccs);
2932 if (CHAR_TABLEP (encoding_table))
2933 return get_char_id_table (XCHAR_TABLE(encoding_table),
2938 Lisp_Object table = Fgethash (attribute,
2939 Vchar_attribute_hash_table,
2941 if (!UNBOUNDP (table))
2943 Lisp_Object ret = get_char_id_table (XCHAR_TABLE(table),
2945 if (!UNBOUNDP (ret))
2949 return default_value;
2952 DEFUN ("put-char-attribute", Fput_char_attribute, 3, 3, 0, /*
2953 Store CHARACTER's ATTRIBUTE with VALUE.
2955 (character, attribute, value))
2959 ccs = Ffind_charset (attribute);
2962 CHECK_CHAR (character);
2963 return put_char_ccs_code_point (character, ccs, value);
2965 else if (EQ (attribute, Q_decomposition))
2969 CHECK_CHAR (character);
2971 signal_simple_error ("Invalid value for ->decomposition",
2974 if (CONSP (Fcdr (value)))
2976 Lisp_Object rest = value;
2977 Lisp_Object table = Vcharacter_composition_table;
2981 GET_EXTERNAL_LIST_LENGTH (rest, len);
2982 seq = make_vector (len, Qnil);
2984 while (CONSP (rest))
2986 Lisp_Object v = Fcar (rest);
2989 = to_char_id (v, "Invalid value for ->decomposition", value);
2992 XVECTOR_DATA(seq)[i++] = v;
2994 XVECTOR_DATA(seq)[i++] = make_char (c);
2998 put_char_id_table (XCHAR_TABLE(table),
2999 make_char (c), character);
3004 ntable = get_char_id_table (XCHAR_TABLE(table), c);
3005 if (!CHAR_TABLEP (ntable))
3007 ntable = make_char_id_table (Qnil);
3008 put_char_id_table (XCHAR_TABLE(table),
3009 make_char (c), ntable);
3017 Lisp_Object v = Fcar (value);
3021 Emchar c = XINT (v);
3023 = get_char_id_table (XCHAR_TABLE(Vcharacter_variant_table),
3026 if (NILP (Fmemq (v, ret)))
3028 put_char_id_table (XCHAR_TABLE(Vcharacter_variant_table),
3029 make_char (c), Fcons (character, ret));
3032 seq = make_vector (1, v);
3036 else if (EQ (attribute, Qto_ucs) || EQ (attribute, Q_ucs))
3041 CHECK_CHAR (character);
3043 signal_simple_error ("Invalid value for ->ucs", value);
3047 ret = get_char_id_table (XCHAR_TABLE(Vcharacter_variant_table), c);
3048 if (NILP (Fmemq (character, ret)))
3050 put_char_id_table (XCHAR_TABLE(Vcharacter_variant_table),
3051 make_char (c), Fcons (character, ret));
3054 if (EQ (attribute, Q_ucs))
3055 attribute = Qto_ucs;
3059 Lisp_Object table = Fgethash (attribute,
3060 Vchar_attribute_hash_table,
3065 table = make_char_id_table (Qunbound);
3066 Fputhash (attribute, table, Vchar_attribute_hash_table);
3068 put_char_id_table (XCHAR_TABLE(table), character, value);
3073 DEFUN ("remove-char-attribute", Fremove_char_attribute, 2, 2, 0, /*
3074 Remove CHARACTER's ATTRIBUTE.
3076 (character, attribute))
3080 CHECK_CHAR (character);
3081 ccs = Ffind_charset (attribute);
3084 return remove_char_ccs (character, ccs);
3088 Lisp_Object table = Fgethash (attribute,
3089 Vchar_attribute_hash_table,
3091 if (!UNBOUNDP (table))
3093 put_char_id_table (XCHAR_TABLE(table), character, Qunbound);
3100 DEFUN ("map-char-attribute", Fmap_char_attribute, 2, 3, 0, /*
3101 Map FUNCTION over entries in ATTRIBUTE, calling it with two args,
3102 each key and value in the table.
3104 RANGE specifies a subrange to map over and is in the same format as
3105 the RANGE argument to `put-range-table'. If omitted or t, it defaults to
3108 (function, attribute, range))
3111 Lisp_Char_Table *ct;
3112 struct slow_map_char_table_arg slarg;
3113 struct gcpro gcpro1, gcpro2;
3114 struct chartab_range rainj;
3116 if (!NILP (ccs = Ffind_charset (attribute)))
3118 Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (ccs);
3120 if (CHAR_TABLEP (encoding_table))
3121 ct = XCHAR_TABLE (encoding_table);
3127 Lisp_Object table = Fgethash (attribute,
3128 Vchar_attribute_hash_table,
3130 if (CHAR_TABLEP (table))
3131 ct = XCHAR_TABLE (table);
3137 decode_char_table_range (range, &rainj);
3138 slarg.function = function;
3139 slarg.retval = Qnil;
3140 GCPRO2 (slarg.function, slarg.retval);
3141 map_char_table (ct, &rainj, slow_map_char_table_fun, &slarg);
3144 return slarg.retval;
3147 EXFUN (Fmake_char, 3);
3148 EXFUN (Fdecode_char, 2);
3150 DEFUN ("define-char", Fdefine_char, 1, 1, 0, /*
3151 Store character's ATTRIBUTES.
3155 Lisp_Object rest = attributes;
3156 Lisp_Object code = Fcdr (Fassq (Qucs, attributes));
3157 Lisp_Object character;
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)))
3169 && ((XCHARSET_FINAL (ccs) != 0) ||
3170 (XCHARSET_UCS_MAX (ccs) > 0)) )
3174 character = Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
3176 character = Fdecode_char (ccs, cell);
3177 if (!NILP (character))
3178 goto setup_attributes;
3182 if ( (!NILP (code = Fcdr (Fassq (Qto_ucs, attributes)))) ||
3183 (!NILP (code = Fcdr (Fassq (Q_ucs, attributes)))) )
3187 signal_simple_error ("Invalid argument", attributes);
3189 character = make_char (XINT (code) + 0x100000);
3190 goto setup_attributes;
3194 else if (!INTP (code))
3195 signal_simple_error ("Invalid argument", attributes);
3197 character = make_char (XINT (code));
3201 while (CONSP (rest))
3203 Lisp_Object cell = Fcar (rest);
3206 signal_simple_error ("Invalid argument", attributes);
3208 Fput_char_attribute (character, Fcar (cell), Fcdr (cell));
3214 DEFUN ("find-char", Ffind_char, 1, 1, 0, /*
3215 Retrieve the character of the given ATTRIBUTES.
3219 Lisp_Object rest = attributes;
3222 while (CONSP (rest))
3224 Lisp_Object cell = Fcar (rest);
3228 signal_simple_error ("Invalid argument", attributes);
3229 if (!NILP (ccs = Ffind_charset (Fcar (cell))))
3233 return Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
3235 return Fdecode_char (ccs, cell);
3239 if ( (!NILP (code = Fcdr (Fassq (Qto_ucs, attributes)))) ||
3240 (!NILP (code = Fcdr (Fassq (Q_ucs, attributes)))) )
3243 signal_simple_error ("Invalid argument", attributes);
3245 return make_char (XINT (code) + 0x100000);
3253 /************************************************************************/
3254 /* Char table read syntax */
3255 /************************************************************************/
3258 chartab_type_validate (Lisp_Object keyword, Lisp_Object value,
3259 Error_behavior errb)
3261 /* #### should deal with ERRB */
3262 symbol_to_char_table_type (value);
3267 chartab_data_validate (Lisp_Object keyword, Lisp_Object value,
3268 Error_behavior errb)
3272 /* #### should deal with ERRB */
3273 EXTERNAL_LIST_LOOP (rest, value)
3275 Lisp_Object range = XCAR (rest);
3276 struct chartab_range dummy;
3280 signal_simple_error ("Invalid list format", value);
3283 if (!CONSP (XCDR (range))
3284 || !NILP (XCDR (XCDR (range))))
3285 signal_simple_error ("Invalid range format", range);
3286 decode_char_table_range (XCAR (range), &dummy);
3287 decode_char_table_range (XCAR (XCDR (range)), &dummy);
3290 decode_char_table_range (range, &dummy);
3297 chartab_instantiate (Lisp_Object data)
3299 Lisp_Object chartab;
3300 Lisp_Object type = Qgeneric;
3301 Lisp_Object dataval = Qnil;
3303 while (!NILP (data))
3305 Lisp_Object keyw = Fcar (data);
3311 if (EQ (keyw, Qtype))
3313 else if (EQ (keyw, Qdata))
3317 chartab = Fmake_char_table (type);
3320 while (!NILP (data))
3322 Lisp_Object range = Fcar (data);
3323 Lisp_Object val = Fcar (Fcdr (data));
3325 data = Fcdr (Fcdr (data));
3328 if (CHAR_OR_CHAR_INTP (XCAR (range)))
3330 Emchar first = XCHAR_OR_CHAR_INT (Fcar (range));
3331 Emchar last = XCHAR_OR_CHAR_INT (Fcar (Fcdr (range)));
3334 for (i = first; i <= last; i++)
3335 Fput_char_table (make_char (i), val, chartab);
3341 Fput_char_table (range, val, chartab);
3350 /************************************************************************/
3351 /* Category Tables, specifically */
3352 /************************************************************************/
3354 DEFUN ("category-table-p", Fcategory_table_p, 1, 1, 0, /*
3355 Return t if OBJECT is a category table.
3356 A category table is a type of char table used for keeping track of
3357 categories. Categories are used for classifying characters for use
3358 in regexps -- you can refer to a category rather than having to use
3359 a complicated [] expression (and category lookups are significantly
3362 There are 95 different categories available, one for each printable
3363 character (including space) in the ASCII charset. Each category
3364 is designated by one such character, called a "category designator".
3365 They are specified in a regexp using the syntax "\\cX", where X is
3366 a category designator.
3368 A category table specifies, for each character, the categories that
3369 the character is in. Note that a character can be in more than one
3370 category. More specifically, a category table maps from a character
3371 to either the value nil (meaning the character is in no categories)
3372 or a 95-element bit vector, specifying for each of the 95 categories
3373 whether the character is in that category.
3375 Special Lisp functions are provided that abstract this, so you do not
3376 have to directly manipulate bit vectors.
3380 return (CHAR_TABLEP (object) &&
3381 XCHAR_TABLE_TYPE (object) == CHAR_TABLE_TYPE_CATEGORY) ?
3386 check_category_table (Lisp_Object object, Lisp_Object default_)
3390 while (NILP (Fcategory_table_p (object)))
3391 object = wrong_type_argument (Qcategory_table_p, object);
3396 check_category_char (Emchar ch, Lisp_Object table,
3397 unsigned int designator, unsigned int not)
3399 REGISTER Lisp_Object temp;
3400 Lisp_Char_Table *ctbl;
3401 #ifdef ERROR_CHECK_TYPECHECK
3402 if (NILP (Fcategory_table_p (table)))
3403 signal_simple_error ("Expected category table", table);
3405 ctbl = XCHAR_TABLE (table);
3406 temp = get_char_table (ch, ctbl);
3411 return bit_vector_bit (XBIT_VECTOR (temp), designator) ? !not : not;
3414 DEFUN ("check-category-at", Fcheck_category_at, 2, 4, 0, /*
3415 Return t if category of the character at POSITION includes DESIGNATOR.
3416 Optional third arg BUFFER specifies which buffer to use, and defaults
3417 to the current buffer.
3418 Optional fourth arg CATEGORY-TABLE specifies the category table to
3419 use, and defaults to BUFFER's category table.
3421 (position, designator, buffer, category_table))
3426 struct buffer *buf = decode_buffer (buffer, 0);
3428 CHECK_INT (position);
3429 CHECK_CATEGORY_DESIGNATOR (designator);
3430 des = XCHAR (designator);
3431 ctbl = check_category_table (category_table, Vstandard_category_table);
3432 ch = BUF_FETCH_CHAR (buf, XINT (position));
3433 return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil;
3436 DEFUN ("char-in-category-p", Fchar_in_category_p, 2, 3, 0, /*
3437 Return t if category of CHARACTER includes DESIGNATOR, else nil.
3438 Optional third arg CATEGORY-TABLE specifies the category table to use,
3439 and defaults to the standard category table.
3441 (character, designator, category_table))
3447 CHECK_CATEGORY_DESIGNATOR (designator);
3448 des = XCHAR (designator);
3449 CHECK_CHAR (character);
3450 ch = XCHAR (character);
3451 ctbl = check_category_table (category_table, Vstandard_category_table);
3452 return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil;
3455 DEFUN ("category-table", Fcategory_table, 0, 1, 0, /*
3456 Return BUFFER's current category table.
3457 BUFFER defaults to the current buffer.
3461 return decode_buffer (buffer, 0)->category_table;
3464 DEFUN ("standard-category-table", Fstandard_category_table, 0, 0, 0, /*
3465 Return the standard category table.
3466 This is the one used for new buffers.
3470 return Vstandard_category_table;
3473 DEFUN ("copy-category-table", Fcopy_category_table, 0, 1, 0, /*
3474 Return a new category table which is a copy of CATEGORY-TABLE.
3475 CATEGORY-TABLE defaults to the standard category table.
3479 if (NILP (Vstandard_category_table))
3480 return Fmake_char_table (Qcategory);
3483 check_category_table (category_table, Vstandard_category_table);
3484 return Fcopy_char_table (category_table);
3487 DEFUN ("set-category-table", Fset_category_table, 1, 2, 0, /*
3488 Select CATEGORY-TABLE as the new category table for BUFFER.
3489 BUFFER defaults to the current buffer if omitted.
3491 (category_table, buffer))
3493 struct buffer *buf = decode_buffer (buffer, 0);
3494 category_table = check_category_table (category_table, Qnil);
3495 buf->category_table = category_table;
3496 /* Indicate that this buffer now has a specified category table. */
3497 buf->local_var_flags |= XINT (buffer_local_flags.category_table);
3498 return category_table;
3501 DEFUN ("category-designator-p", Fcategory_designator_p, 1, 1, 0, /*
3502 Return t if OBJECT is a category designator (a char in the range ' ' to '~').
3506 return CATEGORY_DESIGNATORP (object) ? Qt : Qnil;
3509 DEFUN ("category-table-value-p", Fcategory_table_value_p, 1, 1, 0, /*
3510 Return t if OBJECT is a category table value.
3511 Valid values are nil or a bit vector of size 95.
3515 return CATEGORY_TABLE_VALUEP (object) ? Qt : Qnil;
3519 #define CATEGORYP(x) \
3520 (CHARP (x) && XCHAR (x) >= 0x20 && XCHAR (x) <= 0x7E)
3522 #define CATEGORY_SET(c) \
3523 (get_char_table(c, XCHAR_TABLE(current_buffer->category_table)))
3525 /* Return 1 if CATEGORY_SET contains CATEGORY, else return 0.
3526 The faster version of `!NILP (Faref (category_set, category))'. */
3527 #define CATEGORY_MEMBER(category, category_set) \
3528 (bit_vector_bit(XBIT_VECTOR (category_set), category - 32))
3530 /* Return 1 if there is a word boundary between two word-constituent
3531 characters C1 and C2 if they appear in this order, else return 0.
3532 Use the macro WORD_BOUNDARY_P instead of calling this function
3535 int word_boundary_p (Emchar c1, Emchar c2);
3537 word_boundary_p (Emchar c1, Emchar c2)
3539 Lisp_Object category_set1, category_set2;
3544 if (COMPOSITE_CHAR_P (c1))
3545 c1 = cmpchar_component (c1, 0, 1);
3546 if (COMPOSITE_CHAR_P (c2))
3547 c2 = cmpchar_component (c2, 0, 1);
3550 if (EQ (CHAR_CHARSET (c1), CHAR_CHARSET (c2)))
3552 tail = Vword_separating_categories;
3557 tail = Vword_combining_categories;
3561 category_set1 = CATEGORY_SET (c1);
3562 if (NILP (category_set1))
3563 return default_result;
3564 category_set2 = CATEGORY_SET (c2);
3565 if (NILP (category_set2))
3566 return default_result;
3568 for (; CONSP (tail); tail = XCONS (tail)->cdr)
3570 Lisp_Object elt = XCONS(tail)->car;
3573 && CATEGORYP (XCONS (elt)->car)
3574 && CATEGORYP (XCONS (elt)->cdr)
3575 && CATEGORY_MEMBER (XCHAR (XCONS (elt)->car), category_set1)
3576 && CATEGORY_MEMBER (XCHAR (XCONS (elt)->cdr), category_set2))
3577 return !default_result;
3579 return default_result;
3585 syms_of_chartab (void)
3588 INIT_LRECORD_IMPLEMENTATION (uint8_byte_table);
3589 INIT_LRECORD_IMPLEMENTATION (uint16_byte_table);
3590 INIT_LRECORD_IMPLEMENTATION (byte_table);
3592 defsymbol (&Qto_ucs, "=>ucs");
3593 defsymbol (&Q_ucs, "->ucs");
3594 defsymbol (&Q_decomposition, "->decomposition");
3595 defsymbol (&Qcompat, "compat");
3596 defsymbol (&Qisolated, "isolated");
3597 defsymbol (&Qinitial, "initial");
3598 defsymbol (&Qmedial, "medial");
3599 defsymbol (&Qfinal, "final");
3600 defsymbol (&Qvertical, "vertical");
3601 defsymbol (&QnoBreak, "noBreak");
3602 defsymbol (&Qfraction, "fraction");
3603 defsymbol (&Qsuper, "super");
3604 defsymbol (&Qsub, "sub");
3605 defsymbol (&Qcircle, "circle");
3606 defsymbol (&Qsquare, "square");
3607 defsymbol (&Qwide, "wide");
3608 defsymbol (&Qnarrow, "narrow");
3609 defsymbol (&Qsmall, "small");
3610 defsymbol (&Qfont, "font");
3612 DEFSUBR (Fchar_attribute_list);
3613 DEFSUBR (Ffind_char_attribute_table);
3614 DEFSUBR (Fchar_attribute_alist);
3615 DEFSUBR (Fget_char_attribute);
3616 DEFSUBR (Fput_char_attribute);
3617 DEFSUBR (Fremove_char_attribute);
3618 DEFSUBR (Fmap_char_attribute);
3619 DEFSUBR (Fdefine_char);
3620 DEFSUBR (Ffind_char);
3621 DEFSUBR (Fchar_variants);
3623 DEFSUBR (Fget_composite_char);
3626 INIT_LRECORD_IMPLEMENTATION (char_table);
3630 INIT_LRECORD_IMPLEMENTATION (char_table_entry);
3633 defsymbol (&Qcategory_table_p, "category-table-p");
3634 defsymbol (&Qcategory_designator_p, "category-designator-p");
3635 defsymbol (&Qcategory_table_value_p, "category-table-value-p");
3638 defsymbol (&Qchar_table, "char-table");
3639 defsymbol (&Qchar_tablep, "char-table-p");
3641 DEFSUBR (Fchar_table_p);
3642 DEFSUBR (Fchar_table_type_list);
3643 DEFSUBR (Fvalid_char_table_type_p);
3644 DEFSUBR (Fchar_table_type);
3645 DEFSUBR (Freset_char_table);
3646 DEFSUBR (Fmake_char_table);
3647 DEFSUBR (Fcopy_char_table);
3648 DEFSUBR (Fget_char_table);
3649 DEFSUBR (Fget_range_char_table);
3650 DEFSUBR (Fvalid_char_table_value_p);
3651 DEFSUBR (Fcheck_valid_char_table_value);
3652 DEFSUBR (Fput_char_table);
3653 DEFSUBR (Fmap_char_table);
3656 DEFSUBR (Fcategory_table_p);
3657 DEFSUBR (Fcategory_table);
3658 DEFSUBR (Fstandard_category_table);
3659 DEFSUBR (Fcopy_category_table);
3660 DEFSUBR (Fset_category_table);
3661 DEFSUBR (Fcheck_category_at);
3662 DEFSUBR (Fchar_in_category_p);
3663 DEFSUBR (Fcategory_designator_p);
3664 DEFSUBR (Fcategory_table_value_p);
3670 vars_of_chartab (void)
3673 Vutf_2000_version = build_string("0.18 (Yamato-Koizumi)");
3674 DEFVAR_LISP ("utf-2000-version", &Vutf_2000_version /*
3675 Version number of XEmacs UTF-2000.
3678 staticpro (&Vcharacter_composition_table);
3679 Vcharacter_composition_table = make_char_id_table (Qnil);
3681 staticpro (&Vcharacter_variant_table);
3682 Vcharacter_variant_table = make_char_id_table (Qnil);
3684 /* DO NOT staticpro this. It works just like Vweak_hash_tables. */
3685 Vall_syntax_tables = Qnil;
3686 dump_add_weak_object_chain (&Vall_syntax_tables);
3690 structure_type_create_chartab (void)
3692 struct structure_type *st;
3694 st = define_structure_type (Qchar_table, 0, chartab_instantiate);
3696 define_structure_type_keyword (st, Qtype, chartab_type_validate);
3697 define_structure_type_keyword (st, Qdata, chartab_data_validate);
3701 complex_vars_of_chartab (void)
3704 staticpro (&Vchar_attribute_hash_table);
3705 Vchar_attribute_hash_table
3706 = make_lisp_hash_table (16, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
3707 #endif /* UTF2000 */
3709 /* Set this now, so first buffer creation can refer to it. */
3710 /* Make it nil before calling copy-category-table
3711 so that copy-category-table will know not to try to copy from garbage */
3712 Vstandard_category_table = Qnil;
3713 Vstandard_category_table = Fcopy_category_table (Qnil);
3714 staticpro (&Vstandard_category_table);
3716 DEFVAR_LISP ("word-combining-categories", &Vword_combining_categories /*
3717 List of pair (cons) of categories to determine word boundary.
3719 Emacs treats a sequence of word constituent characters as a single
3720 word (i.e. finds no word boundary between them) iff they belongs to
3721 the same charset. But, exceptions are allowed in the following cases.
3723 \(1) The case that characters are in different charsets is controlled
3724 by the variable `word-combining-categories'.
3726 Emacs finds no word boundary between characters of different charsets
3727 if they have categories matching some element of this list.
3729 More precisely, if an element of this list is a cons of category CAT1
3730 and CAT2, and a multibyte character C1 which has CAT1 is followed by
3731 C2 which has CAT2, there's no word boundary between C1 and C2.
3733 For instance, to tell that ASCII characters and Latin-1 characters can
3734 form a single word, the element `(?l . ?l)' should be in this list
3735 because both characters have the category `l' (Latin characters).
3737 \(2) The case that character are in the same charset is controlled by
3738 the variable `word-separating-categories'.
3740 Emacs find a word boundary between characters of the same charset
3741 if they have categories matching some element of this list.
3743 More precisely, if an element of this list is a cons of category CAT1
3744 and CAT2, and a multibyte character C1 which has CAT1 is followed by
3745 C2 which has CAT2, there's a word boundary between C1 and C2.
3747 For instance, to tell that there's a word boundary between Japanese
3748 Hiragana and Japanese Kanji (both are in the same charset), the
3749 element `(?H . ?C) should be in this list.
3752 Vword_combining_categories = Qnil;
3754 DEFVAR_LISP ("word-separating-categories", &Vword_separating_categories /*
3755 List of pair (cons) of categories to determine word boundary.
3756 See the documentation of the variable `word-combining-categories'.
3759 Vword_separating_categories = Qnil;