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);
74 map_char_id_table (Lisp_Char_Table *ct,
75 struct chartab_range *range,
76 int (*fn) (struct chartab_range *range,
77 Lisp_Object val, void *arg),
80 #define BT_UINT8_MIN 0
81 #define BT_UINT8_MAX (UCHAR_MAX - 3)
82 #define BT_UINT8_t (UCHAR_MAX - 2)
83 #define BT_UINT8_nil (UCHAR_MAX - 1)
84 #define BT_UINT8_unbound UCHAR_MAX
86 INLINE_HEADER int INT_UINT8_P (Lisp_Object obj);
87 INLINE_HEADER int UINT8_VALUE_P (Lisp_Object obj);
88 INLINE_HEADER unsigned char UINT8_ENCODE (Lisp_Object obj);
89 INLINE_HEADER Lisp_Object UINT8_DECODE (unsigned char n);
90 INLINE_HEADER unsigned short UINT8_TO_UINT16 (unsigned char n);
93 INT_UINT8_P (Lisp_Object obj)
99 return (BT_UINT8_MIN <= num) && (num <= BT_UINT8_MAX);
106 UINT8_VALUE_P (Lisp_Object obj)
108 return EQ (obj, Qunbound)
109 || EQ (obj, Qnil) || EQ (obj, Qt) || INT_UINT8_P (obj);
112 INLINE_HEADER unsigned char
113 UINT8_ENCODE (Lisp_Object obj)
115 if (EQ (obj, Qunbound))
116 return BT_UINT8_unbound;
117 else if (EQ (obj, Qnil))
119 else if (EQ (obj, Qt))
125 INLINE_HEADER Lisp_Object
126 UINT8_DECODE (unsigned char n)
128 if (n == BT_UINT8_unbound)
130 else if (n == BT_UINT8_nil)
132 else if (n == BT_UINT8_t)
139 mark_uint8_byte_table (Lisp_Object obj)
145 print_uint8_byte_table (Lisp_Object obj,
146 Lisp_Object printcharfun, int escapeflag)
148 Lisp_Uint8_Byte_Table *bte = XUINT8_BYTE_TABLE (obj);
150 struct gcpro gcpro1, gcpro2;
151 GCPRO2 (obj, printcharfun);
153 write_c_string ("\n#<uint8-byte-table", printcharfun);
154 for (i = 0; i < 256; i++)
156 unsigned char n = bte->property[i];
158 write_c_string ("\n ", printcharfun);
159 write_c_string (" ", printcharfun);
160 if (n == BT_UINT8_unbound)
161 write_c_string ("void", printcharfun);
162 else if (n == BT_UINT8_nil)
163 write_c_string ("nil", printcharfun);
164 else if (n == BT_UINT8_t)
165 write_c_string ("t", printcharfun);
170 sprintf (buf, "%hd", n);
171 write_c_string (buf, printcharfun);
175 write_c_string (">", printcharfun);
179 uint8_byte_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
181 Lisp_Uint8_Byte_Table *te1 = XUINT8_BYTE_TABLE (obj1);
182 Lisp_Uint8_Byte_Table *te2 = XUINT8_BYTE_TABLE (obj2);
185 for (i = 0; i < 256; i++)
186 if (te1->property[i] != te2->property[i])
192 uint8_byte_table_hash (Lisp_Object obj, int depth)
194 Lisp_Uint8_Byte_Table *te = XUINT8_BYTE_TABLE (obj);
198 for (i = 0; i < 256; i++)
199 hash = HASH2 (hash, te->property[i]);
203 DEFINE_LRECORD_IMPLEMENTATION ("uint8-byte-table", uint8_byte_table,
204 mark_uint8_byte_table,
205 print_uint8_byte_table,
206 0, uint8_byte_table_equal,
207 uint8_byte_table_hash,
208 0 /* uint8_byte_table_description */,
209 Lisp_Uint8_Byte_Table);
212 make_uint8_byte_table (unsigned char initval)
216 Lisp_Uint8_Byte_Table *cte;
218 cte = alloc_lcrecord_type (Lisp_Uint8_Byte_Table,
219 &lrecord_uint8_byte_table);
221 for (i = 0; i < 256; i++)
222 cte->property[i] = initval;
224 XSETUINT8_BYTE_TABLE (obj, cte);
229 copy_uint8_byte_table (Lisp_Object entry)
231 Lisp_Uint8_Byte_Table *cte = XUINT8_BYTE_TABLE (entry);
234 Lisp_Uint8_Byte_Table *ctenew
235 = alloc_lcrecord_type (Lisp_Uint8_Byte_Table,
236 &lrecord_uint8_byte_table);
238 for (i = 0; i < 256; i++)
240 ctenew->property[i] = cte->property[i];
243 XSETUINT8_BYTE_TABLE (obj, ctenew);
248 uint8_byte_table_same_value_p (Lisp_Object obj)
250 Lisp_Uint8_Byte_Table *bte = XUINT8_BYTE_TABLE (obj);
251 unsigned char v0 = bte->property[0];
254 for (i = 1; i < 256; i++)
256 if (bte->property[i] != v0)
263 map_over_uint8_byte_table (Lisp_Uint8_Byte_Table *ct, Emchar ofs, int place,
265 int (*fn) (struct chartab_range *range,
266 Lisp_Object val, void *arg),
269 struct chartab_range rainj;
271 int unit = 1 << (8 * place);
275 rainj.type = CHARTAB_RANGE_CHAR;
277 for (i = 0, retval = 0; i < 256 && retval == 0; i++)
279 if (ct->property[i] != BT_UINT8_unbound)
282 for (; c < c1 && retval == 0; c++)
284 if ( NILP (ccs) || charset_code_point (ccs, c) >= 0 )
287 retval = (fn) (&rainj, UINT8_DECODE (ct->property[i]), arg);
297 #define BT_UINT16_MIN 0
298 #define BT_UINT16_MAX (USHRT_MAX - 3)
299 #define BT_UINT16_t (USHRT_MAX - 2)
300 #define BT_UINT16_nil (USHRT_MAX - 1)
301 #define BT_UINT16_unbound USHRT_MAX
303 INLINE_HEADER int INT_UINT16_P (Lisp_Object obj);
304 INLINE_HEADER int UINT16_VALUE_P (Lisp_Object obj);
305 INLINE_HEADER unsigned short UINT16_ENCODE (Lisp_Object obj);
306 INLINE_HEADER Lisp_Object UINT16_DECODE (unsigned short us);
309 INT_UINT16_P (Lisp_Object obj)
313 int num = XINT (obj);
315 return (BT_UINT16_MIN <= num) && (num <= BT_UINT16_MAX);
322 UINT16_VALUE_P (Lisp_Object obj)
324 return EQ (obj, Qunbound)
325 || EQ (obj, Qnil) || EQ (obj, Qt) || INT_UINT16_P (obj);
328 INLINE_HEADER unsigned short
329 UINT16_ENCODE (Lisp_Object obj)
331 if (EQ (obj, Qunbound))
332 return BT_UINT16_unbound;
333 else if (EQ (obj, Qnil))
334 return BT_UINT16_nil;
335 else if (EQ (obj, Qt))
341 INLINE_HEADER Lisp_Object
342 UINT16_DECODE (unsigned short n)
344 if (n == BT_UINT16_unbound)
346 else if (n == BT_UINT16_nil)
348 else if (n == BT_UINT16_t)
354 INLINE_HEADER unsigned short
355 UINT8_TO_UINT16 (unsigned char n)
357 if (n == BT_UINT8_unbound)
358 return BT_UINT16_unbound;
359 else if (n == BT_UINT8_nil)
360 return BT_UINT16_nil;
361 else if (n == BT_UINT8_t)
368 mark_uint16_byte_table (Lisp_Object obj)
374 print_uint16_byte_table (Lisp_Object obj,
375 Lisp_Object printcharfun, int escapeflag)
377 Lisp_Uint16_Byte_Table *bte = XUINT16_BYTE_TABLE (obj);
379 struct gcpro gcpro1, gcpro2;
380 GCPRO2 (obj, printcharfun);
382 write_c_string ("\n#<uint16-byte-table", printcharfun);
383 for (i = 0; i < 256; i++)
385 unsigned short n = bte->property[i];
387 write_c_string ("\n ", printcharfun);
388 write_c_string (" ", printcharfun);
389 if (n == BT_UINT16_unbound)
390 write_c_string ("void", printcharfun);
391 else if (n == BT_UINT16_nil)
392 write_c_string ("nil", printcharfun);
393 else if (n == BT_UINT16_t)
394 write_c_string ("t", printcharfun);
399 sprintf (buf, "%hd", n);
400 write_c_string (buf, printcharfun);
404 write_c_string (">", printcharfun);
408 uint16_byte_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
410 Lisp_Uint16_Byte_Table *te1 = XUINT16_BYTE_TABLE (obj1);
411 Lisp_Uint16_Byte_Table *te2 = XUINT16_BYTE_TABLE (obj2);
414 for (i = 0; i < 256; i++)
415 if (te1->property[i] != te2->property[i])
421 uint16_byte_table_hash (Lisp_Object obj, int depth)
423 Lisp_Uint16_Byte_Table *te = XUINT16_BYTE_TABLE (obj);
427 for (i = 0; i < 256; i++)
428 hash = HASH2 (hash, te->property[i]);
432 DEFINE_LRECORD_IMPLEMENTATION ("uint16-byte-table", uint16_byte_table,
433 mark_uint16_byte_table,
434 print_uint16_byte_table,
435 0, uint16_byte_table_equal,
436 uint16_byte_table_hash,
437 0 /* uint16_byte_table_description */,
438 Lisp_Uint16_Byte_Table);
441 make_uint16_byte_table (unsigned short initval)
445 Lisp_Uint16_Byte_Table *cte;
447 cte = alloc_lcrecord_type (Lisp_Uint16_Byte_Table,
448 &lrecord_uint16_byte_table);
450 for (i = 0; i < 256; i++)
451 cte->property[i] = initval;
453 XSETUINT16_BYTE_TABLE (obj, cte);
458 copy_uint16_byte_table (Lisp_Object entry)
460 Lisp_Uint16_Byte_Table *cte = XUINT16_BYTE_TABLE (entry);
463 Lisp_Uint16_Byte_Table *ctenew
464 = alloc_lcrecord_type (Lisp_Uint16_Byte_Table,
465 &lrecord_uint16_byte_table);
467 for (i = 0; i < 256; i++)
469 ctenew->property[i] = cte->property[i];
472 XSETUINT16_BYTE_TABLE (obj, ctenew);
477 expand_uint8_byte_table_to_uint16 (Lisp_Object table)
481 Lisp_Uint8_Byte_Table* bte = XUINT8_BYTE_TABLE(table);
482 Lisp_Uint16_Byte_Table* cte;
484 cte = alloc_lcrecord_type (Lisp_Uint16_Byte_Table,
485 &lrecord_uint16_byte_table);
486 for (i = 0; i < 256; i++)
488 cte->property[i] = UINT8_TO_UINT16 (bte->property[i]);
490 XSETUINT16_BYTE_TABLE (obj, cte);
495 uint16_byte_table_same_value_p (Lisp_Object obj)
497 Lisp_Uint16_Byte_Table *bte = XUINT16_BYTE_TABLE (obj);
498 unsigned short v0 = bte->property[0];
501 for (i = 1; i < 256; i++)
503 if (bte->property[i] != v0)
510 map_over_uint16_byte_table (Lisp_Uint16_Byte_Table *ct, Emchar ofs, int place,
512 int (*fn) (struct chartab_range *range,
513 Lisp_Object val, void *arg),
516 struct chartab_range rainj;
518 int unit = 1 << (8 * place);
522 rainj.type = CHARTAB_RANGE_CHAR;
524 for (i = 0, retval = 0; i < 256 && retval == 0; i++)
526 if (ct->property[i] != BT_UINT16_unbound)
529 for (; c < c1 && retval == 0; c++)
531 if ( NILP (ccs) || charset_code_point (ccs, c) >= 0 )
534 retval = (fn) (&rainj, UINT16_DECODE (ct->property[i]),
547 mark_byte_table (Lisp_Object obj)
549 Lisp_Byte_Table *cte = XBYTE_TABLE (obj);
552 for (i = 0; i < 256; i++)
554 mark_object (cte->property[i]);
560 print_byte_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
562 Lisp_Byte_Table *bte = XBYTE_TABLE (obj);
564 struct gcpro gcpro1, gcpro2;
565 GCPRO2 (obj, printcharfun);
567 write_c_string ("\n#<byte-table", printcharfun);
568 for (i = 0; i < 256; i++)
570 Lisp_Object elt = bte->property[i];
572 write_c_string ("\n ", printcharfun);
573 write_c_string (" ", printcharfun);
574 if (EQ (elt, Qunbound))
575 write_c_string ("void", printcharfun);
577 print_internal (elt, printcharfun, escapeflag);
580 write_c_string (">", printcharfun);
584 byte_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
586 Lisp_Byte_Table *cte1 = XBYTE_TABLE (obj1);
587 Lisp_Byte_Table *cte2 = XBYTE_TABLE (obj2);
590 for (i = 0; i < 256; i++)
591 if (BYTE_TABLE_P (cte1->property[i]))
593 if (BYTE_TABLE_P (cte2->property[i]))
595 if (!byte_table_equal (cte1->property[i],
596 cte2->property[i], depth + 1))
603 if (!internal_equal (cte1->property[i], cte2->property[i], depth + 1))
609 byte_table_hash (Lisp_Object obj, int depth)
611 Lisp_Byte_Table *cte = XBYTE_TABLE (obj);
613 return internal_array_hash (cte->property, 256, depth);
616 static const struct lrecord_description byte_table_description[] = {
617 { XD_LISP_OBJECT_ARRAY, offsetof(Lisp_Byte_Table, property), 256 },
621 DEFINE_LRECORD_IMPLEMENTATION ("byte-table", byte_table,
626 byte_table_description,
630 make_byte_table (Lisp_Object initval)
634 Lisp_Byte_Table *cte;
636 cte = alloc_lcrecord_type (Lisp_Byte_Table, &lrecord_byte_table);
638 for (i = 0; i < 256; i++)
639 cte->property[i] = initval;
641 XSETBYTE_TABLE (obj, cte);
646 copy_byte_table (Lisp_Object entry)
648 Lisp_Byte_Table *cte = XBYTE_TABLE (entry);
651 Lisp_Byte_Table *ctnew
652 = alloc_lcrecord_type (Lisp_Byte_Table, &lrecord_byte_table);
654 for (i = 0; i < 256; i++)
656 if (UINT8_BYTE_TABLE_P (cte->property[i]))
658 ctnew->property[i] = copy_uint8_byte_table (cte->property[i]);
660 else if (UINT16_BYTE_TABLE_P (cte->property[i]))
662 ctnew->property[i] = copy_uint16_byte_table (cte->property[i]);
664 else if (BYTE_TABLE_P (cte->property[i]))
666 ctnew->property[i] = copy_byte_table (cte->property[i]);
669 ctnew->property[i] = cte->property[i];
672 XSETBYTE_TABLE (obj, ctnew);
677 byte_table_same_value_p (Lisp_Object obj)
679 Lisp_Byte_Table *bte = XBYTE_TABLE (obj);
680 Lisp_Object v0 = bte->property[0];
683 for (i = 1; i < 256; i++)
685 if (!internal_equal (bte->property[i], v0, 0))
692 map_over_byte_table (Lisp_Byte_Table *ct, Emchar ofs, int place,
694 int (*fn) (struct chartab_range *range,
695 Lisp_Object val, void *arg),
700 int unit = 1 << (8 * place);
703 for (i = 0, retval = 0; i < 256 && retval == 0; i++)
706 if (UINT8_BYTE_TABLE_P (v))
709 = map_over_uint8_byte_table (XUINT8_BYTE_TABLE(v),
710 c, place - 1, ccs, fn, arg);
713 else if (UINT16_BYTE_TABLE_P (v))
716 = map_over_uint16_byte_table (XUINT16_BYTE_TABLE(v),
717 c, place - 1, ccs, fn, arg);
720 else if (BYTE_TABLE_P (v))
722 retval = map_over_byte_table (XBYTE_TABLE(v),
723 c, place - 1, ccs, fn, arg);
726 else if (!UNBOUNDP (v))
728 struct chartab_range rainj;
729 Emchar c1 = c + unit;
731 rainj.type = CHARTAB_RANGE_CHAR;
733 for (; c < c1 && retval == 0; c++)
735 if ( NILP (ccs) || charset_code_point (ccs, c) >= 0 )
738 retval = (fn) (&rainj, v, arg);
750 get_byte_table (Lisp_Object table, unsigned char idx)
752 if (UINT8_BYTE_TABLE_P (table))
753 return UINT8_DECODE (XUINT8_BYTE_TABLE(table)->property[idx]);
754 else if (UINT16_BYTE_TABLE_P (table))
755 return UINT16_DECODE (XUINT16_BYTE_TABLE(table)->property[idx]);
756 else if (BYTE_TABLE_P (table))
757 return XBYTE_TABLE(table)->property[idx];
763 put_byte_table (Lisp_Object table, unsigned char idx, Lisp_Object value)
765 if (UINT8_BYTE_TABLE_P (table))
767 if (UINT8_VALUE_P (value))
769 XUINT8_BYTE_TABLE(table)->property[idx] = UINT8_ENCODE (value);
770 if (!UINT8_BYTE_TABLE_P (value) &&
771 !UINT16_BYTE_TABLE_P (value) && !BYTE_TABLE_P (value)
772 && uint8_byte_table_same_value_p (table))
777 else if (UINT16_VALUE_P (value))
779 Lisp_Object new = expand_uint8_byte_table_to_uint16 (table);
781 XUINT16_BYTE_TABLE(new)->property[idx] = UINT16_ENCODE (value);
786 Lisp_Object new = make_byte_table (Qnil);
789 for (i = 0; i < 256; i++)
791 XBYTE_TABLE(new)->property[i]
792 = UINT8_DECODE (XUINT8_BYTE_TABLE(table)->property[i]);
794 XBYTE_TABLE(new)->property[idx] = value;
798 else if (UINT16_BYTE_TABLE_P (table))
800 if (UINT16_VALUE_P (value))
802 XUINT16_BYTE_TABLE(table)->property[idx] = UINT16_ENCODE (value);
803 if (!UINT8_BYTE_TABLE_P (value) &&
804 !UINT16_BYTE_TABLE_P (value) && !BYTE_TABLE_P (value)
805 && uint16_byte_table_same_value_p (table))
812 Lisp_Object new = make_byte_table (Qnil);
815 for (i = 0; i < 256; i++)
817 XBYTE_TABLE(new)->property[i]
818 = UINT16_DECODE (XUINT16_BYTE_TABLE(table)->property[i]);
820 XBYTE_TABLE(new)->property[idx] = value;
824 else if (BYTE_TABLE_P (table))
826 XBYTE_TABLE(table)->property[idx] = value;
827 if (!UINT8_BYTE_TABLE_P (value) &&
828 !UINT16_BYTE_TABLE_P (value) && !BYTE_TABLE_P (value)
829 && byte_table_same_value_p (table))
834 else if (!internal_equal (table, value, 0))
836 if (UINT8_VALUE_P (table) && UINT8_VALUE_P (value))
838 table = make_uint8_byte_table (UINT8_ENCODE (table));
839 XUINT8_BYTE_TABLE(table)->property[idx] = UINT8_ENCODE (value);
841 else if (UINT16_VALUE_P (table) && UINT16_VALUE_P (value))
843 table = make_uint16_byte_table (UINT16_ENCODE (table));
844 XUINT16_BYTE_TABLE(table)->property[idx] = UINT16_ENCODE (value);
848 table = make_byte_table (table);
849 XBYTE_TABLE(table)->property[idx] = value;
857 make_char_id_table (Lisp_Object initval)
860 obj = Fmake_char_table (Qgeneric);
861 fill_char_table (XCHAR_TABLE (obj), initval);
866 get_char_id_table (Lisp_Char_Table* cit, Emchar ch)
868 Lisp_Object val = get_byte_table (get_byte_table
872 (unsigned char)(ch >> 24)),
873 (unsigned char) (ch >> 16)),
874 (unsigned char) (ch >> 8)),
877 return cit->default_value;
883 put_char_id_table (Lisp_Char_Table* cit,
884 Lisp_Object character, Lisp_Object value)
886 struct chartab_range range;
888 decode_char_table_range (character, &range);
891 case CHARTAB_RANGE_ALL:
894 case CHARTAB_RANGE_DEFAULT:
895 cit->default_value = value;
897 case CHARTAB_RANGE_CHARSET:
900 Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (range.charset);
902 if ( CHAR_TABLEP (encoding_table) )
904 for (c = 0; c < 1 << 24; c++)
906 if ( INTP (get_char_id_table (XCHAR_TABLE(encoding_table),
908 put_char_id_table_0 (cit, c, value);
913 for (c = 0; c < 1 << 24; c++)
915 if ( charset_code_point (range.charset, c) >= 0 )
916 put_char_id_table_0 (cit, c, value);
921 case CHARTAB_RANGE_ROW:
923 int cell_min, cell_max, i;
925 if (XCHARSET_DIMENSION (range.charset) < 2)
926 signal_simple_error ("Charset in row vector must be multi-byte",
930 switch (XCHARSET_CHARS (range.charset))
933 cell_min = 33; cell_max = 126;
936 cell_min = 32; cell_max = 127;
939 cell_min = 0; cell_max = 127;
942 cell_min = 0; cell_max = 255;
948 if (XCHARSET_DIMENSION (range.charset) == 2)
949 check_int_range (range.row, cell_min, cell_max);
950 else if (XCHARSET_DIMENSION (range.charset) == 3)
952 check_int_range (range.row >> 8 , cell_min, cell_max);
953 check_int_range (range.row & 0xFF, cell_min, cell_max);
955 else if (XCHARSET_DIMENSION (range.charset) == 4)
957 check_int_range ( range.row >> 16 , cell_min, cell_max);
958 check_int_range ((range.row >> 8) & 0xFF, cell_min, cell_max);
959 check_int_range ( range.row & 0xFF, cell_min, cell_max);
964 for (i = cell_min; i <= cell_max; i++)
966 Emchar ch = DECODE_CHAR (range.charset, (range.row << 8) | i);
967 if ( charset_code_point (range.charset, ch) >= 0 )
968 put_char_id_table_0 (cit, ch, value);
972 case CHARTAB_RANGE_CHAR:
973 put_char_id_table_0 (cit, range.ch, value);
978 /* Map FN (with client data ARG) in char table CT.
979 Mapping stops the first time FN returns non-zero, and that value
980 becomes the return value of map_char_id_table(). */
982 map_char_id_table (Lisp_Char_Table *ct,
983 struct chartab_range *range,
984 int (*fn) (struct chartab_range *range,
985 Lisp_Object val, void *arg),
988 Lisp_Object v = ct->table;
992 case CHARTAB_RANGE_ALL:
993 if (UINT8_BYTE_TABLE_P (v))
994 return map_over_uint8_byte_table (XUINT8_BYTE_TABLE(v), 0, 3,
996 else if (UINT16_BYTE_TABLE_P (v))
997 return map_over_uint16_byte_table (XUINT16_BYTE_TABLE(v), 0, 3,
999 else if (BYTE_TABLE_P (v))
1000 return map_over_byte_table (XBYTE_TABLE(v), 0, 3, Qnil, fn, arg);
1001 else if (!UNBOUNDP (v))
1003 struct chartab_range rainj;
1006 Emchar c1 = c + unit;
1009 rainj.type = CHARTAB_RANGE_CHAR;
1011 for (retval = 0; c < c1 && retval == 0; c++)
1014 retval = (fn) (&rainj, v, arg);
1018 case CHARTAB_RANGE_CHARSET:
1019 if (UINT8_BYTE_TABLE_P (v))
1020 return map_over_uint8_byte_table (XUINT8_BYTE_TABLE(v), 0, 3,
1021 range->charset, fn, arg);
1022 else if (UINT16_BYTE_TABLE_P (v))
1023 return map_over_uint16_byte_table (XUINT16_BYTE_TABLE(v), 0, 3,
1024 range->charset, fn, arg);
1025 else if (BYTE_TABLE_P (v))
1026 return map_over_byte_table (XBYTE_TABLE(v), 0, 3,
1027 range->charset, fn, arg);
1028 else if (!UNBOUNDP (v))
1030 struct chartab_range rainj;
1033 Emchar c1 = c + unit;
1036 rainj.type = CHARTAB_RANGE_CHAR;
1038 for (retval = 0; c < c1 && retval == 0; c++)
1040 if ( charset_code_point (range->charset, c) >= 0 )
1043 retval = (fn) (&rainj, v, arg);
1048 case CHARTAB_RANGE_ROW:
1050 int cell_min, cell_max, i;
1052 struct chartab_range rainj;
1054 if (XCHARSET_DIMENSION (range->charset) < 2)
1055 signal_simple_error ("Charset in row vector must be multi-byte",
1059 switch (XCHARSET_CHARS (range->charset))
1062 cell_min = 33; cell_max = 126;
1065 cell_min = 32; cell_max = 127;
1068 cell_min = 0; cell_max = 127;
1071 cell_min = 0; cell_max = 255;
1077 if (XCHARSET_DIMENSION (range->charset) == 2)
1078 check_int_range (range->row, cell_min, cell_max);
1079 else if (XCHARSET_DIMENSION (range->charset) == 3)
1081 check_int_range (range->row >> 8 , cell_min, cell_max);
1082 check_int_range (range->row & 0xFF, cell_min, cell_max);
1084 else if (XCHARSET_DIMENSION (range->charset) == 4)
1086 check_int_range ( range->row >> 16 , cell_min, cell_max);
1087 check_int_range ((range->row >> 8) & 0xFF, cell_min, cell_max);
1088 check_int_range ( range->row & 0xFF, cell_min, cell_max);
1093 rainj.type = CHARTAB_RANGE_CHAR;
1094 for (retval =0, i = cell_min; i <= cell_max && retval == 0; i++)
1096 Emchar ch = DECODE_CHAR (range->charset, (range->row << 8) | i);
1098 = get_byte_table (get_byte_table
1102 (unsigned char)(ch >> 24)),
1103 (unsigned char) (ch >> 16)),
1104 (unsigned char) (ch >> 8)),
1105 (unsigned char) ch);
1107 if (!UNBOUNDP (val))
1110 retval = (fn) (&rainj, val, arg);
1115 case CHARTAB_RANGE_CHAR:
1117 Emchar ch = range->ch;
1119 = get_byte_table (get_byte_table
1123 (unsigned char)(ch >> 24)),
1124 (unsigned char) (ch >> 16)),
1125 (unsigned char) (ch >> 8)),
1126 (unsigned char) ch);
1127 struct chartab_range rainj;
1129 if (!UNBOUNDP (val))
1131 rainj.type = CHARTAB_RANGE_CHAR;
1133 return (fn) (&rainj, val, arg);
1145 Lisp_Object Vcharacter_composition_table;
1146 Lisp_Object Vcharacter_variant_table;
1149 Lisp_Object Q_decomposition;
1150 Lisp_Object Qto_ucs;
1152 Lisp_Object Qcompat;
1153 Lisp_Object Qisolated;
1154 Lisp_Object Qinitial;
1155 Lisp_Object Qmedial;
1157 Lisp_Object Qvertical;
1158 Lisp_Object QnoBreak;
1159 Lisp_Object Qfraction;
1162 Lisp_Object Qcircle;
1163 Lisp_Object Qsquare;
1165 Lisp_Object Qnarrow;
1169 Emchar to_char_id (Lisp_Object v, char* err_msg, Lisp_Object err_arg);
1172 to_char_id (Lisp_Object v, char* err_msg, Lisp_Object err_arg)
1178 else if (EQ (v, Qcompat))
1180 else if (EQ (v, Qisolated))
1182 else if (EQ (v, Qinitial))
1184 else if (EQ (v, Qmedial))
1186 else if (EQ (v, Qfinal))
1188 else if (EQ (v, Qvertical))
1190 else if (EQ (v, QnoBreak))
1192 else if (EQ (v, Qfraction))
1194 else if (EQ (v, Qsuper))
1196 else if (EQ (v, Qsub))
1198 else if (EQ (v, Qcircle))
1200 else if (EQ (v, Qsquare))
1202 else if (EQ (v, Qwide))
1204 else if (EQ (v, Qnarrow))
1206 else if (EQ (v, Qsmall))
1208 else if (EQ (v, Qfont))
1211 signal_simple_error (err_msg, err_arg);
1214 DEFUN ("get-composite-char", Fget_composite_char, 1, 1, 0, /*
1215 Return character corresponding with list.
1219 Lisp_Object table = Vcharacter_composition_table;
1220 Lisp_Object rest = list;
1222 while (CONSP (rest))
1224 Lisp_Object v = Fcar (rest);
1226 Emchar c = to_char_id (v, "Invalid value for composition", list);
1228 ret = get_char_id_table (XCHAR_TABLE(table), c);
1233 if (!CHAR_TABLEP (ret))
1238 else if (!CONSP (rest))
1240 else if (CHAR_TABLEP (ret))
1243 signal_simple_error ("Invalid table is found with", list);
1245 signal_simple_error ("Invalid value for composition", list);
1248 DEFUN ("char-variants", Fchar_variants, 1, 1, 0, /*
1249 Return variants of CHARACTER.
1253 CHECK_CHAR (character);
1254 return Fcopy_list (get_char_id_table
1255 (XCHAR_TABLE(Vcharacter_variant_table),
1256 XCHAR (character)));
1262 /* A char table maps from ranges of characters to values.
1264 Implementing a general data structure that maps from arbitrary
1265 ranges of numbers to values is tricky to do efficiently. As it
1266 happens, it should suffice (and is usually more convenient, anyway)
1267 when dealing with characters to restrict the sorts of ranges that
1268 can be assigned values, as follows:
1271 2) All characters in a charset.
1272 3) All characters in a particular row of a charset, where a "row"
1273 means all characters with the same first byte.
1274 4) A particular character in a charset.
1276 We use char tables to generalize the 256-element vectors now
1277 littering the Emacs code.
1279 Possible uses (all should be converted at some point):
1285 5) keyboard-translate-table?
1288 abstract type to generalize the Emacs vectors and Mule
1289 vectors-of-vectors goo.
1292 /************************************************************************/
1293 /* Char Table object */
1294 /************************************************************************/
1296 #if defined(MULE)&&!defined(UTF2000)
1299 mark_char_table_entry (Lisp_Object obj)
1301 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj);
1304 for (i = 0; i < 96; i++)
1306 mark_object (cte->level2[i]);
1312 char_table_entry_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
1314 Lisp_Char_Table_Entry *cte1 = XCHAR_TABLE_ENTRY (obj1);
1315 Lisp_Char_Table_Entry *cte2 = XCHAR_TABLE_ENTRY (obj2);
1318 for (i = 0; i < 96; i++)
1319 if (!internal_equal (cte1->level2[i], cte2->level2[i], depth + 1))
1325 static unsigned long
1326 char_table_entry_hash (Lisp_Object obj, int depth)
1328 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj);
1330 return internal_array_hash (cte->level2, 96, depth);
1333 static const struct lrecord_description char_table_entry_description[] = {
1334 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table_Entry, level2), 96 },
1338 DEFINE_LRECORD_IMPLEMENTATION ("char-table-entry", char_table_entry,
1339 mark_char_table_entry, internal_object_printer,
1340 0, char_table_entry_equal,
1341 char_table_entry_hash,
1342 char_table_entry_description,
1343 Lisp_Char_Table_Entry);
1347 mark_char_table (Lisp_Object obj)
1349 Lisp_Char_Table *ct = XCHAR_TABLE (obj);
1352 mark_object (ct->table);
1356 for (i = 0; i < NUM_ASCII_CHARS; i++)
1357 mark_object (ct->ascii[i]);
1359 for (i = 0; i < NUM_LEADING_BYTES; i++)
1360 mark_object (ct->level1[i]);
1364 return ct->default_value;
1366 return ct->mirror_table;
1370 /* WARNING: All functions of this nature need to be written extremely
1371 carefully to avoid crashes during GC. Cf. prune_specifiers()
1372 and prune_weak_hash_tables(). */
1375 prune_syntax_tables (void)
1377 Lisp_Object rest, prev = Qnil;
1379 for (rest = Vall_syntax_tables;
1381 rest = XCHAR_TABLE (rest)->next_table)
1383 if (! marked_p (rest))
1385 /* This table is garbage. Remove it from the list. */
1387 Vall_syntax_tables = XCHAR_TABLE (rest)->next_table;
1389 XCHAR_TABLE (prev)->next_table =
1390 XCHAR_TABLE (rest)->next_table;
1396 char_table_type_to_symbol (enum char_table_type type)
1401 case CHAR_TABLE_TYPE_GENERIC: return Qgeneric;
1402 case CHAR_TABLE_TYPE_SYNTAX: return Qsyntax;
1403 case CHAR_TABLE_TYPE_DISPLAY: return Qdisplay;
1404 case CHAR_TABLE_TYPE_CHAR: return Qchar;
1406 case CHAR_TABLE_TYPE_CATEGORY: return Qcategory;
1411 static enum char_table_type
1412 symbol_to_char_table_type (Lisp_Object symbol)
1414 CHECK_SYMBOL (symbol);
1416 if (EQ (symbol, Qgeneric)) return CHAR_TABLE_TYPE_GENERIC;
1417 if (EQ (symbol, Qsyntax)) return CHAR_TABLE_TYPE_SYNTAX;
1418 if (EQ (symbol, Qdisplay)) return CHAR_TABLE_TYPE_DISPLAY;
1419 if (EQ (symbol, Qchar)) return CHAR_TABLE_TYPE_CHAR;
1421 if (EQ (symbol, Qcategory)) return CHAR_TABLE_TYPE_CATEGORY;
1424 signal_simple_error ("Unrecognized char table type", symbol);
1425 return CHAR_TABLE_TYPE_GENERIC; /* not reached */
1429 print_chartab_range (Emchar first, Emchar last, Lisp_Object val,
1430 Lisp_Object printcharfun)
1434 write_c_string (" (", printcharfun);
1435 print_internal (make_char (first), printcharfun, 0);
1436 write_c_string (" ", printcharfun);
1437 print_internal (make_char (last), printcharfun, 0);
1438 write_c_string (") ", printcharfun);
1442 write_c_string (" ", printcharfun);
1443 print_internal (make_char (first), printcharfun, 0);
1444 write_c_string (" ", printcharfun);
1446 print_internal (val, printcharfun, 1);
1449 #if defined(MULE)&&!defined(UTF2000)
1452 print_chartab_charset_row (Lisp_Object charset,
1454 Lisp_Char_Table_Entry *cte,
1455 Lisp_Object printcharfun)
1458 Lisp_Object cat = Qunbound;
1461 for (i = 32; i < 128; i++)
1463 Lisp_Object pam = cte->level2[i - 32];
1475 print_chartab_range (MAKE_CHAR (charset, first, 0),
1476 MAKE_CHAR (charset, i - 1, 0),
1479 print_chartab_range (MAKE_CHAR (charset, row, first),
1480 MAKE_CHAR (charset, row, i - 1),
1490 print_chartab_range (MAKE_CHAR (charset, first, 0),
1491 MAKE_CHAR (charset, i - 1, 0),
1494 print_chartab_range (MAKE_CHAR (charset, row, first),
1495 MAKE_CHAR (charset, row, i - 1),
1501 print_chartab_two_byte_charset (Lisp_Object charset,
1502 Lisp_Char_Table_Entry *cte,
1503 Lisp_Object printcharfun)
1507 for (i = 32; i < 128; i++)
1509 Lisp_Object jen = cte->level2[i - 32];
1511 if (!CHAR_TABLE_ENTRYP (jen))
1515 write_c_string (" [", printcharfun);
1516 print_internal (XCHARSET_NAME (charset), printcharfun, 0);
1517 sprintf (buf, " %d] ", i);
1518 write_c_string (buf, printcharfun);
1519 print_internal (jen, printcharfun, 0);
1522 print_chartab_charset_row (charset, i, XCHAR_TABLE_ENTRY (jen),
1530 print_char_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1532 Lisp_Char_Table *ct = XCHAR_TABLE (obj);
1535 struct gcpro gcpro1, gcpro2;
1536 GCPRO2 (obj, printcharfun);
1538 write_c_string ("#s(char-table ", printcharfun);
1539 write_c_string (" ", printcharfun);
1540 write_c_string (string_data
1542 (XSYMBOL (char_table_type_to_symbol (ct->type)))),
1544 write_c_string ("\n ", printcharfun);
1545 print_internal (ct->default_value, printcharfun, escapeflag);
1546 for (i = 0; i < 256; i++)
1548 Lisp_Object elt = get_byte_table (ct->table, i);
1549 if (i != 0) write_c_string ("\n ", printcharfun);
1550 if (EQ (elt, Qunbound))
1551 write_c_string ("void", printcharfun);
1553 print_internal (elt, printcharfun, escapeflag);
1556 #else /* non UTF2000 */
1559 sprintf (buf, "#s(char-table type %s data (",
1560 string_data (symbol_name (XSYMBOL
1561 (char_table_type_to_symbol (ct->type)))));
1562 write_c_string (buf, printcharfun);
1564 /* Now write out the ASCII/Control-1 stuff. */
1568 Lisp_Object val = Qunbound;
1570 for (i = 0; i < NUM_ASCII_CHARS; i++)
1579 if (!EQ (ct->ascii[i], val))
1581 print_chartab_range (first, i - 1, val, printcharfun);
1588 print_chartab_range (first, i - 1, val, printcharfun);
1595 for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES;
1598 Lisp_Object ann = ct->level1[i - MIN_LEADING_BYTE];
1599 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (i);
1601 if (!CHARSETP (charset) || i == LEADING_BYTE_ASCII
1602 || i == LEADING_BYTE_CONTROL_1)
1604 if (!CHAR_TABLE_ENTRYP (ann))
1606 write_c_string (" ", printcharfun);
1607 print_internal (XCHARSET_NAME (charset),
1609 write_c_string (" ", printcharfun);
1610 print_internal (ann, printcharfun, 0);
1614 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (ann);
1615 if (XCHARSET_DIMENSION (charset) == 1)
1616 print_chartab_charset_row (charset, -1, cte, printcharfun);
1618 print_chartab_two_byte_charset (charset, cte, printcharfun);
1623 #endif /* non UTF2000 */
1625 write_c_string ("))", printcharfun);
1629 char_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
1631 Lisp_Char_Table *ct1 = XCHAR_TABLE (obj1);
1632 Lisp_Char_Table *ct2 = XCHAR_TABLE (obj2);
1635 if (CHAR_TABLE_TYPE (ct1) != CHAR_TABLE_TYPE (ct2))
1639 for (i = 0; i < 256; i++)
1641 if (!internal_equal (get_byte_table (ct1->table, i),
1642 get_byte_table (ct2->table, i), 0))
1646 for (i = 0; i < NUM_ASCII_CHARS; i++)
1647 if (!internal_equal (ct1->ascii[i], ct2->ascii[i], depth + 1))
1651 for (i = 0; i < NUM_LEADING_BYTES; i++)
1652 if (!internal_equal (ct1->level1[i], ct2->level1[i], depth + 1))
1655 #endif /* non UTF2000 */
1660 static unsigned long
1661 char_table_hash (Lisp_Object obj, int depth)
1663 Lisp_Char_Table *ct = XCHAR_TABLE (obj);
1665 return byte_table_hash (ct->table, depth + 1);
1667 unsigned long hashval = internal_array_hash (ct->ascii, NUM_ASCII_CHARS,
1670 hashval = HASH2 (hashval,
1671 internal_array_hash (ct->level1, NUM_LEADING_BYTES, depth));
1677 static const struct lrecord_description char_table_description[] = {
1679 { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, table) },
1680 { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, default_value) },
1682 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, ascii), NUM_ASCII_CHARS },
1684 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, level1), NUM_LEADING_BYTES },
1688 { XD_LISP_OBJECT, offsetof (Lisp_Char_Table, mirror_table) },
1690 { XD_LO_LINK, offsetof (Lisp_Char_Table, next_table) },
1694 DEFINE_LRECORD_IMPLEMENTATION ("char-table", char_table,
1695 mark_char_table, print_char_table, 0,
1696 char_table_equal, char_table_hash,
1697 char_table_description,
1700 DEFUN ("char-table-p", Fchar_table_p, 1, 1, 0, /*
1701 Return non-nil if OBJECT is a char table.
1703 A char table is a table that maps characters (or ranges of characters)
1704 to values. Char tables are specialized for characters, only allowing
1705 particular sorts of ranges to be assigned values. Although this
1706 loses in generality, it makes for extremely fast (constant-time)
1707 lookups, and thus is feasible for applications that do an extremely
1708 large number of lookups (e.g. scanning a buffer for a character in
1709 a particular syntax, where a lookup in the syntax table must occur
1710 once per character).
1712 When Mule support exists, the types of ranges that can be assigned
1716 -- an entire charset
1717 -- a single row in a two-octet charset
1718 -- a single character
1720 When Mule support is not present, the types of ranges that can be
1724 -- a single character
1726 To create a char table, use `make-char-table'.
1727 To modify a char table, use `put-char-table' or `remove-char-table'.
1728 To retrieve the value for a particular character, use `get-char-table'.
1729 See also `map-char-table', `clear-char-table', `copy-char-table',
1730 `valid-char-table-type-p', `char-table-type-list',
1731 `valid-char-table-value-p', and `check-char-table-value'.
1735 return CHAR_TABLEP (object) ? Qt : Qnil;
1738 DEFUN ("char-table-type-list", Fchar_table_type_list, 0, 0, 0, /*
1739 Return a list of the recognized char table types.
1740 See `valid-char-table-type-p'.
1745 return list5 (Qchar, Qcategory, Qdisplay, Qgeneric, Qsyntax);
1747 return list4 (Qchar, Qdisplay, Qgeneric, Qsyntax);
1751 DEFUN ("valid-char-table-type-p", Fvalid_char_table_type_p, 1, 1, 0, /*
1752 Return t if TYPE if a recognized char table type.
1754 Each char table type is used for a different purpose and allows different
1755 sorts of values. The different char table types are
1758 Used for category tables, which specify the regexp categories
1759 that a character is in. The valid values are nil or a
1760 bit vector of 95 elements. Higher-level Lisp functions are
1761 provided for working with category tables. Currently categories
1762 and category tables only exist when Mule support is present.
1764 A generalized char table, for mapping from one character to
1765 another. Used for case tables, syntax matching tables,
1766 `keyboard-translate-table', etc. The valid values are characters.
1768 An even more generalized char table, for mapping from a
1769 character to anything.
1771 Used for display tables, which specify how a particular character
1772 is to appear when displayed. #### Not yet implemented.
1774 Used for syntax tables, which specify the syntax of a particular
1775 character. Higher-level Lisp functions are provided for
1776 working with syntax tables. The valid values are integers.
1781 return (EQ (type, Qchar) ||
1783 EQ (type, Qcategory) ||
1785 EQ (type, Qdisplay) ||
1786 EQ (type, Qgeneric) ||
1787 EQ (type, Qsyntax)) ? Qt : Qnil;
1790 DEFUN ("char-table-type", Fchar_table_type, 1, 1, 0, /*
1791 Return the type of CHAR-TABLE.
1792 See `valid-char-table-type-p'.
1796 CHECK_CHAR_TABLE (char_table);
1797 return char_table_type_to_symbol (XCHAR_TABLE (char_table)->type);
1801 fill_char_table (Lisp_Char_Table *ct, Lisp_Object value)
1804 ct->table = Qunbound;
1805 ct->default_value = value;
1809 for (i = 0; i < NUM_ASCII_CHARS; i++)
1810 ct->ascii[i] = value;
1812 for (i = 0; i < NUM_LEADING_BYTES; i++)
1813 ct->level1[i] = value;
1818 if (ct->type == CHAR_TABLE_TYPE_SYNTAX)
1819 update_syntax_table (ct);
1823 DEFUN ("reset-char-table", Freset_char_table, 1, 1, 0, /*
1824 Reset CHAR-TABLE to its default state.
1828 Lisp_Char_Table *ct;
1830 CHECK_CHAR_TABLE (char_table);
1831 ct = XCHAR_TABLE (char_table);
1835 case CHAR_TABLE_TYPE_CHAR:
1836 fill_char_table (ct, make_char (0));
1838 case CHAR_TABLE_TYPE_DISPLAY:
1839 case CHAR_TABLE_TYPE_GENERIC:
1841 case CHAR_TABLE_TYPE_CATEGORY:
1843 fill_char_table (ct, Qnil);
1846 case CHAR_TABLE_TYPE_SYNTAX:
1847 fill_char_table (ct, make_int (Sinherit));
1857 DEFUN ("make-char-table", Fmake_char_table, 1, 1, 0, /*
1858 Return a new, empty char table of type TYPE.
1859 Currently recognized types are 'char, 'category, 'display, 'generic,
1860 and 'syntax. See `valid-char-table-type-p'.
1864 Lisp_Char_Table *ct;
1866 enum char_table_type ty = symbol_to_char_table_type (type);
1868 ct = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table);
1871 if (ty == CHAR_TABLE_TYPE_SYNTAX)
1873 ct->mirror_table = Fmake_char_table (Qgeneric);
1874 fill_char_table (XCHAR_TABLE (ct->mirror_table),
1878 ct->mirror_table = Qnil;
1880 ct->next_table = Qnil;
1881 XSETCHAR_TABLE (obj, ct);
1882 if (ty == CHAR_TABLE_TYPE_SYNTAX)
1884 ct->next_table = Vall_syntax_tables;
1885 Vall_syntax_tables = obj;
1887 Freset_char_table (obj);
1891 #if defined(MULE)&&!defined(UTF2000)
1894 make_char_table_entry (Lisp_Object initval)
1898 Lisp_Char_Table_Entry *cte =
1899 alloc_lcrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry);
1901 for (i = 0; i < 96; i++)
1902 cte->level2[i] = initval;
1904 XSETCHAR_TABLE_ENTRY (obj, cte);
1909 copy_char_table_entry (Lisp_Object entry)
1911 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (entry);
1914 Lisp_Char_Table_Entry *ctenew =
1915 alloc_lcrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry);
1917 for (i = 0; i < 96; i++)
1919 Lisp_Object new = cte->level2[i];
1920 if (CHAR_TABLE_ENTRYP (new))
1921 ctenew->level2[i] = copy_char_table_entry (new);
1923 ctenew->level2[i] = new;
1926 XSETCHAR_TABLE_ENTRY (obj, ctenew);
1932 DEFUN ("copy-char-table", Fcopy_char_table, 1, 1, 0, /*
1933 Return a new char table which is a copy of CHAR-TABLE.
1934 It will contain the same values for the same characters and ranges
1935 as CHAR-TABLE. The values will not themselves be copied.
1939 Lisp_Char_Table *ct, *ctnew;
1945 CHECK_CHAR_TABLE (char_table);
1946 ct = XCHAR_TABLE (char_table);
1947 ctnew = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table);
1948 ctnew->type = ct->type;
1950 ctnew->default_value = ct->default_value;
1952 if (UINT8_BYTE_TABLE_P (ct->table))
1954 ctnew->table = copy_uint8_byte_table (ct->table);
1956 else if (UINT16_BYTE_TABLE_P (ct->table))
1958 ctnew->table = copy_uint16_byte_table (ct->table);
1960 else if (BYTE_TABLE_P (ct->table))
1962 ctnew->table = copy_byte_table (ct->table);
1964 else if (!UNBOUNDP (ct->table))
1965 ctnew->table = ct->table;
1966 #else /* non UTF2000 */
1968 for (i = 0; i < NUM_ASCII_CHARS; i++)
1970 Lisp_Object new = ct->ascii[i];
1972 assert (! (CHAR_TABLE_ENTRYP (new)));
1974 ctnew->ascii[i] = new;
1979 for (i = 0; i < NUM_LEADING_BYTES; i++)
1981 Lisp_Object new = ct->level1[i];
1982 if (CHAR_TABLE_ENTRYP (new))
1983 ctnew->level1[i] = copy_char_table_entry (new);
1985 ctnew->level1[i] = new;
1989 #endif /* non UTF2000 */
1992 if (CHAR_TABLEP (ct->mirror_table))
1993 ctnew->mirror_table = Fcopy_char_table (ct->mirror_table);
1995 ctnew->mirror_table = ct->mirror_table;
1997 ctnew->next_table = Qnil;
1998 XSETCHAR_TABLE (obj, ctnew);
1999 if (ctnew->type == CHAR_TABLE_TYPE_SYNTAX)
2001 ctnew->next_table = Vall_syntax_tables;
2002 Vall_syntax_tables = obj;
2008 decode_char_table_range (Lisp_Object range, struct chartab_range *outrange)
2011 outrange->type = CHARTAB_RANGE_ALL;
2012 else if (EQ (range, Qnil))
2013 outrange->type = CHARTAB_RANGE_DEFAULT;
2014 else if (CHAR_OR_CHAR_INTP (range))
2016 outrange->type = CHARTAB_RANGE_CHAR;
2017 outrange->ch = XCHAR_OR_CHAR_INT (range);
2021 signal_simple_error ("Range must be t or a character", range);
2023 else if (VECTORP (range))
2025 Lisp_Vector *vec = XVECTOR (range);
2026 Lisp_Object *elts = vector_data (vec);
2027 if (vector_length (vec) != 2)
2028 signal_simple_error ("Length of charset row vector must be 2",
2030 outrange->type = CHARTAB_RANGE_ROW;
2031 outrange->charset = Fget_charset (elts[0]);
2032 CHECK_INT (elts[1]);
2033 outrange->row = XINT (elts[1]);
2034 if (XCHARSET_DIMENSION (outrange->charset) >= 2)
2036 switch (XCHARSET_CHARS (outrange->charset))
2039 check_int_range (outrange->row, 33, 126);
2042 check_int_range (outrange->row, 32, 127);
2049 signal_simple_error ("Charset in row vector must be multi-byte",
2054 if (!CHARSETP (range) && !SYMBOLP (range))
2056 ("Char table range must be t, charset, char, or vector", range);
2057 outrange->type = CHARTAB_RANGE_CHARSET;
2058 outrange->charset = Fget_charset (range);
2063 #if defined(MULE)&&!defined(UTF2000)
2065 /* called from CHAR_TABLE_VALUE(). */
2067 get_non_ascii_char_table_value (Lisp_Char_Table *ct, Charset_ID leading_byte,
2072 Lisp_Object charset;
2074 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (leading_byte);
2079 BREAKUP_CHAR (c, charset, byte1, byte2);
2081 BREAKUP_CHAR_1_UNSAFE (c, charset, byte1, byte2);
2083 val = ct->level1[leading_byte - MIN_LEADING_BYTE];
2084 if (CHAR_TABLE_ENTRYP (val))
2086 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
2087 val = cte->level2[byte1 - 32];
2088 if (CHAR_TABLE_ENTRYP (val))
2090 cte = XCHAR_TABLE_ENTRY (val);
2091 assert (byte2 >= 32);
2092 val = cte->level2[byte2 - 32];
2093 assert (!CHAR_TABLE_ENTRYP (val));
2103 get_char_table (Emchar ch, Lisp_Char_Table *ct)
2106 Lisp_Object val = get_byte_table (get_byte_table
2110 (unsigned char)(ch >> 24)),
2111 (unsigned char) (ch >> 16)),
2112 (unsigned char) (ch >> 8)),
2113 (unsigned char) ch);
2115 return ct->default_value;
2120 Lisp_Object charset;
2124 BREAKUP_CHAR (ch, charset, byte1, byte2);
2126 if (EQ (charset, Vcharset_ascii))
2127 val = ct->ascii[byte1];
2128 else if (EQ (charset, Vcharset_control_1))
2129 val = ct->ascii[byte1 + 128];
2132 int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE;
2133 val = ct->level1[lb];
2134 if (CHAR_TABLE_ENTRYP (val))
2136 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
2137 val = cte->level2[byte1 - 32];
2138 if (CHAR_TABLE_ENTRYP (val))
2140 cte = XCHAR_TABLE_ENTRY (val);
2141 assert (byte2 >= 32);
2142 val = cte->level2[byte2 - 32];
2143 assert (!CHAR_TABLE_ENTRYP (val));
2150 #else /* not MULE */
2151 return ct->ascii[(unsigned char)ch];
2152 #endif /* not MULE */
2156 DEFUN ("get-char-table", Fget_char_table, 2, 2, 0, /*
2157 Find value for CHARACTER in CHAR-TABLE.
2159 (character, char_table))
2161 CHECK_CHAR_TABLE (char_table);
2162 CHECK_CHAR_COERCE_INT (character);
2164 return get_char_table (XCHAR (character), XCHAR_TABLE (char_table));
2167 DEFUN ("get-range-char-table", Fget_range_char_table, 2, 3, 0, /*
2168 Find value for a range in CHAR-TABLE.
2169 If there is more than one value, return MULTI (defaults to nil).
2171 (range, char_table, multi))
2173 Lisp_Char_Table *ct;
2174 struct chartab_range rainj;
2176 if (CHAR_OR_CHAR_INTP (range))
2177 return Fget_char_table (range, char_table);
2178 CHECK_CHAR_TABLE (char_table);
2179 ct = XCHAR_TABLE (char_table);
2181 decode_char_table_range (range, &rainj);
2184 case CHARTAB_RANGE_ALL:
2187 if (UINT8_BYTE_TABLE_P (ct->table))
2189 else if (UINT16_BYTE_TABLE_P (ct->table))
2191 else if (BYTE_TABLE_P (ct->table))
2195 #else /* non UTF2000 */
2197 Lisp_Object first = ct->ascii[0];
2199 for (i = 1; i < NUM_ASCII_CHARS; i++)
2200 if (!EQ (first, ct->ascii[i]))
2204 for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES;
2207 if (!CHARSETP (CHARSET_BY_LEADING_BYTE (i))
2208 || i == LEADING_BYTE_ASCII
2209 || i == LEADING_BYTE_CONTROL_1)
2211 if (!EQ (first, ct->level1[i - MIN_LEADING_BYTE]))
2217 #endif /* non UTF2000 */
2221 case CHARTAB_RANGE_CHARSET:
2225 if (EQ (rainj.charset, Vcharset_ascii))
2228 Lisp_Object first = ct->ascii[0];
2230 for (i = 1; i < 128; i++)
2231 if (!EQ (first, ct->ascii[i]))
2236 if (EQ (rainj.charset, Vcharset_control_1))
2239 Lisp_Object first = ct->ascii[128];
2241 for (i = 129; i < 160; i++)
2242 if (!EQ (first, ct->ascii[i]))
2248 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (rainj.charset) -
2250 if (CHAR_TABLE_ENTRYP (val))
2256 case CHARTAB_RANGE_ROW:
2261 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (rainj.charset) -
2263 if (!CHAR_TABLE_ENTRYP (val))
2265 val = XCHAR_TABLE_ENTRY (val)->level2[rainj.row - 32];
2266 if (CHAR_TABLE_ENTRYP (val))
2270 #endif /* not UTF2000 */
2271 #endif /* not MULE */
2277 return Qnil; /* not reached */
2281 check_valid_char_table_value (Lisp_Object value, enum char_table_type type,
2282 Error_behavior errb)
2286 case CHAR_TABLE_TYPE_SYNTAX:
2287 if (!ERRB_EQ (errb, ERROR_ME))
2288 return INTP (value) || (CONSP (value) && INTP (XCAR (value))
2289 && CHAR_OR_CHAR_INTP (XCDR (value)));
2292 Lisp_Object cdr = XCDR (value);
2293 CHECK_INT (XCAR (value));
2294 CHECK_CHAR_COERCE_INT (cdr);
2301 case CHAR_TABLE_TYPE_CATEGORY:
2302 if (!ERRB_EQ (errb, ERROR_ME))
2303 return CATEGORY_TABLE_VALUEP (value);
2304 CHECK_CATEGORY_TABLE_VALUE (value);
2308 case CHAR_TABLE_TYPE_GENERIC:
2311 case CHAR_TABLE_TYPE_DISPLAY:
2313 maybe_signal_simple_error ("Display char tables not yet implemented",
2314 value, Qchar_table, errb);
2317 case CHAR_TABLE_TYPE_CHAR:
2318 if (!ERRB_EQ (errb, ERROR_ME))
2319 return CHAR_OR_CHAR_INTP (value);
2320 CHECK_CHAR_COERCE_INT (value);
2327 return 0; /* not reached */
2331 canonicalize_char_table_value (Lisp_Object value, enum char_table_type type)
2335 case CHAR_TABLE_TYPE_SYNTAX:
2338 Lisp_Object car = XCAR (value);
2339 Lisp_Object cdr = XCDR (value);
2340 CHECK_CHAR_COERCE_INT (cdr);
2341 return Fcons (car, cdr);
2344 case CHAR_TABLE_TYPE_CHAR:
2345 CHECK_CHAR_COERCE_INT (value);
2353 DEFUN ("valid-char-table-value-p", Fvalid_char_table_value_p, 2, 2, 0, /*
2354 Return non-nil if VALUE is a valid value for CHAR-TABLE-TYPE.
2356 (value, char_table_type))
2358 enum char_table_type type = symbol_to_char_table_type (char_table_type);
2360 return check_valid_char_table_value (value, type, ERROR_ME_NOT) ? Qt : Qnil;
2363 DEFUN ("check-valid-char-table-value", Fcheck_valid_char_table_value, 2, 2, 0, /*
2364 Signal an error if VALUE is not a valid value for CHAR-TABLE-TYPE.
2366 (value, char_table_type))
2368 enum char_table_type type = symbol_to_char_table_type (char_table_type);
2370 check_valid_char_table_value (value, type, ERROR_ME);
2374 /* Assign VAL to all characters in RANGE in char table CT. */
2377 put_char_table (Lisp_Char_Table *ct, struct chartab_range *range,
2380 switch (range->type)
2382 case CHARTAB_RANGE_ALL:
2383 /* printf ("put-char-table: range = all\n"); */
2384 fill_char_table (ct, val);
2385 return; /* avoid the duplicate call to update_syntax_table() below,
2386 since fill_char_table() also did that. */
2389 case CHARTAB_RANGE_DEFAULT:
2390 ct->default_value = val;
2395 case CHARTAB_RANGE_CHARSET:
2399 Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (range->charset);
2401 /* printf ("put-char-table: range = charset: %d\n",
2402 XCHARSET_LEADING_BYTE (range->charset));
2404 if ( CHAR_TABLEP (encoding_table) )
2406 for (c = 0; c < 1 << 24; c++)
2408 if ( INTP (get_char_id_table (XCHAR_TABLE(encoding_table),
2410 put_char_id_table_0 (ct, c, val);
2415 for (c = 0; c < 1 << 24; c++)
2417 if ( charset_code_point (range->charset, c) >= 0 )
2418 put_char_id_table_0 (ct, c, val);
2423 if (EQ (range->charset, Vcharset_ascii))
2426 for (i = 0; i < 128; i++)
2429 else if (EQ (range->charset, Vcharset_control_1))
2432 for (i = 128; i < 160; i++)
2437 int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE;
2438 ct->level1[lb] = val;
2443 case CHARTAB_RANGE_ROW:
2446 int cell_min, cell_max, i;
2448 /* printf ("put-char-table: range = charset-row: %d, 0x%x\n",
2449 XCHARSET_LEADING_BYTE (range->charset), range->row); */
2450 if (XCHARSET_DIMENSION (range->charset) < 2)
2451 signal_simple_error ("Charset in row vector must be multi-byte",
2455 switch (XCHARSET_CHARS (range->charset))
2458 cell_min = 33; cell_max = 126;
2461 cell_min = 32; cell_max = 127;
2464 cell_min = 0; cell_max = 127;
2467 cell_min = 0; cell_max = 255;
2473 if (XCHARSET_DIMENSION (range->charset) == 2)
2474 check_int_range (range->row, cell_min, cell_max);
2475 else if (XCHARSET_DIMENSION (range->charset) == 3)
2477 check_int_range (range->row >> 8 , cell_min, cell_max);
2478 check_int_range (range->row & 0xFF, cell_min, cell_max);
2480 else if (XCHARSET_DIMENSION (range->charset) == 4)
2482 check_int_range ( range->row >> 16 , cell_min, cell_max);
2483 check_int_range ((range->row >> 8) & 0xFF, cell_min, cell_max);
2484 check_int_range ( range->row & 0xFF, cell_min, cell_max);
2489 for (i = cell_min; i <= cell_max; i++)
2491 Emchar ch = DECODE_CHAR (range->charset, (range->row << 8) | i);
2492 if ( charset_code_point (range->charset, ch) >= 0 )
2493 put_char_id_table_0 (ct, ch, val);
2498 Lisp_Char_Table_Entry *cte;
2499 int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE;
2500 /* make sure that there is a separate entry for the row. */
2501 if (!CHAR_TABLE_ENTRYP (ct->level1[lb]))
2502 ct->level1[lb] = make_char_table_entry (ct->level1[lb]);
2503 cte = XCHAR_TABLE_ENTRY (ct->level1[lb]);
2504 cte->level2[range->row - 32] = val;
2506 #endif /* not UTF2000 */
2510 case CHARTAB_RANGE_CHAR:
2512 /* printf ("put-char-table: range = char: 0x%x\n", range->ch); */
2513 put_char_id_table_0 (ct, range->ch, val);
2517 Lisp_Object charset;
2520 BREAKUP_CHAR (range->ch, charset, byte1, byte2);
2521 if (EQ (charset, Vcharset_ascii))
2522 ct->ascii[byte1] = val;
2523 else if (EQ (charset, Vcharset_control_1))
2524 ct->ascii[byte1 + 128] = val;
2527 Lisp_Char_Table_Entry *cte;
2528 int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE;
2529 /* make sure that there is a separate entry for the row. */
2530 if (!CHAR_TABLE_ENTRYP (ct->level1[lb]))
2531 ct->level1[lb] = make_char_table_entry (ct->level1[lb]);
2532 cte = XCHAR_TABLE_ENTRY (ct->level1[lb]);
2533 /* now CTE is a char table entry for the charset;
2534 each entry is for a single row (or character of
2535 a one-octet charset). */
2536 if (XCHARSET_DIMENSION (charset) == 1)
2537 cte->level2[byte1 - 32] = val;
2540 /* assigning to one character in a two-octet charset. */
2541 /* make sure that the charset row contains a separate
2542 entry for each character. */
2543 if (!CHAR_TABLE_ENTRYP (cte->level2[byte1 - 32]))
2544 cte->level2[byte1 - 32] =
2545 make_char_table_entry (cte->level2[byte1 - 32]);
2546 cte = XCHAR_TABLE_ENTRY (cte->level2[byte1 - 32]);
2547 cte->level2[byte2 - 32] = val;
2551 #else /* not MULE */
2552 ct->ascii[(unsigned char) (range->ch)] = val;
2554 #endif /* not MULE */
2558 if (ct->type == CHAR_TABLE_TYPE_SYNTAX)
2559 update_syntax_table (ct);
2563 DEFUN ("put-char-table", Fput_char_table, 3, 3, 0, /*
2564 Set the value for chars in RANGE to be VALUE in CHAR-TABLE.
2566 RANGE specifies one or more characters to be affected and should be
2567 one of the following:
2569 -- t (all characters are affected)
2570 -- A charset (only allowed when Mule support is present)
2571 -- A vector of two elements: a two-octet charset and a row number
2572 (only allowed when Mule support is present)
2573 -- A single character
2575 VALUE must be a value appropriate for the type of CHAR-TABLE.
2576 See `valid-char-table-type-p'.
2578 (range, value, char_table))
2580 Lisp_Char_Table *ct;
2581 struct chartab_range rainj;
2583 CHECK_CHAR_TABLE (char_table);
2584 ct = XCHAR_TABLE (char_table);
2585 check_valid_char_table_value (value, ct->type, ERROR_ME);
2586 decode_char_table_range (range, &rainj);
2587 value = canonicalize_char_table_value (value, ct->type);
2588 put_char_table (ct, &rainj, value);
2593 /* Map FN over the ASCII chars in CT. */
2596 map_over_charset_ascii (Lisp_Char_Table *ct,
2597 int (*fn) (struct chartab_range *range,
2598 Lisp_Object val, void *arg),
2601 struct chartab_range rainj;
2610 rainj.type = CHARTAB_RANGE_CHAR;
2612 for (i = start, retval = 0; i < stop && retval == 0; i++)
2614 rainj.ch = (Emchar) i;
2615 retval = (fn) (&rainj, ct->ascii[i], arg);
2623 /* Map FN over the Control-1 chars in CT. */
2626 map_over_charset_control_1 (Lisp_Char_Table *ct,
2627 int (*fn) (struct chartab_range *range,
2628 Lisp_Object val, void *arg),
2631 struct chartab_range rainj;
2634 int stop = start + 32;
2636 rainj.type = CHARTAB_RANGE_CHAR;
2638 for (i = start, retval = 0; i < stop && retval == 0; i++)
2640 rainj.ch = (Emchar) (i);
2641 retval = (fn) (&rainj, ct->ascii[i], arg);
2647 /* Map FN over the row ROW of two-byte charset CHARSET.
2648 There must be a separate value for that row in the char table.
2649 CTE specifies the char table entry for CHARSET. */
2652 map_over_charset_row (Lisp_Char_Table_Entry *cte,
2653 Lisp_Object charset, int row,
2654 int (*fn) (struct chartab_range *range,
2655 Lisp_Object val, void *arg),
2658 Lisp_Object val = cte->level2[row - 32];
2660 if (!CHAR_TABLE_ENTRYP (val))
2662 struct chartab_range rainj;
2664 rainj.type = CHARTAB_RANGE_ROW;
2665 rainj.charset = charset;
2667 return (fn) (&rainj, val, arg);
2671 struct chartab_range rainj;
2673 int charset94_p = (XCHARSET_CHARS (charset) == 94);
2674 int start = charset94_p ? 33 : 32;
2675 int stop = charset94_p ? 127 : 128;
2677 cte = XCHAR_TABLE_ENTRY (val);
2679 rainj.type = CHARTAB_RANGE_CHAR;
2681 for (i = start, retval = 0; i < stop && retval == 0; i++)
2683 rainj.ch = MAKE_CHAR (charset, row, i);
2684 retval = (fn) (&rainj, cte->level2[i - 32], arg);
2692 map_over_other_charset (Lisp_Char_Table *ct, Charset_ID lb,
2693 int (*fn) (struct chartab_range *range,
2694 Lisp_Object val, void *arg),
2697 Lisp_Object val = ct->level1[lb - MIN_LEADING_BYTE];
2698 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (lb);
2700 if (!CHARSETP (charset)
2701 || lb == LEADING_BYTE_ASCII
2702 || lb == LEADING_BYTE_CONTROL_1)
2705 if (!CHAR_TABLE_ENTRYP (val))
2707 struct chartab_range rainj;
2709 rainj.type = CHARTAB_RANGE_CHARSET;
2710 rainj.charset = charset;
2711 return (fn) (&rainj, val, arg);
2715 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
2716 int charset94_p = (XCHARSET_CHARS (charset) == 94);
2717 int start = charset94_p ? 33 : 32;
2718 int stop = charset94_p ? 127 : 128;
2721 if (XCHARSET_DIMENSION (charset) == 1)
2723 struct chartab_range rainj;
2724 rainj.type = CHARTAB_RANGE_CHAR;
2726 for (i = start, retval = 0; i < stop && retval == 0; i++)
2728 rainj.ch = MAKE_CHAR (charset, i, 0);
2729 retval = (fn) (&rainj, cte->level2[i - 32], arg);
2734 for (i = start, retval = 0; i < stop && retval == 0; i++)
2735 retval = map_over_charset_row (cte, charset, i, fn, arg);
2743 #endif /* not UTF2000 */
2745 /* Map FN (with client data ARG) over range RANGE in char table CT.
2746 Mapping stops the first time FN returns non-zero, and that value
2747 becomes the return value of map_char_table(). */
2750 map_char_table (Lisp_Char_Table *ct,
2751 struct chartab_range *range,
2752 int (*fn) (struct chartab_range *range,
2753 Lisp_Object val, void *arg),
2756 switch (range->type)
2758 case CHARTAB_RANGE_ALL:
2760 if (!UNBOUNDP (ct->default_value))
2762 struct chartab_range rainj;
2765 rainj.type = CHARTAB_RANGE_DEFAULT;
2766 retval = (fn) (&rainj, ct->default_value, arg);
2770 if (UINT8_BYTE_TABLE_P (ct->table))
2771 return map_over_uint8_byte_table (XUINT8_BYTE_TABLE(ct->table), 0, 3,
2773 else if (UINT16_BYTE_TABLE_P (ct->table))
2774 return map_over_uint16_byte_table (XUINT16_BYTE_TABLE(ct->table), 0, 3,
2776 else if (BYTE_TABLE_P (ct->table))
2777 return map_over_byte_table (XBYTE_TABLE(ct->table), 0, 3,
2779 else if (!UNBOUNDP (ct->table))
2782 struct chartab_range rainj;
2785 Emchar c1 = c + unit;
2788 rainj.type = CHARTAB_RANGE_CHAR;
2790 for (retval = 0; c < c1 && retval == 0; c++)
2793 retval = (fn) (&rainj, ct->table, arg);
2798 return (fn) (range, ct->table, arg);
2805 retval = map_over_charset_ascii (ct, fn, arg);
2809 retval = map_over_charset_control_1 (ct, fn, arg);
2814 Charset_ID start = MIN_LEADING_BYTE;
2815 Charset_ID stop = start + NUM_LEADING_BYTES;
2817 for (i = start, retval = 0; i < stop && retval == 0; i++)
2819 retval = map_over_other_charset (ct, i, fn, arg);
2828 case CHARTAB_RANGE_DEFAULT:
2829 if (!UNBOUNDP (ct->default_value))
2830 return (fn) (range, ct->default_value, arg);
2835 case CHARTAB_RANGE_CHARSET:
2837 if (UINT8_BYTE_TABLE_P (ct->table))
2838 return map_over_uint8_byte_table (XUINT8_BYTE_TABLE(ct->table), 0, 3,
2839 range->charset, fn, arg);
2840 else if (UINT16_BYTE_TABLE_P (ct->table))
2841 return map_over_uint16_byte_table (XUINT16_BYTE_TABLE(ct->table), 0, 3,
2842 range->charset, fn, arg);
2843 else if (BYTE_TABLE_P (ct->table))
2844 return map_over_byte_table (XBYTE_TABLE(ct->table), 0, 3,
2845 range->charset, fn, arg);
2846 else if (!UNBOUNDP (ct->table))
2849 struct chartab_range rainj;
2852 Emchar c1 = c + unit;
2855 rainj.type = CHARTAB_RANGE_CHAR;
2857 for (retval = 0; c < c1 && retval == 0; c++)
2859 if ( charset_code_point (range->charset, c) >= 0 )
2862 retval = (fn) (&rainj, ct->table, arg);
2866 return (fn) (range, ct->table, arg);
2871 return map_over_other_charset (ct,
2872 XCHARSET_LEADING_BYTE (range->charset),
2876 case CHARTAB_RANGE_ROW:
2879 int cell_min, cell_max, i;
2881 struct chartab_range rainj;
2883 if (XCHARSET_DIMENSION (range->charset) < 2)
2884 signal_simple_error ("Charset in row vector must be multi-byte",
2888 switch (XCHARSET_CHARS (range->charset))
2891 cell_min = 33; cell_max = 126;
2894 cell_min = 32; cell_max = 127;
2897 cell_min = 0; cell_max = 127;
2900 cell_min = 0; cell_max = 255;
2906 if (XCHARSET_DIMENSION (range->charset) == 2)
2907 check_int_range (range->row, cell_min, cell_max);
2908 else if (XCHARSET_DIMENSION (range->charset) == 3)
2910 check_int_range (range->row >> 8 , cell_min, cell_max);
2911 check_int_range (range->row & 0xFF, cell_min, cell_max);
2913 else if (XCHARSET_DIMENSION (range->charset) == 4)
2915 check_int_range ( range->row >> 16 , cell_min, cell_max);
2916 check_int_range ((range->row >> 8) & 0xFF, cell_min, cell_max);
2917 check_int_range ( range->row & 0xFF, cell_min, cell_max);
2922 rainj.type = CHARTAB_RANGE_CHAR;
2923 for (retval =0, i = cell_min; i <= cell_max && retval == 0; i++)
2925 Emchar ch = DECODE_CHAR (range->charset, (range->row << 8) | i);
2927 = get_byte_table (get_byte_table
2931 (unsigned char)(ch >> 24)),
2932 (unsigned char) (ch >> 16)),
2933 (unsigned char) (ch >> 8)),
2934 (unsigned char) ch);
2936 if (!UNBOUNDP (val))
2939 retval = (fn) (&rainj, val, arg);
2946 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (range->charset)
2947 - MIN_LEADING_BYTE];
2948 if (!CHAR_TABLE_ENTRYP (val))
2950 struct chartab_range rainj;
2952 rainj.type = CHARTAB_RANGE_ROW;
2953 rainj.charset = range->charset;
2954 rainj.row = range->row;
2955 return (fn) (&rainj, val, arg);
2958 return map_over_charset_row (XCHAR_TABLE_ENTRY (val),
2959 range->charset, range->row,
2962 #endif /* not UTF2000 */
2965 case CHARTAB_RANGE_CHAR:
2967 Emchar ch = range->ch;
2968 Lisp_Object val = CHAR_TABLE_VALUE_UNSAFE (ct, ch);
2970 if (!UNBOUNDP (val))
2972 struct chartab_range rainj;
2974 rainj.type = CHARTAB_RANGE_CHAR;
2976 return (fn) (&rainj, val, arg);
2988 struct slow_map_char_table_arg
2990 Lisp_Object function;
2995 slow_map_char_table_fun (struct chartab_range *range,
2996 Lisp_Object val, void *arg)
2998 Lisp_Object ranjarg = Qnil;
2999 struct slow_map_char_table_arg *closure =
3000 (struct slow_map_char_table_arg *) arg;
3002 switch (range->type)
3004 case CHARTAB_RANGE_ALL:
3009 case CHARTAB_RANGE_DEFAULT:
3015 case CHARTAB_RANGE_CHARSET:
3016 ranjarg = XCHARSET_NAME (range->charset);
3019 case CHARTAB_RANGE_ROW:
3020 ranjarg = vector2 (XCHARSET_NAME (range->charset),
3021 make_int (range->row));
3024 case CHARTAB_RANGE_CHAR:
3025 ranjarg = make_char (range->ch);
3031 closure->retval = call2 (closure->function, ranjarg, val);
3032 return !NILP (closure->retval);
3035 DEFUN ("map-char-table", Fmap_char_table, 2, 3, 0, /*
3036 Map FUNCTION over entries in CHAR-TABLE, calling it with two args,
3037 each key and value in the table.
3039 RANGE specifies a subrange to map over and is in the same format as
3040 the RANGE argument to `put-range-table'. If omitted or t, it defaults to
3043 (function, char_table, range))
3045 Lisp_Char_Table *ct;
3046 struct slow_map_char_table_arg slarg;
3047 struct gcpro gcpro1, gcpro2;
3048 struct chartab_range rainj;
3050 CHECK_CHAR_TABLE (char_table);
3051 ct = XCHAR_TABLE (char_table);
3054 decode_char_table_range (range, &rainj);
3055 slarg.function = function;
3056 slarg.retval = Qnil;
3057 GCPRO2 (slarg.function, slarg.retval);
3058 map_char_table (ct, &rainj, slow_map_char_table_fun, &slarg);
3061 return slarg.retval;
3065 /************************************************************************/
3066 /* Character Attributes */
3067 /************************************************************************/
3071 Lisp_Object Vchar_attribute_hash_table;
3073 /* We store the char-attributes in hash tables with the names as the
3074 key and the actual char-id-table object as the value. Occasionally
3075 we need to use them in a list format. These routines provide us
3077 struct char_attribute_list_closure
3079 Lisp_Object *char_attribute_list;
3083 add_char_attribute_to_list_mapper (Lisp_Object key, Lisp_Object value,
3084 void *char_attribute_list_closure)
3086 /* This function can GC */
3087 struct char_attribute_list_closure *calcl
3088 = (struct char_attribute_list_closure*) char_attribute_list_closure;
3089 Lisp_Object *char_attribute_list = calcl->char_attribute_list;
3091 *char_attribute_list = Fcons (key, *char_attribute_list);
3095 DEFUN ("char-attribute-list", Fchar_attribute_list, 0, 0, 0, /*
3096 Return the list of all existing character attributes except coded-charsets.
3100 Lisp_Object char_attribute_list = Qnil;
3101 struct gcpro gcpro1;
3102 struct char_attribute_list_closure char_attribute_list_closure;
3104 GCPRO1 (char_attribute_list);
3105 char_attribute_list_closure.char_attribute_list = &char_attribute_list;
3106 elisp_maphash (add_char_attribute_to_list_mapper,
3107 Vchar_attribute_hash_table,
3108 &char_attribute_list_closure);
3110 return char_attribute_list;
3113 DEFUN ("find-char-attribute-table", Ffind_char_attribute_table, 1, 1, 0, /*
3114 Return char-id-table corresponding to ATTRIBUTE.
3118 return Fgethash (attribute, Vchar_attribute_hash_table, Qnil);
3122 /* We store the char-id-tables in hash tables with the attributes as
3123 the key and the actual char-id-table object as the value. Each
3124 char-id-table stores values of an attribute corresponding with
3125 characters. Occasionally we need to get attributes of a character
3126 in a association-list format. These routines provide us with
3128 struct char_attribute_alist_closure
3131 Lisp_Object *char_attribute_alist;
3135 add_char_attribute_alist_mapper (Lisp_Object key, Lisp_Object value,
3136 void *char_attribute_alist_closure)
3138 /* This function can GC */
3139 struct char_attribute_alist_closure *caacl =
3140 (struct char_attribute_alist_closure*) char_attribute_alist_closure;
3142 = get_char_id_table (XCHAR_TABLE(value), caacl->char_id);
3143 if (!UNBOUNDP (ret))
3145 Lisp_Object *char_attribute_alist = caacl->char_attribute_alist;
3146 *char_attribute_alist
3147 = Fcons (Fcons (key, ret), *char_attribute_alist);
3152 DEFUN ("char-attribute-alist", Fchar_attribute_alist, 1, 1, 0, /*
3153 Return the alist of attributes of CHARACTER.
3157 Lisp_Object alist = Qnil;
3160 CHECK_CHAR (character);
3162 struct gcpro gcpro1;
3163 struct char_attribute_alist_closure char_attribute_alist_closure;
3166 char_attribute_alist_closure.char_id = XCHAR (character);
3167 char_attribute_alist_closure.char_attribute_alist = &alist;
3168 elisp_maphash (add_char_attribute_alist_mapper,
3169 Vchar_attribute_hash_table,
3170 &char_attribute_alist_closure);
3174 for (i = 0; i < countof (chlook->charset_by_leading_byte); i++)
3176 Lisp_Object ccs = chlook->charset_by_leading_byte[i];
3180 Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (ccs);
3183 if ( CHAR_TABLEP (encoding_table)
3185 = get_char_id_table (XCHAR_TABLE(encoding_table),
3186 XCHAR (character))) )
3188 alist = Fcons (Fcons (ccs, cpos), alist);
3195 DEFUN ("get-char-attribute", Fget_char_attribute, 2, 3, 0, /*
3196 Return the value of CHARACTER's ATTRIBUTE.
3197 Return DEFAULT-VALUE if the value is not exist.
3199 (character, attribute, default_value))
3203 CHECK_CHAR (character);
3204 if (!NILP (ccs = Ffind_charset (attribute)))
3206 Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (ccs);
3208 if (CHAR_TABLEP (encoding_table))
3209 return get_char_id_table (XCHAR_TABLE(encoding_table),
3214 Lisp_Object table = Fgethash (attribute,
3215 Vchar_attribute_hash_table,
3217 if (!UNBOUNDP (table))
3219 Lisp_Object ret = get_char_id_table (XCHAR_TABLE(table),
3221 if (!UNBOUNDP (ret))
3225 return default_value;
3228 DEFUN ("put-char-attribute", Fput_char_attribute, 3, 3, 0, /*
3229 Store CHARACTER's ATTRIBUTE with VALUE.
3231 (character, attribute, value))
3235 ccs = Ffind_charset (attribute);
3238 CHECK_CHAR (character);
3239 return put_char_ccs_code_point (character, ccs, value);
3241 else if (EQ (attribute, Q_decomposition))
3245 CHECK_CHAR (character);
3247 signal_simple_error ("Invalid value for ->decomposition",
3250 if (CONSP (Fcdr (value)))
3252 Lisp_Object rest = value;
3253 Lisp_Object table = Vcharacter_composition_table;
3257 GET_EXTERNAL_LIST_LENGTH (rest, len);
3258 seq = make_vector (len, Qnil);
3260 while (CONSP (rest))
3262 Lisp_Object v = Fcar (rest);
3265 = to_char_id (v, "Invalid value for ->decomposition", value);
3268 XVECTOR_DATA(seq)[i++] = v;
3270 XVECTOR_DATA(seq)[i++] = make_char (c);
3274 put_char_id_table (XCHAR_TABLE(table),
3275 make_char (c), character);
3280 ntable = get_char_id_table (XCHAR_TABLE(table), c);
3281 if (!CHAR_TABLEP (ntable))
3283 ntable = make_char_id_table (Qnil);
3284 put_char_id_table (XCHAR_TABLE(table),
3285 make_char (c), ntable);
3293 Lisp_Object v = Fcar (value);
3297 Emchar c = XINT (v);
3299 = get_char_id_table (XCHAR_TABLE(Vcharacter_variant_table),
3302 if (NILP (Fmemq (v, ret)))
3304 put_char_id_table (XCHAR_TABLE(Vcharacter_variant_table),
3305 make_char (c), Fcons (character, ret));
3308 seq = make_vector (1, v);
3312 else if (EQ (attribute, Qto_ucs) || EQ (attribute, Q_ucs))
3317 CHECK_CHAR (character);
3319 signal_simple_error ("Invalid value for ->ucs", value);
3323 ret = get_char_id_table (XCHAR_TABLE(Vcharacter_variant_table), c);
3324 if (NILP (Fmemq (character, ret)))
3326 put_char_id_table (XCHAR_TABLE(Vcharacter_variant_table),
3327 make_char (c), Fcons (character, ret));
3330 if (EQ (attribute, Q_ucs))
3331 attribute = Qto_ucs;
3335 Lisp_Object table = Fgethash (attribute,
3336 Vchar_attribute_hash_table,
3341 table = make_char_id_table (Qunbound);
3342 Fputhash (attribute, table, Vchar_attribute_hash_table);
3344 put_char_id_table (XCHAR_TABLE(table), character, value);
3349 DEFUN ("remove-char-attribute", Fremove_char_attribute, 2, 2, 0, /*
3350 Remove CHARACTER's ATTRIBUTE.
3352 (character, attribute))
3356 CHECK_CHAR (character);
3357 ccs = Ffind_charset (attribute);
3360 return remove_char_ccs (character, ccs);
3364 Lisp_Object table = Fgethash (attribute,
3365 Vchar_attribute_hash_table,
3367 if (!UNBOUNDP (table))
3369 put_char_id_table (XCHAR_TABLE(table), character, Qunbound);
3376 DEFUN ("map-char-attribute", Fmap_char_attribute, 2, 3, 0, /*
3377 Map FUNCTION over entries in ATTRIBUTE, calling it with two args,
3378 each key and value in the table.
3380 RANGE specifies a subrange to map over and is in the same format as
3381 the RANGE argument to `put-range-table'. If omitted or t, it defaults to
3384 (function, attribute, range))
3387 Lisp_Char_Table *ct;
3388 struct slow_map_char_table_arg slarg;
3389 struct gcpro gcpro1, gcpro2;
3390 struct chartab_range rainj;
3392 if (!NILP (ccs = Ffind_charset (attribute)))
3394 Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (ccs);
3396 if (CHAR_TABLEP (encoding_table))
3397 ct = XCHAR_TABLE (encoding_table);
3403 Lisp_Object table = Fgethash (attribute,
3404 Vchar_attribute_hash_table,
3406 if (CHAR_TABLEP (table))
3407 ct = XCHAR_TABLE (table);
3413 decode_char_table_range (range, &rainj);
3414 slarg.function = function;
3415 slarg.retval = Qnil;
3416 GCPRO2 (slarg.function, slarg.retval);
3417 map_char_id_table (ct, &rainj, slow_map_char_table_fun, &slarg);
3420 return slarg.retval;
3423 EXFUN (Fmake_char, 3);
3424 EXFUN (Fdecode_char, 2);
3426 DEFUN ("define-char", Fdefine_char, 1, 1, 0, /*
3427 Store character's ATTRIBUTES.
3431 Lisp_Object rest = attributes;
3432 Lisp_Object code = Fcdr (Fassq (Qucs, attributes));
3433 Lisp_Object character;
3437 while (CONSP (rest))
3439 Lisp_Object cell = Fcar (rest);
3443 signal_simple_error ("Invalid argument", attributes);
3444 if (!NILP (ccs = Ffind_charset (Fcar (cell)))
3445 && ((XCHARSET_FINAL (ccs) != 0) ||
3446 (XCHARSET_UCS_MAX (ccs) > 0)) )
3450 character = Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
3452 character = Fdecode_char (ccs, cell);
3453 if (!NILP (character))
3454 goto setup_attributes;
3458 if ( (!NILP (code = Fcdr (Fassq (Qto_ucs, attributes)))) ||
3459 (!NILP (code = Fcdr (Fassq (Q_ucs, attributes)))) )
3463 signal_simple_error ("Invalid argument", attributes);
3465 character = make_char (XINT (code) + 0x100000);
3466 goto setup_attributes;
3470 else if (!INTP (code))
3471 signal_simple_error ("Invalid argument", attributes);
3473 character = make_char (XINT (code));
3477 while (CONSP (rest))
3479 Lisp_Object cell = Fcar (rest);
3482 signal_simple_error ("Invalid argument", attributes);
3484 Fput_char_attribute (character, Fcar (cell), Fcdr (cell));
3490 DEFUN ("find-char", Ffind_char, 1, 1, 0, /*
3491 Retrieve the character of the given ATTRIBUTES.
3495 Lisp_Object rest = attributes;
3498 while (CONSP (rest))
3500 Lisp_Object cell = Fcar (rest);
3504 signal_simple_error ("Invalid argument", attributes);
3505 if (!NILP (ccs = Ffind_charset (Fcar (cell))))
3509 return Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
3511 return Fdecode_char (ccs, cell);
3515 if ( (!NILP (code = Fcdr (Fassq (Qto_ucs, attributes)))) ||
3516 (!NILP (code = Fcdr (Fassq (Q_ucs, attributes)))) )
3519 signal_simple_error ("Invalid argument", attributes);
3521 return make_char (XINT (code) + 0x100000);
3529 /************************************************************************/
3530 /* Char table read syntax */
3531 /************************************************************************/
3534 chartab_type_validate (Lisp_Object keyword, Lisp_Object value,
3535 Error_behavior errb)
3537 /* #### should deal with ERRB */
3538 symbol_to_char_table_type (value);
3543 chartab_data_validate (Lisp_Object keyword, Lisp_Object value,
3544 Error_behavior errb)
3548 /* #### should deal with ERRB */
3549 EXTERNAL_LIST_LOOP (rest, value)
3551 Lisp_Object range = XCAR (rest);
3552 struct chartab_range dummy;
3556 signal_simple_error ("Invalid list format", value);
3559 if (!CONSP (XCDR (range))
3560 || !NILP (XCDR (XCDR (range))))
3561 signal_simple_error ("Invalid range format", range);
3562 decode_char_table_range (XCAR (range), &dummy);
3563 decode_char_table_range (XCAR (XCDR (range)), &dummy);
3566 decode_char_table_range (range, &dummy);
3573 chartab_instantiate (Lisp_Object data)
3575 Lisp_Object chartab;
3576 Lisp_Object type = Qgeneric;
3577 Lisp_Object dataval = Qnil;
3579 while (!NILP (data))
3581 Lisp_Object keyw = Fcar (data);
3587 if (EQ (keyw, Qtype))
3589 else if (EQ (keyw, Qdata))
3593 chartab = Fmake_char_table (type);
3596 while (!NILP (data))
3598 Lisp_Object range = Fcar (data);
3599 Lisp_Object val = Fcar (Fcdr (data));
3601 data = Fcdr (Fcdr (data));
3604 if (CHAR_OR_CHAR_INTP (XCAR (range)))
3606 Emchar first = XCHAR_OR_CHAR_INT (Fcar (range));
3607 Emchar last = XCHAR_OR_CHAR_INT (Fcar (Fcdr (range)));
3610 for (i = first; i <= last; i++)
3611 Fput_char_table (make_char (i), val, chartab);
3617 Fput_char_table (range, val, chartab);
3626 /************************************************************************/
3627 /* Category Tables, specifically */
3628 /************************************************************************/
3630 DEFUN ("category-table-p", Fcategory_table_p, 1, 1, 0, /*
3631 Return t if OBJECT is a category table.
3632 A category table is a type of char table used for keeping track of
3633 categories. Categories are used for classifying characters for use
3634 in regexps -- you can refer to a category rather than having to use
3635 a complicated [] expression (and category lookups are significantly
3638 There are 95 different categories available, one for each printable
3639 character (including space) in the ASCII charset. Each category
3640 is designated by one such character, called a "category designator".
3641 They are specified in a regexp using the syntax "\\cX", where X is
3642 a category designator.
3644 A category table specifies, for each character, the categories that
3645 the character is in. Note that a character can be in more than one
3646 category. More specifically, a category table maps from a character
3647 to either the value nil (meaning the character is in no categories)
3648 or a 95-element bit vector, specifying for each of the 95 categories
3649 whether the character is in that category.
3651 Special Lisp functions are provided that abstract this, so you do not
3652 have to directly manipulate bit vectors.
3656 return (CHAR_TABLEP (object) &&
3657 XCHAR_TABLE_TYPE (object) == CHAR_TABLE_TYPE_CATEGORY) ?
3662 check_category_table (Lisp_Object object, Lisp_Object default_)
3666 while (NILP (Fcategory_table_p (object)))
3667 object = wrong_type_argument (Qcategory_table_p, object);
3672 check_category_char (Emchar ch, Lisp_Object table,
3673 unsigned int designator, unsigned int not)
3675 REGISTER Lisp_Object temp;
3676 Lisp_Char_Table *ctbl;
3677 #ifdef ERROR_CHECK_TYPECHECK
3678 if (NILP (Fcategory_table_p (table)))
3679 signal_simple_error ("Expected category table", table);
3681 ctbl = XCHAR_TABLE (table);
3682 temp = get_char_table (ch, ctbl);
3687 return bit_vector_bit (XBIT_VECTOR (temp), designator) ? !not : not;
3690 DEFUN ("check-category-at", Fcheck_category_at, 2, 4, 0, /*
3691 Return t if category of the character at POSITION includes DESIGNATOR.
3692 Optional third arg BUFFER specifies which buffer to use, and defaults
3693 to the current buffer.
3694 Optional fourth arg CATEGORY-TABLE specifies the category table to
3695 use, and defaults to BUFFER's category table.
3697 (position, designator, buffer, category_table))
3702 struct buffer *buf = decode_buffer (buffer, 0);
3704 CHECK_INT (position);
3705 CHECK_CATEGORY_DESIGNATOR (designator);
3706 des = XCHAR (designator);
3707 ctbl = check_category_table (category_table, Vstandard_category_table);
3708 ch = BUF_FETCH_CHAR (buf, XINT (position));
3709 return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil;
3712 DEFUN ("char-in-category-p", Fchar_in_category_p, 2, 3, 0, /*
3713 Return t if category of CHARACTER includes DESIGNATOR, else nil.
3714 Optional third arg CATEGORY-TABLE specifies the category table to use,
3715 and defaults to the standard category table.
3717 (character, designator, category_table))
3723 CHECK_CATEGORY_DESIGNATOR (designator);
3724 des = XCHAR (designator);
3725 CHECK_CHAR (character);
3726 ch = XCHAR (character);
3727 ctbl = check_category_table (category_table, Vstandard_category_table);
3728 return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil;
3731 DEFUN ("category-table", Fcategory_table, 0, 1, 0, /*
3732 Return BUFFER's current category table.
3733 BUFFER defaults to the current buffer.
3737 return decode_buffer (buffer, 0)->category_table;
3740 DEFUN ("standard-category-table", Fstandard_category_table, 0, 0, 0, /*
3741 Return the standard category table.
3742 This is the one used for new buffers.
3746 return Vstandard_category_table;
3749 DEFUN ("copy-category-table", Fcopy_category_table, 0, 1, 0, /*
3750 Return a new category table which is a copy of CATEGORY-TABLE.
3751 CATEGORY-TABLE defaults to the standard category table.
3755 if (NILP (Vstandard_category_table))
3756 return Fmake_char_table (Qcategory);
3759 check_category_table (category_table, Vstandard_category_table);
3760 return Fcopy_char_table (category_table);
3763 DEFUN ("set-category-table", Fset_category_table, 1, 2, 0, /*
3764 Select CATEGORY-TABLE as the new category table for BUFFER.
3765 BUFFER defaults to the current buffer if omitted.
3767 (category_table, buffer))
3769 struct buffer *buf = decode_buffer (buffer, 0);
3770 category_table = check_category_table (category_table, Qnil);
3771 buf->category_table = category_table;
3772 /* Indicate that this buffer now has a specified category table. */
3773 buf->local_var_flags |= XINT (buffer_local_flags.category_table);
3774 return category_table;
3777 DEFUN ("category-designator-p", Fcategory_designator_p, 1, 1, 0, /*
3778 Return t if OBJECT is a category designator (a char in the range ' ' to '~').
3782 return CATEGORY_DESIGNATORP (object) ? Qt : Qnil;
3785 DEFUN ("category-table-value-p", Fcategory_table_value_p, 1, 1, 0, /*
3786 Return t if OBJECT is a category table value.
3787 Valid values are nil or a bit vector of size 95.
3791 return CATEGORY_TABLE_VALUEP (object) ? Qt : Qnil;
3795 #define CATEGORYP(x) \
3796 (CHARP (x) && XCHAR (x) >= 0x20 && XCHAR (x) <= 0x7E)
3798 #define CATEGORY_SET(c) \
3799 (get_char_table(c, XCHAR_TABLE(current_buffer->category_table)))
3801 /* Return 1 if CATEGORY_SET contains CATEGORY, else return 0.
3802 The faster version of `!NILP (Faref (category_set, category))'. */
3803 #define CATEGORY_MEMBER(category, category_set) \
3804 (bit_vector_bit(XBIT_VECTOR (category_set), category - 32))
3806 /* Return 1 if there is a word boundary between two word-constituent
3807 characters C1 and C2 if they appear in this order, else return 0.
3808 Use the macro WORD_BOUNDARY_P instead of calling this function
3811 int word_boundary_p (Emchar c1, Emchar c2);
3813 word_boundary_p (Emchar c1, Emchar c2)
3815 Lisp_Object category_set1, category_set2;
3820 if (COMPOSITE_CHAR_P (c1))
3821 c1 = cmpchar_component (c1, 0, 1);
3822 if (COMPOSITE_CHAR_P (c2))
3823 c2 = cmpchar_component (c2, 0, 1);
3826 if (EQ (CHAR_CHARSET (c1), CHAR_CHARSET (c2)))
3828 tail = Vword_separating_categories;
3833 tail = Vword_combining_categories;
3837 category_set1 = CATEGORY_SET (c1);
3838 if (NILP (category_set1))
3839 return default_result;
3840 category_set2 = CATEGORY_SET (c2);
3841 if (NILP (category_set2))
3842 return default_result;
3844 for (; CONSP (tail); tail = XCONS (tail)->cdr)
3846 Lisp_Object elt = XCONS(tail)->car;
3849 && CATEGORYP (XCONS (elt)->car)
3850 && CATEGORYP (XCONS (elt)->cdr)
3851 && CATEGORY_MEMBER (XCHAR (XCONS (elt)->car), category_set1)
3852 && CATEGORY_MEMBER (XCHAR (XCONS (elt)->cdr), category_set2))
3853 return !default_result;
3855 return default_result;
3861 syms_of_chartab (void)
3864 INIT_LRECORD_IMPLEMENTATION (uint8_byte_table);
3865 INIT_LRECORD_IMPLEMENTATION (uint16_byte_table);
3866 INIT_LRECORD_IMPLEMENTATION (byte_table);
3868 defsymbol (&Qto_ucs, "=>ucs");
3869 defsymbol (&Q_ucs, "->ucs");
3870 defsymbol (&Q_decomposition, "->decomposition");
3871 defsymbol (&Qcompat, "compat");
3872 defsymbol (&Qisolated, "isolated");
3873 defsymbol (&Qinitial, "initial");
3874 defsymbol (&Qmedial, "medial");
3875 defsymbol (&Qfinal, "final");
3876 defsymbol (&Qvertical, "vertical");
3877 defsymbol (&QnoBreak, "noBreak");
3878 defsymbol (&Qfraction, "fraction");
3879 defsymbol (&Qsuper, "super");
3880 defsymbol (&Qsub, "sub");
3881 defsymbol (&Qcircle, "circle");
3882 defsymbol (&Qsquare, "square");
3883 defsymbol (&Qwide, "wide");
3884 defsymbol (&Qnarrow, "narrow");
3885 defsymbol (&Qsmall, "small");
3886 defsymbol (&Qfont, "font");
3888 DEFSUBR (Fchar_attribute_list);
3889 DEFSUBR (Ffind_char_attribute_table);
3890 DEFSUBR (Fchar_attribute_alist);
3891 DEFSUBR (Fget_char_attribute);
3892 DEFSUBR (Fput_char_attribute);
3893 DEFSUBR (Fremove_char_attribute);
3894 DEFSUBR (Fmap_char_attribute);
3895 DEFSUBR (Fdefine_char);
3896 DEFSUBR (Ffind_char);
3897 DEFSUBR (Fchar_variants);
3899 DEFSUBR (Fget_composite_char);
3902 INIT_LRECORD_IMPLEMENTATION (char_table);
3906 INIT_LRECORD_IMPLEMENTATION (char_table_entry);
3909 defsymbol (&Qcategory_table_p, "category-table-p");
3910 defsymbol (&Qcategory_designator_p, "category-designator-p");
3911 defsymbol (&Qcategory_table_value_p, "category-table-value-p");
3914 defsymbol (&Qchar_table, "char-table");
3915 defsymbol (&Qchar_tablep, "char-table-p");
3917 DEFSUBR (Fchar_table_p);
3918 DEFSUBR (Fchar_table_type_list);
3919 DEFSUBR (Fvalid_char_table_type_p);
3920 DEFSUBR (Fchar_table_type);
3921 DEFSUBR (Freset_char_table);
3922 DEFSUBR (Fmake_char_table);
3923 DEFSUBR (Fcopy_char_table);
3924 DEFSUBR (Fget_char_table);
3925 DEFSUBR (Fget_range_char_table);
3926 DEFSUBR (Fvalid_char_table_value_p);
3927 DEFSUBR (Fcheck_valid_char_table_value);
3928 DEFSUBR (Fput_char_table);
3929 DEFSUBR (Fmap_char_table);
3932 DEFSUBR (Fcategory_table_p);
3933 DEFSUBR (Fcategory_table);
3934 DEFSUBR (Fstandard_category_table);
3935 DEFSUBR (Fcopy_category_table);
3936 DEFSUBR (Fset_category_table);
3937 DEFSUBR (Fcheck_category_at);
3938 DEFSUBR (Fchar_in_category_p);
3939 DEFSUBR (Fcategory_designator_p);
3940 DEFSUBR (Fcategory_table_value_p);
3946 vars_of_chartab (void)
3949 Vutf_2000_version = build_string("0.18 (Yamato-Koizumi)");
3950 DEFVAR_LISP ("utf-2000-version", &Vutf_2000_version /*
3951 Version number of XEmacs UTF-2000.
3954 staticpro (&Vcharacter_composition_table);
3955 Vcharacter_composition_table = make_char_id_table (Qnil);
3957 staticpro (&Vcharacter_variant_table);
3958 Vcharacter_variant_table = make_char_id_table (Qnil);
3960 /* DO NOT staticpro this. It works just like Vweak_hash_tables. */
3961 Vall_syntax_tables = Qnil;
3962 dump_add_weak_object_chain (&Vall_syntax_tables);
3966 structure_type_create_chartab (void)
3968 struct structure_type *st;
3970 st = define_structure_type (Qchar_table, 0, chartab_instantiate);
3972 define_structure_type_keyword (st, Qtype, chartab_type_validate);
3973 define_structure_type_keyword (st, Qdata, chartab_data_validate);
3977 complex_vars_of_chartab (void)
3980 staticpro (&Vchar_attribute_hash_table);
3981 Vchar_attribute_hash_table
3982 = make_lisp_hash_table (16, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
3983 #endif /* UTF2000 */
3985 /* Set this now, so first buffer creation can refer to it. */
3986 /* Make it nil before calling copy-category-table
3987 so that copy-category-table will know not to try to copy from garbage */
3988 Vstandard_category_table = Qnil;
3989 Vstandard_category_table = Fcopy_category_table (Qnil);
3990 staticpro (&Vstandard_category_table);
3992 DEFVAR_LISP ("word-combining-categories", &Vword_combining_categories /*
3993 List of pair (cons) of categories to determine word boundary.
3995 Emacs treats a sequence of word constituent characters as a single
3996 word (i.e. finds no word boundary between them) iff they belongs to
3997 the same charset. But, exceptions are allowed in the following cases.
3999 \(1) The case that characters are in different charsets is controlled
4000 by the variable `word-combining-categories'.
4002 Emacs finds no word boundary between characters of different charsets
4003 if they have categories matching some element of this list.
4005 More precisely, if an element of this list is a cons of category CAT1
4006 and CAT2, and a multibyte character C1 which has CAT1 is followed by
4007 C2 which has CAT2, there's no word boundary between C1 and C2.
4009 For instance, to tell that ASCII characters and Latin-1 characters can
4010 form a single word, the element `(?l . ?l)' should be in this list
4011 because both characters have the category `l' (Latin characters).
4013 \(2) The case that character are in the same charset is controlled by
4014 the variable `word-separating-categories'.
4016 Emacs find a word boundary between characters of the same charset
4017 if they have categories matching some element of this list.
4019 More precisely, if an element of this list is a cons of category CAT1
4020 and CAT2, and a multibyte character C1 which has CAT1 is followed by
4021 C2 which has CAT2, there's a word boundary between C1 and C2.
4023 For instance, to tell that there's a word boundary between Japanese
4024 Hiragana and Japanese Kanji (both are in the same charset), the
4025 element `(?H . ?C) should be in this list.
4028 Vword_combining_categories = Qnil;
4030 DEFVAR_LISP ("word-separating-categories", &Vword_separating_categories /*
4031 List of pair (cons) of categories to determine word boundary.
4032 See the documentation of the variable `word-combining-categories'.
4035 Vword_separating_categories = Qnil;