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 Lisp_Object val = get_byte_table (get_byte_table
1811 (unsigned char)(ch >> 24)),
1812 (unsigned char) (ch >> 16)),
1813 (unsigned char) (ch >> 8)),
1814 (unsigned char) ch);
1816 return ct->default_value;
1821 Lisp_Object charset;
1825 BREAKUP_CHAR (ch, charset, byte1, byte2);
1827 if (EQ (charset, Vcharset_ascii))
1828 val = ct->ascii[byte1];
1829 else if (EQ (charset, Vcharset_control_1))
1830 val = ct->ascii[byte1 + 128];
1833 int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE;
1834 val = ct->level1[lb];
1835 if (CHAR_TABLE_ENTRYP (val))
1837 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
1838 val = cte->level2[byte1 - 32];
1839 if (CHAR_TABLE_ENTRYP (val))
1841 cte = XCHAR_TABLE_ENTRY (val);
1842 assert (byte2 >= 32);
1843 val = cte->level2[byte2 - 32];
1844 assert (!CHAR_TABLE_ENTRYP (val));
1851 #else /* not MULE */
1852 return ct->ascii[(unsigned char)ch];
1853 #endif /* not MULE */
1857 DEFUN ("get-char-table", Fget_char_table, 2, 2, 0, /*
1858 Find value for CHARACTER in CHAR-TABLE.
1860 (character, char_table))
1862 CHECK_CHAR_TABLE (char_table);
1863 CHECK_CHAR_COERCE_INT (character);
1865 return get_char_table (XCHAR (character), XCHAR_TABLE (char_table));
1868 DEFUN ("get-range-char-table", Fget_range_char_table, 2, 3, 0, /*
1869 Find value for a range in CHAR-TABLE.
1870 If there is more than one value, return MULTI (defaults to nil).
1872 (range, char_table, multi))
1874 Lisp_Char_Table *ct;
1875 struct chartab_range rainj;
1877 if (CHAR_OR_CHAR_INTP (range))
1878 return Fget_char_table (range, char_table);
1879 CHECK_CHAR_TABLE (char_table);
1880 ct = XCHAR_TABLE (char_table);
1882 decode_char_table_range (range, &rainj);
1885 case CHARTAB_RANGE_ALL:
1888 if (UINT8_BYTE_TABLE_P (ct->table))
1890 else if (UINT16_BYTE_TABLE_P (ct->table))
1892 else if (BYTE_TABLE_P (ct->table))
1896 #else /* non UTF2000 */
1898 Lisp_Object first = ct->ascii[0];
1900 for (i = 1; i < NUM_ASCII_CHARS; i++)
1901 if (!EQ (first, ct->ascii[i]))
1905 for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES;
1908 if (!CHARSETP (CHARSET_BY_LEADING_BYTE (i))
1909 || i == LEADING_BYTE_ASCII
1910 || i == LEADING_BYTE_CONTROL_1)
1912 if (!EQ (first, ct->level1[i - MIN_LEADING_BYTE]))
1918 #endif /* non UTF2000 */
1922 case CHARTAB_RANGE_CHARSET:
1926 if (EQ (rainj.charset, Vcharset_ascii))
1929 Lisp_Object first = ct->ascii[0];
1931 for (i = 1; i < 128; i++)
1932 if (!EQ (first, ct->ascii[i]))
1937 if (EQ (rainj.charset, Vcharset_control_1))
1940 Lisp_Object first = ct->ascii[128];
1942 for (i = 129; i < 160; i++)
1943 if (!EQ (first, ct->ascii[i]))
1949 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (rainj.charset) -
1951 if (CHAR_TABLE_ENTRYP (val))
1957 case CHARTAB_RANGE_ROW:
1962 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (rainj.charset) -
1964 if (!CHAR_TABLE_ENTRYP (val))
1966 val = XCHAR_TABLE_ENTRY (val)->level2[rainj.row - 32];
1967 if (CHAR_TABLE_ENTRYP (val))
1971 #endif /* not UTF2000 */
1972 #endif /* not MULE */
1978 return Qnil; /* not reached */
1982 check_valid_char_table_value (Lisp_Object value, enum char_table_type type,
1983 Error_behavior errb)
1987 case CHAR_TABLE_TYPE_SYNTAX:
1988 if (!ERRB_EQ (errb, ERROR_ME))
1989 return INTP (value) || (CONSP (value) && INTP (XCAR (value))
1990 && CHAR_OR_CHAR_INTP (XCDR (value)));
1993 Lisp_Object cdr = XCDR (value);
1994 CHECK_INT (XCAR (value));
1995 CHECK_CHAR_COERCE_INT (cdr);
2002 case CHAR_TABLE_TYPE_CATEGORY:
2003 if (!ERRB_EQ (errb, ERROR_ME))
2004 return CATEGORY_TABLE_VALUEP (value);
2005 CHECK_CATEGORY_TABLE_VALUE (value);
2009 case CHAR_TABLE_TYPE_GENERIC:
2012 case CHAR_TABLE_TYPE_DISPLAY:
2014 maybe_signal_simple_error ("Display char tables not yet implemented",
2015 value, Qchar_table, errb);
2018 case CHAR_TABLE_TYPE_CHAR:
2019 if (!ERRB_EQ (errb, ERROR_ME))
2020 return CHAR_OR_CHAR_INTP (value);
2021 CHECK_CHAR_COERCE_INT (value);
2028 return 0; /* not reached */
2032 canonicalize_char_table_value (Lisp_Object value, enum char_table_type type)
2036 case CHAR_TABLE_TYPE_SYNTAX:
2039 Lisp_Object car = XCAR (value);
2040 Lisp_Object cdr = XCDR (value);
2041 CHECK_CHAR_COERCE_INT (cdr);
2042 return Fcons (car, cdr);
2045 case CHAR_TABLE_TYPE_CHAR:
2046 CHECK_CHAR_COERCE_INT (value);
2054 DEFUN ("valid-char-table-value-p", Fvalid_char_table_value_p, 2, 2, 0, /*
2055 Return non-nil if VALUE is a valid value for CHAR-TABLE-TYPE.
2057 (value, char_table_type))
2059 enum char_table_type type = symbol_to_char_table_type (char_table_type);
2061 return check_valid_char_table_value (value, type, ERROR_ME_NOT) ? Qt : Qnil;
2064 DEFUN ("check-valid-char-table-value", Fcheck_valid_char_table_value, 2, 2, 0, /*
2065 Signal an error if VALUE is not a valid value for CHAR-TABLE-TYPE.
2067 (value, char_table_type))
2069 enum char_table_type type = symbol_to_char_table_type (char_table_type);
2071 check_valid_char_table_value (value, type, ERROR_ME);
2075 /* Assign VAL to all characters in RANGE in char table CT. */
2078 put_char_table (Lisp_Char_Table *ct, struct chartab_range *range,
2081 switch (range->type)
2083 case CHARTAB_RANGE_ALL:
2084 /* printf ("put-char-table: range = all\n"); */
2085 fill_char_table (ct, val);
2086 return; /* avoid the duplicate call to update_syntax_table() below,
2087 since fill_char_table() also did that. */
2090 case CHARTAB_RANGE_DEFAULT:
2091 ct->default_value = val;
2096 case CHARTAB_RANGE_CHARSET:
2100 Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (range->charset);
2102 /* printf ("put-char-table: range = charset: %d\n",
2103 XCHARSET_LEADING_BYTE (range->charset));
2105 if ( CHAR_TABLEP (encoding_table) )
2107 for (c = 0; c < 1 << 24; c++)
2109 if ( INTP (get_char_id_table (XCHAR_TABLE(encoding_table),
2111 put_char_id_table_0 (ct, c, val);
2116 for (c = 0; c < 1 << 24; c++)
2118 if ( charset_code_point (range->charset, c) >= 0 )
2119 put_char_id_table_0 (ct, c, val);
2124 if (EQ (range->charset, Vcharset_ascii))
2127 for (i = 0; i < 128; i++)
2130 else if (EQ (range->charset, Vcharset_control_1))
2133 for (i = 128; i < 160; i++)
2138 int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE;
2139 ct->level1[lb] = val;
2144 case CHARTAB_RANGE_ROW:
2147 int cell_min, cell_max, i;
2149 /* printf ("put-char-table: range = charset-row: %d, 0x%x\n",
2150 XCHARSET_LEADING_BYTE (range->charset), range->row); */
2151 if (XCHARSET_DIMENSION (range->charset) < 2)
2152 signal_simple_error ("Charset in row vector must be multi-byte",
2156 switch (XCHARSET_CHARS (range->charset))
2159 cell_min = 33; cell_max = 126;
2162 cell_min = 32; cell_max = 127;
2165 cell_min = 0; cell_max = 127;
2168 cell_min = 0; cell_max = 255;
2174 if (XCHARSET_DIMENSION (range->charset) == 2)
2175 check_int_range (range->row, cell_min, cell_max);
2176 else if (XCHARSET_DIMENSION (range->charset) == 3)
2178 check_int_range (range->row >> 8 , cell_min, cell_max);
2179 check_int_range (range->row & 0xFF, cell_min, cell_max);
2181 else if (XCHARSET_DIMENSION (range->charset) == 4)
2183 check_int_range ( range->row >> 16 , cell_min, cell_max);
2184 check_int_range ((range->row >> 8) & 0xFF, cell_min, cell_max);
2185 check_int_range ( range->row & 0xFF, cell_min, cell_max);
2190 for (i = cell_min; i <= cell_max; i++)
2192 Emchar ch = DECODE_CHAR (range->charset, (range->row << 8) | i);
2193 if ( charset_code_point (range->charset, ch) >= 0 )
2194 put_char_id_table_0 (ct, ch, val);
2199 Lisp_Char_Table_Entry *cte;
2200 int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE;
2201 /* make sure that there is a separate entry for the row. */
2202 if (!CHAR_TABLE_ENTRYP (ct->level1[lb]))
2203 ct->level1[lb] = make_char_table_entry (ct->level1[lb]);
2204 cte = XCHAR_TABLE_ENTRY (ct->level1[lb]);
2205 cte->level2[range->row - 32] = val;
2207 #endif /* not UTF2000 */
2211 case CHARTAB_RANGE_CHAR:
2213 /* printf ("put-char-table: range = char: 0x%x\n", range->ch); */
2214 put_char_id_table_0 (ct, range->ch, val);
2218 Lisp_Object charset;
2221 BREAKUP_CHAR (range->ch, charset, byte1, byte2);
2222 if (EQ (charset, Vcharset_ascii))
2223 ct->ascii[byte1] = val;
2224 else if (EQ (charset, Vcharset_control_1))
2225 ct->ascii[byte1 + 128] = val;
2228 Lisp_Char_Table_Entry *cte;
2229 int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE;
2230 /* make sure that there is a separate entry for the row. */
2231 if (!CHAR_TABLE_ENTRYP (ct->level1[lb]))
2232 ct->level1[lb] = make_char_table_entry (ct->level1[lb]);
2233 cte = XCHAR_TABLE_ENTRY (ct->level1[lb]);
2234 /* now CTE is a char table entry for the charset;
2235 each entry is for a single row (or character of
2236 a one-octet charset). */
2237 if (XCHARSET_DIMENSION (charset) == 1)
2238 cte->level2[byte1 - 32] = val;
2241 /* assigning to one character in a two-octet charset. */
2242 /* make sure that the charset row contains a separate
2243 entry for each character. */
2244 if (!CHAR_TABLE_ENTRYP (cte->level2[byte1 - 32]))
2245 cte->level2[byte1 - 32] =
2246 make_char_table_entry (cte->level2[byte1 - 32]);
2247 cte = XCHAR_TABLE_ENTRY (cte->level2[byte1 - 32]);
2248 cte->level2[byte2 - 32] = val;
2252 #else /* not MULE */
2253 ct->ascii[(unsigned char) (range->ch)] = val;
2255 #endif /* not MULE */
2259 if (ct->type == CHAR_TABLE_TYPE_SYNTAX)
2260 update_syntax_table (ct);
2264 DEFUN ("put-char-table", Fput_char_table, 3, 3, 0, /*
2265 Set the value for chars in RANGE to be VALUE in CHAR-TABLE.
2267 RANGE specifies one or more characters to be affected and should be
2268 one of the following:
2270 -- t (all characters are affected)
2271 -- A charset (only allowed when Mule support is present)
2272 -- A vector of two elements: a two-octet charset and a row number
2273 (only allowed when Mule support is present)
2274 -- A single character
2276 VALUE must be a value appropriate for the type of CHAR-TABLE.
2277 See `valid-char-table-type-p'.
2279 (range, value, char_table))
2281 Lisp_Char_Table *ct;
2282 struct chartab_range rainj;
2284 CHECK_CHAR_TABLE (char_table);
2285 ct = XCHAR_TABLE (char_table);
2286 check_valid_char_table_value (value, ct->type, ERROR_ME);
2287 decode_char_table_range (range, &rainj);
2288 value = canonicalize_char_table_value (value, ct->type);
2289 put_char_table (ct, &rainj, value);
2294 /* Map FN over the ASCII chars in CT. */
2297 map_over_charset_ascii (Lisp_Char_Table *ct,
2298 int (*fn) (struct chartab_range *range,
2299 Lisp_Object val, void *arg),
2302 struct chartab_range rainj;
2311 rainj.type = CHARTAB_RANGE_CHAR;
2313 for (i = start, retval = 0; i < stop && retval == 0; i++)
2315 rainj.ch = (Emchar) i;
2316 retval = (fn) (&rainj, ct->ascii[i], arg);
2324 /* Map FN over the Control-1 chars in CT. */
2327 map_over_charset_control_1 (Lisp_Char_Table *ct,
2328 int (*fn) (struct chartab_range *range,
2329 Lisp_Object val, void *arg),
2332 struct chartab_range rainj;
2335 int stop = start + 32;
2337 rainj.type = CHARTAB_RANGE_CHAR;
2339 for (i = start, retval = 0; i < stop && retval == 0; i++)
2341 rainj.ch = (Emchar) (i);
2342 retval = (fn) (&rainj, ct->ascii[i], arg);
2348 /* Map FN over the row ROW of two-byte charset CHARSET.
2349 There must be a separate value for that row in the char table.
2350 CTE specifies the char table entry for CHARSET. */
2353 map_over_charset_row (Lisp_Char_Table_Entry *cte,
2354 Lisp_Object charset, int row,
2355 int (*fn) (struct chartab_range *range,
2356 Lisp_Object val, void *arg),
2359 Lisp_Object val = cte->level2[row - 32];
2361 if (!CHAR_TABLE_ENTRYP (val))
2363 struct chartab_range rainj;
2365 rainj.type = CHARTAB_RANGE_ROW;
2366 rainj.charset = charset;
2368 return (fn) (&rainj, val, arg);
2372 struct chartab_range rainj;
2374 int charset94_p = (XCHARSET_CHARS (charset) == 94);
2375 int start = charset94_p ? 33 : 32;
2376 int stop = charset94_p ? 127 : 128;
2378 cte = XCHAR_TABLE_ENTRY (val);
2380 rainj.type = CHARTAB_RANGE_CHAR;
2382 for (i = start, retval = 0; i < stop && retval == 0; i++)
2384 rainj.ch = MAKE_CHAR (charset, row, i);
2385 retval = (fn) (&rainj, cte->level2[i - 32], arg);
2393 map_over_other_charset (Lisp_Char_Table *ct, Charset_ID lb,
2394 int (*fn) (struct chartab_range *range,
2395 Lisp_Object val, void *arg),
2398 Lisp_Object val = ct->level1[lb - MIN_LEADING_BYTE];
2399 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (lb);
2401 if (!CHARSETP (charset)
2402 || lb == LEADING_BYTE_ASCII
2403 || lb == LEADING_BYTE_CONTROL_1)
2406 if (!CHAR_TABLE_ENTRYP (val))
2408 struct chartab_range rainj;
2410 rainj.type = CHARTAB_RANGE_CHARSET;
2411 rainj.charset = charset;
2412 return (fn) (&rainj, val, arg);
2416 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
2417 int charset94_p = (XCHARSET_CHARS (charset) == 94);
2418 int start = charset94_p ? 33 : 32;
2419 int stop = charset94_p ? 127 : 128;
2422 if (XCHARSET_DIMENSION (charset) == 1)
2424 struct chartab_range rainj;
2425 rainj.type = CHARTAB_RANGE_CHAR;
2427 for (i = start, retval = 0; i < stop && retval == 0; i++)
2429 rainj.ch = MAKE_CHAR (charset, i, 0);
2430 retval = (fn) (&rainj, cte->level2[i - 32], arg);
2435 for (i = start, retval = 0; i < stop && retval == 0; i++)
2436 retval = map_over_charset_row (cte, charset, i, fn, arg);
2444 #endif /* not UTF2000 */
2447 struct map_char_table_for_charset_arg
2449 int (*fn) (struct chartab_range *range, Lisp_Object val, void *arg);
2450 Lisp_Char_Table *ct;
2455 map_char_table_for_charset_fun (struct chartab_range *range,
2456 Lisp_Object val, void *arg)
2458 struct map_char_table_for_charset_arg *closure =
2459 (struct map_char_table_for_charset_arg *) arg;
2462 switch (range->type)
2464 case CHARTAB_RANGE_ALL:
2467 case CHARTAB_RANGE_DEFAULT:
2470 case CHARTAB_RANGE_CHARSET:
2473 case CHARTAB_RANGE_ROW:
2476 case CHARTAB_RANGE_CHAR:
2477 ret = get_char_table (range->ch, closure->ct);
2478 if (!UNBOUNDP (ret))
2479 return (closure->fn) (range, ret, closure->arg);
2490 /* Map FN (with client data ARG) over range RANGE in char table CT.
2491 Mapping stops the first time FN returns non-zero, and that value
2492 becomes the return value of map_char_table(). */
2495 map_char_table (Lisp_Char_Table *ct,
2496 struct chartab_range *range,
2497 int (*fn) (struct chartab_range *range,
2498 Lisp_Object val, void *arg),
2501 switch (range->type)
2503 case CHARTAB_RANGE_ALL:
2505 if (!UNBOUNDP (ct->default_value))
2507 struct chartab_range rainj;
2510 rainj.type = CHARTAB_RANGE_DEFAULT;
2511 retval = (fn) (&rainj, ct->default_value, arg);
2515 if (UINT8_BYTE_TABLE_P (ct->table))
2516 return map_over_uint8_byte_table (XUINT8_BYTE_TABLE(ct->table),
2518 else if (UINT16_BYTE_TABLE_P (ct->table))
2519 return map_over_uint16_byte_table (XUINT16_BYTE_TABLE(ct->table),
2521 else if (BYTE_TABLE_P (ct->table))
2522 return map_over_byte_table (XBYTE_TABLE(ct->table),
2524 else if (!UNBOUNDP (ct->table))
2527 struct chartab_range rainj;
2530 Emchar c1 = c + unit;
2533 rainj.type = CHARTAB_RANGE_CHAR;
2535 for (retval = 0; c < c1 && retval == 0; c++)
2538 retval = (fn) (&rainj, ct->table, arg);
2543 return (fn) (range, ct->table, arg);
2550 retval = map_over_charset_ascii (ct, fn, arg);
2554 retval = map_over_charset_control_1 (ct, fn, arg);
2559 Charset_ID start = MIN_LEADING_BYTE;
2560 Charset_ID stop = start + NUM_LEADING_BYTES;
2562 for (i = start, retval = 0; i < stop && retval == 0; i++)
2564 retval = map_over_other_charset (ct, i, fn, arg);
2573 case CHARTAB_RANGE_DEFAULT:
2574 if (!UNBOUNDP (ct->default_value))
2575 return (fn) (range, ct->default_value, arg);
2580 case CHARTAB_RANGE_CHARSET:
2583 Lisp_Object encoding_table
2584 = XCHARSET_ENCODING_TABLE (range->charset);
2586 if (!NILP (encoding_table))
2588 struct chartab_range rainj;
2589 struct map_char_table_for_charset_arg mcarg;
2594 rainj.type = CHARTAB_RANGE_ALL;
2595 return map_char_table (XCHAR_TABLE(encoding_table),
2597 &map_char_table_for_charset_fun,
2603 return map_over_other_charset (ct,
2604 XCHARSET_LEADING_BYTE (range->charset),
2608 case CHARTAB_RANGE_ROW:
2611 int cell_min, cell_max, i;
2613 struct chartab_range rainj;
2615 if (XCHARSET_DIMENSION (range->charset) < 2)
2616 signal_simple_error ("Charset in row vector must be multi-byte",
2620 switch (XCHARSET_CHARS (range->charset))
2623 cell_min = 33; cell_max = 126;
2626 cell_min = 32; cell_max = 127;
2629 cell_min = 0; cell_max = 127;
2632 cell_min = 0; cell_max = 255;
2638 if (XCHARSET_DIMENSION (range->charset) == 2)
2639 check_int_range (range->row, cell_min, cell_max);
2640 else if (XCHARSET_DIMENSION (range->charset) == 3)
2642 check_int_range (range->row >> 8 , cell_min, cell_max);
2643 check_int_range (range->row & 0xFF, cell_min, cell_max);
2645 else if (XCHARSET_DIMENSION (range->charset) == 4)
2647 check_int_range ( range->row >> 16 , cell_min, cell_max);
2648 check_int_range ((range->row >> 8) & 0xFF, cell_min, cell_max);
2649 check_int_range ( range->row & 0xFF, cell_min, cell_max);
2654 rainj.type = CHARTAB_RANGE_CHAR;
2655 for (retval =0, i = cell_min; i <= cell_max && retval == 0; i++)
2657 Emchar ch = DECODE_CHAR (range->charset, (range->row << 8) | i);
2659 if ( charset_code_point (range->charset, ch) >= 0 )
2662 = get_byte_table (get_byte_table
2666 (unsigned char)(ch >> 24)),
2667 (unsigned char) (ch >> 16)),
2668 (unsigned char) (ch >> 8)),
2669 (unsigned char) ch);
2672 val = ct->default_value;
2674 retval = (fn) (&rainj, val, arg);
2681 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (range->charset)
2682 - MIN_LEADING_BYTE];
2683 if (!CHAR_TABLE_ENTRYP (val))
2685 struct chartab_range rainj;
2687 rainj.type = CHARTAB_RANGE_ROW;
2688 rainj.charset = range->charset;
2689 rainj.row = range->row;
2690 return (fn) (&rainj, val, arg);
2693 return map_over_charset_row (XCHAR_TABLE_ENTRY (val),
2694 range->charset, range->row,
2697 #endif /* not UTF2000 */
2700 case CHARTAB_RANGE_CHAR:
2702 Emchar ch = range->ch;
2703 Lisp_Object val = CHAR_TABLE_VALUE_UNSAFE (ct, ch);
2705 if (!UNBOUNDP (val))
2707 struct chartab_range rainj;
2709 rainj.type = CHARTAB_RANGE_CHAR;
2711 return (fn) (&rainj, val, arg);
2723 struct slow_map_char_table_arg
2725 Lisp_Object function;
2730 slow_map_char_table_fun (struct chartab_range *range,
2731 Lisp_Object val, void *arg)
2733 Lisp_Object ranjarg = Qnil;
2734 struct slow_map_char_table_arg *closure =
2735 (struct slow_map_char_table_arg *) arg;
2737 switch (range->type)
2739 case CHARTAB_RANGE_ALL:
2744 case CHARTAB_RANGE_DEFAULT:
2750 case CHARTAB_RANGE_CHARSET:
2751 ranjarg = XCHARSET_NAME (range->charset);
2754 case CHARTAB_RANGE_ROW:
2755 ranjarg = vector2 (XCHARSET_NAME (range->charset),
2756 make_int (range->row));
2759 case CHARTAB_RANGE_CHAR:
2760 ranjarg = make_char (range->ch);
2766 closure->retval = call2 (closure->function, ranjarg, val);
2767 return !NILP (closure->retval);
2770 DEFUN ("map-char-table", Fmap_char_table, 2, 3, 0, /*
2771 Map FUNCTION over entries in CHAR-TABLE, calling it with two args,
2772 each key and value in the table.
2774 RANGE specifies a subrange to map over and is in the same format as
2775 the RANGE argument to `put-range-table'. If omitted or t, it defaults to
2778 (function, char_table, range))
2780 Lisp_Char_Table *ct;
2781 struct slow_map_char_table_arg slarg;
2782 struct gcpro gcpro1, gcpro2;
2783 struct chartab_range rainj;
2785 CHECK_CHAR_TABLE (char_table);
2786 ct = XCHAR_TABLE (char_table);
2789 decode_char_table_range (range, &rainj);
2790 slarg.function = function;
2791 slarg.retval = Qnil;
2792 GCPRO2 (slarg.function, slarg.retval);
2793 map_char_table (ct, &rainj, slow_map_char_table_fun, &slarg);
2796 return slarg.retval;
2800 /************************************************************************/
2801 /* Character Attributes */
2802 /************************************************************************/
2806 Lisp_Object Vchar_attribute_hash_table;
2808 /* We store the char-attributes in hash tables with the names as the
2809 key and the actual char-id-table object as the value. Occasionally
2810 we need to use them in a list format. These routines provide us
2812 struct char_attribute_list_closure
2814 Lisp_Object *char_attribute_list;
2818 add_char_attribute_to_list_mapper (Lisp_Object key, Lisp_Object value,
2819 void *char_attribute_list_closure)
2821 /* This function can GC */
2822 struct char_attribute_list_closure *calcl
2823 = (struct char_attribute_list_closure*) char_attribute_list_closure;
2824 Lisp_Object *char_attribute_list = calcl->char_attribute_list;
2826 *char_attribute_list = Fcons (key, *char_attribute_list);
2830 DEFUN ("char-attribute-list", Fchar_attribute_list, 0, 0, 0, /*
2831 Return the list of all existing character attributes except coded-charsets.
2835 Lisp_Object char_attribute_list = Qnil;
2836 struct gcpro gcpro1;
2837 struct char_attribute_list_closure char_attribute_list_closure;
2839 GCPRO1 (char_attribute_list);
2840 char_attribute_list_closure.char_attribute_list = &char_attribute_list;
2841 elisp_maphash (add_char_attribute_to_list_mapper,
2842 Vchar_attribute_hash_table,
2843 &char_attribute_list_closure);
2845 return char_attribute_list;
2848 DEFUN ("find-char-attribute-table", Ffind_char_attribute_table, 1, 1, 0, /*
2849 Return char-id-table corresponding to ATTRIBUTE.
2853 return Fgethash (attribute, Vchar_attribute_hash_table, Qnil);
2857 /* We store the char-id-tables in hash tables with the attributes as
2858 the key and the actual char-id-table object as the value. Each
2859 char-id-table stores values of an attribute corresponding with
2860 characters. Occasionally we need to get attributes of a character
2861 in a association-list format. These routines provide us with
2863 struct char_attribute_alist_closure
2866 Lisp_Object *char_attribute_alist;
2870 add_char_attribute_alist_mapper (Lisp_Object key, Lisp_Object value,
2871 void *char_attribute_alist_closure)
2873 /* This function can GC */
2874 struct char_attribute_alist_closure *caacl =
2875 (struct char_attribute_alist_closure*) char_attribute_alist_closure;
2877 = get_char_id_table (XCHAR_TABLE(value), caacl->char_id);
2878 if (!UNBOUNDP (ret))
2880 Lisp_Object *char_attribute_alist = caacl->char_attribute_alist;
2881 *char_attribute_alist
2882 = Fcons (Fcons (key, ret), *char_attribute_alist);
2887 DEFUN ("char-attribute-alist", Fchar_attribute_alist, 1, 1, 0, /*
2888 Return the alist of attributes of CHARACTER.
2892 Lisp_Object alist = Qnil;
2895 CHECK_CHAR (character);
2897 struct gcpro gcpro1;
2898 struct char_attribute_alist_closure char_attribute_alist_closure;
2901 char_attribute_alist_closure.char_id = XCHAR (character);
2902 char_attribute_alist_closure.char_attribute_alist = &alist;
2903 elisp_maphash (add_char_attribute_alist_mapper,
2904 Vchar_attribute_hash_table,
2905 &char_attribute_alist_closure);
2909 for (i = 0; i < countof (chlook->charset_by_leading_byte); i++)
2911 Lisp_Object ccs = chlook->charset_by_leading_byte[i];
2915 Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (ccs);
2918 if ( CHAR_TABLEP (encoding_table)
2920 = get_char_id_table (XCHAR_TABLE(encoding_table),
2921 XCHAR (character))) )
2923 alist = Fcons (Fcons (ccs, cpos), alist);
2930 DEFUN ("get-char-attribute", Fget_char_attribute, 2, 3, 0, /*
2931 Return the value of CHARACTER's ATTRIBUTE.
2932 Return DEFAULT-VALUE if the value is not exist.
2934 (character, attribute, default_value))
2938 CHECK_CHAR (character);
2939 if (!NILP (ccs = Ffind_charset (attribute)))
2941 Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (ccs);
2943 if (CHAR_TABLEP (encoding_table))
2944 return get_char_id_table (XCHAR_TABLE(encoding_table),
2949 Lisp_Object table = Fgethash (attribute,
2950 Vchar_attribute_hash_table,
2952 if (!UNBOUNDP (table))
2954 Lisp_Object ret = get_char_id_table (XCHAR_TABLE(table),
2956 if (!UNBOUNDP (ret))
2960 return default_value;
2963 DEFUN ("put-char-attribute", Fput_char_attribute, 3, 3, 0, /*
2964 Store CHARACTER's ATTRIBUTE with VALUE.
2966 (character, attribute, value))
2970 ccs = Ffind_charset (attribute);
2973 CHECK_CHAR (character);
2974 return put_char_ccs_code_point (character, ccs, value);
2976 else if (EQ (attribute, Q_decomposition))
2980 CHECK_CHAR (character);
2982 signal_simple_error ("Invalid value for ->decomposition",
2985 if (CONSP (Fcdr (value)))
2987 Lisp_Object rest = value;
2988 Lisp_Object table = Vcharacter_composition_table;
2992 GET_EXTERNAL_LIST_LENGTH (rest, len);
2993 seq = make_vector (len, Qnil);
2995 while (CONSP (rest))
2997 Lisp_Object v = Fcar (rest);
3000 = to_char_id (v, "Invalid value for ->decomposition", value);
3003 XVECTOR_DATA(seq)[i++] = v;
3005 XVECTOR_DATA(seq)[i++] = make_char (c);
3009 put_char_id_table (XCHAR_TABLE(table),
3010 make_char (c), character);
3015 ntable = get_char_id_table (XCHAR_TABLE(table), c);
3016 if (!CHAR_TABLEP (ntable))
3018 ntable = make_char_id_table (Qnil);
3019 put_char_id_table (XCHAR_TABLE(table),
3020 make_char (c), ntable);
3028 Lisp_Object v = Fcar (value);
3032 Emchar c = XINT (v);
3034 = get_char_id_table (XCHAR_TABLE(Vcharacter_variant_table),
3037 if (NILP (Fmemq (v, ret)))
3039 put_char_id_table (XCHAR_TABLE(Vcharacter_variant_table),
3040 make_char (c), Fcons (character, ret));
3043 seq = make_vector (1, v);
3047 else if (EQ (attribute, Qto_ucs) || EQ (attribute, Q_ucs))
3052 CHECK_CHAR (character);
3054 signal_simple_error ("Invalid value for ->ucs", value);
3058 ret = get_char_id_table (XCHAR_TABLE(Vcharacter_variant_table), c);
3059 if (NILP (Fmemq (character, ret)))
3061 put_char_id_table (XCHAR_TABLE(Vcharacter_variant_table),
3062 make_char (c), Fcons (character, ret));
3065 if (EQ (attribute, Q_ucs))
3066 attribute = Qto_ucs;
3070 Lisp_Object table = Fgethash (attribute,
3071 Vchar_attribute_hash_table,
3076 table = make_char_id_table (Qunbound);
3077 Fputhash (attribute, table, Vchar_attribute_hash_table);
3079 put_char_id_table (XCHAR_TABLE(table), character, value);
3084 DEFUN ("remove-char-attribute", Fremove_char_attribute, 2, 2, 0, /*
3085 Remove CHARACTER's ATTRIBUTE.
3087 (character, attribute))
3091 CHECK_CHAR (character);
3092 ccs = Ffind_charset (attribute);
3095 return remove_char_ccs (character, ccs);
3099 Lisp_Object table = Fgethash (attribute,
3100 Vchar_attribute_hash_table,
3102 if (!UNBOUNDP (table))
3104 put_char_id_table (XCHAR_TABLE(table), character, Qunbound);
3111 DEFUN ("map-char-attribute", Fmap_char_attribute, 2, 3, 0, /*
3112 Map FUNCTION over entries in ATTRIBUTE, calling it with two args,
3113 each key and value in the table.
3115 RANGE specifies a subrange to map over and is in the same format as
3116 the RANGE argument to `put-range-table'. If omitted or t, it defaults to
3119 (function, attribute, range))
3122 Lisp_Char_Table *ct;
3123 struct slow_map_char_table_arg slarg;
3124 struct gcpro gcpro1, gcpro2;
3125 struct chartab_range rainj;
3127 if (!NILP (ccs = Ffind_charset (attribute)))
3129 Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (ccs);
3131 if (CHAR_TABLEP (encoding_table))
3132 ct = XCHAR_TABLE (encoding_table);
3138 Lisp_Object table = Fgethash (attribute,
3139 Vchar_attribute_hash_table,
3141 if (CHAR_TABLEP (table))
3142 ct = XCHAR_TABLE (table);
3148 decode_char_table_range (range, &rainj);
3149 slarg.function = function;
3150 slarg.retval = Qnil;
3151 GCPRO2 (slarg.function, slarg.retval);
3152 map_char_table (ct, &rainj, slow_map_char_table_fun, &slarg);
3155 return slarg.retval;
3158 EXFUN (Fmake_char, 3);
3159 EXFUN (Fdecode_char, 2);
3161 DEFUN ("define-char", Fdefine_char, 1, 1, 0, /*
3162 Store character's ATTRIBUTES.
3166 Lisp_Object rest = attributes;
3167 Lisp_Object code = Fcdr (Fassq (Qucs, attributes));
3168 Lisp_Object character;
3172 while (CONSP (rest))
3174 Lisp_Object cell = Fcar (rest);
3178 signal_simple_error ("Invalid argument", attributes);
3179 if (!NILP (ccs = Ffind_charset (Fcar (cell)))
3180 && ((XCHARSET_FINAL (ccs) != 0) ||
3181 (XCHARSET_UCS_MAX (ccs) > 0)) )
3185 character = Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
3187 character = Fdecode_char (ccs, cell);
3188 if (!NILP (character))
3189 goto setup_attributes;
3193 if ( (!NILP (code = Fcdr (Fassq (Qto_ucs, attributes)))) ||
3194 (!NILP (code = Fcdr (Fassq (Q_ucs, attributes)))) )
3198 signal_simple_error ("Invalid argument", attributes);
3200 character = make_char (XINT (code) + 0x100000);
3201 goto setup_attributes;
3205 else if (!INTP (code))
3206 signal_simple_error ("Invalid argument", attributes);
3208 character = make_char (XINT (code));
3212 while (CONSP (rest))
3214 Lisp_Object cell = Fcar (rest);
3217 signal_simple_error ("Invalid argument", attributes);
3219 Fput_char_attribute (character, Fcar (cell), Fcdr (cell));
3225 DEFUN ("find-char", Ffind_char, 1, 1, 0, /*
3226 Retrieve the character of the given ATTRIBUTES.
3230 Lisp_Object rest = attributes;
3233 while (CONSP (rest))
3235 Lisp_Object cell = Fcar (rest);
3239 signal_simple_error ("Invalid argument", attributes);
3240 if (!NILP (ccs = Ffind_charset (Fcar (cell))))
3244 return Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
3246 return Fdecode_char (ccs, cell);
3250 if ( (!NILP (code = Fcdr (Fassq (Qto_ucs, attributes)))) ||
3251 (!NILP (code = Fcdr (Fassq (Q_ucs, attributes)))) )
3254 signal_simple_error ("Invalid argument", attributes);
3256 return make_char (XINT (code) + 0x100000);
3264 /************************************************************************/
3265 /* Char table read syntax */
3266 /************************************************************************/
3269 chartab_type_validate (Lisp_Object keyword, Lisp_Object value,
3270 Error_behavior errb)
3272 /* #### should deal with ERRB */
3273 symbol_to_char_table_type (value);
3278 chartab_data_validate (Lisp_Object keyword, Lisp_Object value,
3279 Error_behavior errb)
3283 /* #### should deal with ERRB */
3284 EXTERNAL_LIST_LOOP (rest, value)
3286 Lisp_Object range = XCAR (rest);
3287 struct chartab_range dummy;
3291 signal_simple_error ("Invalid list format", value);
3294 if (!CONSP (XCDR (range))
3295 || !NILP (XCDR (XCDR (range))))
3296 signal_simple_error ("Invalid range format", range);
3297 decode_char_table_range (XCAR (range), &dummy);
3298 decode_char_table_range (XCAR (XCDR (range)), &dummy);
3301 decode_char_table_range (range, &dummy);
3308 chartab_instantiate (Lisp_Object data)
3310 Lisp_Object chartab;
3311 Lisp_Object type = Qgeneric;
3312 Lisp_Object dataval = Qnil;
3314 while (!NILP (data))
3316 Lisp_Object keyw = Fcar (data);
3322 if (EQ (keyw, Qtype))
3324 else if (EQ (keyw, Qdata))
3328 chartab = Fmake_char_table (type);
3331 while (!NILP (data))
3333 Lisp_Object range = Fcar (data);
3334 Lisp_Object val = Fcar (Fcdr (data));
3336 data = Fcdr (Fcdr (data));
3339 if (CHAR_OR_CHAR_INTP (XCAR (range)))
3341 Emchar first = XCHAR_OR_CHAR_INT (Fcar (range));
3342 Emchar last = XCHAR_OR_CHAR_INT (Fcar (Fcdr (range)));
3345 for (i = first; i <= last; i++)
3346 Fput_char_table (make_char (i), val, chartab);
3352 Fput_char_table (range, val, chartab);
3361 /************************************************************************/
3362 /* Category Tables, specifically */
3363 /************************************************************************/
3365 DEFUN ("category-table-p", Fcategory_table_p, 1, 1, 0, /*
3366 Return t if OBJECT is a category table.
3367 A category table is a type of char table used for keeping track of
3368 categories. Categories are used for classifying characters for use
3369 in regexps -- you can refer to a category rather than having to use
3370 a complicated [] expression (and category lookups are significantly
3373 There are 95 different categories available, one for each printable
3374 character (including space) in the ASCII charset. Each category
3375 is designated by one such character, called a "category designator".
3376 They are specified in a regexp using the syntax "\\cX", where X is
3377 a category designator.
3379 A category table specifies, for each character, the categories that
3380 the character is in. Note that a character can be in more than one
3381 category. More specifically, a category table maps from a character
3382 to either the value nil (meaning the character is in no categories)
3383 or a 95-element bit vector, specifying for each of the 95 categories
3384 whether the character is in that category.
3386 Special Lisp functions are provided that abstract this, so you do not
3387 have to directly manipulate bit vectors.
3391 return (CHAR_TABLEP (object) &&
3392 XCHAR_TABLE_TYPE (object) == CHAR_TABLE_TYPE_CATEGORY) ?
3397 check_category_table (Lisp_Object object, Lisp_Object default_)
3401 while (NILP (Fcategory_table_p (object)))
3402 object = wrong_type_argument (Qcategory_table_p, object);
3407 check_category_char (Emchar ch, Lisp_Object table,
3408 unsigned int designator, unsigned int not)
3410 REGISTER Lisp_Object temp;
3411 Lisp_Char_Table *ctbl;
3412 #ifdef ERROR_CHECK_TYPECHECK
3413 if (NILP (Fcategory_table_p (table)))
3414 signal_simple_error ("Expected category table", table);
3416 ctbl = XCHAR_TABLE (table);
3417 temp = get_char_table (ch, ctbl);
3422 return bit_vector_bit (XBIT_VECTOR (temp), designator) ? !not : not;
3425 DEFUN ("check-category-at", Fcheck_category_at, 2, 4, 0, /*
3426 Return t if category of the character at POSITION includes DESIGNATOR.
3427 Optional third arg BUFFER specifies which buffer to use, and defaults
3428 to the current buffer.
3429 Optional fourth arg CATEGORY-TABLE specifies the category table to
3430 use, and defaults to BUFFER's category table.
3432 (position, designator, buffer, category_table))
3437 struct buffer *buf = decode_buffer (buffer, 0);
3439 CHECK_INT (position);
3440 CHECK_CATEGORY_DESIGNATOR (designator);
3441 des = XCHAR (designator);
3442 ctbl = check_category_table (category_table, Vstandard_category_table);
3443 ch = BUF_FETCH_CHAR (buf, XINT (position));
3444 return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil;
3447 DEFUN ("char-in-category-p", Fchar_in_category_p, 2, 3, 0, /*
3448 Return t if category of CHARACTER includes DESIGNATOR, else nil.
3449 Optional third arg CATEGORY-TABLE specifies the category table to use,
3450 and defaults to the standard category table.
3452 (character, designator, category_table))
3458 CHECK_CATEGORY_DESIGNATOR (designator);
3459 des = XCHAR (designator);
3460 CHECK_CHAR (character);
3461 ch = XCHAR (character);
3462 ctbl = check_category_table (category_table, Vstandard_category_table);
3463 return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil;
3466 DEFUN ("category-table", Fcategory_table, 0, 1, 0, /*
3467 Return BUFFER's current category table.
3468 BUFFER defaults to the current buffer.
3472 return decode_buffer (buffer, 0)->category_table;
3475 DEFUN ("standard-category-table", Fstandard_category_table, 0, 0, 0, /*
3476 Return the standard category table.
3477 This is the one used for new buffers.
3481 return Vstandard_category_table;
3484 DEFUN ("copy-category-table", Fcopy_category_table, 0, 1, 0, /*
3485 Return a new category table which is a copy of CATEGORY-TABLE.
3486 CATEGORY-TABLE defaults to the standard category table.
3490 if (NILP (Vstandard_category_table))
3491 return Fmake_char_table (Qcategory);
3494 check_category_table (category_table, Vstandard_category_table);
3495 return Fcopy_char_table (category_table);
3498 DEFUN ("set-category-table", Fset_category_table, 1, 2, 0, /*
3499 Select CATEGORY-TABLE as the new category table for BUFFER.
3500 BUFFER defaults to the current buffer if omitted.
3502 (category_table, buffer))
3504 struct buffer *buf = decode_buffer (buffer, 0);
3505 category_table = check_category_table (category_table, Qnil);
3506 buf->category_table = category_table;
3507 /* Indicate that this buffer now has a specified category table. */
3508 buf->local_var_flags |= XINT (buffer_local_flags.category_table);
3509 return category_table;
3512 DEFUN ("category-designator-p", Fcategory_designator_p, 1, 1, 0, /*
3513 Return t if OBJECT is a category designator (a char in the range ' ' to '~').
3517 return CATEGORY_DESIGNATORP (object) ? Qt : Qnil;
3520 DEFUN ("category-table-value-p", Fcategory_table_value_p, 1, 1, 0, /*
3521 Return t if OBJECT is a category table value.
3522 Valid values are nil or a bit vector of size 95.
3526 return CATEGORY_TABLE_VALUEP (object) ? Qt : Qnil;
3530 #define CATEGORYP(x) \
3531 (CHARP (x) && XCHAR (x) >= 0x20 && XCHAR (x) <= 0x7E)
3533 #define CATEGORY_SET(c) \
3534 (get_char_table(c, XCHAR_TABLE(current_buffer->category_table)))
3536 /* Return 1 if CATEGORY_SET contains CATEGORY, else return 0.
3537 The faster version of `!NILP (Faref (category_set, category))'. */
3538 #define CATEGORY_MEMBER(category, category_set) \
3539 (bit_vector_bit(XBIT_VECTOR (category_set), category - 32))
3541 /* Return 1 if there is a word boundary between two word-constituent
3542 characters C1 and C2 if they appear in this order, else return 0.
3543 Use the macro WORD_BOUNDARY_P instead of calling this function
3546 int word_boundary_p (Emchar c1, Emchar c2);
3548 word_boundary_p (Emchar c1, Emchar c2)
3550 Lisp_Object category_set1, category_set2;
3555 if (COMPOSITE_CHAR_P (c1))
3556 c1 = cmpchar_component (c1, 0, 1);
3557 if (COMPOSITE_CHAR_P (c2))
3558 c2 = cmpchar_component (c2, 0, 1);
3561 if (EQ (CHAR_CHARSET (c1), CHAR_CHARSET (c2)))
3563 tail = Vword_separating_categories;
3568 tail = Vword_combining_categories;
3572 category_set1 = CATEGORY_SET (c1);
3573 if (NILP (category_set1))
3574 return default_result;
3575 category_set2 = CATEGORY_SET (c2);
3576 if (NILP (category_set2))
3577 return default_result;
3579 for (; CONSP (tail); tail = XCONS (tail)->cdr)
3581 Lisp_Object elt = XCONS(tail)->car;
3584 && CATEGORYP (XCONS (elt)->car)
3585 && CATEGORYP (XCONS (elt)->cdr)
3586 && CATEGORY_MEMBER (XCHAR (XCONS (elt)->car), category_set1)
3587 && CATEGORY_MEMBER (XCHAR (XCONS (elt)->cdr), category_set2))
3588 return !default_result;
3590 return default_result;
3596 syms_of_chartab (void)
3599 INIT_LRECORD_IMPLEMENTATION (uint8_byte_table);
3600 INIT_LRECORD_IMPLEMENTATION (uint16_byte_table);
3601 INIT_LRECORD_IMPLEMENTATION (byte_table);
3603 defsymbol (&Qto_ucs, "=>ucs");
3604 defsymbol (&Q_ucs, "->ucs");
3605 defsymbol (&Q_decomposition, "->decomposition");
3606 defsymbol (&Qcompat, "compat");
3607 defsymbol (&Qisolated, "isolated");
3608 defsymbol (&Qinitial, "initial");
3609 defsymbol (&Qmedial, "medial");
3610 defsymbol (&Qfinal, "final");
3611 defsymbol (&Qvertical, "vertical");
3612 defsymbol (&QnoBreak, "noBreak");
3613 defsymbol (&Qfraction, "fraction");
3614 defsymbol (&Qsuper, "super");
3615 defsymbol (&Qsub, "sub");
3616 defsymbol (&Qcircle, "circle");
3617 defsymbol (&Qsquare, "square");
3618 defsymbol (&Qwide, "wide");
3619 defsymbol (&Qnarrow, "narrow");
3620 defsymbol (&Qsmall, "small");
3621 defsymbol (&Qfont, "font");
3623 DEFSUBR (Fchar_attribute_list);
3624 DEFSUBR (Ffind_char_attribute_table);
3625 DEFSUBR (Fchar_attribute_alist);
3626 DEFSUBR (Fget_char_attribute);
3627 DEFSUBR (Fput_char_attribute);
3628 DEFSUBR (Fremove_char_attribute);
3629 DEFSUBR (Fmap_char_attribute);
3630 DEFSUBR (Fdefine_char);
3631 DEFSUBR (Ffind_char);
3632 DEFSUBR (Fchar_variants);
3634 DEFSUBR (Fget_composite_char);
3637 INIT_LRECORD_IMPLEMENTATION (char_table);
3641 INIT_LRECORD_IMPLEMENTATION (char_table_entry);
3644 defsymbol (&Qcategory_table_p, "category-table-p");
3645 defsymbol (&Qcategory_designator_p, "category-designator-p");
3646 defsymbol (&Qcategory_table_value_p, "category-table-value-p");
3649 defsymbol (&Qchar_table, "char-table");
3650 defsymbol (&Qchar_tablep, "char-table-p");
3652 DEFSUBR (Fchar_table_p);
3653 DEFSUBR (Fchar_table_type_list);
3654 DEFSUBR (Fvalid_char_table_type_p);
3655 DEFSUBR (Fchar_table_type);
3656 DEFSUBR (Freset_char_table);
3657 DEFSUBR (Fmake_char_table);
3658 DEFSUBR (Fcopy_char_table);
3659 DEFSUBR (Fget_char_table);
3660 DEFSUBR (Fget_range_char_table);
3661 DEFSUBR (Fvalid_char_table_value_p);
3662 DEFSUBR (Fcheck_valid_char_table_value);
3663 DEFSUBR (Fput_char_table);
3664 DEFSUBR (Fmap_char_table);
3667 DEFSUBR (Fcategory_table_p);
3668 DEFSUBR (Fcategory_table);
3669 DEFSUBR (Fstandard_category_table);
3670 DEFSUBR (Fcopy_category_table);
3671 DEFSUBR (Fset_category_table);
3672 DEFSUBR (Fcheck_category_at);
3673 DEFSUBR (Fchar_in_category_p);
3674 DEFSUBR (Fcategory_designator_p);
3675 DEFSUBR (Fcategory_table_value_p);
3681 vars_of_chartab (void)
3684 Vutf_2000_version = build_string("0.18 (Yamato-Koizumi)");
3685 DEFVAR_LISP ("utf-2000-version", &Vutf_2000_version /*
3686 Version number of XEmacs UTF-2000.
3689 staticpro (&Vcharacter_composition_table);
3690 Vcharacter_composition_table = make_char_id_table (Qnil);
3692 staticpro (&Vcharacter_variant_table);
3693 Vcharacter_variant_table = make_char_id_table (Qnil);
3695 /* DO NOT staticpro this. It works just like Vweak_hash_tables. */
3696 Vall_syntax_tables = Qnil;
3697 dump_add_weak_object_chain (&Vall_syntax_tables);
3701 structure_type_create_chartab (void)
3703 struct structure_type *st;
3705 st = define_structure_type (Qchar_table, 0, chartab_instantiate);
3707 define_structure_type_keyword (st, Qtype, chartab_type_validate);
3708 define_structure_type_keyword (st, Qdata, chartab_data_validate);
3712 complex_vars_of_chartab (void)
3715 staticpro (&Vchar_attribute_hash_table);
3716 Vchar_attribute_hash_table
3717 = make_lisp_hash_table (16, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
3718 #endif /* UTF2000 */
3720 /* Set this now, so first buffer creation can refer to it. */
3721 /* Make it nil before calling copy-category-table
3722 so that copy-category-table will know not to try to copy from garbage */
3723 Vstandard_category_table = Qnil;
3724 Vstandard_category_table = Fcopy_category_table (Qnil);
3725 staticpro (&Vstandard_category_table);
3727 DEFVAR_LISP ("word-combining-categories", &Vword_combining_categories /*
3728 List of pair (cons) of categories to determine word boundary.
3730 Emacs treats a sequence of word constituent characters as a single
3731 word (i.e. finds no word boundary between them) iff they belongs to
3732 the same charset. But, exceptions are allowed in the following cases.
3734 \(1) The case that characters are in different charsets is controlled
3735 by the variable `word-combining-categories'.
3737 Emacs finds no word boundary between characters of different charsets
3738 if they have categories matching some element of this list.
3740 More precisely, if an element of this list is a cons of category CAT1
3741 and CAT2, and a multibyte character C1 which has CAT1 is followed by
3742 C2 which has CAT2, there's no word boundary between C1 and C2.
3744 For instance, to tell that ASCII characters and Latin-1 characters can
3745 form a single word, the element `(?l . ?l)' should be in this list
3746 because both characters have the category `l' (Latin characters).
3748 \(2) The case that character are in the same charset is controlled by
3749 the variable `word-separating-categories'.
3751 Emacs find a word boundary between characters of the same charset
3752 if they have categories matching some element of this list.
3754 More precisely, if an element of this list is a cons of category CAT1
3755 and CAT2, and a multibyte character C1 which has CAT1 is followed by
3756 C2 which has CAT2, there's a word boundary between C1 and C2.
3758 For instance, to tell that there's a word boundary between Japanese
3759 Hiragana and Japanese Kanji (both are in the same charset), the
3760 element `(?H . ?C) should be in this list.
3763 Vword_combining_categories = Qnil;
3765 DEFVAR_LISP ("word-separating-categories", &Vword_separating_categories /*
3766 List of pair (cons) of categories to determine word boundary.
3767 See the documentation of the variable `word-combining-categories'.
3770 Vword_separating_categories = Qnil;