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;
71 decode_char_table_range (Lisp_Object range, struct chartab_range *outrange);
73 #define BT_UINT8_MIN 0
74 #define BT_UINT8_MAX (UCHAR_MAX - 3)
75 #define BT_UINT8_t (UCHAR_MAX - 2)
76 #define BT_UINT8_nil (UCHAR_MAX - 1)
77 #define BT_UINT8_unbound UCHAR_MAX
79 INLINE_HEADER int INT_UINT8_P (Lisp_Object obj);
80 INLINE_HEADER int UINT8_VALUE_P (Lisp_Object obj);
81 INLINE_HEADER unsigned char UINT8_ENCODE (Lisp_Object obj);
82 INLINE_HEADER Lisp_Object UINT8_DECODE (unsigned char n);
83 INLINE_HEADER unsigned short UINT8_TO_UINT16 (unsigned char n);
86 INT_UINT8_P (Lisp_Object obj)
92 return (BT_UINT8_MIN <= num) && (num <= BT_UINT8_MAX);
99 UINT8_VALUE_P (Lisp_Object obj)
101 return EQ (obj, Qunbound)
102 || EQ (obj, Qnil) || EQ (obj, Qt) || INT_UINT8_P (obj);
105 INLINE_HEADER unsigned char
106 UINT8_ENCODE (Lisp_Object obj)
108 if (EQ (obj, Qunbound))
109 return BT_UINT8_unbound;
110 else if (EQ (obj, Qnil))
112 else if (EQ (obj, Qt))
118 INLINE_HEADER Lisp_Object
119 UINT8_DECODE (unsigned char n)
121 if (n == BT_UINT8_unbound)
123 else if (n == BT_UINT8_nil)
125 else if (n == BT_UINT8_t)
132 mark_uint8_byte_table (Lisp_Object obj)
138 print_uint8_byte_table (Lisp_Object obj,
139 Lisp_Object printcharfun, int escapeflag)
141 Lisp_Uint8_Byte_Table *bte = XUINT8_BYTE_TABLE (obj);
143 struct gcpro gcpro1, gcpro2;
144 GCPRO2 (obj, printcharfun);
146 write_c_string ("\n#<uint8-byte-table", printcharfun);
147 for (i = 0; i < 256; i++)
149 unsigned char n = bte->property[i];
151 write_c_string ("\n ", printcharfun);
152 write_c_string (" ", printcharfun);
153 if (n == BT_UINT8_unbound)
154 write_c_string ("void", printcharfun);
155 else if (n == BT_UINT8_nil)
156 write_c_string ("nil", printcharfun);
157 else if (n == BT_UINT8_t)
158 write_c_string ("t", printcharfun);
163 sprintf (buf, "%hd", n);
164 write_c_string (buf, printcharfun);
168 write_c_string (">", printcharfun);
172 uint8_byte_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
174 Lisp_Uint8_Byte_Table *te1 = XUINT8_BYTE_TABLE (obj1);
175 Lisp_Uint8_Byte_Table *te2 = XUINT8_BYTE_TABLE (obj2);
178 for (i = 0; i < 256; i++)
179 if (te1->property[i] != te2->property[i])
185 uint8_byte_table_hash (Lisp_Object obj, int depth)
187 Lisp_Uint8_Byte_Table *te = XUINT8_BYTE_TABLE (obj);
191 for (i = 0; i < 256; i++)
192 hash = HASH2 (hash, te->property[i]);
196 DEFINE_LRECORD_IMPLEMENTATION ("uint8-byte-table", uint8_byte_table,
197 mark_uint8_byte_table,
198 print_uint8_byte_table,
199 0, uint8_byte_table_equal,
200 uint8_byte_table_hash,
201 0 /* uint8_byte_table_description */,
202 Lisp_Uint8_Byte_Table);
205 make_uint8_byte_table (unsigned char initval)
209 Lisp_Uint8_Byte_Table *cte;
211 cte = alloc_lcrecord_type (Lisp_Uint8_Byte_Table,
212 &lrecord_uint8_byte_table);
214 for (i = 0; i < 256; i++)
215 cte->property[i] = initval;
217 XSETUINT8_BYTE_TABLE (obj, cte);
222 copy_uint8_byte_table (Lisp_Object entry)
224 Lisp_Uint8_Byte_Table *cte = XUINT8_BYTE_TABLE (entry);
227 Lisp_Uint8_Byte_Table *ctenew
228 = alloc_lcrecord_type (Lisp_Uint8_Byte_Table,
229 &lrecord_uint8_byte_table);
231 for (i = 0; i < 256; i++)
233 ctenew->property[i] = cte->property[i];
236 XSETUINT8_BYTE_TABLE (obj, ctenew);
241 uint8_byte_table_same_value_p (Lisp_Object obj)
243 Lisp_Uint8_Byte_Table *bte = XUINT8_BYTE_TABLE (obj);
244 unsigned char v0 = bte->property[0];
247 for (i = 1; i < 256; i++)
249 if (bte->property[i] != v0)
256 map_over_uint8_byte_table (Lisp_Uint8_Byte_Table *ct, Emchar ofs, int place,
258 int (*fn) (struct chartab_range *range,
259 Lisp_Object val, void *arg),
262 struct chartab_range rainj;
264 int unit = 1 << (8 * place);
268 rainj.type = CHARTAB_RANGE_CHAR;
270 for (i = 0, retval = 0; i < 256 && retval == 0; i++)
272 if (ct->property[i] != BT_UINT8_unbound)
275 for (; c < c1 && retval == 0; c++)
277 if ( NILP (ccs) || charset_code_point (ccs, c) >= 0 )
280 retval = (fn) (&rainj, UINT8_DECODE (ct->property[i]), arg);
290 #define BT_UINT16_MIN 0
291 #define BT_UINT16_MAX (USHRT_MAX - 3)
292 #define BT_UINT16_t (USHRT_MAX - 2)
293 #define BT_UINT16_nil (USHRT_MAX - 1)
294 #define BT_UINT16_unbound USHRT_MAX
296 INLINE_HEADER int INT_UINT16_P (Lisp_Object obj);
297 INLINE_HEADER int UINT16_VALUE_P (Lisp_Object obj);
298 INLINE_HEADER unsigned short UINT16_ENCODE (Lisp_Object obj);
299 INLINE_HEADER Lisp_Object UINT16_DECODE (unsigned short us);
302 INT_UINT16_P (Lisp_Object obj)
306 int num = XINT (obj);
308 return (BT_UINT16_MIN <= num) && (num <= BT_UINT16_MAX);
315 UINT16_VALUE_P (Lisp_Object obj)
317 return EQ (obj, Qunbound)
318 || EQ (obj, Qnil) || EQ (obj, Qt) || INT_UINT16_P (obj);
321 INLINE_HEADER unsigned short
322 UINT16_ENCODE (Lisp_Object obj)
324 if (EQ (obj, Qunbound))
325 return BT_UINT16_unbound;
326 else if (EQ (obj, Qnil))
327 return BT_UINT16_nil;
328 else if (EQ (obj, Qt))
334 INLINE_HEADER Lisp_Object
335 UINT16_DECODE (unsigned short n)
337 if (n == BT_UINT16_unbound)
339 else if (n == BT_UINT16_nil)
341 else if (n == BT_UINT16_t)
347 INLINE_HEADER unsigned short
348 UINT8_TO_UINT16 (unsigned char n)
350 if (n == BT_UINT8_unbound)
351 return BT_UINT16_unbound;
352 else if (n == BT_UINT8_nil)
353 return BT_UINT16_nil;
354 else if (n == BT_UINT8_t)
361 mark_uint16_byte_table (Lisp_Object obj)
367 print_uint16_byte_table (Lisp_Object obj,
368 Lisp_Object printcharfun, int escapeflag)
370 Lisp_Uint16_Byte_Table *bte = XUINT16_BYTE_TABLE (obj);
372 struct gcpro gcpro1, gcpro2;
373 GCPRO2 (obj, printcharfun);
375 write_c_string ("\n#<uint16-byte-table", printcharfun);
376 for (i = 0; i < 256; i++)
378 unsigned short n = bte->property[i];
380 write_c_string ("\n ", printcharfun);
381 write_c_string (" ", printcharfun);
382 if (n == BT_UINT16_unbound)
383 write_c_string ("void", printcharfun);
384 else if (n == BT_UINT16_nil)
385 write_c_string ("nil", printcharfun);
386 else if (n == BT_UINT16_t)
387 write_c_string ("t", printcharfun);
392 sprintf (buf, "%hd", n);
393 write_c_string (buf, printcharfun);
397 write_c_string (">", printcharfun);
401 uint16_byte_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
403 Lisp_Uint16_Byte_Table *te1 = XUINT16_BYTE_TABLE (obj1);
404 Lisp_Uint16_Byte_Table *te2 = XUINT16_BYTE_TABLE (obj2);
407 for (i = 0; i < 256; i++)
408 if (te1->property[i] != te2->property[i])
414 uint16_byte_table_hash (Lisp_Object obj, int depth)
416 Lisp_Uint16_Byte_Table *te = XUINT16_BYTE_TABLE (obj);
420 for (i = 0; i < 256; i++)
421 hash = HASH2 (hash, te->property[i]);
425 DEFINE_LRECORD_IMPLEMENTATION ("uint16-byte-table", uint16_byte_table,
426 mark_uint16_byte_table,
427 print_uint16_byte_table,
428 0, uint16_byte_table_equal,
429 uint16_byte_table_hash,
430 0 /* uint16_byte_table_description */,
431 Lisp_Uint16_Byte_Table);
434 make_uint16_byte_table (unsigned short initval)
438 Lisp_Uint16_Byte_Table *cte;
440 cte = alloc_lcrecord_type (Lisp_Uint16_Byte_Table,
441 &lrecord_uint16_byte_table);
443 for (i = 0; i < 256; i++)
444 cte->property[i] = initval;
446 XSETUINT16_BYTE_TABLE (obj, cte);
451 copy_uint16_byte_table (Lisp_Object entry)
453 Lisp_Uint16_Byte_Table *cte = XUINT16_BYTE_TABLE (entry);
456 Lisp_Uint16_Byte_Table *ctenew
457 = alloc_lcrecord_type (Lisp_Uint16_Byte_Table,
458 &lrecord_uint16_byte_table);
460 for (i = 0; i < 256; i++)
462 ctenew->property[i] = cte->property[i];
465 XSETUINT16_BYTE_TABLE (obj, ctenew);
470 expand_uint8_byte_table_to_uint16 (Lisp_Object table)
474 Lisp_Uint8_Byte_Table* bte = XUINT8_BYTE_TABLE(table);
475 Lisp_Uint16_Byte_Table* cte;
477 cte = alloc_lcrecord_type (Lisp_Uint16_Byte_Table,
478 &lrecord_uint16_byte_table);
479 for (i = 0; i < 256; i++)
481 cte->property[i] = UINT8_TO_UINT16 (bte->property[i]);
483 XSETUINT16_BYTE_TABLE (obj, cte);
488 uint16_byte_table_same_value_p (Lisp_Object obj)
490 Lisp_Uint16_Byte_Table *bte = XUINT16_BYTE_TABLE (obj);
491 unsigned short v0 = bte->property[0];
494 for (i = 1; i < 256; i++)
496 if (bte->property[i] != v0)
503 map_over_uint16_byte_table (Lisp_Uint16_Byte_Table *ct, Emchar ofs, int place,
505 int (*fn) (struct chartab_range *range,
506 Lisp_Object val, void *arg),
509 struct chartab_range rainj;
511 int unit = 1 << (8 * place);
515 rainj.type = CHARTAB_RANGE_CHAR;
517 for (i = 0, retval = 0; i < 256 && retval == 0; i++)
519 if (ct->property[i] != BT_UINT16_unbound)
522 for (; c < c1 && retval == 0; c++)
524 if ( NILP (ccs) || charset_code_point (ccs, c) >= 0 )
527 retval = (fn) (&rainj, UINT16_DECODE (ct->property[i]),
540 mark_byte_table (Lisp_Object obj)
542 Lisp_Byte_Table *cte = XBYTE_TABLE (obj);
545 for (i = 0; i < 256; i++)
547 mark_object (cte->property[i]);
553 print_byte_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
555 Lisp_Byte_Table *bte = XBYTE_TABLE (obj);
557 struct gcpro gcpro1, gcpro2;
558 GCPRO2 (obj, printcharfun);
560 write_c_string ("\n#<byte-table", printcharfun);
561 for (i = 0; i < 256; i++)
563 Lisp_Object elt = bte->property[i];
565 write_c_string ("\n ", printcharfun);
566 write_c_string (" ", printcharfun);
567 if (EQ (elt, Qunbound))
568 write_c_string ("void", printcharfun);
570 print_internal (elt, printcharfun, escapeflag);
573 write_c_string (">", printcharfun);
577 byte_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
579 Lisp_Byte_Table *cte1 = XBYTE_TABLE (obj1);
580 Lisp_Byte_Table *cte2 = XBYTE_TABLE (obj2);
583 for (i = 0; i < 256; i++)
584 if (BYTE_TABLE_P (cte1->property[i]))
586 if (BYTE_TABLE_P (cte2->property[i]))
588 if (!byte_table_equal (cte1->property[i],
589 cte2->property[i], depth + 1))
596 if (!internal_equal (cte1->property[i], cte2->property[i], depth + 1))
602 byte_table_hash (Lisp_Object obj, int depth)
604 Lisp_Byte_Table *cte = XBYTE_TABLE (obj);
606 return internal_array_hash (cte->property, 256, depth);
609 static const struct lrecord_description byte_table_description[] = {
610 { XD_LISP_OBJECT_ARRAY, offsetof(Lisp_Byte_Table, property), 256 },
614 DEFINE_LRECORD_IMPLEMENTATION ("byte-table", byte_table,
619 byte_table_description,
623 make_byte_table (Lisp_Object initval)
627 Lisp_Byte_Table *cte;
629 cte = alloc_lcrecord_type (Lisp_Byte_Table, &lrecord_byte_table);
631 for (i = 0; i < 256; i++)
632 cte->property[i] = initval;
634 XSETBYTE_TABLE (obj, cte);
639 copy_byte_table (Lisp_Object entry)
641 Lisp_Byte_Table *cte = XBYTE_TABLE (entry);
644 Lisp_Byte_Table *ctnew
645 = alloc_lcrecord_type (Lisp_Byte_Table, &lrecord_byte_table);
647 for (i = 0; i < 256; i++)
649 if (UINT8_BYTE_TABLE_P (cte->property[i]))
651 ctnew->property[i] = copy_uint8_byte_table (cte->property[i]);
653 else if (UINT16_BYTE_TABLE_P (cte->property[i]))
655 ctnew->property[i] = copy_uint16_byte_table (cte->property[i]);
657 else if (BYTE_TABLE_P (cte->property[i]))
659 ctnew->property[i] = copy_byte_table (cte->property[i]);
662 ctnew->property[i] = cte->property[i];
665 XSETBYTE_TABLE (obj, ctnew);
670 byte_table_same_value_p (Lisp_Object obj)
672 Lisp_Byte_Table *bte = XBYTE_TABLE (obj);
673 Lisp_Object v0 = bte->property[0];
676 for (i = 1; i < 256; i++)
678 if (!internal_equal (bte->property[i], v0, 0))
685 map_over_byte_table (Lisp_Byte_Table *ct, Emchar ofs, int place,
687 int (*fn) (struct chartab_range *range,
688 Lisp_Object val, void *arg),
693 int unit = 1 << (8 * place);
696 for (i = 0, retval = 0; i < 256 && retval == 0; i++)
699 if (UINT8_BYTE_TABLE_P (v))
702 = map_over_uint8_byte_table (XUINT8_BYTE_TABLE(v),
703 c, place - 1, ccs, fn, arg);
706 else if (UINT16_BYTE_TABLE_P (v))
709 = map_over_uint16_byte_table (XUINT16_BYTE_TABLE(v),
710 c, place - 1, ccs, fn, arg);
713 else if (BYTE_TABLE_P (v))
715 retval = map_over_byte_table (XBYTE_TABLE(v),
716 c, place - 1, ccs, fn, arg);
719 else if (!UNBOUNDP (v))
721 struct chartab_range rainj;
722 Emchar c1 = c + unit;
724 rainj.type = CHARTAB_RANGE_CHAR;
726 for (; c < c1 && retval == 0; c++)
728 if ( NILP (ccs) || charset_code_point (ccs, c) >= 0 )
731 retval = (fn) (&rainj, v, arg);
743 get_byte_table (Lisp_Object table, unsigned char idx)
745 if (UINT8_BYTE_TABLE_P (table))
746 return UINT8_DECODE (XUINT8_BYTE_TABLE(table)->property[idx]);
747 else if (UINT16_BYTE_TABLE_P (table))
748 return UINT16_DECODE (XUINT16_BYTE_TABLE(table)->property[idx]);
749 else if (BYTE_TABLE_P (table))
750 return XBYTE_TABLE(table)->property[idx];
756 put_byte_table (Lisp_Object table, unsigned char idx, Lisp_Object value)
758 if (UINT8_BYTE_TABLE_P (table))
760 if (UINT8_VALUE_P (value))
762 XUINT8_BYTE_TABLE(table)->property[idx] = UINT8_ENCODE (value);
763 if (!UINT8_BYTE_TABLE_P (value) &&
764 !UINT16_BYTE_TABLE_P (value) && !BYTE_TABLE_P (value)
765 && uint8_byte_table_same_value_p (table))
770 else if (UINT16_VALUE_P (value))
772 Lisp_Object new = expand_uint8_byte_table_to_uint16 (table);
774 XUINT16_BYTE_TABLE(new)->property[idx] = UINT16_ENCODE (value);
779 Lisp_Object new = make_byte_table (Qnil);
782 for (i = 0; i < 256; i++)
784 XBYTE_TABLE(new)->property[i]
785 = UINT8_DECODE (XUINT8_BYTE_TABLE(table)->property[i]);
787 XBYTE_TABLE(new)->property[idx] = value;
791 else if (UINT16_BYTE_TABLE_P (table))
793 if (UINT16_VALUE_P (value))
795 XUINT16_BYTE_TABLE(table)->property[idx] = UINT16_ENCODE (value);
796 if (!UINT8_BYTE_TABLE_P (value) &&
797 !UINT16_BYTE_TABLE_P (value) && !BYTE_TABLE_P (value)
798 && uint16_byte_table_same_value_p (table))
805 Lisp_Object new = make_byte_table (Qnil);
808 for (i = 0; i < 256; i++)
810 XBYTE_TABLE(new)->property[i]
811 = UINT16_DECODE (XUINT16_BYTE_TABLE(table)->property[i]);
813 XBYTE_TABLE(new)->property[idx] = value;
817 else if (BYTE_TABLE_P (table))
819 XBYTE_TABLE(table)->property[idx] = value;
820 if (!UINT8_BYTE_TABLE_P (value) &&
821 !UINT16_BYTE_TABLE_P (value) && !BYTE_TABLE_P (value)
822 && byte_table_same_value_p (table))
827 else if (!internal_equal (table, value, 0))
829 if (UINT8_VALUE_P (table) && UINT8_VALUE_P (value))
831 table = make_uint8_byte_table (UINT8_ENCODE (table));
832 XUINT8_BYTE_TABLE(table)->property[idx] = UINT8_ENCODE (value);
834 else if (UINT16_VALUE_P (table) && UINT16_VALUE_P (value))
836 table = make_uint16_byte_table (UINT16_ENCODE (table));
837 XUINT16_BYTE_TABLE(table)->property[idx] = UINT16_ENCODE (value);
841 table = make_byte_table (table);
842 XBYTE_TABLE(table)->property[idx] = value;
850 make_char_id_table (Lisp_Object initval)
853 obj = Fmake_char_table (Qgeneric);
854 fill_char_table (XCHAR_TABLE (obj), initval);
859 get_char_id_table (Lisp_Char_Table* cit, Emchar ch)
861 Lisp_Object val = get_byte_table (get_byte_table
865 (unsigned char)(ch >> 24)),
866 (unsigned char) (ch >> 16)),
867 (unsigned char) (ch >> 8)),
870 return cit->default_value;
876 put_char_id_table (Lisp_Char_Table* cit,
877 Lisp_Object character, Lisp_Object value)
879 struct chartab_range range;
881 decode_char_table_range (character, &range);
884 case CHARTAB_RANGE_ALL:
887 case CHARTAB_RANGE_DEFAULT:
888 cit->default_value = value;
890 case CHARTAB_RANGE_CHARSET:
893 Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (range.charset);
895 if ( CHAR_TABLEP (encoding_table) )
897 for (c = 0; c < 1 << 24; c++)
899 if ( INTP (get_char_id_table (XCHAR_TABLE(encoding_table),
901 put_char_id_table_0 (cit, c, value);
906 for (c = 0; c < 1 << 24; c++)
908 if ( charset_code_point (range.charset, c) >= 0 )
909 put_char_id_table_0 (cit, c, value);
914 case CHARTAB_RANGE_ROW:
916 int cell_min, cell_max, i;
918 if (XCHARSET_DIMENSION (range.charset) < 2)
919 signal_simple_error ("Charset in row vector must be multi-byte",
923 switch (XCHARSET_CHARS (range.charset))
926 cell_min = 33; cell_max = 126;
929 cell_min = 32; cell_max = 127;
932 cell_min = 0; cell_max = 127;
935 cell_min = 0; cell_max = 255;
941 if (XCHARSET_DIMENSION (range.charset) == 2)
942 check_int_range (range.row, cell_min, cell_max);
943 else if (XCHARSET_DIMENSION (range.charset) == 3)
945 check_int_range (range.row >> 8 , cell_min, cell_max);
946 check_int_range (range.row & 0xFF, cell_min, cell_max);
948 else if (XCHARSET_DIMENSION (range.charset) == 4)
950 check_int_range ( range.row >> 16 , cell_min, cell_max);
951 check_int_range ((range.row >> 8) & 0xFF, cell_min, cell_max);
952 check_int_range ( range.row & 0xFF, cell_min, cell_max);
957 for (i = cell_min; i <= cell_max; i++)
959 Emchar ch = DECODE_CHAR (range.charset, (range.row << 8) | i);
960 if ( charset_code_point (range.charset, ch) >= 0 )
961 put_char_id_table_0 (cit, ch, value);
965 case CHARTAB_RANGE_CHAR:
966 put_char_id_table_0 (cit, range.ch, value);
972 Lisp_Object Vcharacter_composition_table;
973 Lisp_Object Vcharacter_variant_table;
976 Lisp_Object Q_decomposition;
980 Lisp_Object Qisolated;
981 Lisp_Object Qinitial;
984 Lisp_Object Qvertical;
985 Lisp_Object QnoBreak;
986 Lisp_Object Qfraction;
996 Emchar to_char_id (Lisp_Object v, char* err_msg, Lisp_Object err_arg);
999 to_char_id (Lisp_Object v, char* err_msg, Lisp_Object err_arg)
1005 else if (EQ (v, Qcompat))
1007 else if (EQ (v, Qisolated))
1009 else if (EQ (v, Qinitial))
1011 else if (EQ (v, Qmedial))
1013 else if (EQ (v, Qfinal))
1015 else if (EQ (v, Qvertical))
1017 else if (EQ (v, QnoBreak))
1019 else if (EQ (v, Qfraction))
1021 else if (EQ (v, Qsuper))
1023 else if (EQ (v, Qsub))
1025 else if (EQ (v, Qcircle))
1027 else if (EQ (v, Qsquare))
1029 else if (EQ (v, Qwide))
1031 else if (EQ (v, Qnarrow))
1033 else if (EQ (v, Qsmall))
1035 else if (EQ (v, Qfont))
1038 signal_simple_error (err_msg, err_arg);
1041 DEFUN ("get-composite-char", Fget_composite_char, 1, 1, 0, /*
1042 Return character corresponding with list.
1046 Lisp_Object table = Vcharacter_composition_table;
1047 Lisp_Object rest = list;
1049 while (CONSP (rest))
1051 Lisp_Object v = Fcar (rest);
1053 Emchar c = to_char_id (v, "Invalid value for composition", list);
1055 ret = get_char_id_table (XCHAR_TABLE(table), c);
1060 if (!CHAR_TABLEP (ret))
1065 else if (!CONSP (rest))
1067 else if (CHAR_TABLEP (ret))
1070 signal_simple_error ("Invalid table is found with", list);
1072 signal_simple_error ("Invalid value for composition", list);
1075 DEFUN ("char-variants", Fchar_variants, 1, 1, 0, /*
1076 Return variants of CHARACTER.
1080 CHECK_CHAR (character);
1081 return Fcopy_list (get_char_id_table
1082 (XCHAR_TABLE(Vcharacter_variant_table),
1083 XCHAR (character)));
1089 /* A char table maps from ranges of characters to values.
1091 Implementing a general data structure that maps from arbitrary
1092 ranges of numbers to values is tricky to do efficiently. As it
1093 happens, it should suffice (and is usually more convenient, anyway)
1094 when dealing with characters to restrict the sorts of ranges that
1095 can be assigned values, as follows:
1098 2) All characters in a charset.
1099 3) All characters in a particular row of a charset, where a "row"
1100 means all characters with the same first byte.
1101 4) A particular character in a charset.
1103 We use char tables to generalize the 256-element vectors now
1104 littering the Emacs code.
1106 Possible uses (all should be converted at some point):
1112 5) keyboard-translate-table?
1115 abstract type to generalize the Emacs vectors and Mule
1116 vectors-of-vectors goo.
1119 /************************************************************************/
1120 /* Char Table object */
1121 /************************************************************************/
1123 #if defined(MULE)&&!defined(UTF2000)
1126 mark_char_table_entry (Lisp_Object obj)
1128 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj);
1131 for (i = 0; i < 96; i++)
1133 mark_object (cte->level2[i]);
1139 char_table_entry_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
1141 Lisp_Char_Table_Entry *cte1 = XCHAR_TABLE_ENTRY (obj1);
1142 Lisp_Char_Table_Entry *cte2 = XCHAR_TABLE_ENTRY (obj2);
1145 for (i = 0; i < 96; i++)
1146 if (!internal_equal (cte1->level2[i], cte2->level2[i], depth + 1))
1152 static unsigned long
1153 char_table_entry_hash (Lisp_Object obj, int depth)
1155 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj);
1157 return internal_array_hash (cte->level2, 96, depth);
1160 static const struct lrecord_description char_table_entry_description[] = {
1161 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table_Entry, level2), 96 },
1165 DEFINE_LRECORD_IMPLEMENTATION ("char-table-entry", char_table_entry,
1166 mark_char_table_entry, internal_object_printer,
1167 0, char_table_entry_equal,
1168 char_table_entry_hash,
1169 char_table_entry_description,
1170 Lisp_Char_Table_Entry);
1174 mark_char_table (Lisp_Object obj)
1176 Lisp_Char_Table *ct = XCHAR_TABLE (obj);
1179 mark_object (ct->table);
1183 for (i = 0; i < NUM_ASCII_CHARS; i++)
1184 mark_object (ct->ascii[i]);
1186 for (i = 0; i < NUM_LEADING_BYTES; i++)
1187 mark_object (ct->level1[i]);
1191 return ct->default_value;
1193 return ct->mirror_table;
1197 /* WARNING: All functions of this nature need to be written extremely
1198 carefully to avoid crashes during GC. Cf. prune_specifiers()
1199 and prune_weak_hash_tables(). */
1202 prune_syntax_tables (void)
1204 Lisp_Object rest, prev = Qnil;
1206 for (rest = Vall_syntax_tables;
1208 rest = XCHAR_TABLE (rest)->next_table)
1210 if (! marked_p (rest))
1212 /* This table is garbage. Remove it from the list. */
1214 Vall_syntax_tables = XCHAR_TABLE (rest)->next_table;
1216 XCHAR_TABLE (prev)->next_table =
1217 XCHAR_TABLE (rest)->next_table;
1223 char_table_type_to_symbol (enum char_table_type type)
1228 case CHAR_TABLE_TYPE_GENERIC: return Qgeneric;
1229 case CHAR_TABLE_TYPE_SYNTAX: return Qsyntax;
1230 case CHAR_TABLE_TYPE_DISPLAY: return Qdisplay;
1231 case CHAR_TABLE_TYPE_CHAR: return Qchar;
1233 case CHAR_TABLE_TYPE_CATEGORY: return Qcategory;
1238 static enum char_table_type
1239 symbol_to_char_table_type (Lisp_Object symbol)
1241 CHECK_SYMBOL (symbol);
1243 if (EQ (symbol, Qgeneric)) return CHAR_TABLE_TYPE_GENERIC;
1244 if (EQ (symbol, Qsyntax)) return CHAR_TABLE_TYPE_SYNTAX;
1245 if (EQ (symbol, Qdisplay)) return CHAR_TABLE_TYPE_DISPLAY;
1246 if (EQ (symbol, Qchar)) return CHAR_TABLE_TYPE_CHAR;
1248 if (EQ (symbol, Qcategory)) return CHAR_TABLE_TYPE_CATEGORY;
1251 signal_simple_error ("Unrecognized char table type", symbol);
1252 return CHAR_TABLE_TYPE_GENERIC; /* not reached */
1256 print_chartab_range (Emchar first, Emchar last, Lisp_Object val,
1257 Lisp_Object printcharfun)
1261 write_c_string (" (", printcharfun);
1262 print_internal (make_char (first), printcharfun, 0);
1263 write_c_string (" ", printcharfun);
1264 print_internal (make_char (last), printcharfun, 0);
1265 write_c_string (") ", printcharfun);
1269 write_c_string (" ", printcharfun);
1270 print_internal (make_char (first), printcharfun, 0);
1271 write_c_string (" ", printcharfun);
1273 print_internal (val, printcharfun, 1);
1276 #if defined(MULE)&&!defined(UTF2000)
1279 print_chartab_charset_row (Lisp_Object charset,
1281 Lisp_Char_Table_Entry *cte,
1282 Lisp_Object printcharfun)
1285 Lisp_Object cat = Qunbound;
1288 for (i = 32; i < 128; i++)
1290 Lisp_Object pam = cte->level2[i - 32];
1302 print_chartab_range (MAKE_CHAR (charset, first, 0),
1303 MAKE_CHAR (charset, i - 1, 0),
1306 print_chartab_range (MAKE_CHAR (charset, row, first),
1307 MAKE_CHAR (charset, row, i - 1),
1317 print_chartab_range (MAKE_CHAR (charset, first, 0),
1318 MAKE_CHAR (charset, i - 1, 0),
1321 print_chartab_range (MAKE_CHAR (charset, row, first),
1322 MAKE_CHAR (charset, row, i - 1),
1328 print_chartab_two_byte_charset (Lisp_Object charset,
1329 Lisp_Char_Table_Entry *cte,
1330 Lisp_Object printcharfun)
1334 for (i = 32; i < 128; i++)
1336 Lisp_Object jen = cte->level2[i - 32];
1338 if (!CHAR_TABLE_ENTRYP (jen))
1342 write_c_string (" [", printcharfun);
1343 print_internal (XCHARSET_NAME (charset), printcharfun, 0);
1344 sprintf (buf, " %d] ", i);
1345 write_c_string (buf, printcharfun);
1346 print_internal (jen, printcharfun, 0);
1349 print_chartab_charset_row (charset, i, XCHAR_TABLE_ENTRY (jen),
1357 print_char_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1359 Lisp_Char_Table *ct = XCHAR_TABLE (obj);
1362 struct gcpro gcpro1, gcpro2;
1363 GCPRO2 (obj, printcharfun);
1365 write_c_string ("#s(char-table ", printcharfun);
1366 write_c_string (" ", printcharfun);
1367 write_c_string (string_data
1369 (XSYMBOL (char_table_type_to_symbol (ct->type)))),
1371 write_c_string ("\n ", printcharfun);
1372 print_internal (ct->default_value, printcharfun, escapeflag);
1373 for (i = 0; i < 256; i++)
1375 Lisp_Object elt = get_byte_table (ct->table, i);
1376 if (i != 0) write_c_string ("\n ", printcharfun);
1377 if (EQ (elt, Qunbound))
1378 write_c_string ("void", printcharfun);
1380 print_internal (elt, printcharfun, escapeflag);
1383 #else /* non UTF2000 */
1386 sprintf (buf, "#s(char-table type %s data (",
1387 string_data (symbol_name (XSYMBOL
1388 (char_table_type_to_symbol (ct->type)))));
1389 write_c_string (buf, printcharfun);
1391 /* Now write out the ASCII/Control-1 stuff. */
1395 Lisp_Object val = Qunbound;
1397 for (i = 0; i < NUM_ASCII_CHARS; i++)
1406 if (!EQ (ct->ascii[i], val))
1408 print_chartab_range (first, i - 1, val, printcharfun);
1415 print_chartab_range (first, i - 1, val, printcharfun);
1422 for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES;
1425 Lisp_Object ann = ct->level1[i - MIN_LEADING_BYTE];
1426 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (i);
1428 if (!CHARSETP (charset) || i == LEADING_BYTE_ASCII
1429 || i == LEADING_BYTE_CONTROL_1)
1431 if (!CHAR_TABLE_ENTRYP (ann))
1433 write_c_string (" ", printcharfun);
1434 print_internal (XCHARSET_NAME (charset),
1436 write_c_string (" ", printcharfun);
1437 print_internal (ann, printcharfun, 0);
1441 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (ann);
1442 if (XCHARSET_DIMENSION (charset) == 1)
1443 print_chartab_charset_row (charset, -1, cte, printcharfun);
1445 print_chartab_two_byte_charset (charset, cte, printcharfun);
1450 #endif /* non UTF2000 */
1452 write_c_string ("))", printcharfun);
1456 char_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
1458 Lisp_Char_Table *ct1 = XCHAR_TABLE (obj1);
1459 Lisp_Char_Table *ct2 = XCHAR_TABLE (obj2);
1462 if (CHAR_TABLE_TYPE (ct1) != CHAR_TABLE_TYPE (ct2))
1466 for (i = 0; i < 256; i++)
1468 if (!internal_equal (get_byte_table (ct1->table, i),
1469 get_byte_table (ct2->table, i), 0))
1473 for (i = 0; i < NUM_ASCII_CHARS; i++)
1474 if (!internal_equal (ct1->ascii[i], ct2->ascii[i], depth + 1))
1478 for (i = 0; i < NUM_LEADING_BYTES; i++)
1479 if (!internal_equal (ct1->level1[i], ct2->level1[i], depth + 1))
1482 #endif /* non UTF2000 */
1487 static unsigned long
1488 char_table_hash (Lisp_Object obj, int depth)
1490 Lisp_Char_Table *ct = XCHAR_TABLE (obj);
1492 return byte_table_hash (ct->table, depth + 1);
1494 unsigned long hashval = internal_array_hash (ct->ascii, NUM_ASCII_CHARS,
1497 hashval = HASH2 (hashval,
1498 internal_array_hash (ct->level1, NUM_LEADING_BYTES, depth));
1504 static const struct lrecord_description char_table_description[] = {
1506 { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, table) },
1507 { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, default_value) },
1509 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, ascii), NUM_ASCII_CHARS },
1511 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, level1), NUM_LEADING_BYTES },
1515 { XD_LISP_OBJECT, offsetof (Lisp_Char_Table, mirror_table) },
1517 { XD_LO_LINK, offsetof (Lisp_Char_Table, next_table) },
1521 DEFINE_LRECORD_IMPLEMENTATION ("char-table", char_table,
1522 mark_char_table, print_char_table, 0,
1523 char_table_equal, char_table_hash,
1524 char_table_description,
1527 DEFUN ("char-table-p", Fchar_table_p, 1, 1, 0, /*
1528 Return non-nil if OBJECT is a char table.
1530 A char table is a table that maps characters (or ranges of characters)
1531 to values. Char tables are specialized for characters, only allowing
1532 particular sorts of ranges to be assigned values. Although this
1533 loses in generality, it makes for extremely fast (constant-time)
1534 lookups, and thus is feasible for applications that do an extremely
1535 large number of lookups (e.g. scanning a buffer for a character in
1536 a particular syntax, where a lookup in the syntax table must occur
1537 once per character).
1539 When Mule support exists, the types of ranges that can be assigned
1543 -- an entire charset
1544 -- a single row in a two-octet charset
1545 -- a single character
1547 When Mule support is not present, the types of ranges that can be
1551 -- a single character
1553 To create a char table, use `make-char-table'.
1554 To modify a char table, use `put-char-table' or `remove-char-table'.
1555 To retrieve the value for a particular character, use `get-char-table'.
1556 See also `map-char-table', `clear-char-table', `copy-char-table',
1557 `valid-char-table-type-p', `char-table-type-list',
1558 `valid-char-table-value-p', and `check-char-table-value'.
1562 return CHAR_TABLEP (object) ? Qt : Qnil;
1565 DEFUN ("char-table-type-list", Fchar_table_type_list, 0, 0, 0, /*
1566 Return a list of the recognized char table types.
1567 See `valid-char-table-type-p'.
1572 return list5 (Qchar, Qcategory, Qdisplay, Qgeneric, Qsyntax);
1574 return list4 (Qchar, Qdisplay, Qgeneric, Qsyntax);
1578 DEFUN ("valid-char-table-type-p", Fvalid_char_table_type_p, 1, 1, 0, /*
1579 Return t if TYPE if a recognized char table type.
1581 Each char table type is used for a different purpose and allows different
1582 sorts of values. The different char table types are
1585 Used for category tables, which specify the regexp categories
1586 that a character is in. The valid values are nil or a
1587 bit vector of 95 elements. Higher-level Lisp functions are
1588 provided for working with category tables. Currently categories
1589 and category tables only exist when Mule support is present.
1591 A generalized char table, for mapping from one character to
1592 another. Used for case tables, syntax matching tables,
1593 `keyboard-translate-table', etc. The valid values are characters.
1595 An even more generalized char table, for mapping from a
1596 character to anything.
1598 Used for display tables, which specify how a particular character
1599 is to appear when displayed. #### Not yet implemented.
1601 Used for syntax tables, which specify the syntax of a particular
1602 character. Higher-level Lisp functions are provided for
1603 working with syntax tables. The valid values are integers.
1608 return (EQ (type, Qchar) ||
1610 EQ (type, Qcategory) ||
1612 EQ (type, Qdisplay) ||
1613 EQ (type, Qgeneric) ||
1614 EQ (type, Qsyntax)) ? Qt : Qnil;
1617 DEFUN ("char-table-type", Fchar_table_type, 1, 1, 0, /*
1618 Return the type of CHAR-TABLE.
1619 See `valid-char-table-type-p'.
1623 CHECK_CHAR_TABLE (char_table);
1624 return char_table_type_to_symbol (XCHAR_TABLE (char_table)->type);
1628 fill_char_table (Lisp_Char_Table *ct, Lisp_Object value)
1631 ct->table = Qunbound;
1632 ct->default_value = value;
1636 for (i = 0; i < NUM_ASCII_CHARS; i++)
1637 ct->ascii[i] = value;
1639 for (i = 0; i < NUM_LEADING_BYTES; i++)
1640 ct->level1[i] = value;
1645 if (ct->type == CHAR_TABLE_TYPE_SYNTAX)
1646 update_syntax_table (ct);
1650 DEFUN ("reset-char-table", Freset_char_table, 1, 1, 0, /*
1651 Reset CHAR-TABLE to its default state.
1655 Lisp_Char_Table *ct;
1657 CHECK_CHAR_TABLE (char_table);
1658 ct = XCHAR_TABLE (char_table);
1662 case CHAR_TABLE_TYPE_CHAR:
1663 fill_char_table (ct, make_char (0));
1665 case CHAR_TABLE_TYPE_DISPLAY:
1666 case CHAR_TABLE_TYPE_GENERIC:
1668 case CHAR_TABLE_TYPE_CATEGORY:
1670 fill_char_table (ct, Qnil);
1673 case CHAR_TABLE_TYPE_SYNTAX:
1674 fill_char_table (ct, make_int (Sinherit));
1684 DEFUN ("make-char-table", Fmake_char_table, 1, 1, 0, /*
1685 Return a new, empty char table of type TYPE.
1686 Currently recognized types are 'char, 'category, 'display, 'generic,
1687 and 'syntax. See `valid-char-table-type-p'.
1691 Lisp_Char_Table *ct;
1693 enum char_table_type ty = symbol_to_char_table_type (type);
1695 ct = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table);
1698 if (ty == CHAR_TABLE_TYPE_SYNTAX)
1700 ct->mirror_table = Fmake_char_table (Qgeneric);
1701 fill_char_table (XCHAR_TABLE (ct->mirror_table),
1705 ct->mirror_table = Qnil;
1707 ct->next_table = Qnil;
1708 XSETCHAR_TABLE (obj, ct);
1709 if (ty == CHAR_TABLE_TYPE_SYNTAX)
1711 ct->next_table = Vall_syntax_tables;
1712 Vall_syntax_tables = obj;
1714 Freset_char_table (obj);
1718 #if defined(MULE)&&!defined(UTF2000)
1721 make_char_table_entry (Lisp_Object initval)
1725 Lisp_Char_Table_Entry *cte =
1726 alloc_lcrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry);
1728 for (i = 0; i < 96; i++)
1729 cte->level2[i] = initval;
1731 XSETCHAR_TABLE_ENTRY (obj, cte);
1736 copy_char_table_entry (Lisp_Object entry)
1738 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (entry);
1741 Lisp_Char_Table_Entry *ctenew =
1742 alloc_lcrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry);
1744 for (i = 0; i < 96; i++)
1746 Lisp_Object new = cte->level2[i];
1747 if (CHAR_TABLE_ENTRYP (new))
1748 ctenew->level2[i] = copy_char_table_entry (new);
1750 ctenew->level2[i] = new;
1753 XSETCHAR_TABLE_ENTRY (obj, ctenew);
1759 DEFUN ("copy-char-table", Fcopy_char_table, 1, 1, 0, /*
1760 Return a new char table which is a copy of CHAR-TABLE.
1761 It will contain the same values for the same characters and ranges
1762 as CHAR-TABLE. The values will not themselves be copied.
1766 Lisp_Char_Table *ct, *ctnew;
1772 CHECK_CHAR_TABLE (char_table);
1773 ct = XCHAR_TABLE (char_table);
1774 ctnew = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table);
1775 ctnew->type = ct->type;
1777 ctnew->default_value = ct->default_value;
1779 if (UINT8_BYTE_TABLE_P (ct->table))
1781 ctnew->table = copy_uint8_byte_table (ct->table);
1783 else if (UINT16_BYTE_TABLE_P (ct->table))
1785 ctnew->table = copy_uint16_byte_table (ct->table);
1787 else if (BYTE_TABLE_P (ct->table))
1789 ctnew->table = copy_byte_table (ct->table);
1791 else if (!UNBOUNDP (ct->table))
1792 ctnew->table = ct->table;
1793 #else /* non UTF2000 */
1795 for (i = 0; i < NUM_ASCII_CHARS; i++)
1797 Lisp_Object new = ct->ascii[i];
1799 assert (! (CHAR_TABLE_ENTRYP (new)));
1801 ctnew->ascii[i] = new;
1806 for (i = 0; i < NUM_LEADING_BYTES; i++)
1808 Lisp_Object new = ct->level1[i];
1809 if (CHAR_TABLE_ENTRYP (new))
1810 ctnew->level1[i] = copy_char_table_entry (new);
1812 ctnew->level1[i] = new;
1816 #endif /* non UTF2000 */
1819 if (CHAR_TABLEP (ct->mirror_table))
1820 ctnew->mirror_table = Fcopy_char_table (ct->mirror_table);
1822 ctnew->mirror_table = ct->mirror_table;
1824 ctnew->next_table = Qnil;
1825 XSETCHAR_TABLE (obj, ctnew);
1826 if (ctnew->type == CHAR_TABLE_TYPE_SYNTAX)
1828 ctnew->next_table = Vall_syntax_tables;
1829 Vall_syntax_tables = obj;
1835 decode_char_table_range (Lisp_Object range, struct chartab_range *outrange)
1838 outrange->type = CHARTAB_RANGE_ALL;
1839 else if (EQ (range, Qnil))
1840 outrange->type = CHARTAB_RANGE_DEFAULT;
1841 else if (CHAR_OR_CHAR_INTP (range))
1843 outrange->type = CHARTAB_RANGE_CHAR;
1844 outrange->ch = XCHAR_OR_CHAR_INT (range);
1848 signal_simple_error ("Range must be t or a character", range);
1850 else if (VECTORP (range))
1852 Lisp_Vector *vec = XVECTOR (range);
1853 Lisp_Object *elts = vector_data (vec);
1854 if (vector_length (vec) != 2)
1855 signal_simple_error ("Length of charset row vector must be 2",
1857 outrange->type = CHARTAB_RANGE_ROW;
1858 outrange->charset = Fget_charset (elts[0]);
1859 CHECK_INT (elts[1]);
1860 outrange->row = XINT (elts[1]);
1861 if (XCHARSET_DIMENSION (outrange->charset) >= 2)
1863 switch (XCHARSET_CHARS (outrange->charset))
1866 check_int_range (outrange->row, 33, 126);
1869 check_int_range (outrange->row, 32, 127);
1876 signal_simple_error ("Charset in row vector must be multi-byte",
1881 if (!CHARSETP (range) && !SYMBOLP (range))
1883 ("Char table range must be t, charset, char, or vector", range);
1884 outrange->type = CHARTAB_RANGE_CHARSET;
1885 outrange->charset = Fget_charset (range);
1890 #if defined(MULE)&&!defined(UTF2000)
1892 /* called from CHAR_TABLE_VALUE(). */
1894 get_non_ascii_char_table_value (Lisp_Char_Table *ct, Charset_ID leading_byte,
1899 Lisp_Object charset;
1901 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (leading_byte);
1906 BREAKUP_CHAR (c, charset, byte1, byte2);
1908 BREAKUP_CHAR_1_UNSAFE (c, charset, byte1, byte2);
1910 val = ct->level1[leading_byte - MIN_LEADING_BYTE];
1911 if (CHAR_TABLE_ENTRYP (val))
1913 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
1914 val = cte->level2[byte1 - 32];
1915 if (CHAR_TABLE_ENTRYP (val))
1917 cte = XCHAR_TABLE_ENTRY (val);
1918 assert (byte2 >= 32);
1919 val = cte->level2[byte2 - 32];
1920 assert (!CHAR_TABLE_ENTRYP (val));
1930 get_char_table (Emchar ch, Lisp_Char_Table *ct)
1933 Lisp_Object val = get_byte_table (get_byte_table
1937 (unsigned char)(ch >> 24)),
1938 (unsigned char) (ch >> 16)),
1939 (unsigned char) (ch >> 8)),
1940 (unsigned char) ch);
1942 return ct->default_value;
1947 Lisp_Object charset;
1951 BREAKUP_CHAR (ch, charset, byte1, byte2);
1953 if (EQ (charset, Vcharset_ascii))
1954 val = ct->ascii[byte1];
1955 else if (EQ (charset, Vcharset_control_1))
1956 val = ct->ascii[byte1 + 128];
1959 int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE;
1960 val = ct->level1[lb];
1961 if (CHAR_TABLE_ENTRYP (val))
1963 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
1964 val = cte->level2[byte1 - 32];
1965 if (CHAR_TABLE_ENTRYP (val))
1967 cte = XCHAR_TABLE_ENTRY (val);
1968 assert (byte2 >= 32);
1969 val = cte->level2[byte2 - 32];
1970 assert (!CHAR_TABLE_ENTRYP (val));
1977 #else /* not MULE */
1978 return ct->ascii[(unsigned char)ch];
1979 #endif /* not MULE */
1983 DEFUN ("get-char-table", Fget_char_table, 2, 2, 0, /*
1984 Find value for CHARACTER in CHAR-TABLE.
1986 (character, char_table))
1988 CHECK_CHAR_TABLE (char_table);
1989 CHECK_CHAR_COERCE_INT (character);
1991 return get_char_table (XCHAR (character), XCHAR_TABLE (char_table));
1994 DEFUN ("get-range-char-table", Fget_range_char_table, 2, 3, 0, /*
1995 Find value for a range in CHAR-TABLE.
1996 If there is more than one value, return MULTI (defaults to nil).
1998 (range, char_table, multi))
2000 Lisp_Char_Table *ct;
2001 struct chartab_range rainj;
2003 if (CHAR_OR_CHAR_INTP (range))
2004 return Fget_char_table (range, char_table);
2005 CHECK_CHAR_TABLE (char_table);
2006 ct = XCHAR_TABLE (char_table);
2008 decode_char_table_range (range, &rainj);
2011 case CHARTAB_RANGE_ALL:
2014 if (UINT8_BYTE_TABLE_P (ct->table))
2016 else if (UINT16_BYTE_TABLE_P (ct->table))
2018 else if (BYTE_TABLE_P (ct->table))
2022 #else /* non UTF2000 */
2024 Lisp_Object first = ct->ascii[0];
2026 for (i = 1; i < NUM_ASCII_CHARS; i++)
2027 if (!EQ (first, ct->ascii[i]))
2031 for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES;
2034 if (!CHARSETP (CHARSET_BY_LEADING_BYTE (i))
2035 || i == LEADING_BYTE_ASCII
2036 || i == LEADING_BYTE_CONTROL_1)
2038 if (!EQ (first, ct->level1[i - MIN_LEADING_BYTE]))
2044 #endif /* non UTF2000 */
2048 case CHARTAB_RANGE_CHARSET:
2052 if (EQ (rainj.charset, Vcharset_ascii))
2055 Lisp_Object first = ct->ascii[0];
2057 for (i = 1; i < 128; i++)
2058 if (!EQ (first, ct->ascii[i]))
2063 if (EQ (rainj.charset, Vcharset_control_1))
2066 Lisp_Object first = ct->ascii[128];
2068 for (i = 129; i < 160; i++)
2069 if (!EQ (first, ct->ascii[i]))
2075 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (rainj.charset) -
2077 if (CHAR_TABLE_ENTRYP (val))
2083 case CHARTAB_RANGE_ROW:
2088 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (rainj.charset) -
2090 if (!CHAR_TABLE_ENTRYP (val))
2092 val = XCHAR_TABLE_ENTRY (val)->level2[rainj.row - 32];
2093 if (CHAR_TABLE_ENTRYP (val))
2097 #endif /* not UTF2000 */
2098 #endif /* not MULE */
2104 return Qnil; /* not reached */
2108 check_valid_char_table_value (Lisp_Object value, enum char_table_type type,
2109 Error_behavior errb)
2113 case CHAR_TABLE_TYPE_SYNTAX:
2114 if (!ERRB_EQ (errb, ERROR_ME))
2115 return INTP (value) || (CONSP (value) && INTP (XCAR (value))
2116 && CHAR_OR_CHAR_INTP (XCDR (value)));
2119 Lisp_Object cdr = XCDR (value);
2120 CHECK_INT (XCAR (value));
2121 CHECK_CHAR_COERCE_INT (cdr);
2128 case CHAR_TABLE_TYPE_CATEGORY:
2129 if (!ERRB_EQ (errb, ERROR_ME))
2130 return CATEGORY_TABLE_VALUEP (value);
2131 CHECK_CATEGORY_TABLE_VALUE (value);
2135 case CHAR_TABLE_TYPE_GENERIC:
2138 case CHAR_TABLE_TYPE_DISPLAY:
2140 maybe_signal_simple_error ("Display char tables not yet implemented",
2141 value, Qchar_table, errb);
2144 case CHAR_TABLE_TYPE_CHAR:
2145 if (!ERRB_EQ (errb, ERROR_ME))
2146 return CHAR_OR_CHAR_INTP (value);
2147 CHECK_CHAR_COERCE_INT (value);
2154 return 0; /* not reached */
2158 canonicalize_char_table_value (Lisp_Object value, enum char_table_type type)
2162 case CHAR_TABLE_TYPE_SYNTAX:
2165 Lisp_Object car = XCAR (value);
2166 Lisp_Object cdr = XCDR (value);
2167 CHECK_CHAR_COERCE_INT (cdr);
2168 return Fcons (car, cdr);
2171 case CHAR_TABLE_TYPE_CHAR:
2172 CHECK_CHAR_COERCE_INT (value);
2180 DEFUN ("valid-char-table-value-p", Fvalid_char_table_value_p, 2, 2, 0, /*
2181 Return non-nil if VALUE is a valid value for CHAR-TABLE-TYPE.
2183 (value, char_table_type))
2185 enum char_table_type type = symbol_to_char_table_type (char_table_type);
2187 return check_valid_char_table_value (value, type, ERROR_ME_NOT) ? Qt : Qnil;
2190 DEFUN ("check-valid-char-table-value", Fcheck_valid_char_table_value, 2, 2, 0, /*
2191 Signal an error if VALUE is not a valid value for CHAR-TABLE-TYPE.
2193 (value, char_table_type))
2195 enum char_table_type type = symbol_to_char_table_type (char_table_type);
2197 check_valid_char_table_value (value, type, ERROR_ME);
2201 /* Assign VAL to all characters in RANGE in char table CT. */
2204 put_char_table (Lisp_Char_Table *ct, struct chartab_range *range,
2207 switch (range->type)
2209 case CHARTAB_RANGE_ALL:
2210 /* printf ("put-char-table: range = all\n"); */
2211 fill_char_table (ct, val);
2212 return; /* avoid the duplicate call to update_syntax_table() below,
2213 since fill_char_table() also did that. */
2216 case CHARTAB_RANGE_DEFAULT:
2217 ct->default_value = val;
2222 case CHARTAB_RANGE_CHARSET:
2226 Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (range->charset);
2228 /* printf ("put-char-table: range = charset: %d\n",
2229 XCHARSET_LEADING_BYTE (range->charset));
2231 if ( CHAR_TABLEP (encoding_table) )
2233 for (c = 0; c < 1 << 24; c++)
2235 if ( INTP (get_char_id_table (XCHAR_TABLE(encoding_table),
2237 put_char_id_table_0 (ct, c, val);
2242 for (c = 0; c < 1 << 24; c++)
2244 if ( charset_code_point (range->charset, c) >= 0 )
2245 put_char_id_table_0 (ct, c, val);
2250 if (EQ (range->charset, Vcharset_ascii))
2253 for (i = 0; i < 128; i++)
2256 else if (EQ (range->charset, Vcharset_control_1))
2259 for (i = 128; i < 160; i++)
2264 int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE;
2265 ct->level1[lb] = val;
2270 case CHARTAB_RANGE_ROW:
2273 int cell_min, cell_max, i;
2275 /* printf ("put-char-table: range = charset-row: %d, 0x%x\n",
2276 XCHARSET_LEADING_BYTE (range->charset), range->row); */
2277 if (XCHARSET_DIMENSION (range->charset) < 2)
2278 signal_simple_error ("Charset in row vector must be multi-byte",
2282 switch (XCHARSET_CHARS (range->charset))
2285 cell_min = 33; cell_max = 126;
2288 cell_min = 32; cell_max = 127;
2291 cell_min = 0; cell_max = 127;
2294 cell_min = 0; cell_max = 255;
2300 if (XCHARSET_DIMENSION (range->charset) == 2)
2301 check_int_range (range->row, cell_min, cell_max);
2302 else if (XCHARSET_DIMENSION (range->charset) == 3)
2304 check_int_range (range->row >> 8 , cell_min, cell_max);
2305 check_int_range (range->row & 0xFF, cell_min, cell_max);
2307 else if (XCHARSET_DIMENSION (range->charset) == 4)
2309 check_int_range ( range->row >> 16 , cell_min, cell_max);
2310 check_int_range ((range->row >> 8) & 0xFF, cell_min, cell_max);
2311 check_int_range ( range->row & 0xFF, cell_min, cell_max);
2316 for (i = cell_min; i <= cell_max; i++)
2318 Emchar ch = DECODE_CHAR (range->charset, (range->row << 8) | i);
2319 if ( charset_code_point (range->charset, ch) >= 0 )
2320 put_char_id_table_0 (ct, ch, val);
2325 Lisp_Char_Table_Entry *cte;
2326 int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE;
2327 /* make sure that there is a separate entry for the row. */
2328 if (!CHAR_TABLE_ENTRYP (ct->level1[lb]))
2329 ct->level1[lb] = make_char_table_entry (ct->level1[lb]);
2330 cte = XCHAR_TABLE_ENTRY (ct->level1[lb]);
2331 cte->level2[range->row - 32] = val;
2333 #endif /* not UTF2000 */
2337 case CHARTAB_RANGE_CHAR:
2339 /* printf ("put-char-table: range = char: 0x%x\n", range->ch); */
2340 put_char_id_table_0 (ct, range->ch, val);
2344 Lisp_Object charset;
2347 BREAKUP_CHAR (range->ch, charset, byte1, byte2);
2348 if (EQ (charset, Vcharset_ascii))
2349 ct->ascii[byte1] = val;
2350 else if (EQ (charset, Vcharset_control_1))
2351 ct->ascii[byte1 + 128] = val;
2354 Lisp_Char_Table_Entry *cte;
2355 int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE;
2356 /* make sure that there is a separate entry for the row. */
2357 if (!CHAR_TABLE_ENTRYP (ct->level1[lb]))
2358 ct->level1[lb] = make_char_table_entry (ct->level1[lb]);
2359 cte = XCHAR_TABLE_ENTRY (ct->level1[lb]);
2360 /* now CTE is a char table entry for the charset;
2361 each entry is for a single row (or character of
2362 a one-octet charset). */
2363 if (XCHARSET_DIMENSION (charset) == 1)
2364 cte->level2[byte1 - 32] = val;
2367 /* assigning to one character in a two-octet charset. */
2368 /* make sure that the charset row contains a separate
2369 entry for each character. */
2370 if (!CHAR_TABLE_ENTRYP (cte->level2[byte1 - 32]))
2371 cte->level2[byte1 - 32] =
2372 make_char_table_entry (cte->level2[byte1 - 32]);
2373 cte = XCHAR_TABLE_ENTRY (cte->level2[byte1 - 32]);
2374 cte->level2[byte2 - 32] = val;
2378 #else /* not MULE */
2379 ct->ascii[(unsigned char) (range->ch)] = val;
2381 #endif /* not MULE */
2385 if (ct->type == CHAR_TABLE_TYPE_SYNTAX)
2386 update_syntax_table (ct);
2390 DEFUN ("put-char-table", Fput_char_table, 3, 3, 0, /*
2391 Set the value for chars in RANGE to be VALUE in CHAR-TABLE.
2393 RANGE specifies one or more characters to be affected and should be
2394 one of the following:
2396 -- t (all characters are affected)
2397 -- A charset (only allowed when Mule support is present)
2398 -- A vector of two elements: a two-octet charset and a row number
2399 (only allowed when Mule support is present)
2400 -- A single character
2402 VALUE must be a value appropriate for the type of CHAR-TABLE.
2403 See `valid-char-table-type-p'.
2405 (range, value, char_table))
2407 Lisp_Char_Table *ct;
2408 struct chartab_range rainj;
2410 CHECK_CHAR_TABLE (char_table);
2411 ct = XCHAR_TABLE (char_table);
2412 check_valid_char_table_value (value, ct->type, ERROR_ME);
2413 decode_char_table_range (range, &rainj);
2414 value = canonicalize_char_table_value (value, ct->type);
2415 put_char_table (ct, &rainj, value);
2420 /* Map FN over the ASCII chars in CT. */
2423 map_over_charset_ascii (Lisp_Char_Table *ct,
2424 int (*fn) (struct chartab_range *range,
2425 Lisp_Object val, void *arg),
2428 struct chartab_range rainj;
2437 rainj.type = CHARTAB_RANGE_CHAR;
2439 for (i = start, retval = 0; i < stop && retval == 0; i++)
2441 rainj.ch = (Emchar) i;
2442 retval = (fn) (&rainj, ct->ascii[i], arg);
2450 /* Map FN over the Control-1 chars in CT. */
2453 map_over_charset_control_1 (Lisp_Char_Table *ct,
2454 int (*fn) (struct chartab_range *range,
2455 Lisp_Object val, void *arg),
2458 struct chartab_range rainj;
2461 int stop = start + 32;
2463 rainj.type = CHARTAB_RANGE_CHAR;
2465 for (i = start, retval = 0; i < stop && retval == 0; i++)
2467 rainj.ch = (Emchar) (i);
2468 retval = (fn) (&rainj, ct->ascii[i], arg);
2474 /* Map FN over the row ROW of two-byte charset CHARSET.
2475 There must be a separate value for that row in the char table.
2476 CTE specifies the char table entry for CHARSET. */
2479 map_over_charset_row (Lisp_Char_Table_Entry *cte,
2480 Lisp_Object charset, int row,
2481 int (*fn) (struct chartab_range *range,
2482 Lisp_Object val, void *arg),
2485 Lisp_Object val = cte->level2[row - 32];
2487 if (!CHAR_TABLE_ENTRYP (val))
2489 struct chartab_range rainj;
2491 rainj.type = CHARTAB_RANGE_ROW;
2492 rainj.charset = charset;
2494 return (fn) (&rainj, val, arg);
2498 struct chartab_range rainj;
2500 int charset94_p = (XCHARSET_CHARS (charset) == 94);
2501 int start = charset94_p ? 33 : 32;
2502 int stop = charset94_p ? 127 : 128;
2504 cte = XCHAR_TABLE_ENTRY (val);
2506 rainj.type = CHARTAB_RANGE_CHAR;
2508 for (i = start, retval = 0; i < stop && retval == 0; i++)
2510 rainj.ch = MAKE_CHAR (charset, row, i);
2511 retval = (fn) (&rainj, cte->level2[i - 32], arg);
2519 map_over_other_charset (Lisp_Char_Table *ct, Charset_ID lb,
2520 int (*fn) (struct chartab_range *range,
2521 Lisp_Object val, void *arg),
2524 Lisp_Object val = ct->level1[lb - MIN_LEADING_BYTE];
2525 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (lb);
2527 if (!CHARSETP (charset)
2528 || lb == LEADING_BYTE_ASCII
2529 || lb == LEADING_BYTE_CONTROL_1)
2532 if (!CHAR_TABLE_ENTRYP (val))
2534 struct chartab_range rainj;
2536 rainj.type = CHARTAB_RANGE_CHARSET;
2537 rainj.charset = charset;
2538 return (fn) (&rainj, val, arg);
2542 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
2543 int charset94_p = (XCHARSET_CHARS (charset) == 94);
2544 int start = charset94_p ? 33 : 32;
2545 int stop = charset94_p ? 127 : 128;
2548 if (XCHARSET_DIMENSION (charset) == 1)
2550 struct chartab_range rainj;
2551 rainj.type = CHARTAB_RANGE_CHAR;
2553 for (i = start, retval = 0; i < stop && retval == 0; i++)
2555 rainj.ch = MAKE_CHAR (charset, i, 0);
2556 retval = (fn) (&rainj, cte->level2[i - 32], arg);
2561 for (i = start, retval = 0; i < stop && retval == 0; i++)
2562 retval = map_over_charset_row (cte, charset, i, fn, arg);
2570 #endif /* not UTF2000 */
2572 /* Map FN (with client data ARG) over range RANGE in char table CT.
2573 Mapping stops the first time FN returns non-zero, and that value
2574 becomes the return value of map_char_table(). */
2577 map_char_table (Lisp_Char_Table *ct,
2578 struct chartab_range *range,
2579 int (*fn) (struct chartab_range *range,
2580 Lisp_Object val, void *arg),
2583 switch (range->type)
2585 case CHARTAB_RANGE_ALL:
2587 if (!UNBOUNDP (ct->default_value))
2589 struct chartab_range rainj;
2592 rainj.type = CHARTAB_RANGE_DEFAULT;
2593 retval = (fn) (&rainj, ct->default_value, arg);
2597 if (UINT8_BYTE_TABLE_P (ct->table))
2598 return map_over_uint8_byte_table (XUINT8_BYTE_TABLE(ct->table), 0, 3,
2600 else if (UINT16_BYTE_TABLE_P (ct->table))
2601 return map_over_uint16_byte_table (XUINT16_BYTE_TABLE(ct->table), 0, 3,
2603 else if (BYTE_TABLE_P (ct->table))
2604 return map_over_byte_table (XBYTE_TABLE(ct->table), 0, 3,
2606 else if (!UNBOUNDP (ct->table))
2609 struct chartab_range rainj;
2612 Emchar c1 = c + unit;
2615 rainj.type = CHARTAB_RANGE_CHAR;
2617 for (retval = 0; c < c1 && retval == 0; c++)
2620 retval = (fn) (&rainj, ct->table, arg);
2625 return (fn) (range, ct->table, arg);
2632 retval = map_over_charset_ascii (ct, fn, arg);
2636 retval = map_over_charset_control_1 (ct, fn, arg);
2641 Charset_ID start = MIN_LEADING_BYTE;
2642 Charset_ID stop = start + NUM_LEADING_BYTES;
2644 for (i = start, retval = 0; i < stop && retval == 0; i++)
2646 retval = map_over_other_charset (ct, i, fn, arg);
2655 case CHARTAB_RANGE_DEFAULT:
2656 if (!UNBOUNDP (ct->default_value))
2657 return (fn) (range, ct->default_value, arg);
2662 case CHARTAB_RANGE_CHARSET:
2664 if (UINT8_BYTE_TABLE_P (ct->table))
2665 return map_over_uint8_byte_table (XUINT8_BYTE_TABLE(ct->table), 0, 3,
2666 range->charset, fn, arg);
2667 else if (UINT16_BYTE_TABLE_P (ct->table))
2668 return map_over_uint16_byte_table (XUINT16_BYTE_TABLE(ct->table), 0, 3,
2669 range->charset, fn, arg);
2670 else if (BYTE_TABLE_P (ct->table))
2671 return map_over_byte_table (XBYTE_TABLE(ct->table), 0, 3,
2672 range->charset, fn, arg);
2673 else if (!UNBOUNDP (ct->table))
2676 struct chartab_range rainj;
2679 Emchar c1 = c + unit;
2682 rainj.type = CHARTAB_RANGE_CHAR;
2684 for (retval = 0; c < c1 && retval == 0; c++)
2686 if ( charset_code_point (range->charset, c) >= 0 )
2689 retval = (fn) (&rainj, ct->table, arg);
2693 return (fn) (range, ct->table, arg);
2698 return map_over_other_charset (ct,
2699 XCHARSET_LEADING_BYTE (range->charset),
2703 case CHARTAB_RANGE_ROW:
2706 int cell_min, cell_max, i;
2708 struct chartab_range rainj;
2710 if (XCHARSET_DIMENSION (range->charset) < 2)
2711 signal_simple_error ("Charset in row vector must be multi-byte",
2715 switch (XCHARSET_CHARS (range->charset))
2718 cell_min = 33; cell_max = 126;
2721 cell_min = 32; cell_max = 127;
2724 cell_min = 0; cell_max = 127;
2727 cell_min = 0; cell_max = 255;
2733 if (XCHARSET_DIMENSION (range->charset) == 2)
2734 check_int_range (range->row, cell_min, cell_max);
2735 else if (XCHARSET_DIMENSION (range->charset) == 3)
2737 check_int_range (range->row >> 8 , cell_min, cell_max);
2738 check_int_range (range->row & 0xFF, cell_min, cell_max);
2740 else if (XCHARSET_DIMENSION (range->charset) == 4)
2742 check_int_range ( range->row >> 16 , cell_min, cell_max);
2743 check_int_range ((range->row >> 8) & 0xFF, cell_min, cell_max);
2744 check_int_range ( range->row & 0xFF, cell_min, cell_max);
2749 rainj.type = CHARTAB_RANGE_CHAR;
2750 for (retval =0, i = cell_min; i <= cell_max && retval == 0; i++)
2752 Emchar ch = DECODE_CHAR (range->charset, (range->row << 8) | i);
2754 if ( charset_code_point (range->charset, ch) >= 0 )
2757 = get_byte_table (get_byte_table
2761 (unsigned char)(ch >> 24)),
2762 (unsigned char) (ch >> 16)),
2763 (unsigned char) (ch >> 8)),
2764 (unsigned char) ch);
2767 val = ct->default_value;
2769 retval = (fn) (&rainj, val, arg);
2776 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (range->charset)
2777 - MIN_LEADING_BYTE];
2778 if (!CHAR_TABLE_ENTRYP (val))
2780 struct chartab_range rainj;
2782 rainj.type = CHARTAB_RANGE_ROW;
2783 rainj.charset = range->charset;
2784 rainj.row = range->row;
2785 return (fn) (&rainj, val, arg);
2788 return map_over_charset_row (XCHAR_TABLE_ENTRY (val),
2789 range->charset, range->row,
2792 #endif /* not UTF2000 */
2795 case CHARTAB_RANGE_CHAR:
2797 Emchar ch = range->ch;
2798 Lisp_Object val = CHAR_TABLE_VALUE_UNSAFE (ct, ch);
2800 if (!UNBOUNDP (val))
2802 struct chartab_range rainj;
2804 rainj.type = CHARTAB_RANGE_CHAR;
2806 return (fn) (&rainj, val, arg);
2818 struct slow_map_char_table_arg
2820 Lisp_Object function;
2825 slow_map_char_table_fun (struct chartab_range *range,
2826 Lisp_Object val, void *arg)
2828 Lisp_Object ranjarg = Qnil;
2829 struct slow_map_char_table_arg *closure =
2830 (struct slow_map_char_table_arg *) arg;
2832 switch (range->type)
2834 case CHARTAB_RANGE_ALL:
2839 case CHARTAB_RANGE_DEFAULT:
2845 case CHARTAB_RANGE_CHARSET:
2846 ranjarg = XCHARSET_NAME (range->charset);
2849 case CHARTAB_RANGE_ROW:
2850 ranjarg = vector2 (XCHARSET_NAME (range->charset),
2851 make_int (range->row));
2854 case CHARTAB_RANGE_CHAR:
2855 ranjarg = make_char (range->ch);
2861 closure->retval = call2 (closure->function, ranjarg, val);
2862 return !NILP (closure->retval);
2865 DEFUN ("map-char-table", Fmap_char_table, 2, 3, 0, /*
2866 Map FUNCTION over entries in CHAR-TABLE, calling it with two args,
2867 each key and value in the table.
2869 RANGE specifies a subrange to map over and is in the same format as
2870 the RANGE argument to `put-range-table'. If omitted or t, it defaults to
2873 (function, char_table, range))
2875 Lisp_Char_Table *ct;
2876 struct slow_map_char_table_arg slarg;
2877 struct gcpro gcpro1, gcpro2;
2878 struct chartab_range rainj;
2880 CHECK_CHAR_TABLE (char_table);
2881 ct = XCHAR_TABLE (char_table);
2884 decode_char_table_range (range, &rainj);
2885 slarg.function = function;
2886 slarg.retval = Qnil;
2887 GCPRO2 (slarg.function, slarg.retval);
2888 map_char_table (ct, &rainj, slow_map_char_table_fun, &slarg);
2891 return slarg.retval;
2895 /************************************************************************/
2896 /* Character Attributes */
2897 /************************************************************************/
2901 Lisp_Object Vchar_attribute_hash_table;
2903 /* We store the char-attributes in hash tables with the names as the
2904 key and the actual char-id-table object as the value. Occasionally
2905 we need to use them in a list format. These routines provide us
2907 struct char_attribute_list_closure
2909 Lisp_Object *char_attribute_list;
2913 add_char_attribute_to_list_mapper (Lisp_Object key, Lisp_Object value,
2914 void *char_attribute_list_closure)
2916 /* This function can GC */
2917 struct char_attribute_list_closure *calcl
2918 = (struct char_attribute_list_closure*) char_attribute_list_closure;
2919 Lisp_Object *char_attribute_list = calcl->char_attribute_list;
2921 *char_attribute_list = Fcons (key, *char_attribute_list);
2925 DEFUN ("char-attribute-list", Fchar_attribute_list, 0, 0, 0, /*
2926 Return the list of all existing character attributes except coded-charsets.
2930 Lisp_Object char_attribute_list = Qnil;
2931 struct gcpro gcpro1;
2932 struct char_attribute_list_closure char_attribute_list_closure;
2934 GCPRO1 (char_attribute_list);
2935 char_attribute_list_closure.char_attribute_list = &char_attribute_list;
2936 elisp_maphash (add_char_attribute_to_list_mapper,
2937 Vchar_attribute_hash_table,
2938 &char_attribute_list_closure);
2940 return char_attribute_list;
2943 DEFUN ("find-char-attribute-table", Ffind_char_attribute_table, 1, 1, 0, /*
2944 Return char-id-table corresponding to ATTRIBUTE.
2948 return Fgethash (attribute, Vchar_attribute_hash_table, Qnil);
2952 /* We store the char-id-tables in hash tables with the attributes as
2953 the key and the actual char-id-table object as the value. Each
2954 char-id-table stores values of an attribute corresponding with
2955 characters. Occasionally we need to get attributes of a character
2956 in a association-list format. These routines provide us with
2958 struct char_attribute_alist_closure
2961 Lisp_Object *char_attribute_alist;
2965 add_char_attribute_alist_mapper (Lisp_Object key, Lisp_Object value,
2966 void *char_attribute_alist_closure)
2968 /* This function can GC */
2969 struct char_attribute_alist_closure *caacl =
2970 (struct char_attribute_alist_closure*) char_attribute_alist_closure;
2972 = get_char_id_table (XCHAR_TABLE(value), caacl->char_id);
2973 if (!UNBOUNDP (ret))
2975 Lisp_Object *char_attribute_alist = caacl->char_attribute_alist;
2976 *char_attribute_alist
2977 = Fcons (Fcons (key, ret), *char_attribute_alist);
2982 DEFUN ("char-attribute-alist", Fchar_attribute_alist, 1, 1, 0, /*
2983 Return the alist of attributes of CHARACTER.
2987 Lisp_Object alist = Qnil;
2990 CHECK_CHAR (character);
2992 struct gcpro gcpro1;
2993 struct char_attribute_alist_closure char_attribute_alist_closure;
2996 char_attribute_alist_closure.char_id = XCHAR (character);
2997 char_attribute_alist_closure.char_attribute_alist = &alist;
2998 elisp_maphash (add_char_attribute_alist_mapper,
2999 Vchar_attribute_hash_table,
3000 &char_attribute_alist_closure);
3004 for (i = 0; i < countof (chlook->charset_by_leading_byte); i++)
3006 Lisp_Object ccs = chlook->charset_by_leading_byte[i];
3010 Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (ccs);
3013 if ( CHAR_TABLEP (encoding_table)
3015 = get_char_id_table (XCHAR_TABLE(encoding_table),
3016 XCHAR (character))) )
3018 alist = Fcons (Fcons (ccs, cpos), alist);
3025 DEFUN ("get-char-attribute", Fget_char_attribute, 2, 3, 0, /*
3026 Return the value of CHARACTER's ATTRIBUTE.
3027 Return DEFAULT-VALUE if the value is not exist.
3029 (character, attribute, default_value))
3033 CHECK_CHAR (character);
3034 if (!NILP (ccs = Ffind_charset (attribute)))
3036 Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (ccs);
3038 if (CHAR_TABLEP (encoding_table))
3039 return get_char_id_table (XCHAR_TABLE(encoding_table),
3044 Lisp_Object table = Fgethash (attribute,
3045 Vchar_attribute_hash_table,
3047 if (!UNBOUNDP (table))
3049 Lisp_Object ret = get_char_id_table (XCHAR_TABLE(table),
3051 if (!UNBOUNDP (ret))
3055 return default_value;
3058 DEFUN ("put-char-attribute", Fput_char_attribute, 3, 3, 0, /*
3059 Store CHARACTER's ATTRIBUTE with VALUE.
3061 (character, attribute, value))
3065 ccs = Ffind_charset (attribute);
3068 CHECK_CHAR (character);
3069 return put_char_ccs_code_point (character, ccs, value);
3071 else if (EQ (attribute, Q_decomposition))
3075 CHECK_CHAR (character);
3077 signal_simple_error ("Invalid value for ->decomposition",
3080 if (CONSP (Fcdr (value)))
3082 Lisp_Object rest = value;
3083 Lisp_Object table = Vcharacter_composition_table;
3087 GET_EXTERNAL_LIST_LENGTH (rest, len);
3088 seq = make_vector (len, Qnil);
3090 while (CONSP (rest))
3092 Lisp_Object v = Fcar (rest);
3095 = to_char_id (v, "Invalid value for ->decomposition", value);
3098 XVECTOR_DATA(seq)[i++] = v;
3100 XVECTOR_DATA(seq)[i++] = make_char (c);
3104 put_char_id_table (XCHAR_TABLE(table),
3105 make_char (c), character);
3110 ntable = get_char_id_table (XCHAR_TABLE(table), c);
3111 if (!CHAR_TABLEP (ntable))
3113 ntable = make_char_id_table (Qnil);
3114 put_char_id_table (XCHAR_TABLE(table),
3115 make_char (c), ntable);
3123 Lisp_Object v = Fcar (value);
3127 Emchar c = XINT (v);
3129 = get_char_id_table (XCHAR_TABLE(Vcharacter_variant_table),
3132 if (NILP (Fmemq (v, ret)))
3134 put_char_id_table (XCHAR_TABLE(Vcharacter_variant_table),
3135 make_char (c), Fcons (character, ret));
3138 seq = make_vector (1, v);
3142 else if (EQ (attribute, Qto_ucs) || EQ (attribute, Q_ucs))
3147 CHECK_CHAR (character);
3149 signal_simple_error ("Invalid value for ->ucs", value);
3153 ret = get_char_id_table (XCHAR_TABLE(Vcharacter_variant_table), c);
3154 if (NILP (Fmemq (character, ret)))
3156 put_char_id_table (XCHAR_TABLE(Vcharacter_variant_table),
3157 make_char (c), Fcons (character, ret));
3160 if (EQ (attribute, Q_ucs))
3161 attribute = Qto_ucs;
3165 Lisp_Object table = Fgethash (attribute,
3166 Vchar_attribute_hash_table,
3171 table = make_char_id_table (Qunbound);
3172 Fputhash (attribute, table, Vchar_attribute_hash_table);
3174 put_char_id_table (XCHAR_TABLE(table), character, value);
3179 DEFUN ("remove-char-attribute", Fremove_char_attribute, 2, 2, 0, /*
3180 Remove CHARACTER's ATTRIBUTE.
3182 (character, attribute))
3186 CHECK_CHAR (character);
3187 ccs = Ffind_charset (attribute);
3190 return remove_char_ccs (character, ccs);
3194 Lisp_Object table = Fgethash (attribute,
3195 Vchar_attribute_hash_table,
3197 if (!UNBOUNDP (table))
3199 put_char_id_table (XCHAR_TABLE(table), character, Qunbound);
3206 DEFUN ("map-char-attribute", Fmap_char_attribute, 2, 3, 0, /*
3207 Map FUNCTION over entries in ATTRIBUTE, calling it with two args,
3208 each key and value in the table.
3210 RANGE specifies a subrange to map over and is in the same format as
3211 the RANGE argument to `put-range-table'. If omitted or t, it defaults to
3214 (function, attribute, range))
3217 Lisp_Char_Table *ct;
3218 struct slow_map_char_table_arg slarg;
3219 struct gcpro gcpro1, gcpro2;
3220 struct chartab_range rainj;
3222 if (!NILP (ccs = Ffind_charset (attribute)))
3224 Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (ccs);
3226 if (CHAR_TABLEP (encoding_table))
3227 ct = XCHAR_TABLE (encoding_table);
3233 Lisp_Object table = Fgethash (attribute,
3234 Vchar_attribute_hash_table,
3236 if (CHAR_TABLEP (table))
3237 ct = XCHAR_TABLE (table);
3243 decode_char_table_range (range, &rainj);
3244 slarg.function = function;
3245 slarg.retval = Qnil;
3246 GCPRO2 (slarg.function, slarg.retval);
3247 map_char_table (ct, &rainj, slow_map_char_table_fun, &slarg);
3250 return slarg.retval;
3253 EXFUN (Fmake_char, 3);
3254 EXFUN (Fdecode_char, 2);
3256 DEFUN ("define-char", Fdefine_char, 1, 1, 0, /*
3257 Store character's ATTRIBUTES.
3261 Lisp_Object rest = attributes;
3262 Lisp_Object code = Fcdr (Fassq (Qucs, attributes));
3263 Lisp_Object character;
3267 while (CONSP (rest))
3269 Lisp_Object cell = Fcar (rest);
3273 signal_simple_error ("Invalid argument", attributes);
3274 if (!NILP (ccs = Ffind_charset (Fcar (cell)))
3275 && ((XCHARSET_FINAL (ccs) != 0) ||
3276 (XCHARSET_UCS_MAX (ccs) > 0)) )
3280 character = Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
3282 character = Fdecode_char (ccs, cell);
3283 if (!NILP (character))
3284 goto setup_attributes;
3288 if ( (!NILP (code = Fcdr (Fassq (Qto_ucs, attributes)))) ||
3289 (!NILP (code = Fcdr (Fassq (Q_ucs, attributes)))) )
3293 signal_simple_error ("Invalid argument", attributes);
3295 character = make_char (XINT (code) + 0x100000);
3296 goto setup_attributes;
3300 else if (!INTP (code))
3301 signal_simple_error ("Invalid argument", attributes);
3303 character = make_char (XINT (code));
3307 while (CONSP (rest))
3309 Lisp_Object cell = Fcar (rest);
3312 signal_simple_error ("Invalid argument", attributes);
3314 Fput_char_attribute (character, Fcar (cell), Fcdr (cell));
3320 DEFUN ("find-char", Ffind_char, 1, 1, 0, /*
3321 Retrieve the character of the given ATTRIBUTES.
3325 Lisp_Object rest = attributes;
3328 while (CONSP (rest))
3330 Lisp_Object cell = Fcar (rest);
3334 signal_simple_error ("Invalid argument", attributes);
3335 if (!NILP (ccs = Ffind_charset (Fcar (cell))))
3339 return Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
3341 return Fdecode_char (ccs, cell);
3345 if ( (!NILP (code = Fcdr (Fassq (Qto_ucs, attributes)))) ||
3346 (!NILP (code = Fcdr (Fassq (Q_ucs, attributes)))) )
3349 signal_simple_error ("Invalid argument", attributes);
3351 return make_char (XINT (code) + 0x100000);
3359 /************************************************************************/
3360 /* Char table read syntax */
3361 /************************************************************************/
3364 chartab_type_validate (Lisp_Object keyword, Lisp_Object value,
3365 Error_behavior errb)
3367 /* #### should deal with ERRB */
3368 symbol_to_char_table_type (value);
3373 chartab_data_validate (Lisp_Object keyword, Lisp_Object value,
3374 Error_behavior errb)
3378 /* #### should deal with ERRB */
3379 EXTERNAL_LIST_LOOP (rest, value)
3381 Lisp_Object range = XCAR (rest);
3382 struct chartab_range dummy;
3386 signal_simple_error ("Invalid list format", value);
3389 if (!CONSP (XCDR (range))
3390 || !NILP (XCDR (XCDR (range))))
3391 signal_simple_error ("Invalid range format", range);
3392 decode_char_table_range (XCAR (range), &dummy);
3393 decode_char_table_range (XCAR (XCDR (range)), &dummy);
3396 decode_char_table_range (range, &dummy);
3403 chartab_instantiate (Lisp_Object data)
3405 Lisp_Object chartab;
3406 Lisp_Object type = Qgeneric;
3407 Lisp_Object dataval = Qnil;
3409 while (!NILP (data))
3411 Lisp_Object keyw = Fcar (data);
3417 if (EQ (keyw, Qtype))
3419 else if (EQ (keyw, Qdata))
3423 chartab = Fmake_char_table (type);
3426 while (!NILP (data))
3428 Lisp_Object range = Fcar (data);
3429 Lisp_Object val = Fcar (Fcdr (data));
3431 data = Fcdr (Fcdr (data));
3434 if (CHAR_OR_CHAR_INTP (XCAR (range)))
3436 Emchar first = XCHAR_OR_CHAR_INT (Fcar (range));
3437 Emchar last = XCHAR_OR_CHAR_INT (Fcar (Fcdr (range)));
3440 for (i = first; i <= last; i++)
3441 Fput_char_table (make_char (i), val, chartab);
3447 Fput_char_table (range, val, chartab);
3456 /************************************************************************/
3457 /* Category Tables, specifically */
3458 /************************************************************************/
3460 DEFUN ("category-table-p", Fcategory_table_p, 1, 1, 0, /*
3461 Return t if OBJECT is a category table.
3462 A category table is a type of char table used for keeping track of
3463 categories. Categories are used for classifying characters for use
3464 in regexps -- you can refer to a category rather than having to use
3465 a complicated [] expression (and category lookups are significantly
3468 There are 95 different categories available, one for each printable
3469 character (including space) in the ASCII charset. Each category
3470 is designated by one such character, called a "category designator".
3471 They are specified in a regexp using the syntax "\\cX", where X is
3472 a category designator.
3474 A category table specifies, for each character, the categories that
3475 the character is in. Note that a character can be in more than one
3476 category. More specifically, a category table maps from a character
3477 to either the value nil (meaning the character is in no categories)
3478 or a 95-element bit vector, specifying for each of the 95 categories
3479 whether the character is in that category.
3481 Special Lisp functions are provided that abstract this, so you do not
3482 have to directly manipulate bit vectors.
3486 return (CHAR_TABLEP (object) &&
3487 XCHAR_TABLE_TYPE (object) == CHAR_TABLE_TYPE_CATEGORY) ?
3492 check_category_table (Lisp_Object object, Lisp_Object default_)
3496 while (NILP (Fcategory_table_p (object)))
3497 object = wrong_type_argument (Qcategory_table_p, object);
3502 check_category_char (Emchar ch, Lisp_Object table,
3503 unsigned int designator, unsigned int not)
3505 REGISTER Lisp_Object temp;
3506 Lisp_Char_Table *ctbl;
3507 #ifdef ERROR_CHECK_TYPECHECK
3508 if (NILP (Fcategory_table_p (table)))
3509 signal_simple_error ("Expected category table", table);
3511 ctbl = XCHAR_TABLE (table);
3512 temp = get_char_table (ch, ctbl);
3517 return bit_vector_bit (XBIT_VECTOR (temp), designator) ? !not : not;
3520 DEFUN ("check-category-at", Fcheck_category_at, 2, 4, 0, /*
3521 Return t if category of the character at POSITION includes DESIGNATOR.
3522 Optional third arg BUFFER specifies which buffer to use, and defaults
3523 to the current buffer.
3524 Optional fourth arg CATEGORY-TABLE specifies the category table to
3525 use, and defaults to BUFFER's category table.
3527 (position, designator, buffer, category_table))
3532 struct buffer *buf = decode_buffer (buffer, 0);
3534 CHECK_INT (position);
3535 CHECK_CATEGORY_DESIGNATOR (designator);
3536 des = XCHAR (designator);
3537 ctbl = check_category_table (category_table, Vstandard_category_table);
3538 ch = BUF_FETCH_CHAR (buf, XINT (position));
3539 return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil;
3542 DEFUN ("char-in-category-p", Fchar_in_category_p, 2, 3, 0, /*
3543 Return t if category of CHARACTER includes DESIGNATOR, else nil.
3544 Optional third arg CATEGORY-TABLE specifies the category table to use,
3545 and defaults to the standard category table.
3547 (character, designator, category_table))
3553 CHECK_CATEGORY_DESIGNATOR (designator);
3554 des = XCHAR (designator);
3555 CHECK_CHAR (character);
3556 ch = XCHAR (character);
3557 ctbl = check_category_table (category_table, Vstandard_category_table);
3558 return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil;
3561 DEFUN ("category-table", Fcategory_table, 0, 1, 0, /*
3562 Return BUFFER's current category table.
3563 BUFFER defaults to the current buffer.
3567 return decode_buffer (buffer, 0)->category_table;
3570 DEFUN ("standard-category-table", Fstandard_category_table, 0, 0, 0, /*
3571 Return the standard category table.
3572 This is the one used for new buffers.
3576 return Vstandard_category_table;
3579 DEFUN ("copy-category-table", Fcopy_category_table, 0, 1, 0, /*
3580 Return a new category table which is a copy of CATEGORY-TABLE.
3581 CATEGORY-TABLE defaults to the standard category table.
3585 if (NILP (Vstandard_category_table))
3586 return Fmake_char_table (Qcategory);
3589 check_category_table (category_table, Vstandard_category_table);
3590 return Fcopy_char_table (category_table);
3593 DEFUN ("set-category-table", Fset_category_table, 1, 2, 0, /*
3594 Select CATEGORY-TABLE as the new category table for BUFFER.
3595 BUFFER defaults to the current buffer if omitted.
3597 (category_table, buffer))
3599 struct buffer *buf = decode_buffer (buffer, 0);
3600 category_table = check_category_table (category_table, Qnil);
3601 buf->category_table = category_table;
3602 /* Indicate that this buffer now has a specified category table. */
3603 buf->local_var_flags |= XINT (buffer_local_flags.category_table);
3604 return category_table;
3607 DEFUN ("category-designator-p", Fcategory_designator_p, 1, 1, 0, /*
3608 Return t if OBJECT is a category designator (a char in the range ' ' to '~').
3612 return CATEGORY_DESIGNATORP (object) ? Qt : Qnil;
3615 DEFUN ("category-table-value-p", Fcategory_table_value_p, 1, 1, 0, /*
3616 Return t if OBJECT is a category table value.
3617 Valid values are nil or a bit vector of size 95.
3621 return CATEGORY_TABLE_VALUEP (object) ? Qt : Qnil;
3625 #define CATEGORYP(x) \
3626 (CHARP (x) && XCHAR (x) >= 0x20 && XCHAR (x) <= 0x7E)
3628 #define CATEGORY_SET(c) \
3629 (get_char_table(c, XCHAR_TABLE(current_buffer->category_table)))
3631 /* Return 1 if CATEGORY_SET contains CATEGORY, else return 0.
3632 The faster version of `!NILP (Faref (category_set, category))'. */
3633 #define CATEGORY_MEMBER(category, category_set) \
3634 (bit_vector_bit(XBIT_VECTOR (category_set), category - 32))
3636 /* Return 1 if there is a word boundary between two word-constituent
3637 characters C1 and C2 if they appear in this order, else return 0.
3638 Use the macro WORD_BOUNDARY_P instead of calling this function
3641 int word_boundary_p (Emchar c1, Emchar c2);
3643 word_boundary_p (Emchar c1, Emchar c2)
3645 Lisp_Object category_set1, category_set2;
3650 if (COMPOSITE_CHAR_P (c1))
3651 c1 = cmpchar_component (c1, 0, 1);
3652 if (COMPOSITE_CHAR_P (c2))
3653 c2 = cmpchar_component (c2, 0, 1);
3656 if (EQ (CHAR_CHARSET (c1), CHAR_CHARSET (c2)))
3658 tail = Vword_separating_categories;
3663 tail = Vword_combining_categories;
3667 category_set1 = CATEGORY_SET (c1);
3668 if (NILP (category_set1))
3669 return default_result;
3670 category_set2 = CATEGORY_SET (c2);
3671 if (NILP (category_set2))
3672 return default_result;
3674 for (; CONSP (tail); tail = XCONS (tail)->cdr)
3676 Lisp_Object elt = XCONS(tail)->car;
3679 && CATEGORYP (XCONS (elt)->car)
3680 && CATEGORYP (XCONS (elt)->cdr)
3681 && CATEGORY_MEMBER (XCHAR (XCONS (elt)->car), category_set1)
3682 && CATEGORY_MEMBER (XCHAR (XCONS (elt)->cdr), category_set2))
3683 return !default_result;
3685 return default_result;
3691 syms_of_chartab (void)
3694 INIT_LRECORD_IMPLEMENTATION (uint8_byte_table);
3695 INIT_LRECORD_IMPLEMENTATION (uint16_byte_table);
3696 INIT_LRECORD_IMPLEMENTATION (byte_table);
3698 defsymbol (&Qto_ucs, "=>ucs");
3699 defsymbol (&Q_ucs, "->ucs");
3700 defsymbol (&Q_decomposition, "->decomposition");
3701 defsymbol (&Qcompat, "compat");
3702 defsymbol (&Qisolated, "isolated");
3703 defsymbol (&Qinitial, "initial");
3704 defsymbol (&Qmedial, "medial");
3705 defsymbol (&Qfinal, "final");
3706 defsymbol (&Qvertical, "vertical");
3707 defsymbol (&QnoBreak, "noBreak");
3708 defsymbol (&Qfraction, "fraction");
3709 defsymbol (&Qsuper, "super");
3710 defsymbol (&Qsub, "sub");
3711 defsymbol (&Qcircle, "circle");
3712 defsymbol (&Qsquare, "square");
3713 defsymbol (&Qwide, "wide");
3714 defsymbol (&Qnarrow, "narrow");
3715 defsymbol (&Qsmall, "small");
3716 defsymbol (&Qfont, "font");
3718 DEFSUBR (Fchar_attribute_list);
3719 DEFSUBR (Ffind_char_attribute_table);
3720 DEFSUBR (Fchar_attribute_alist);
3721 DEFSUBR (Fget_char_attribute);
3722 DEFSUBR (Fput_char_attribute);
3723 DEFSUBR (Fremove_char_attribute);
3724 DEFSUBR (Fmap_char_attribute);
3725 DEFSUBR (Fdefine_char);
3726 DEFSUBR (Ffind_char);
3727 DEFSUBR (Fchar_variants);
3729 DEFSUBR (Fget_composite_char);
3732 INIT_LRECORD_IMPLEMENTATION (char_table);
3736 INIT_LRECORD_IMPLEMENTATION (char_table_entry);
3739 defsymbol (&Qcategory_table_p, "category-table-p");
3740 defsymbol (&Qcategory_designator_p, "category-designator-p");
3741 defsymbol (&Qcategory_table_value_p, "category-table-value-p");
3744 defsymbol (&Qchar_table, "char-table");
3745 defsymbol (&Qchar_tablep, "char-table-p");
3747 DEFSUBR (Fchar_table_p);
3748 DEFSUBR (Fchar_table_type_list);
3749 DEFSUBR (Fvalid_char_table_type_p);
3750 DEFSUBR (Fchar_table_type);
3751 DEFSUBR (Freset_char_table);
3752 DEFSUBR (Fmake_char_table);
3753 DEFSUBR (Fcopy_char_table);
3754 DEFSUBR (Fget_char_table);
3755 DEFSUBR (Fget_range_char_table);
3756 DEFSUBR (Fvalid_char_table_value_p);
3757 DEFSUBR (Fcheck_valid_char_table_value);
3758 DEFSUBR (Fput_char_table);
3759 DEFSUBR (Fmap_char_table);
3762 DEFSUBR (Fcategory_table_p);
3763 DEFSUBR (Fcategory_table);
3764 DEFSUBR (Fstandard_category_table);
3765 DEFSUBR (Fcopy_category_table);
3766 DEFSUBR (Fset_category_table);
3767 DEFSUBR (Fcheck_category_at);
3768 DEFSUBR (Fchar_in_category_p);
3769 DEFSUBR (Fcategory_designator_p);
3770 DEFSUBR (Fcategory_table_value_p);
3776 vars_of_chartab (void)
3779 Vutf_2000_version = build_string("0.18 (Yamato-Koizumi)");
3780 DEFVAR_LISP ("utf-2000-version", &Vutf_2000_version /*
3781 Version number of XEmacs UTF-2000.
3784 staticpro (&Vcharacter_composition_table);
3785 Vcharacter_composition_table = make_char_id_table (Qnil);
3787 staticpro (&Vcharacter_variant_table);
3788 Vcharacter_variant_table = make_char_id_table (Qnil);
3790 /* DO NOT staticpro this. It works just like Vweak_hash_tables. */
3791 Vall_syntax_tables = Qnil;
3792 dump_add_weak_object_chain (&Vall_syntax_tables);
3796 structure_type_create_chartab (void)
3798 struct structure_type *st;
3800 st = define_structure_type (Qchar_table, 0, chartab_instantiate);
3802 define_structure_type_keyword (st, Qtype, chartab_type_validate);
3803 define_structure_type_keyword (st, Qdata, chartab_data_validate);
3807 complex_vars_of_chartab (void)
3810 staticpro (&Vchar_attribute_hash_table);
3811 Vchar_attribute_hash_table
3812 = make_lisp_hash_table (16, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
3813 #endif /* UTF2000 */
3815 /* Set this now, so first buffer creation can refer to it. */
3816 /* Make it nil before calling copy-category-table
3817 so that copy-category-table will know not to try to copy from garbage */
3818 Vstandard_category_table = Qnil;
3819 Vstandard_category_table = Fcopy_category_table (Qnil);
3820 staticpro (&Vstandard_category_table);
3822 DEFVAR_LISP ("word-combining-categories", &Vword_combining_categories /*
3823 List of pair (cons) of categories to determine word boundary.
3825 Emacs treats a sequence of word constituent characters as a single
3826 word (i.e. finds no word boundary between them) iff they belongs to
3827 the same charset. But, exceptions are allowed in the following cases.
3829 \(1) The case that characters are in different charsets is controlled
3830 by the variable `word-combining-categories'.
3832 Emacs finds no word boundary between characters of different charsets
3833 if they have categories matching some element of this list.
3835 More precisely, if an element of this list is a cons of category CAT1
3836 and CAT2, and a multibyte character C1 which has CAT1 is followed by
3837 C2 which has CAT2, there's no word boundary between C1 and C2.
3839 For instance, to tell that ASCII characters and Latin-1 characters can
3840 form a single word, the element `(?l . ?l)' should be in this list
3841 because both characters have the category `l' (Latin characters).
3843 \(2) The case that character are in the same charset is controlled by
3844 the variable `word-separating-categories'.
3846 Emacs find a word boundary between characters of the same charset
3847 if they have categories matching some element of this list.
3849 More precisely, if an element of this list is a cons of category CAT1
3850 and CAT2, and a multibyte character C1 which has CAT1 is followed by
3851 C2 which has CAT2, there's a word boundary between C1 and C2.
3853 For instance, to tell that there's a word boundary between Japanese
3854 Hiragana and Japanese Kanji (both are in the same charset), the
3855 element `(?H . ?C) should be in this list.
3858 Vword_combining_categories = Qnil;
3860 DEFVAR_LISP ("word-separating-categories", &Vword_separating_categories /*
3861 List of pair (cons) of categories to determine word boundary.
3862 See the documentation of the variable `word-combining-categories'.
3865 Vword_separating_categories = Qnil;