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.
8 This file is part of XEmacs.
10 XEmacs is free software; you can redistribute it and/or modify it
11 under the terms of the GNU General Public License as published by the
12 Free Software Foundation; either version 2, or (at your option) any
15 XEmacs is distributed in the hope that it will be useful, but WITHOUT
16 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
17 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
20 You should have received a copy of the GNU General Public License
21 along with XEmacs; see the file COPYING. If not, write to
22 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 Boston, MA 02111-1307, USA. */
25 /* Synched up with: Mule 2.3. Not synched with FSF.
27 This file was written independently of the FSF implementation,
28 and is not compatible. */
32 Ben Wing: wrote, for 19.13 (Mule). Some category table stuff
33 loosely based on the original Mule.
34 Jareth Hein: fixed a couple of bugs in the implementation, and
35 added regex support for categories with check_category_at
45 Lisp_Object Qchar_tablep, Qchar_table;
47 Lisp_Object Vall_syntax_tables;
50 Lisp_Object Qcategory_table_p;
51 Lisp_Object Qcategory_designator_p;
52 Lisp_Object Qcategory_table_value_p;
54 Lisp_Object Vstandard_category_table;
56 /* Variables to determine word boundary. */
57 Lisp_Object Vword_combining_categories, Vword_separating_categories;
61 /* A char table maps from ranges of characters to values.
63 Implementing a general data structure that maps from arbitrary
64 ranges of numbers to values is tricky to do efficiently. As it
65 happens, it should suffice (and is usually more convenient, anyway)
66 when dealing with characters to restrict the sorts of ranges that
67 can be assigned values, as follows:
70 2) All characters in a charset.
71 3) All characters in a particular row of a charset, where a "row"
72 means all characters with the same first byte.
73 4) A particular character in a charset.
75 We use char tables to generalize the 256-element vectors now
76 littering the Emacs code.
78 Possible uses (all should be converted at some point):
84 5) keyboard-translate-table?
87 abstract type to generalize the Emacs vectors and Mule
88 vectors-of-vectors goo.
91 /************************************************************************/
92 /* Char Table object */
93 /************************************************************************/
98 mark_char_table_entry (Lisp_Object obj)
100 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj);
103 for (i = 0; i < 96; i++)
105 mark_object (cte->level2[i]);
111 char_table_entry_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
113 Lisp_Char_Table_Entry *cte1 = XCHAR_TABLE_ENTRY (obj1);
114 Lisp_Char_Table_Entry *cte2 = XCHAR_TABLE_ENTRY (obj2);
117 for (i = 0; i < 96; i++)
118 if (!internal_equal (cte1->level2[i], cte2->level2[i], depth + 1))
125 char_table_entry_hash (Lisp_Object obj, int depth)
127 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj);
129 return internal_array_hash (cte->level2, 96, depth);
132 static const struct lrecord_description char_table_entry_description[] = {
133 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table_Entry, level2), 96 },
137 DEFINE_LRECORD_IMPLEMENTATION ("char-table-entry", char_table_entry,
138 mark_char_table_entry, internal_object_printer,
139 0, char_table_entry_equal,
140 char_table_entry_hash,
141 char_table_entry_description,
142 Lisp_Char_Table_Entry);
146 mark_char_table (Lisp_Object obj)
148 Lisp_Char_Table *ct = XCHAR_TABLE (obj);
151 for (i = 0; i < NUM_ASCII_CHARS; i++)
152 mark_object (ct->ascii[i]);
154 for (i = 0; i < NUM_LEADING_BYTES; i++)
155 mark_object (ct->level1[i]);
157 return ct->mirror_table;
160 /* WARNING: All functions of this nature need to be written extremely
161 carefully to avoid crashes during GC. Cf. prune_specifiers()
162 and prune_weak_hash_tables(). */
165 prune_syntax_tables (void)
167 Lisp_Object rest, prev = Qnil;
169 for (rest = Vall_syntax_tables;
171 rest = XCHAR_TABLE (rest)->next_table)
173 if (! marked_p (rest))
175 /* This table is garbage. Remove it from the list. */
177 Vall_syntax_tables = XCHAR_TABLE (rest)->next_table;
179 XCHAR_TABLE (prev)->next_table =
180 XCHAR_TABLE (rest)->next_table;
186 char_table_type_to_symbol (enum char_table_type type)
191 case CHAR_TABLE_TYPE_GENERIC: return Qgeneric;
192 case CHAR_TABLE_TYPE_SYNTAX: return Qsyntax;
193 case CHAR_TABLE_TYPE_DISPLAY: return Qdisplay;
194 case CHAR_TABLE_TYPE_CHAR: return Qchar;
196 case CHAR_TABLE_TYPE_CATEGORY: return Qcategory;
201 static enum char_table_type
202 symbol_to_char_table_type (Lisp_Object symbol)
204 CHECK_SYMBOL (symbol);
206 if (EQ (symbol, Qgeneric)) return CHAR_TABLE_TYPE_GENERIC;
207 if (EQ (symbol, Qsyntax)) return CHAR_TABLE_TYPE_SYNTAX;
208 if (EQ (symbol, Qdisplay)) return CHAR_TABLE_TYPE_DISPLAY;
209 if (EQ (symbol, Qchar)) return CHAR_TABLE_TYPE_CHAR;
211 if (EQ (symbol, Qcategory)) return CHAR_TABLE_TYPE_CATEGORY;
214 signal_simple_error ("Unrecognized char table type", symbol);
215 return CHAR_TABLE_TYPE_GENERIC; /* not reached */
219 print_chartab_range (Emchar first, Emchar last, Lisp_Object val,
220 Lisp_Object printcharfun)
224 write_c_string (" (", printcharfun);
225 print_internal (make_char (first), printcharfun, 0);
226 write_c_string (" ", printcharfun);
227 print_internal (make_char (last), printcharfun, 0);
228 write_c_string (") ", printcharfun);
232 write_c_string (" ", printcharfun);
233 print_internal (make_char (first), printcharfun, 0);
234 write_c_string (" ", printcharfun);
236 print_internal (val, printcharfun, 1);
242 print_chartab_charset_row (Lisp_Object charset,
244 Lisp_Char_Table_Entry *cte,
245 Lisp_Object printcharfun)
248 Lisp_Object cat = Qunbound;
251 for (i = 32; i < 128; i++)
253 Lisp_Object pam = cte->level2[i - 32];
265 print_chartab_range (MAKE_CHAR (charset, first, 0),
266 MAKE_CHAR (charset, i - 1, 0),
269 print_chartab_range (MAKE_CHAR (charset, row, first),
270 MAKE_CHAR (charset, row, i - 1),
280 print_chartab_range (MAKE_CHAR (charset, first, 0),
281 MAKE_CHAR (charset, i - 1, 0),
284 print_chartab_range (MAKE_CHAR (charset, row, first),
285 MAKE_CHAR (charset, row, i - 1),
291 print_chartab_two_byte_charset (Lisp_Object charset,
292 Lisp_Char_Table_Entry *cte,
293 Lisp_Object printcharfun)
297 for (i = 32; i < 128; i++)
299 Lisp_Object jen = cte->level2[i - 32];
301 if (!CHAR_TABLE_ENTRYP (jen))
305 write_c_string (" [", printcharfun);
306 print_internal (XCHARSET_NAME (charset), printcharfun, 0);
307 sprintf (buf, " %d] ", i);
308 write_c_string (buf, printcharfun);
309 print_internal (jen, printcharfun, 0);
312 print_chartab_charset_row (charset, i, XCHAR_TABLE_ENTRY (jen),
320 print_char_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
322 Lisp_Char_Table *ct = XCHAR_TABLE (obj);
325 sprintf (buf, "#s(char-table type %s data (",
326 string_data (symbol_name (XSYMBOL
327 (char_table_type_to_symbol (ct->type)))));
328 write_c_string (buf, printcharfun);
330 /* Now write out the ASCII/Control-1 stuff. */
334 Lisp_Object val = Qunbound;
336 for (i = 0; i < NUM_ASCII_CHARS; i++)
345 if (!EQ (ct->ascii[i], val))
347 print_chartab_range (first, i - 1, val, printcharfun);
354 print_chartab_range (first, i - 1, val, printcharfun);
361 for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES;
364 Lisp_Object ann = ct->level1[i - MIN_LEADING_BYTE];
365 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (i);
367 if (!CHARSETP (charset) || i == LEADING_BYTE_ASCII
368 || i == LEADING_BYTE_CONTROL_1)
370 if (!CHAR_TABLE_ENTRYP (ann))
372 write_c_string (" ", printcharfun);
373 print_internal (XCHARSET_NAME (charset),
375 write_c_string (" ", printcharfun);
376 print_internal (ann, printcharfun, 0);
380 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (ann);
381 if (XCHARSET_DIMENSION (charset) == 1)
382 print_chartab_charset_row (charset, -1, cte, printcharfun);
384 print_chartab_two_byte_charset (charset, cte, printcharfun);
390 write_c_string ("))", printcharfun);
394 char_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
396 Lisp_Char_Table *ct1 = XCHAR_TABLE (obj1);
397 Lisp_Char_Table *ct2 = XCHAR_TABLE (obj2);
400 if (CHAR_TABLE_TYPE (ct1) != CHAR_TABLE_TYPE (ct2))
403 for (i = 0; i < NUM_ASCII_CHARS; i++)
404 if (!internal_equal (ct1->ascii[i], ct2->ascii[i], depth + 1))
408 for (i = 0; i < NUM_LEADING_BYTES; i++)
409 if (!internal_equal (ct1->level1[i], ct2->level1[i], depth + 1))
417 char_table_hash (Lisp_Object obj, int depth)
419 Lisp_Char_Table *ct = XCHAR_TABLE (obj);
420 unsigned long hashval = internal_array_hash (ct->ascii, NUM_ASCII_CHARS,
423 hashval = HASH2 (hashval,
424 internal_array_hash (ct->level1, NUM_LEADING_BYTES, depth));
429 static const struct lrecord_description char_table_description[] = {
430 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, ascii), NUM_ASCII_CHARS },
432 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, level1), NUM_LEADING_BYTES },
434 { XD_LISP_OBJECT, offsetof (Lisp_Char_Table, mirror_table) },
435 { XD_LO_LINK, offsetof (Lisp_Char_Table, next_table) },
439 DEFINE_LRECORD_IMPLEMENTATION ("char-table", char_table,
440 mark_char_table, print_char_table, 0,
441 char_table_equal, char_table_hash,
442 char_table_description,
445 DEFUN ("char-table-p", Fchar_table_p, 1, 1, 0, /*
446 Return non-nil if OBJECT is a char table.
448 A char table is a table that maps characters (or ranges of characters)
449 to values. Char tables are specialized for characters, only allowing
450 particular sorts of ranges to be assigned values. Although this
451 loses in generality, it makes for extremely fast (constant-time)
452 lookups, and thus is feasible for applications that do an extremely
453 large number of lookups (e.g. scanning a buffer for a character in
454 a particular syntax, where a lookup in the syntax table must occur
457 When Mule support exists, the types of ranges that can be assigned
462 -- a single row in a two-octet charset
463 -- a single character
465 When Mule support is not present, the types of ranges that can be
469 -- a single character
471 To create a char table, use `make-char-table'.
472 To modify a char table, use `put-char-table' or `remove-char-table'.
473 To retrieve the value for a particular character, use `get-char-table'.
474 See also `map-char-table', `clear-char-table', `copy-char-table',
475 `valid-char-table-type-p', `char-table-type-list',
476 `valid-char-table-value-p', and `check-char-table-value'.
480 return CHAR_TABLEP (object) ? Qt : Qnil;
483 DEFUN ("char-table-type-list", Fchar_table_type_list, 0, 0, 0, /*
484 Return a list of the recognized char table types.
485 See `valid-char-table-type-p'.
490 return list5 (Qchar, Qcategory, Qdisplay, Qgeneric, Qsyntax);
492 return list4 (Qchar, Qdisplay, Qgeneric, Qsyntax);
496 DEFUN ("valid-char-table-type-p", Fvalid_char_table_type_p, 1, 1, 0, /*
497 Return t if TYPE if a recognized char table type.
499 Each char table type is used for a different purpose and allows different
500 sorts of values. The different char table types are
503 Used for category tables, which specify the regexp categories
504 that a character is in. The valid values are nil or a
505 bit vector of 95 elements. Higher-level Lisp functions are
506 provided for working with category tables. Currently categories
507 and category tables only exist when Mule support is present.
509 A generalized char table, for mapping from one character to
510 another. Used for case tables, syntax matching tables,
511 `keyboard-translate-table', etc. The valid values are characters.
513 An even more generalized char table, for mapping from a
514 character to anything.
516 Used for display tables, which specify how a particular character
517 is to appear when displayed. #### Not yet implemented.
519 Used for syntax tables, which specify the syntax of a particular
520 character. Higher-level Lisp functions are provided for
521 working with syntax tables. The valid values are integers.
526 return (EQ (type, Qchar) ||
528 EQ (type, Qcategory) ||
530 EQ (type, Qdisplay) ||
531 EQ (type, Qgeneric) ||
532 EQ (type, Qsyntax)) ? Qt : Qnil;
535 DEFUN ("char-table-type", Fchar_table_type, 1, 1, 0, /*
536 Return the type of CHAR-TABLE.
537 See `valid-char-table-type-p'.
541 CHECK_CHAR_TABLE (char_table);
542 return char_table_type_to_symbol (XCHAR_TABLE (char_table)->type);
546 fill_char_table (Lisp_Char_Table *ct, Lisp_Object value)
550 for (i = 0; i < NUM_ASCII_CHARS; i++)
551 ct->ascii[i] = value;
553 for (i = 0; i < NUM_LEADING_BYTES; i++)
554 ct->level1[i] = value;
557 if (ct->type == CHAR_TABLE_TYPE_SYNTAX)
558 update_syntax_table (ct);
561 DEFUN ("reset-char-table", Freset_char_table, 1, 1, 0, /*
562 Reset CHAR-TABLE to its default state.
568 CHECK_CHAR_TABLE (char_table);
569 ct = XCHAR_TABLE (char_table);
573 case CHAR_TABLE_TYPE_CHAR:
574 fill_char_table (ct, make_char (0));
576 case CHAR_TABLE_TYPE_DISPLAY:
577 case CHAR_TABLE_TYPE_GENERIC:
579 case CHAR_TABLE_TYPE_CATEGORY:
581 fill_char_table (ct, Qnil);
584 case CHAR_TABLE_TYPE_SYNTAX:
585 fill_char_table (ct, make_int (Sinherit));
595 DEFUN ("make-char-table", Fmake_char_table, 1, 1, 0, /*
596 Return a new, empty char table of type TYPE.
597 Currently recognized types are 'char, 'category, 'display, 'generic,
598 and 'syntax. See `valid-char-table-type-p'.
604 enum char_table_type ty = symbol_to_char_table_type (type);
606 ct = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table);
608 if (ty == CHAR_TABLE_TYPE_SYNTAX)
610 ct->mirror_table = Fmake_char_table (Qgeneric);
611 fill_char_table (XCHAR_TABLE (ct->mirror_table),
615 ct->mirror_table = Qnil;
616 ct->next_table = Qnil;
617 XSETCHAR_TABLE (obj, ct);
618 if (ty == CHAR_TABLE_TYPE_SYNTAX)
620 ct->next_table = Vall_syntax_tables;
621 Vall_syntax_tables = obj;
623 Freset_char_table (obj);
630 make_char_table_entry (Lisp_Object initval)
634 Lisp_Char_Table_Entry *cte =
635 alloc_lcrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry);
637 for (i = 0; i < 96; i++)
638 cte->level2[i] = initval;
640 XSETCHAR_TABLE_ENTRY (obj, cte);
645 copy_char_table_entry (Lisp_Object entry)
647 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (entry);
650 Lisp_Char_Table_Entry *ctenew =
651 alloc_lcrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry);
653 for (i = 0; i < 96; i++)
655 Lisp_Object new = cte->level2[i];
656 if (CHAR_TABLE_ENTRYP (new))
657 ctenew->level2[i] = copy_char_table_entry (new);
659 ctenew->level2[i] = new;
662 XSETCHAR_TABLE_ENTRY (obj, ctenew);
668 DEFUN ("copy-char-table", Fcopy_char_table, 1, 1, 0, /*
669 Return a new char table which is a copy of CHAR-TABLE.
670 It will contain the same values for the same characters and ranges
671 as CHAR-TABLE. The values will not themselves be copied.
675 Lisp_Char_Table *ct, *ctnew;
679 CHECK_CHAR_TABLE (char_table);
680 ct = XCHAR_TABLE (char_table);
681 ctnew = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table);
682 ctnew->type = ct->type;
684 for (i = 0; i < NUM_ASCII_CHARS; i++)
686 Lisp_Object new = ct->ascii[i];
688 assert (! (CHAR_TABLE_ENTRYP (new)));
690 ctnew->ascii[i] = new;
695 for (i = 0; i < NUM_LEADING_BYTES; i++)
697 Lisp_Object new = ct->level1[i];
698 if (CHAR_TABLE_ENTRYP (new))
699 ctnew->level1[i] = copy_char_table_entry (new);
701 ctnew->level1[i] = new;
706 if (CHAR_TABLEP (ct->mirror_table))
707 ctnew->mirror_table = Fcopy_char_table (ct->mirror_table);
709 ctnew->mirror_table = ct->mirror_table;
710 ctnew->next_table = Qnil;
711 XSETCHAR_TABLE (obj, ctnew);
712 if (ctnew->type == CHAR_TABLE_TYPE_SYNTAX)
714 ctnew->next_table = Vall_syntax_tables;
715 Vall_syntax_tables = obj;
721 decode_char_table_range (Lisp_Object range, struct chartab_range *outrange)
724 outrange->type = CHARTAB_RANGE_ALL;
725 else if (CHAR_OR_CHAR_INTP (range))
727 outrange->type = CHARTAB_RANGE_CHAR;
728 outrange->ch = XCHAR_OR_CHAR_INT (range);
732 signal_simple_error ("Range must be t or a character", range);
734 else if (VECTORP (range))
736 Lisp_Vector *vec = XVECTOR (range);
737 Lisp_Object *elts = vector_data (vec);
738 if (vector_length (vec) != 2)
739 signal_simple_error ("Length of charset row vector must be 2",
741 outrange->type = CHARTAB_RANGE_ROW;
742 outrange->charset = Fget_charset (elts[0]);
744 outrange->row = XINT (elts[1]);
745 switch (XCHARSET_TYPE (outrange->charset))
747 case CHARSET_TYPE_94:
748 case CHARSET_TYPE_96:
749 signal_simple_error ("Charset in row vector must be multi-byte",
751 case CHARSET_TYPE_94X94:
752 check_int_range (outrange->row, 33, 126);
754 case CHARSET_TYPE_96X96:
755 check_int_range (outrange->row, 32, 127);
763 if (!CHARSETP (range) && !SYMBOLP (range))
765 ("Char table range must be t, charset, char, or vector", range);
766 outrange->type = CHARTAB_RANGE_CHARSET;
767 outrange->charset = Fget_charset (range);
774 /* called from CHAR_TABLE_VALUE(). */
776 get_non_ascii_char_table_value (Lisp_Char_Table *ct, int leading_byte,
780 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (leading_byte);
783 BREAKUP_CHAR_1_UNSAFE (c, charset, byte1, byte2);
784 val = ct->level1[leading_byte - MIN_LEADING_BYTE];
785 if (CHAR_TABLE_ENTRYP (val))
787 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
788 val = cte->level2[byte1 - 32];
789 if (CHAR_TABLE_ENTRYP (val))
791 cte = XCHAR_TABLE_ENTRY (val);
792 assert (byte2 >= 32);
793 val = cte->level2[byte2 - 32];
794 assert (!CHAR_TABLE_ENTRYP (val));
804 get_char_table (Emchar ch, Lisp_Char_Table *ct)
812 BREAKUP_CHAR (ch, charset, byte1, byte2);
814 if (EQ (charset, Vcharset_ascii))
815 val = ct->ascii[byte1];
816 else if (EQ (charset, Vcharset_control_1))
817 val = ct->ascii[byte1 + 128];
820 int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE;
821 val = ct->level1[lb];
822 if (CHAR_TABLE_ENTRYP (val))
824 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
825 val = cte->level2[byte1 - 32];
826 if (CHAR_TABLE_ENTRYP (val))
828 cte = XCHAR_TABLE_ENTRY (val);
829 assert (byte2 >= 32);
830 val = cte->level2[byte2 - 32];
831 assert (!CHAR_TABLE_ENTRYP (val));
839 return ct->ascii[(unsigned char)ch];
840 #endif /* not MULE */
844 DEFUN ("get-char-table", Fget_char_table, 2, 2, 0, /*
845 Find value for CHARACTER in CHAR-TABLE.
847 (character, char_table))
849 CHECK_CHAR_TABLE (char_table);
850 CHECK_CHAR_COERCE_INT (character);
852 return get_char_table (XCHAR (character), XCHAR_TABLE (char_table));
855 DEFUN ("get-range-char-table", Fget_range_char_table, 2, 3, 0, /*
856 Find value for a range in CHAR-TABLE.
857 If there is more than one value, return MULTI (defaults to nil).
859 (range, char_table, multi))
862 struct chartab_range rainj;
864 if (CHAR_OR_CHAR_INTP (range))
865 return Fget_char_table (range, char_table);
866 CHECK_CHAR_TABLE (char_table);
867 ct = XCHAR_TABLE (char_table);
869 decode_char_table_range (range, &rainj);
872 case CHARTAB_RANGE_ALL:
875 Lisp_Object first = ct->ascii[0];
877 for (i = 1; i < NUM_ASCII_CHARS; i++)
878 if (!EQ (first, ct->ascii[i]))
882 for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES;
885 if (!CHARSETP (CHARSET_BY_LEADING_BYTE (i))
886 || i == LEADING_BYTE_ASCII
887 || i == LEADING_BYTE_CONTROL_1)
889 if (!EQ (first, ct->level1[i - MIN_LEADING_BYTE]))
898 case CHARTAB_RANGE_CHARSET:
899 if (EQ (rainj.charset, Vcharset_ascii))
902 Lisp_Object first = ct->ascii[0];
904 for (i = 1; i < 128; i++)
905 if (!EQ (first, ct->ascii[i]))
910 if (EQ (rainj.charset, Vcharset_control_1))
913 Lisp_Object first = ct->ascii[128];
915 for (i = 129; i < 160; i++)
916 if (!EQ (first, ct->ascii[i]))
922 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (rainj.charset) -
924 if (CHAR_TABLE_ENTRYP (val))
929 case CHARTAB_RANGE_ROW:
931 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (rainj.charset) -
933 if (!CHAR_TABLE_ENTRYP (val))
935 val = XCHAR_TABLE_ENTRY (val)->level2[rainj.row - 32];
936 if (CHAR_TABLE_ENTRYP (val))
940 #endif /* not MULE */
946 return Qnil; /* not reached */
950 check_valid_char_table_value (Lisp_Object value, enum char_table_type type,
955 case CHAR_TABLE_TYPE_SYNTAX:
956 if (!ERRB_EQ (errb, ERROR_ME))
957 return INTP (value) || (CONSP (value) && INTP (XCAR (value))
958 && CHAR_OR_CHAR_INTP (XCDR (value)));
961 Lisp_Object cdr = XCDR (value);
962 CHECK_INT (XCAR (value));
963 CHECK_CHAR_COERCE_INT (cdr);
970 case CHAR_TABLE_TYPE_CATEGORY:
971 if (!ERRB_EQ (errb, ERROR_ME))
972 return CATEGORY_TABLE_VALUEP (value);
973 CHECK_CATEGORY_TABLE_VALUE (value);
977 case CHAR_TABLE_TYPE_GENERIC:
980 case CHAR_TABLE_TYPE_DISPLAY:
982 maybe_signal_simple_error ("Display char tables not yet implemented",
983 value, Qchar_table, errb);
986 case CHAR_TABLE_TYPE_CHAR:
987 if (!ERRB_EQ (errb, ERROR_ME))
988 return CHAR_OR_CHAR_INTP (value);
989 CHECK_CHAR_COERCE_INT (value);
996 return 0; /* not reached */
1000 canonicalize_char_table_value (Lisp_Object value, enum char_table_type type)
1004 case CHAR_TABLE_TYPE_SYNTAX:
1007 Lisp_Object car = XCAR (value);
1008 Lisp_Object cdr = XCDR (value);
1009 CHECK_CHAR_COERCE_INT (cdr);
1010 return Fcons (car, cdr);
1013 case CHAR_TABLE_TYPE_CHAR:
1014 CHECK_CHAR_COERCE_INT (value);
1022 DEFUN ("valid-char-table-value-p", Fvalid_char_table_value_p, 2, 2, 0, /*
1023 Return non-nil if VALUE is a valid value for CHAR-TABLE-TYPE.
1025 (value, char_table_type))
1027 enum char_table_type type = symbol_to_char_table_type (char_table_type);
1029 return check_valid_char_table_value (value, type, ERROR_ME_NOT) ? Qt : Qnil;
1032 DEFUN ("check-valid-char-table-value", Fcheck_valid_char_table_value, 2, 2, 0, /*
1033 Signal an error if VALUE is not a valid value for CHAR-TABLE-TYPE.
1035 (value, char_table_type))
1037 enum char_table_type type = symbol_to_char_table_type (char_table_type);
1039 check_valid_char_table_value (value, type, ERROR_ME);
1043 /* Assign VAL to all characters in RANGE in char table CT. */
1046 put_char_table (Lisp_Char_Table *ct, struct chartab_range *range,
1049 switch (range->type)
1051 case CHARTAB_RANGE_ALL:
1052 fill_char_table (ct, val);
1053 return; /* avoid the duplicate call to update_syntax_table() below,
1054 since fill_char_table() also did that. */
1057 case CHARTAB_RANGE_CHARSET:
1058 if (EQ (range->charset, Vcharset_ascii))
1061 for (i = 0; i < 128; i++)
1064 else if (EQ (range->charset, Vcharset_control_1))
1067 for (i = 128; i < 160; i++)
1072 int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE;
1073 ct->level1[lb] = val;
1077 case CHARTAB_RANGE_ROW:
1079 Lisp_Char_Table_Entry *cte;
1080 int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE;
1081 /* make sure that there is a separate entry for the row. */
1082 if (!CHAR_TABLE_ENTRYP (ct->level1[lb]))
1083 ct->level1[lb] = make_char_table_entry (ct->level1[lb]);
1084 cte = XCHAR_TABLE_ENTRY (ct->level1[lb]);
1085 cte->level2[range->row - 32] = val;
1090 case CHARTAB_RANGE_CHAR:
1093 Lisp_Object charset;
1096 BREAKUP_CHAR (range->ch, charset, byte1, byte2);
1097 if (EQ (charset, Vcharset_ascii))
1098 ct->ascii[byte1] = val;
1099 else if (EQ (charset, Vcharset_control_1))
1100 ct->ascii[byte1 + 128] = val;
1103 Lisp_Char_Table_Entry *cte;
1104 int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE;
1105 /* make sure that there is a separate entry for the row. */
1106 if (!CHAR_TABLE_ENTRYP (ct->level1[lb]))
1107 ct->level1[lb] = make_char_table_entry (ct->level1[lb]);
1108 cte = XCHAR_TABLE_ENTRY (ct->level1[lb]);
1109 /* now CTE is a char table entry for the charset;
1110 each entry is for a single row (or character of
1111 a one-octet charset). */
1112 if (XCHARSET_DIMENSION (charset) == 1)
1113 cte->level2[byte1 - 32] = val;
1116 /* assigning to one character in a two-octet charset. */
1117 /* make sure that the charset row contains a separate
1118 entry for each character. */
1119 if (!CHAR_TABLE_ENTRYP (cte->level2[byte1 - 32]))
1120 cte->level2[byte1 - 32] =
1121 make_char_table_entry (cte->level2[byte1 - 32]);
1122 cte = XCHAR_TABLE_ENTRY (cte->level2[byte1 - 32]);
1123 cte->level2[byte2 - 32] = val;
1127 #else /* not MULE */
1128 ct->ascii[(unsigned char) (range->ch)] = val;
1130 #endif /* not MULE */
1133 if (ct->type == CHAR_TABLE_TYPE_SYNTAX)
1134 update_syntax_table (ct);
1137 DEFUN ("put-char-table", Fput_char_table, 3, 3, 0, /*
1138 Set the value for chars in RANGE to be VALUE in CHAR-TABLE.
1140 RANGE specifies one or more characters to be affected and should be
1141 one of the following:
1143 -- t (all characters are affected)
1144 -- A charset (only allowed when Mule support is present)
1145 -- A vector of two elements: a two-octet charset and a row number
1146 (only allowed when Mule support is present)
1147 -- A single character
1149 VALUE must be a value appropriate for the type of CHAR-TABLE.
1150 See `valid-char-table-type-p'.
1152 (range, value, char_table))
1154 Lisp_Char_Table *ct;
1155 struct chartab_range rainj;
1157 CHECK_CHAR_TABLE (char_table);
1158 ct = XCHAR_TABLE (char_table);
1159 check_valid_char_table_value (value, ct->type, ERROR_ME);
1160 decode_char_table_range (range, &rainj);
1161 value = canonicalize_char_table_value (value, ct->type);
1162 put_char_table (ct, &rainj, value);
1166 /* Map FN over the ASCII chars in CT. */
1169 map_over_charset_ascii (Lisp_Char_Table *ct,
1170 int (*fn) (struct chartab_range *range,
1171 Lisp_Object val, void *arg),
1174 struct chartab_range rainj;
1183 rainj.type = CHARTAB_RANGE_CHAR;
1185 for (i = start, retval = 0; i < stop && retval == 0; i++)
1187 rainj.ch = (Emchar) i;
1188 retval = (fn) (&rainj, ct->ascii[i], arg);
1196 /* Map FN over the Control-1 chars in CT. */
1199 map_over_charset_control_1 (Lisp_Char_Table *ct,
1200 int (*fn) (struct chartab_range *range,
1201 Lisp_Object val, void *arg),
1204 struct chartab_range rainj;
1207 int stop = start + 32;
1209 rainj.type = CHARTAB_RANGE_CHAR;
1211 for (i = start, retval = 0; i < stop && retval == 0; i++)
1213 rainj.ch = (Emchar) (i);
1214 retval = (fn) (&rainj, ct->ascii[i], arg);
1220 /* Map FN over the row ROW of two-byte charset CHARSET.
1221 There must be a separate value for that row in the char table.
1222 CTE specifies the char table entry for CHARSET. */
1225 map_over_charset_row (Lisp_Char_Table_Entry *cte,
1226 Lisp_Object charset, int row,
1227 int (*fn) (struct chartab_range *range,
1228 Lisp_Object val, void *arg),
1231 Lisp_Object val = cte->level2[row - 32];
1233 if (!CHAR_TABLE_ENTRYP (val))
1235 struct chartab_range rainj;
1237 rainj.type = CHARTAB_RANGE_ROW;
1238 rainj.charset = charset;
1240 return (fn) (&rainj, val, arg);
1244 struct chartab_range rainj;
1246 int charset94_p = (XCHARSET_CHARS (charset) == 94);
1247 int start = charset94_p ? 33 : 32;
1248 int stop = charset94_p ? 127 : 128;
1250 cte = XCHAR_TABLE_ENTRY (val);
1252 rainj.type = CHARTAB_RANGE_CHAR;
1254 for (i = start, retval = 0; i < stop && retval == 0; i++)
1256 rainj.ch = MAKE_CHAR (charset, row, i);
1257 retval = (fn) (&rainj, cte->level2[i - 32], arg);
1265 map_over_other_charset (Lisp_Char_Table *ct, int lb,
1266 int (*fn) (struct chartab_range *range,
1267 Lisp_Object val, void *arg),
1270 Lisp_Object val = ct->level1[lb - MIN_LEADING_BYTE];
1271 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (lb);
1273 if (!CHARSETP (charset)
1274 || lb == LEADING_BYTE_ASCII
1275 || lb == LEADING_BYTE_CONTROL_1)
1278 if (!CHAR_TABLE_ENTRYP (val))
1280 struct chartab_range rainj;
1282 rainj.type = CHARTAB_RANGE_CHARSET;
1283 rainj.charset = charset;
1284 return (fn) (&rainj, val, arg);
1288 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
1289 int charset94_p = (XCHARSET_CHARS (charset) == 94);
1290 int start = charset94_p ? 33 : 32;
1291 int stop = charset94_p ? 127 : 128;
1294 if (XCHARSET_DIMENSION (charset) == 1)
1296 struct chartab_range rainj;
1297 rainj.type = CHARTAB_RANGE_CHAR;
1299 for (i = start, retval = 0; i < stop && retval == 0; i++)
1301 rainj.ch = MAKE_CHAR (charset, i, 0);
1302 retval = (fn) (&rainj, cte->level2[i - 32], arg);
1307 for (i = start, retval = 0; i < stop && retval == 0; i++)
1308 retval = map_over_charset_row (cte, charset, i, fn, arg);
1317 /* Map FN (with client data ARG) over range RANGE in char table CT.
1318 Mapping stops the first time FN returns non-zero, and that value
1319 becomes the return value of map_char_table(). */
1322 map_char_table (Lisp_Char_Table *ct,
1323 struct chartab_range *range,
1324 int (*fn) (struct chartab_range *range,
1325 Lisp_Object val, void *arg),
1328 switch (range->type)
1330 case CHARTAB_RANGE_ALL:
1334 retval = map_over_charset_ascii (ct, fn, arg);
1338 retval = map_over_charset_control_1 (ct, fn, arg);
1343 int start = MIN_LEADING_BYTE;
1344 int stop = start + NUM_LEADING_BYTES;
1346 for (i = start, retval = 0; i < stop && retval == 0; i++)
1348 retval = map_over_other_charset (ct, i, fn, arg);
1356 case CHARTAB_RANGE_CHARSET:
1357 return map_over_other_charset (ct,
1358 XCHARSET_LEADING_BYTE (range->charset),
1361 case CHARTAB_RANGE_ROW:
1363 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE];
1364 if (!CHAR_TABLE_ENTRYP (val))
1366 struct chartab_range rainj;
1368 rainj.type = CHARTAB_RANGE_ROW;
1369 rainj.charset = range->charset;
1370 rainj.row = range->row;
1371 return (fn) (&rainj, val, arg);
1374 return map_over_charset_row (XCHAR_TABLE_ENTRY (val),
1375 range->charset, range->row,
1380 case CHARTAB_RANGE_CHAR:
1382 Emchar ch = range->ch;
1383 Lisp_Object val = CHAR_TABLE_VALUE_UNSAFE (ct, ch);
1384 struct chartab_range rainj;
1386 rainj.type = CHARTAB_RANGE_CHAR;
1388 return (fn) (&rainj, val, arg);
1398 struct slow_map_char_table_arg
1400 Lisp_Object function;
1405 slow_map_char_table_fun (struct chartab_range *range,
1406 Lisp_Object val, void *arg)
1408 Lisp_Object ranjarg = Qnil;
1409 struct slow_map_char_table_arg *closure =
1410 (struct slow_map_char_table_arg *) arg;
1412 switch (range->type)
1414 case CHARTAB_RANGE_ALL:
1419 case CHARTAB_RANGE_CHARSET:
1420 ranjarg = XCHARSET_NAME (range->charset);
1423 case CHARTAB_RANGE_ROW:
1424 ranjarg = vector2 (XCHARSET_NAME (range->charset),
1425 make_int (range->row));
1428 case CHARTAB_RANGE_CHAR:
1429 ranjarg = make_char (range->ch);
1435 closure->retval = call2 (closure->function, ranjarg, val);
1436 return !NILP (closure->retval);
1439 DEFUN ("map-char-table", Fmap_char_table, 2, 3, 0, /*
1440 Map FUNCTION over entries in CHAR-TABLE, calling it with two args,
1441 each key and value in the table.
1443 RANGE specifies a subrange to map over and is in the same format as
1444 the RANGE argument to `put-range-table'. If omitted or t, it defaults to
1447 (function, char_table, range))
1449 Lisp_Char_Table *ct;
1450 struct slow_map_char_table_arg slarg;
1451 struct gcpro gcpro1, gcpro2;
1452 struct chartab_range rainj;
1454 CHECK_CHAR_TABLE (char_table);
1455 ct = XCHAR_TABLE (char_table);
1458 decode_char_table_range (range, &rainj);
1459 slarg.function = function;
1460 slarg.retval = Qnil;
1461 GCPRO2 (slarg.function, slarg.retval);
1462 map_char_table (ct, &rainj, slow_map_char_table_fun, &slarg);
1465 return slarg.retval;
1470 /************************************************************************/
1471 /* Char table read syntax */
1472 /************************************************************************/
1475 chartab_type_validate (Lisp_Object keyword, Lisp_Object value,
1476 Error_behavior errb)
1478 /* #### should deal with ERRB */
1479 symbol_to_char_table_type (value);
1484 chartab_data_validate (Lisp_Object keyword, Lisp_Object value,
1485 Error_behavior errb)
1489 /* #### should deal with ERRB */
1490 EXTERNAL_LIST_LOOP (rest, value)
1492 Lisp_Object range = XCAR (rest);
1493 struct chartab_range dummy;
1497 signal_simple_error ("Invalid list format", value);
1500 if (!CONSP (XCDR (range))
1501 || !NILP (XCDR (XCDR (range))))
1502 signal_simple_error ("Invalid range format", range);
1503 decode_char_table_range (XCAR (range), &dummy);
1504 decode_char_table_range (XCAR (XCDR (range)), &dummy);
1507 decode_char_table_range (range, &dummy);
1514 chartab_instantiate (Lisp_Object data)
1516 Lisp_Object chartab;
1517 Lisp_Object type = Qgeneric;
1518 Lisp_Object dataval = Qnil;
1520 while (!NILP (data))
1522 Lisp_Object keyw = Fcar (data);
1528 if (EQ (keyw, Qtype))
1530 else if (EQ (keyw, Qdata))
1534 chartab = Fmake_char_table (type);
1537 while (!NILP (data))
1539 Lisp_Object range = Fcar (data);
1540 Lisp_Object val = Fcar (Fcdr (data));
1542 data = Fcdr (Fcdr (data));
1545 if (CHAR_OR_CHAR_INTP (XCAR (range)))
1547 Emchar first = XCHAR_OR_CHAR_INT (Fcar (range));
1548 Emchar last = XCHAR_OR_CHAR_INT (Fcar (Fcdr (range)));
1551 for (i = first; i <= last; i++)
1552 Fput_char_table (make_char (i), val, chartab);
1558 Fput_char_table (range, val, chartab);
1567 /************************************************************************/
1568 /* Category Tables, specifically */
1569 /************************************************************************/
1571 DEFUN ("category-table-p", Fcategory_table_p, 1, 1, 0, /*
1572 Return t if OBJECT is a category table.
1573 A category table is a type of char table used for keeping track of
1574 categories. Categories are used for classifying characters for use
1575 in regexps -- you can refer to a category rather than having to use
1576 a complicated [] expression (and category lookups are significantly
1579 There are 95 different categories available, one for each printable
1580 character (including space) in the ASCII charset. Each category
1581 is designated by one such character, called a "category designator".
1582 They are specified in a regexp using the syntax "\\cX", where X is
1583 a category designator.
1585 A category table specifies, for each character, the categories that
1586 the character is in. Note that a character can be in more than one
1587 category. More specifically, a category table maps from a character
1588 to either the value nil (meaning the character is in no categories)
1589 or a 95-element bit vector, specifying for each of the 95 categories
1590 whether the character is in that category.
1592 Special Lisp functions are provided that abstract this, so you do not
1593 have to directly manipulate bit vectors.
1597 return (CHAR_TABLEP (object) &&
1598 XCHAR_TABLE_TYPE (object) == CHAR_TABLE_TYPE_CATEGORY) ?
1603 check_category_table (Lisp_Object object, Lisp_Object default_)
1607 while (NILP (Fcategory_table_p (object)))
1608 object = wrong_type_argument (Qcategory_table_p, object);
1613 check_category_char (Emchar ch, Lisp_Object table,
1614 unsigned int designator, unsigned int not)
1616 REGISTER Lisp_Object temp;
1617 Lisp_Char_Table *ctbl;
1618 #ifdef ERROR_CHECK_TYPECHECK
1619 if (NILP (Fcategory_table_p (table)))
1620 signal_simple_error ("Expected category table", table);
1622 ctbl = XCHAR_TABLE (table);
1623 temp = get_char_table (ch, ctbl);
1628 return bit_vector_bit (XBIT_VECTOR (temp), designator) ? !not : not;
1631 DEFUN ("check-category-at", Fcheck_category_at, 2, 4, 0, /*
1632 Return t if category of the character at POSITION includes DESIGNATOR.
1633 Optional third arg BUFFER specifies which buffer to use, and defaults
1634 to the current buffer.
1635 Optional fourth arg CATEGORY-TABLE specifies the category table to
1636 use, and defaults to BUFFER's category table.
1638 (position, designator, buffer, category_table))
1643 struct buffer *buf = decode_buffer (buffer, 0);
1645 CHECK_INT (position);
1646 CHECK_CATEGORY_DESIGNATOR (designator);
1647 des = XCHAR (designator);
1648 ctbl = check_category_table (category_table, Vstandard_category_table);
1649 ch = BUF_FETCH_CHAR (buf, XINT (position));
1650 return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil;
1653 DEFUN ("char-in-category-p", Fchar_in_category_p, 2, 3, 0, /*
1654 Return t if category of CHARACTER includes DESIGNATOR, else nil.
1655 Optional third arg CATEGORY-TABLE specifies the category table to use,
1656 and defaults to the standard category table.
1658 (character, designator, category_table))
1664 CHECK_CATEGORY_DESIGNATOR (designator);
1665 des = XCHAR (designator);
1666 CHECK_CHAR (character);
1667 ch = XCHAR (character);
1668 ctbl = check_category_table (category_table, Vstandard_category_table);
1669 return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil;
1672 DEFUN ("category-table", Fcategory_table, 0, 1, 0, /*
1673 Return BUFFER's current category table.
1674 BUFFER defaults to the current buffer.
1678 return decode_buffer (buffer, 0)->category_table;
1681 DEFUN ("standard-category-table", Fstandard_category_table, 0, 0, 0, /*
1682 Return the standard category table.
1683 This is the one used for new buffers.
1687 return Vstandard_category_table;
1690 DEFUN ("copy-category-table", Fcopy_category_table, 0, 1, 0, /*
1691 Return a new category table which is a copy of CATEGORY-TABLE.
1692 CATEGORY-TABLE defaults to the standard category table.
1696 if (NILP (Vstandard_category_table))
1697 return Fmake_char_table (Qcategory);
1700 check_category_table (category_table, Vstandard_category_table);
1701 return Fcopy_char_table (category_table);
1704 DEFUN ("set-category-table", Fset_category_table, 1, 2, 0, /*
1705 Select CATEGORY-TABLE as the new category table for BUFFER.
1706 BUFFER defaults to the current buffer if omitted.
1708 (category_table, buffer))
1710 struct buffer *buf = decode_buffer (buffer, 0);
1711 category_table = check_category_table (category_table, Qnil);
1712 buf->category_table = category_table;
1713 /* Indicate that this buffer now has a specified category table. */
1714 buf->local_var_flags |= XINT (buffer_local_flags.category_table);
1715 return category_table;
1718 DEFUN ("category-designator-p", Fcategory_designator_p, 1, 1, 0, /*
1719 Return t if OBJECT is a category designator (a char in the range ' ' to '~').
1723 return CATEGORY_DESIGNATORP (object) ? Qt : Qnil;
1726 DEFUN ("category-table-value-p", Fcategory_table_value_p, 1, 1, 0, /*
1727 Return t if OBJECT is a category table value.
1728 Valid values are nil or a bit vector of size 95.
1732 return CATEGORY_TABLE_VALUEP (object) ? Qt : Qnil;
1736 #define CATEGORYP(x) \
1737 (CHARP (x) && XCHAR (x) >= 0x20 && XCHAR (x) <= 0x7E)
1739 #define CATEGORY_SET(c) \
1740 (get_char_table(c, XCHAR_TABLE(current_buffer->category_table)))
1742 /* Return 1 if CATEGORY_SET contains CATEGORY, else return 0.
1743 The faster version of `!NILP (Faref (category_set, category))'. */
1744 #define CATEGORY_MEMBER(category, category_set) \
1745 (bit_vector_bit(XBIT_VECTOR (category_set), category - 32))
1747 /* Return 1 if there is a word boundary between two word-constituent
1748 characters C1 and C2 if they appear in this order, else return 0.
1749 Use the macro WORD_BOUNDARY_P instead of calling this function
1752 int word_boundary_p (Emchar c1, Emchar c2);
1754 word_boundary_p (Emchar c1, Emchar c2)
1756 Lisp_Object category_set1, category_set2;
1761 if (COMPOSITE_CHAR_P (c1))
1762 c1 = cmpchar_component (c1, 0, 1);
1763 if (COMPOSITE_CHAR_P (c2))
1764 c2 = cmpchar_component (c2, 0, 1);
1767 if (EQ (CHAR_CHARSET (c1), CHAR_CHARSET (c2)))
1769 tail = Vword_separating_categories;
1774 tail = Vword_combining_categories;
1778 category_set1 = CATEGORY_SET (c1);
1779 if (NILP (category_set1))
1780 return default_result;
1781 category_set2 = CATEGORY_SET (c2);
1782 if (NILP (category_set2))
1783 return default_result;
1785 for (; CONSP (tail); tail = XCONS (tail)->cdr)
1787 Lisp_Object elt = XCONS(tail)->car;
1790 && CATEGORYP (XCONS (elt)->car)
1791 && CATEGORYP (XCONS (elt)->cdr)
1792 && CATEGORY_MEMBER (XCHAR (XCONS (elt)->car), category_set1)
1793 && CATEGORY_MEMBER (XCHAR (XCONS (elt)->cdr), category_set2))
1794 return !default_result;
1796 return default_result;
1802 syms_of_chartab (void)
1804 INIT_LRECORD_IMPLEMENTATION (char_table);
1807 INIT_LRECORD_IMPLEMENTATION (char_table_entry);
1809 defsymbol (&Qcategory_table_p, "category-table-p");
1810 defsymbol (&Qcategory_designator_p, "category-designator-p");
1811 defsymbol (&Qcategory_table_value_p, "category-table-value-p");
1814 defsymbol (&Qchar_table, "char-table");
1815 defsymbol (&Qchar_tablep, "char-table-p");
1817 DEFSUBR (Fchar_table_p);
1818 DEFSUBR (Fchar_table_type_list);
1819 DEFSUBR (Fvalid_char_table_type_p);
1820 DEFSUBR (Fchar_table_type);
1821 DEFSUBR (Freset_char_table);
1822 DEFSUBR (Fmake_char_table);
1823 DEFSUBR (Fcopy_char_table);
1824 DEFSUBR (Fget_char_table);
1825 DEFSUBR (Fget_range_char_table);
1826 DEFSUBR (Fvalid_char_table_value_p);
1827 DEFSUBR (Fcheck_valid_char_table_value);
1828 DEFSUBR (Fput_char_table);
1829 DEFSUBR (Fmap_char_table);
1832 DEFSUBR (Fcategory_table_p);
1833 DEFSUBR (Fcategory_table);
1834 DEFSUBR (Fstandard_category_table);
1835 DEFSUBR (Fcopy_category_table);
1836 DEFSUBR (Fset_category_table);
1837 DEFSUBR (Fcheck_category_at);
1838 DEFSUBR (Fchar_in_category_p);
1839 DEFSUBR (Fcategory_designator_p);
1840 DEFSUBR (Fcategory_table_value_p);
1846 vars_of_chartab (void)
1848 /* DO NOT staticpro this. It works just like Vweak_hash_tables. */
1849 Vall_syntax_tables = Qnil;
1850 dump_add_weak_object_chain (&Vall_syntax_tables);
1854 structure_type_create_chartab (void)
1856 struct structure_type *st;
1858 st = define_structure_type (Qchar_table, 0, chartab_instantiate);
1860 define_structure_type_keyword (st, Qtype, chartab_type_validate);
1861 define_structure_type_keyword (st, Qdata, chartab_data_validate);
1865 complex_vars_of_chartab (void)
1868 /* Set this now, so first buffer creation can refer to it. */
1869 /* Make it nil before calling copy-category-table
1870 so that copy-category-table will know not to try to copy from garbage */
1871 Vstandard_category_table = Qnil;
1872 Vstandard_category_table = Fcopy_category_table (Qnil);
1873 staticpro (&Vstandard_category_table);
1875 DEFVAR_LISP ("word-combining-categories", &Vword_combining_categories /*
1876 List of pair (cons) of categories to determine word boundary.
1878 Emacs treats a sequence of word constituent characters as a single
1879 word (i.e. finds no word boundary between them) iff they belongs to
1880 the same charset. But, exceptions are allowed in the following cases.
1882 \(1) The case that characters are in different charsets is controlled
1883 by the variable `word-combining-categories'.
1885 Emacs finds no word boundary between characters of different charsets
1886 if they have categories matching some element of this list.
1888 More precisely, if an element of this list is a cons of category CAT1
1889 and CAT2, and a multibyte character C1 which has CAT1 is followed by
1890 C2 which has CAT2, there's no word boundary between C1 and C2.
1892 For instance, to tell that ASCII characters and Latin-1 characters can
1893 form a single word, the element `(?l . ?l)' should be in this list
1894 because both characters have the category `l' (Latin characters).
1896 \(2) The case that character are in the same charset is controlled by
1897 the variable `word-separating-categories'.
1899 Emacs find a word boundary between characters of the same charset
1900 if they have categories matching some element of this list.
1902 More precisely, if an element of this list is a cons of category CAT1
1903 and CAT2, and a multibyte character C1 which has CAT1 is followed by
1904 C2 which has CAT2, there's a word boundary between C1 and C2.
1906 For instance, to tell that there's a word boundary between Japanese
1907 Hiragana and Japanese Kanji (both are in the same charset), the
1908 element `(?H . ?C) should be in this list.
1911 Vword_combining_categories = Qnil;
1913 DEFVAR_LISP ("word-separating-categories", &Vword_separating_categories /*
1914 List of pair (cons) of categories to determine word boundary.
1915 See the documentation of the variable `word-combining-categories'.
1918 Vword_separating_categories = Qnil;