Mercurial > hg > xemacs-beta
annotate src/chartab.c @ 5015:d95c102a96d3
cleanups for specifier font stages, from ben-unicode-internal (preparation for eliminating shadowed warnings)
-------------------- ChangeLog entries follow: --------------------
src/ChangeLog addition:
2010-02-08 Ben Wing <ben@xemacs.org>
* faces.c:
* faces.c (face_property_matching_instance):
* faces.c (ensure_face_cachel_contains_charset):
* faces.h (FACE_FONT):
* lisp.h:
* lisp.h (enum font_specifier_matchspec_stages):
* objects-msw.c:
* objects-msw.c (mswindows_font_spec_matches_charset):
* objects-msw.c (mswindows_find_charset_font):
* objects-tty.c:
* objects-tty.c (tty_font_spec_matches_charset):
* objects-tty.c (tty_find_charset_font):
* objects-xlike-inc.c:
* objects-xlike-inc.c (XFUN):
* objects-xlike-inc.c (xft_find_charset_font):
* objects.c:
* objects.c (font_instantiate):
* objects.c (FROB):
* specifier.c:
* specifier.c (charset_matches_specifier_tag_set_p):
* specifier.c (call_charset_predicate):
* specifier.c (define_specifier_tag):
* specifier.c (Fdefine_specifier_tag):
* specifier.c (setup_charset_initial_specifier_tags):
* specifier.c (specifier_instance_from_inst_list):
* specifier.c (FROB):
* specifier.c (vars_of_specifier):
* specifier.h:
Rename the specifier-font-matching stages in preparation for
eliminating shadowed warnings, some other related fixes from
ben-unicode-internal.
1. Rename raw enums:
initial -> STAGE_INITIAL
final -> STAGE_FINAL
impossible -> NUM_MATCHSPEC_STAGES
2. Move `enum font_specifier_matchspec_stages' from
specifier.h to lisp.h.
3. Whitespace changes to match coding standards.
4. Eliminate unused second argument STAGE in charset predicates
that don't use it -- the code that calls the charset predicates
is now smart enough to supply the right number of arguments
automatically.
5. Add some long(ish) comments and authorial notices, esp. in
objects.c.
6. In specifier.c, change Vcharset_tag_lists from a vector over
leading bytes to a hash table over charsets. This change is
unnecessary currently but doesn't hurt and will be required
when we merge in Unicode-internal.
7. In specifier.c, extract out the code that calls charset predicates
into a function call_charset_predicate().
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Mon, 08 Feb 2010 16:51:25 -0600 |
| parents | ae48681c47fa |
| children | b5df3737028a |
| rev | line source |
|---|---|
| 428 | 1 /* XEmacs routines to deal with char tables. |
| 2 Copyright (C) 1992, 1995 Free Software Foundation, Inc. | |
| 3 Copyright (C) 1995 Sun Microsystems, Inc. | |
| 1296 | 4 Copyright (C) 1995, 1996, 2002, 2003 Ben Wing. |
| 428 | 5 Copyright (C) 1995, 1997, 1999 Electrotechnical Laboratory, JAPAN. |
| 6 Licensed to the Free Software Foundation. | |
| 7 | |
| 8 This file is part of XEmacs. | |
| 9 | |
| 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 | |
| 13 later version. | |
| 14 | |
| 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 | |
| 18 for more details. | |
| 19 | |
| 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. */ | |
| 24 | |
| 25 /* Synched up with: Mule 2.3. Not synched with FSF. | |
| 26 | |
| 27 This file was written independently of the FSF implementation, | |
| 28 and is not compatible. */ | |
| 29 | |
| 30 /* Authorship: | |
| 31 | |
| 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 | |
| 36 */ | |
| 37 | |
| 38 #include <config.h> | |
| 39 #include "lisp.h" | |
| 40 | |
| 41 #include "buffer.h" | |
| 42 #include "chartab.h" | |
| 43 #include "syntax.h" | |
| 44 | |
| 45 Lisp_Object Qchar_tablep, Qchar_table; | |
| 46 | |
| 47 Lisp_Object Vall_syntax_tables; | |
| 48 | |
| 49 #ifdef MULE | |
| 50 Lisp_Object Qcategory_table_p; | |
| 51 Lisp_Object Qcategory_designator_p; | |
| 52 Lisp_Object Qcategory_table_value_p; | |
| 53 | |
| 54 Lisp_Object Vstandard_category_table; | |
| 55 | |
| 56 /* Variables to determine word boundary. */ | |
| 57 Lisp_Object Vword_combining_categories, Vword_separating_categories; | |
| 58 #endif /* MULE */ | |
| 59 | |
| 826 | 60 static int check_valid_char_table_value (Lisp_Object value, |
| 61 enum char_table_type type, | |
| 62 Error_Behavior errb); | |
| 63 | |
| 428 | 64 |
| 65 /* A char table maps from ranges of characters to values. | |
| 66 | |
| 67 Implementing a general data structure that maps from arbitrary | |
| 68 ranges of numbers to values is tricky to do efficiently. As it | |
| 69 happens, it should suffice (and is usually more convenient, anyway) | |
| 70 when dealing with characters to restrict the sorts of ranges that | |
| 71 can be assigned values, as follows: | |
| 72 | |
| 73 1) All characters. | |
| 74 2) All characters in a charset. | |
| 75 3) All characters in a particular row of a charset, where a "row" | |
| 76 means all characters with the same first byte. | |
| 77 4) A particular character in a charset. | |
| 78 | |
| 79 We use char tables to generalize the 256-element vectors now | |
| 80 littering the Emacs code. | |
| 81 | |
| 82 Possible uses (all should be converted at some point): | |
| 83 | |
| 84 1) category tables | |
| 85 2) syntax tables | |
| 86 3) display tables | |
| 87 4) case tables | |
| 88 5) keyboard-translate-table? | |
| 89 | |
| 90 We provide an | |
| 91 abstract type to generalize the Emacs vectors and Mule | |
| 92 vectors-of-vectors goo. | |
| 93 */ | |
| 94 | |
| 95 /************************************************************************/ | |
| 96 /* Char Table object */ | |
| 97 /************************************************************************/ | |
| 98 | |
| 99 #ifdef MULE | |
| 100 | |
| 101 static Lisp_Object | |
| 102 mark_char_table_entry (Lisp_Object obj) | |
| 103 { | |
| 440 | 104 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj); |
| 428 | 105 int i; |
| 106 | |
| 107 for (i = 0; i < 96; i++) | |
| 108 { | |
| 109 mark_object (cte->level2[i]); | |
| 110 } | |
| 111 return Qnil; | |
| 112 } | |
| 113 | |
| 114 static int | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4580
diff
changeset
|
115 char_table_entry_equal (Lisp_Object obj1, Lisp_Object obj2, int depth, |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4580
diff
changeset
|
116 int foldcase) |
| 428 | 117 { |
| 440 | 118 Lisp_Char_Table_Entry *cte1 = XCHAR_TABLE_ENTRY (obj1); |
| 119 Lisp_Char_Table_Entry *cte2 = XCHAR_TABLE_ENTRY (obj2); | |
| 428 | 120 int i; |
| 121 | |
| 122 for (i = 0; i < 96; i++) | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4580
diff
changeset
|
123 if (!internal_equal_0 (cte1->level2[i], cte2->level2[i], depth + 1, |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4580
diff
changeset
|
124 foldcase)) |
| 428 | 125 return 0; |
| 126 | |
| 127 return 1; | |
| 128 } | |
| 129 | |
| 665 | 130 static Hashcode |
| 428 | 131 char_table_entry_hash (Lisp_Object obj, int depth) |
| 132 { | |
| 440 | 133 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj); |
| 428 | 134 |
| 826 | 135 return internal_array_hash (cte->level2, 96, depth + 1); |
| 428 | 136 } |
| 137 | |
| 1204 | 138 static const struct memory_description char_table_entry_description[] = { |
| 440 | 139 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table_Entry, level2), 96 }, |
| 428 | 140 { XD_END } |
| 141 }; | |
| 142 | |
| 934 | 143 DEFINE_LRECORD_IMPLEMENTATION ("char-table-entry", char_table_entry, |
| 144 1, /* dumpable flag */ | |
| 145 mark_char_table_entry, internal_object_printer, | |
| 146 0, char_table_entry_equal, | |
| 147 char_table_entry_hash, | |
| 148 char_table_entry_description, | |
| 149 Lisp_Char_Table_Entry); | |
| 150 | |
| 428 | 151 #endif /* MULE */ |
| 152 | |
| 153 static Lisp_Object | |
| 154 mark_char_table (Lisp_Object obj) | |
| 155 { | |
| 440 | 156 Lisp_Char_Table *ct = XCHAR_TABLE (obj); |
| 428 | 157 int i; |
| 158 | |
| 159 for (i = 0; i < NUM_ASCII_CHARS; i++) | |
| 160 mark_object (ct->ascii[i]); | |
| 161 #ifdef MULE | |
| 162 for (i = 0; i < NUM_LEADING_BYTES; i++) | |
| 163 mark_object (ct->level1[i]); | |
| 164 #endif | |
| 793 | 165 mark_object (ct->parent); |
| 166 mark_object (ct->default_); | |
| 428 | 167 return ct->mirror_table; |
| 168 } | |
| 169 | |
| 170 /* WARNING: All functions of this nature need to be written extremely | |
| 171 carefully to avoid crashes during GC. Cf. prune_specifiers() | |
| 172 and prune_weak_hash_tables(). */ | |
| 173 | |
| 174 void | |
| 175 prune_syntax_tables (void) | |
| 176 { | |
| 177 Lisp_Object rest, prev = Qnil; | |
| 178 | |
| 179 for (rest = Vall_syntax_tables; | |
| 180 !NILP (rest); | |
| 181 rest = XCHAR_TABLE (rest)->next_table) | |
| 182 { | |
| 183 if (! marked_p (rest)) | |
| 184 { | |
| 185 /* This table is garbage. Remove it from the list. */ | |
| 186 if (NILP (prev)) | |
| 187 Vall_syntax_tables = XCHAR_TABLE (rest)->next_table; | |
| 188 else | |
| 189 XCHAR_TABLE (prev)->next_table = | |
| 190 XCHAR_TABLE (rest)->next_table; | |
| 191 } | |
| 192 } | |
| 193 } | |
| 194 | |
| 195 static Lisp_Object | |
| 196 char_table_type_to_symbol (enum char_table_type type) | |
| 197 { | |
| 198 switch (type) | |
| 199 { | |
| 2500 | 200 default: ABORT(); |
| 428 | 201 case CHAR_TABLE_TYPE_GENERIC: return Qgeneric; |
| 202 case CHAR_TABLE_TYPE_SYNTAX: return Qsyntax; | |
| 203 case CHAR_TABLE_TYPE_DISPLAY: return Qdisplay; | |
| 204 case CHAR_TABLE_TYPE_CHAR: return Qchar; | |
| 205 #ifdef MULE | |
| 206 case CHAR_TABLE_TYPE_CATEGORY: return Qcategory; | |
| 207 #endif | |
| 208 } | |
| 209 } | |
| 210 | |
| 211 static enum char_table_type | |
| 212 symbol_to_char_table_type (Lisp_Object symbol) | |
| 213 { | |
| 214 CHECK_SYMBOL (symbol); | |
| 215 | |
| 216 if (EQ (symbol, Qgeneric)) return CHAR_TABLE_TYPE_GENERIC; | |
| 217 if (EQ (symbol, Qsyntax)) return CHAR_TABLE_TYPE_SYNTAX; | |
| 218 if (EQ (symbol, Qdisplay)) return CHAR_TABLE_TYPE_DISPLAY; | |
| 219 if (EQ (symbol, Qchar)) return CHAR_TABLE_TYPE_CHAR; | |
| 220 #ifdef MULE | |
| 221 if (EQ (symbol, Qcategory)) return CHAR_TABLE_TYPE_CATEGORY; | |
| 222 #endif | |
| 223 | |
| 563 | 224 invalid_constant ("Unrecognized char table type", symbol); |
| 1204 | 225 RETURN_NOT_REACHED (CHAR_TABLE_TYPE_GENERIC); |
| 428 | 226 } |
| 227 | |
| 228 static void | |
| 826 | 229 decode_char_table_range (Lisp_Object range, struct chartab_range *outrange) |
| 428 | 230 { |
| 4932 | 231 xzero (*outrange); |
| 826 | 232 if (EQ (range, Qt)) |
| 233 outrange->type = CHARTAB_RANGE_ALL; | |
| 234 else if (CHAR_OR_CHAR_INTP (range)) | |
| 235 { | |
| 236 outrange->type = CHARTAB_RANGE_CHAR; | |
| 237 outrange->ch = XCHAR_OR_CHAR_INT (range); | |
| 238 } | |
| 239 #ifndef MULE | |
| 428 | 240 else |
| 826 | 241 sferror ("Range must be t or a character", range); |
| 242 #else /* MULE */ | |
| 243 else if (VECTORP (range)) | |
| 244 { | |
| 245 Lisp_Vector *vec = XVECTOR (range); | |
| 246 Lisp_Object *elts = vector_data (vec); | |
| 247 if (vector_length (vec) != 2) | |
| 248 sferror ("Length of charset row vector must be 2", | |
| 249 range); | |
| 250 outrange->type = CHARTAB_RANGE_ROW; | |
| 251 outrange->charset = Fget_charset (elts[0]); | |
| 252 CHECK_INT (elts[1]); | |
| 253 outrange->row = XINT (elts[1]); | |
| 254 switch (XCHARSET_TYPE (outrange->charset)) | |
| 255 { | |
| 256 case CHARSET_TYPE_94: | |
| 257 case CHARSET_TYPE_96: | |
| 258 sferror ("Charset in row vector must be multi-byte", | |
| 259 outrange->charset); | |
| 260 case CHARSET_TYPE_94X94: | |
| 261 check_int_range (outrange->row, 33, 126); | |
| 262 break; | |
| 263 case CHARSET_TYPE_96X96: | |
| 264 check_int_range (outrange->row, 32, 127); | |
| 265 break; | |
| 266 default: | |
| 2500 | 267 ABORT (); |
| 826 | 268 } |
| 269 } | |
| 270 else | |
| 271 { | |
| 272 if (!CHARSETP (range) && !SYMBOLP (range)) | |
| 273 sferror | |
| 274 ("Char table range must be t, charset, char, or vector", range); | |
| 275 outrange->type = CHARTAB_RANGE_CHARSET; | |
| 276 outrange->charset = Fget_charset (range); | |
| 277 } | |
| 278 #endif /* MULE */ | |
| 428 | 279 } |
| 280 | |
| 826 | 281 static Lisp_Object |
| 282 encode_char_table_range (struct chartab_range *range) | |
| 428 | 283 { |
| 826 | 284 switch (range->type) |
| 428 | 285 { |
| 826 | 286 case CHARTAB_RANGE_ALL: |
| 287 return Qt; | |
| 288 | |
| 289 #ifdef MULE | |
| 290 case CHARTAB_RANGE_CHARSET: | |
| 291 return XCHARSET_NAME (Fget_charset (range->charset)); | |
| 428 | 292 |
| 826 | 293 case CHARTAB_RANGE_ROW: |
| 294 return vector2 (XCHARSET_NAME (Fget_charset (range->charset)), | |
| 295 make_int (range->row)); | |
| 296 #endif | |
| 297 case CHARTAB_RANGE_CHAR: | |
| 298 return make_char (range->ch); | |
| 299 default: | |
| 2500 | 300 ABORT (); |
| 428 | 301 } |
| 826 | 302 return Qnil; /* not reached */ |
| 428 | 303 } |
| 304 | |
| 826 | 305 struct ptemap |
| 428 | 306 { |
| 826 | 307 Lisp_Object printcharfun; |
| 308 int first; | |
| 309 }; | |
| 428 | 310 |
| 826 | 311 static int |
| 2286 | 312 print_table_entry (struct chartab_range *range, Lisp_Object UNUSED (table), |
| 826 | 313 Lisp_Object val, void *arg) |
| 314 { | |
| 315 struct ptemap *a = (struct ptemap *) arg; | |
| 316 struct gcpro gcpro1; | |
| 317 Lisp_Object lisprange; | |
| 318 if (!a->first) | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
319 write_ascstring (a->printcharfun, " "); |
| 826 | 320 a->first = 0; |
| 321 lisprange = encode_char_table_range (range); | |
| 322 GCPRO1 (lisprange); | |
|
4580
1d11ecca9cd0
Print char table values correctly.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4469
diff
changeset
|
323 write_fmt_string_lisp (a->printcharfun, "%s %S", 2, lisprange, val); |
| 826 | 324 UNGCPRO; |
| 325 return 0; | |
| 428 | 326 } |
| 327 | |
| 328 static void | |
| 2286 | 329 print_char_table (Lisp_Object obj, Lisp_Object printcharfun, |
| 330 int UNUSED (escapeflag)) | |
| 428 | 331 { |
| 440 | 332 Lisp_Char_Table *ct = XCHAR_TABLE (obj); |
| 826 | 333 struct chartab_range range; |
| 334 struct ptemap arg; | |
| 335 | |
| 336 range.type = CHARTAB_RANGE_ALL; | |
| 337 arg.printcharfun = printcharfun; | |
| 338 arg.first = 1; | |
| 428 | 339 |
| 793 | 340 write_fmt_string_lisp (printcharfun, "#s(char-table type %s data (", |
| 341 1, char_table_type_to_symbol (ct->type)); | |
| 826 | 342 map_char_table (obj, &range, print_table_entry, &arg); |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
343 write_ascstring (printcharfun, "))"); |
| 428 | 344 |
| 826 | 345 /* #### need to print and read the default; but that will allow the |
| 346 default to be modified, which we don't (yet) support -- but FSF does */ | |
| 428 | 347 } |
| 348 | |
| 349 static int | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4580
diff
changeset
|
350 char_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth, int foldcase) |
| 428 | 351 { |
| 440 | 352 Lisp_Char_Table *ct1 = XCHAR_TABLE (obj1); |
| 353 Lisp_Char_Table *ct2 = XCHAR_TABLE (obj2); | |
| 428 | 354 int i; |
| 355 | |
| 356 if (CHAR_TABLE_TYPE (ct1) != CHAR_TABLE_TYPE (ct2)) | |
| 357 return 0; | |
| 358 | |
| 359 for (i = 0; i < NUM_ASCII_CHARS; i++) | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4580
diff
changeset
|
360 if (!internal_equal_0 (ct1->ascii[i], ct2->ascii[i], depth + 1, foldcase)) |
| 428 | 361 return 0; |
| 362 | |
| 363 #ifdef MULE | |
| 364 for (i = 0; i < NUM_LEADING_BYTES; i++) | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4580
diff
changeset
|
365 if (!internal_equal_0 (ct1->level1[i], ct2->level1[i], depth + 1, foldcase)) |
| 428 | 366 return 0; |
| 367 #endif /* MULE */ | |
| 368 | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4580
diff
changeset
|
369 return internal_equal_0 (ct1->default_, ct2->default_, depth + 1, foldcase); |
| 428 | 370 } |
| 371 | |
| 665 | 372 static Hashcode |
| 428 | 373 char_table_hash (Lisp_Object obj, int depth) |
| 374 { | |
| 440 | 375 Lisp_Char_Table *ct = XCHAR_TABLE (obj); |
| 665 | 376 Hashcode hashval = internal_array_hash (ct->ascii, NUM_ASCII_CHARS, |
| 826 | 377 depth + 1); |
| 428 | 378 #ifdef MULE |
| 379 hashval = HASH2 (hashval, | |
| 826 | 380 internal_array_hash (ct->level1, NUM_LEADING_BYTES, |
| 381 depth + 1)); | |
| 428 | 382 #endif /* MULE */ |
| 826 | 383 return HASH2 (hashval, internal_hash (ct->default_, depth + 1)); |
| 428 | 384 } |
| 385 | |
| 1204 | 386 static const struct memory_description char_table_description[] = { |
| 440 | 387 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, ascii), NUM_ASCII_CHARS }, |
| 428 | 388 #ifdef MULE |
| 440 | 389 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, level1), NUM_LEADING_BYTES }, |
| 428 | 390 #endif |
| 793 | 391 { XD_LISP_OBJECT, offsetof (Lisp_Char_Table, parent) }, |
| 392 { XD_LISP_OBJECT, offsetof (Lisp_Char_Table, default_) }, | |
| 440 | 393 { XD_LISP_OBJECT, offsetof (Lisp_Char_Table, mirror_table) }, |
| 394 { XD_LO_LINK, offsetof (Lisp_Char_Table, next_table) }, | |
| 428 | 395 { XD_END } |
| 396 }; | |
| 397 | |
| 934 | 398 DEFINE_LRECORD_IMPLEMENTATION ("char-table", char_table, |
| 399 1, /*dumpable-flag*/ | |
| 400 mark_char_table, print_char_table, 0, | |
| 401 char_table_equal, char_table_hash, | |
| 402 char_table_description, | |
| 403 Lisp_Char_Table); | |
| 428 | 404 |
| 405 DEFUN ("char-table-p", Fchar_table_p, 1, 1, 0, /* | |
| 406 Return non-nil if OBJECT is a char table. | |
| 407 */ | |
| 408 (object)) | |
| 409 { | |
| 410 return CHAR_TABLEP (object) ? Qt : Qnil; | |
| 411 } | |
| 412 | |
| 413 DEFUN ("char-table-type-list", Fchar_table_type_list, 0, 0, 0, /* | |
| 414 Return a list of the recognized char table types. | |
| 800 | 415 See `make-char-table'. |
| 428 | 416 */ |
| 417 ()) | |
| 418 { | |
| 419 #ifdef MULE | |
| 420 return list5 (Qchar, Qcategory, Qdisplay, Qgeneric, Qsyntax); | |
| 421 #else | |
| 422 return list4 (Qchar, Qdisplay, Qgeneric, Qsyntax); | |
| 423 #endif | |
| 424 } | |
| 425 | |
| 426 DEFUN ("valid-char-table-type-p", Fvalid_char_table_type_p, 1, 1, 0, /* | |
| 427 Return t if TYPE if a recognized char table type. | |
| 800 | 428 See `make-char-table'. |
| 428 | 429 */ |
| 430 (type)) | |
| 431 { | |
| 432 return (EQ (type, Qchar) || | |
| 433 #ifdef MULE | |
| 434 EQ (type, Qcategory) || | |
| 435 #endif | |
| 436 EQ (type, Qdisplay) || | |
| 437 EQ (type, Qgeneric) || | |
| 438 EQ (type, Qsyntax)) ? Qt : Qnil; | |
| 439 } | |
| 440 | |
| 441 DEFUN ("char-table-type", Fchar_table_type, 1, 1, 0, /* | |
| 444 | 442 Return the type of CHAR-TABLE. |
| 800 | 443 See `make-char-table'. |
| 428 | 444 */ |
| 444 | 445 (char_table)) |
| 428 | 446 { |
| 444 | 447 CHECK_CHAR_TABLE (char_table); |
| 448 return char_table_type_to_symbol (XCHAR_TABLE (char_table)->type); | |
| 428 | 449 } |
| 450 | |
| 1296 | 451 static void |
| 452 set_char_table_dirty (Lisp_Object table) | |
| 453 { | |
| 454 assert (!XCHAR_TABLE (table)->mirror_table_p); | |
| 455 XCHAR_TABLE (XCHAR_TABLE (table)->mirror_table)->dirty = 1; | |
| 456 } | |
| 457 | |
| 428 | 458 void |
| 826 | 459 set_char_table_default (Lisp_Object table, Lisp_Object value) |
| 460 { | |
| 461 Lisp_Char_Table *ct = XCHAR_TABLE (table); | |
| 462 ct->default_ = value; | |
| 463 if (ct->type == CHAR_TABLE_TYPE_SYNTAX) | |
| 1296 | 464 set_char_table_dirty (table); |
| 826 | 465 } |
| 466 | |
| 467 static void | |
| 440 | 468 fill_char_table (Lisp_Char_Table *ct, Lisp_Object value) |
| 428 | 469 { |
| 470 int i; | |
| 471 | |
| 472 for (i = 0; i < NUM_ASCII_CHARS; i++) | |
| 473 ct->ascii[i] = value; | |
| 474 #ifdef MULE | |
| 475 for (i = 0; i < NUM_LEADING_BYTES; i++) | |
| 1296 | 476 { |
| 1330 | 477 /* Don't get stymied when initting the table, or when trying to |
| 478 free a pdump object. */ | |
| 1296 | 479 if (!EQ (ct->level1[i], Qnull_pointer) && |
| 1330 | 480 CHAR_TABLE_ENTRYP (ct->level1[i]) && |
| 481 !OBJECT_DUMPED_P (ct->level1[1])) | |
| 3017 | 482 FREE_LCRECORD (ct->level1[i]); |
| 1296 | 483 ct->level1[i] = value; |
| 484 } | |
| 428 | 485 #endif /* MULE */ |
| 486 | |
| 487 if (ct->type == CHAR_TABLE_TYPE_SYNTAX) | |
| 1296 | 488 set_char_table_dirty (wrap_char_table (ct)); |
| 428 | 489 } |
| 490 | |
| 491 DEFUN ("reset-char-table", Freset_char_table, 1, 1, 0, /* | |
| 444 | 492 Reset CHAR-TABLE to its default state. |
| 428 | 493 */ |
| 444 | 494 (char_table)) |
| 428 | 495 { |
| 440 | 496 Lisp_Char_Table *ct; |
| 826 | 497 Lisp_Object def; |
| 428 | 498 |
| 444 | 499 CHECK_CHAR_TABLE (char_table); |
| 500 ct = XCHAR_TABLE (char_table); | |
| 428 | 501 |
| 502 switch (ct->type) | |
| 503 { | |
| 504 case CHAR_TABLE_TYPE_CHAR: | |
| 826 | 505 def = make_char (0); |
| 428 | 506 break; |
| 507 case CHAR_TABLE_TYPE_DISPLAY: | |
| 508 case CHAR_TABLE_TYPE_GENERIC: | |
| 509 #ifdef MULE | |
| 510 case CHAR_TABLE_TYPE_CATEGORY: | |
| 511 #endif /* MULE */ | |
| 826 | 512 def = Qnil; |
| 428 | 513 break; |
| 514 | |
| 515 case CHAR_TABLE_TYPE_SYNTAX: | |
| 826 | 516 def = make_int (Sinherit); |
| 428 | 517 break; |
| 518 | |
| 519 default: | |
| 2500 | 520 ABORT (); |
| 826 | 521 def = Qnil; |
| 522 break; | |
| 428 | 523 } |
| 524 | |
| 826 | 525 /* Avoid doubly updating the syntax table by setting the default ourselves, |
| 526 since set_char_table_default() also updates. */ | |
| 527 ct->default_ = def; | |
| 528 fill_char_table (ct, Qunbound); | |
| 529 | |
| 428 | 530 return Qnil; |
| 531 } | |
| 532 | |
| 533 DEFUN ("make-char-table", Fmake_char_table, 1, 1, 0, /* | |
| 534 Return a new, empty char table of type TYPE. | |
| 800 | 535 |
| 536 A char table is a table that maps characters (or ranges of characters) | |
| 537 to values. Char tables are specialized for characters, only allowing | |
| 538 particular sorts of ranges to be assigned values. Although this | |
| 539 loses in generality, it makes for extremely fast (constant-time) | |
| 540 lookups, and thus is feasible for applications that do an extremely | |
| 541 large number of lookups (e.g. scanning a buffer for a character in | |
| 542 a particular syntax, where a lookup in the syntax table must occur | |
| 543 once per character). | |
| 544 | |
| 545 When Mule support exists, the types of ranges that can be assigned | |
| 546 values are | |
| 547 | |
| 2714 | 548 -- all characters (represented by t) |
| 800 | 549 -- an entire charset |
| 2714 | 550 -- a single row in a two-octet charset (represented by a vector of two |
| 551 elements: a two-octet charset and a row number; the row must be an | |
| 552 integer, not a character) | |
| 800 | 553 -- a single character |
| 554 | |
| 555 When Mule support is not present, the types of ranges that can be | |
| 556 assigned values are | |
| 557 | |
| 2714 | 558 -- all characters (represented by t) |
| 800 | 559 -- a single character |
| 560 | |
| 561 To create a char table, use `make-char-table'. | |
| 562 To modify a char table, use `put-char-table' or `remove-char-table'. | |
| 563 To retrieve the value for a particular character, use `get-char-table'. | |
| 826 | 564 See also `map-char-table', `reset-char-table', `copy-char-table', |
| 800 | 565 `char-table-p', `valid-char-table-type-p', `char-table-type-list', |
| 566 `valid-char-table-value-p', and `check-char-table-value'. | |
| 567 | |
| 568 Each char table type is used for a different purpose and allows different | |
| 569 sorts of values. The different char table types are | |
| 570 | |
| 571 `category' | |
|
4469
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
572 Used for category tables, which specify the regexp categories that a |
|
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
573 character is in. The valid values are nil or a bit vector of 95 |
|
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
574 elements, and values default to nil. Higher-level Lisp functions |
|
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
575 are provided for working with category tables. Currently categories |
| 800 | 576 and category tables only exist when Mule support is present. |
| 577 `char' | |
|
4469
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
578 A generalized char table, for mapping from one character to another. |
|
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
579 Used for case tables, syntax matching tables, |
|
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
580 `keyboard-translate-table', etc. The valid values are characters, |
|
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
581 and the default result given by `get-char-table' if a value hasn't |
|
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
582 been set for a given character or for a range that includes it, is |
|
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
583 ?\x00. |
| 800 | 584 `generic' |
|
4469
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
585 An even more generalized char table, for mapping from a character to |
|
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
586 anything. The default result given by `get-char-table' is nil. |
| 800 | 587 `display' |
|
4469
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
588 Used for display tables, which specify how a particular character is |
|
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
589 to appear when displayed. #### Not yet implemented; currently, the |
|
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
590 display table code uses generic char tables, and it's not clear that |
|
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
591 implementing this char table type would be useful. |
| 800 | 592 `syntax' |
| 593 Used for syntax tables, which specify the syntax of a particular | |
| 594 character. Higher-level Lisp functions are provided for | |
|
4469
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
595 working with syntax tables. The valid values are integers, and the |
|
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
596 default result given by `get-char-table' is the syntax code for |
|
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
597 `inherit'. |
| 428 | 598 */ |
| 599 (type)) | |
| 600 { | |
| 440 | 601 Lisp_Char_Table *ct; |
| 428 | 602 Lisp_Object obj; |
| 603 enum char_table_type ty = symbol_to_char_table_type (type); | |
| 604 | |
| 3017 | 605 ct = ALLOC_LCRECORD_TYPE (Lisp_Char_Table, &lrecord_char_table); |
| 428 | 606 ct->type = ty; |
| 1296 | 607 obj = wrap_char_table (ct); |
| 428 | 608 if (ty == CHAR_TABLE_TYPE_SYNTAX) |
| 609 { | |
| 826 | 610 /* Qgeneric not Qsyntax because a syntax table has a mirror table |
| 611 and we don't want infinite recursion */ | |
| 428 | 612 ct->mirror_table = Fmake_char_table (Qgeneric); |
| 3145 | 613 set_char_table_default (ct->mirror_table, make_int (Sword)); |
| 1296 | 614 XCHAR_TABLE (ct->mirror_table)->mirror_table_p = 1; |
| 615 XCHAR_TABLE (ct->mirror_table)->mirror_table = obj; | |
| 428 | 616 } |
| 617 else | |
| 618 ct->mirror_table = Qnil; | |
| 619 ct->next_table = Qnil; | |
| 793 | 620 ct->parent = Qnil; |
| 621 ct->default_ = Qnil; | |
| 428 | 622 if (ty == CHAR_TABLE_TYPE_SYNTAX) |
| 623 { | |
| 624 ct->next_table = Vall_syntax_tables; | |
| 625 Vall_syntax_tables = obj; | |
| 626 } | |
| 627 Freset_char_table (obj); | |
| 628 return obj; | |
| 629 } | |
| 630 | |
| 631 #ifdef MULE | |
| 632 | |
| 633 static Lisp_Object | |
| 634 make_char_table_entry (Lisp_Object initval) | |
| 635 { | |
| 636 int i; | |
| 440 | 637 Lisp_Char_Table_Entry *cte = |
| 3017 | 638 ALLOC_LCRECORD_TYPE (Lisp_Char_Table_Entry, &lrecord_char_table_entry); |
| 428 | 639 |
| 640 for (i = 0; i < 96; i++) | |
| 641 cte->level2[i] = initval; | |
| 642 | |
| 793 | 643 return wrap_char_table_entry (cte); |
| 428 | 644 } |
| 645 | |
| 646 static Lisp_Object | |
| 647 copy_char_table_entry (Lisp_Object entry) | |
| 648 { | |
| 440 | 649 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (entry); |
| 428 | 650 int i; |
| 440 | 651 Lisp_Char_Table_Entry *ctenew = |
| 3017 | 652 ALLOC_LCRECORD_TYPE (Lisp_Char_Table_Entry, &lrecord_char_table_entry); |
| 428 | 653 |
| 654 for (i = 0; i < 96; i++) | |
| 655 { | |
| 3025 | 656 Lisp_Object new_ = cte->level2[i]; |
| 657 if (CHAR_TABLE_ENTRYP (new_)) | |
| 658 ctenew->level2[i] = copy_char_table_entry (new_); | |
| 428 | 659 else |
| 3025 | 660 ctenew->level2[i] = new_; |
| 428 | 661 } |
| 662 | |
| 793 | 663 return wrap_char_table_entry (ctenew); |
| 428 | 664 } |
| 665 | |
| 666 #endif /* MULE */ | |
| 667 | |
| 668 DEFUN ("copy-char-table", Fcopy_char_table, 1, 1, 0, /* | |
| 444 | 669 Return a new char table which is a copy of CHAR-TABLE. |
| 428 | 670 It will contain the same values for the same characters and ranges |
| 444 | 671 as CHAR-TABLE. The values will not themselves be copied. |
| 428 | 672 */ |
| 444 | 673 (char_table)) |
| 428 | 674 { |
| 440 | 675 Lisp_Char_Table *ct, *ctnew; |
| 428 | 676 Lisp_Object obj; |
| 677 int i; | |
| 678 | |
| 444 | 679 CHECK_CHAR_TABLE (char_table); |
| 680 ct = XCHAR_TABLE (char_table); | |
| 3879 | 681 assert(!ct->mirror_table_p); |
| 3017 | 682 ctnew = ALLOC_LCRECORD_TYPE (Lisp_Char_Table, &lrecord_char_table); |
| 428 | 683 ctnew->type = ct->type; |
| 793 | 684 ctnew->parent = ct->parent; |
| 685 ctnew->default_ = ct->default_; | |
| 3879 | 686 ctnew->mirror_table_p = 0; |
| 1296 | 687 obj = wrap_char_table (ctnew); |
| 428 | 688 |
| 689 for (i = 0; i < NUM_ASCII_CHARS; i++) | |
| 690 { | |
| 3025 | 691 Lisp_Object new_ = ct->ascii[i]; |
| 428 | 692 #ifdef MULE |
| 3025 | 693 assert (! (CHAR_TABLE_ENTRYP (new_))); |
| 428 | 694 #endif /* MULE */ |
| 3025 | 695 ctnew->ascii[i] = new_; |
| 428 | 696 } |
| 697 | |
| 698 #ifdef MULE | |
| 699 | |
| 700 for (i = 0; i < NUM_LEADING_BYTES; i++) | |
| 701 { | |
| 3025 | 702 Lisp_Object new_ = ct->level1[i]; |
| 703 if (CHAR_TABLE_ENTRYP (new_)) | |
| 704 ctnew->level1[i] = copy_char_table_entry (new_); | |
| 428 | 705 else |
| 3025 | 706 ctnew->level1[i] = new_; |
| 428 | 707 } |
| 708 | |
| 709 #endif /* MULE */ | |
| 710 | |
| 3881 | 711 if (!EQ (ct->mirror_table, Qnil)) |
| 1296 | 712 { |
| 3879 | 713 ctnew->mirror_table = Fmake_char_table (Qgeneric); |
| 714 set_char_table_default (ctnew->mirror_table, make_int (Sword)); | |
| 1296 | 715 XCHAR_TABLE (ctnew->mirror_table)->mirror_table = obj; |
| 3879 | 716 XCHAR_TABLE (ctnew->mirror_table)->mirror_table_p = 1; |
| 717 XCHAR_TABLE (ctnew->mirror_table)->dirty = 1; | |
| 1296 | 718 } |
| 428 | 719 else |
| 3879 | 720 ctnew->mirror_table = Qnil; |
| 721 | |
| 428 | 722 ctnew->next_table = Qnil; |
| 723 if (ctnew->type == CHAR_TABLE_TYPE_SYNTAX) | |
| 724 { | |
| 725 ctnew->next_table = Vall_syntax_tables; | |
| 726 Vall_syntax_tables = obj; | |
| 727 } | |
| 728 return obj; | |
| 729 } | |
| 730 | |
| 731 #ifdef MULE | |
| 732 | |
| 826 | 733 /* called from get_char_table(). */ |
| 428 | 734 Lisp_Object |
| 440 | 735 get_non_ascii_char_table_value (Lisp_Char_Table *ct, int leading_byte, |
| 867 | 736 Ichar c) |
| 428 | 737 { |
| 738 Lisp_Object val; | |
| 826 | 739 Lisp_Object charset = charset_by_leading_byte (leading_byte); |
| 428 | 740 int byte1, byte2; |
| 741 | |
| 867 | 742 BREAKUP_ICHAR_1_UNSAFE (c, charset, byte1, byte2); |
| 428 | 743 val = ct->level1[leading_byte - MIN_LEADING_BYTE]; |
| 744 if (CHAR_TABLE_ENTRYP (val)) | |
| 745 { | |
| 440 | 746 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val); |
| 428 | 747 val = cte->level2[byte1 - 32]; |
| 748 if (CHAR_TABLE_ENTRYP (val)) | |
| 749 { | |
| 750 cte = XCHAR_TABLE_ENTRY (val); | |
| 751 assert (byte2 >= 32); | |
| 752 val = cte->level2[byte2 - 32]; | |
| 753 assert (!CHAR_TABLE_ENTRYP (val)); | |
| 754 } | |
| 755 } | |
| 756 | |
| 757 return val; | |
| 758 } | |
| 759 | |
| 760 #endif /* MULE */ | |
| 761 | |
| 826 | 762 DEFUN ("char-table-default", Fchar_table_default, 1, 1, 0, /* |
| 763 Return the default value for CHAR-TABLE. When an entry for a character | |
| 764 does not exist, the default is returned. | |
| 765 */ | |
| 766 (char_table)) | |
| 428 | 767 { |
| 826 | 768 CHECK_CHAR_TABLE (char_table); |
| 769 return XCHAR_TABLE (char_table)->default_; | |
| 428 | 770 } |
| 771 | |
| 826 | 772 DEFUN ("set-char-table-default", Fset_char_table_default, 2, 2, 0, /* |
| 773 Set the default value for CHAR-TABLE to DEFAULT. | |
| 774 Currently, the default value for syntax tables cannot be changed. | |
| 775 (This policy might change in the future.) | |
| 776 */ | |
| 777 (char_table, default_)) | |
| 778 { | |
| 779 CHECK_CHAR_TABLE (char_table); | |
| 780 if (XCHAR_TABLE_TYPE (char_table) == CHAR_TABLE_TYPE_SYNTAX) | |
| 781 invalid_change ("Can't change default for syntax tables", char_table); | |
| 782 check_valid_char_table_value (default_, XCHAR_TABLE_TYPE (char_table), | |
| 783 ERROR_ME); | |
| 784 set_char_table_default (char_table, default_); | |
| 785 return Qnil; | |
| 786 } | |
| 428 | 787 |
| 788 DEFUN ("get-char-table", Fget_char_table, 2, 2, 0, /* | |
| 444 | 789 Find value for CHARACTER in CHAR-TABLE. |
| 428 | 790 */ |
| 444 | 791 (character, char_table)) |
| 428 | 792 { |
| 444 | 793 CHECK_CHAR_TABLE (char_table); |
| 794 CHECK_CHAR_COERCE_INT (character); | |
| 428 | 795 |
| 826 | 796 return get_char_table (XCHAR (character), char_table); |
| 797 } | |
| 798 | |
| 799 static int | |
| 2286 | 800 copy_mapper (struct chartab_range *range, Lisp_Object UNUSED (table), |
| 826 | 801 Lisp_Object val, void *arg) |
| 802 { | |
| 5013 | 803 put_char_table (GET_LISP_FROM_VOID (arg), range, val); |
| 826 | 804 return 0; |
| 805 } | |
| 806 | |
| 807 void | |
| 808 copy_char_table_range (Lisp_Object from, Lisp_Object to, | |
| 809 struct chartab_range *range) | |
| 810 { | |
| 5013 | 811 map_char_table (from, range, copy_mapper, STORE_LISP_IN_VOID (to)); |
| 826 | 812 } |
| 813 | |
| 1296 | 814 static Lisp_Object |
| 815 get_range_char_table_1 (struct chartab_range *range, Lisp_Object table, | |
| 816 Lisp_Object multi) | |
| 826 | 817 { |
| 818 Lisp_Char_Table *ct = XCHAR_TABLE (table); | |
| 819 Lisp_Object retval = Qnil; | |
| 820 | |
| 821 switch (range->type) | |
| 822 { | |
| 823 case CHARTAB_RANGE_CHAR: | |
| 824 return get_char_table (range->ch, table); | |
| 825 | |
| 826 case CHARTAB_RANGE_ALL: | |
| 827 { | |
| 828 int i; | |
| 829 retval = ct->ascii[0]; | |
| 830 | |
| 831 for (i = 1; i < NUM_ASCII_CHARS; i++) | |
| 832 if (!EQ (retval, ct->ascii[i])) | |
| 833 return multi; | |
| 834 | |
| 835 #ifdef MULE | |
| 836 for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES; | |
| 837 i++) | |
| 838 { | |
| 839 if (!CHARSETP (charset_by_leading_byte (i)) | |
| 840 || i == LEADING_BYTE_ASCII | |
| 841 || i == LEADING_BYTE_CONTROL_1) | |
| 842 continue; | |
| 843 if (!EQ (retval, ct->level1[i - MIN_LEADING_BYTE])) | |
| 844 return multi; | |
| 845 } | |
| 846 #endif /* MULE */ | |
| 847 | |
| 848 break; | |
| 849 } | |
| 850 | |
| 851 #ifdef MULE | |
| 852 case CHARTAB_RANGE_CHARSET: | |
| 853 if (EQ (range->charset, Vcharset_ascii)) | |
| 854 { | |
| 855 int i; | |
| 856 retval = ct->ascii[0]; | |
| 857 | |
| 858 for (i = 1; i < 128; i++) | |
| 859 if (!EQ (retval, ct->ascii[i])) | |
| 860 return multi; | |
| 861 break; | |
| 862 } | |
| 863 | |
| 864 if (EQ (range->charset, Vcharset_control_1)) | |
| 865 { | |
| 866 int i; | |
| 867 retval = ct->ascii[128]; | |
| 868 | |
| 869 for (i = 129; i < 160; i++) | |
| 870 if (!EQ (retval, ct->ascii[i])) | |
| 871 return multi; | |
| 872 break; | |
| 873 } | |
| 874 | |
| 875 { | |
| 876 retval = ct->level1[XCHARSET_LEADING_BYTE (range->charset) - | |
| 877 MIN_LEADING_BYTE]; | |
| 878 if (CHAR_TABLE_ENTRYP (retval)) | |
| 879 return multi; | |
| 880 break; | |
| 881 } | |
| 882 | |
| 883 case CHARTAB_RANGE_ROW: | |
| 884 { | |
| 885 retval = ct->level1[XCHARSET_LEADING_BYTE (range->charset) - | |
| 886 MIN_LEADING_BYTE]; | |
| 887 if (!CHAR_TABLE_ENTRYP (retval)) | |
| 888 break; | |
| 889 retval = XCHAR_TABLE_ENTRY (retval)->level2[range->row - 32]; | |
| 890 if (CHAR_TABLE_ENTRYP (retval)) | |
| 891 return multi; | |
| 892 break; | |
| 893 } | |
| 894 #endif /* not MULE */ | |
| 895 | |
| 896 default: | |
| 2500 | 897 ABORT (); |
| 826 | 898 } |
| 899 | |
| 900 if (UNBOUNDP (retval)) | |
| 901 return ct->default_; | |
| 902 return retval; | |
| 428 | 903 } |
| 904 | |
| 1296 | 905 Lisp_Object |
| 906 get_range_char_table (struct chartab_range *range, Lisp_Object table, | |
| 907 Lisp_Object multi) | |
| 908 { | |
| 909 if (range->type == CHARTAB_RANGE_CHAR) | |
| 910 return get_char_table (range->ch, table); | |
| 911 else | |
| 912 return get_range_char_table_1 (range, table, multi); | |
| 913 } | |
| 914 | |
| 915 #ifdef ERROR_CHECK_TYPES | |
| 916 | |
| 917 /* Only exists so as not to trip an assert in get_char_table(). */ | |
| 918 Lisp_Object | |
| 919 updating_mirror_get_range_char_table (struct chartab_range *range, | |
| 920 Lisp_Object table, | |
| 921 Lisp_Object multi) | |
| 922 { | |
| 923 if (range->type == CHARTAB_RANGE_CHAR) | |
| 924 return get_char_table_1 (range->ch, table); | |
| 925 else | |
| 926 return get_range_char_table_1 (range, table, multi); | |
| 927 } | |
| 928 | |
| 929 #endif /* ERROR_CHECK_TYPES */ | |
| 930 | |
| 428 | 931 DEFUN ("get-range-char-table", Fget_range_char_table, 2, 3, 0, /* |
| 2714 | 932 Find value for RANGE in CHAR-TABLE. |
| 428 | 933 If there is more than one value, return MULTI (defaults to nil). |
| 2714 | 934 |
| 935 Valid values for RANGE are single characters, charsets, a row in a | |
| 936 two-octet charset, and all characters. See `put-char-table'. | |
| 428 | 937 */ |
| 444 | 938 (range, char_table, multi)) |
| 428 | 939 { |
| 940 struct chartab_range rainj; | |
| 941 | |
| 942 if (CHAR_OR_CHAR_INTP (range)) | |
| 444 | 943 return Fget_char_table (range, char_table); |
| 944 CHECK_CHAR_TABLE (char_table); | |
| 428 | 945 |
| 946 decode_char_table_range (range, &rainj); | |
| 826 | 947 return get_range_char_table (&rainj, char_table, multi); |
| 428 | 948 } |
| 826 | 949 |
| 428 | 950 static int |
| 951 check_valid_char_table_value (Lisp_Object value, enum char_table_type type, | |
| 578 | 952 Error_Behavior errb) |
| 428 | 953 { |
| 954 switch (type) | |
| 955 { | |
| 956 case CHAR_TABLE_TYPE_SYNTAX: | |
| 957 if (!ERRB_EQ (errb, ERROR_ME)) | |
| 958 return INTP (value) || (CONSP (value) && INTP (XCAR (value)) | |
| 959 && CHAR_OR_CHAR_INTP (XCDR (value))); | |
| 960 if (CONSP (value)) | |
| 961 { | |
| 962 Lisp_Object cdr = XCDR (value); | |
| 963 CHECK_INT (XCAR (value)); | |
| 964 CHECK_CHAR_COERCE_INT (cdr); | |
| 965 } | |
| 966 else | |
| 967 CHECK_INT (value); | |
| 968 break; | |
| 969 | |
| 970 #ifdef MULE | |
| 971 case CHAR_TABLE_TYPE_CATEGORY: | |
| 972 if (!ERRB_EQ (errb, ERROR_ME)) | |
| 973 return CATEGORY_TABLE_VALUEP (value); | |
| 974 CHECK_CATEGORY_TABLE_VALUE (value); | |
| 975 break; | |
| 976 #endif /* MULE */ | |
| 977 | |
| 978 case CHAR_TABLE_TYPE_GENERIC: | |
| 979 return 1; | |
| 980 | |
| 981 case CHAR_TABLE_TYPE_DISPLAY: | |
| 982 /* #### fix this */ | |
| 563 | 983 maybe_signal_error (Qunimplemented, |
| 984 "Display char tables not yet implemented", | |
| 985 value, Qchar_table, errb); | |
| 428 | 986 return 0; |
| 987 | |
| 988 case CHAR_TABLE_TYPE_CHAR: | |
| 989 if (!ERRB_EQ (errb, ERROR_ME)) | |
| 990 return CHAR_OR_CHAR_INTP (value); | |
| 991 CHECK_CHAR_COERCE_INT (value); | |
| 992 break; | |
| 993 | |
| 994 default: | |
| 2500 | 995 ABORT (); |
| 428 | 996 } |
| 997 | |
| 801 | 998 return 0; /* not (usually) reached */ |
| 428 | 999 } |
| 1000 | |
| 1001 static Lisp_Object | |
| 1002 canonicalize_char_table_value (Lisp_Object value, enum char_table_type type) | |
| 1003 { | |
| 1004 switch (type) | |
| 1005 { | |
| 1006 case CHAR_TABLE_TYPE_SYNTAX: | |
| 1007 if (CONSP (value)) | |
| 1008 { | |
| 1009 Lisp_Object car = XCAR (value); | |
| 1010 Lisp_Object cdr = XCDR (value); | |
| 1011 CHECK_CHAR_COERCE_INT (cdr); | |
| 1012 return Fcons (car, cdr); | |
| 1013 } | |
| 1014 break; | |
| 1015 case CHAR_TABLE_TYPE_CHAR: | |
| 1016 CHECK_CHAR_COERCE_INT (value); | |
| 1017 break; | |
| 1018 default: | |
| 1019 break; | |
| 1020 } | |
| 1021 return value; | |
| 1022 } | |
| 1023 | |
| 1024 DEFUN ("valid-char-table-value-p", Fvalid_char_table_value_p, 2, 2, 0, /* | |
| 1025 Return non-nil if VALUE is a valid value for CHAR-TABLE-TYPE. | |
| 1026 */ | |
| 1027 (value, char_table_type)) | |
| 1028 { | |
| 1029 enum char_table_type type = symbol_to_char_table_type (char_table_type); | |
| 1030 | |
| 1031 return check_valid_char_table_value (value, type, ERROR_ME_NOT) ? Qt : Qnil; | |
| 1032 } | |
| 1033 | |
| 1034 DEFUN ("check-valid-char-table-value", Fcheck_valid_char_table_value, 2, 2, 0, /* | |
| 1035 Signal an error if VALUE is not a valid value for CHAR-TABLE-TYPE. | |
| 1036 */ | |
| 1037 (value, char_table_type)) | |
| 1038 { | |
| 1039 enum char_table_type type = symbol_to_char_table_type (char_table_type); | |
| 1040 | |
| 1041 check_valid_char_table_value (value, type, ERROR_ME); | |
| 1042 return Qnil; | |
| 1043 } | |
| 1044 | |
| 826 | 1045 /* Assign VAL to all characters in RANGE in char table TABLE. */ |
| 428 | 1046 |
| 1047 void | |
| 826 | 1048 put_char_table (Lisp_Object table, struct chartab_range *range, |
| 428 | 1049 Lisp_Object val) |
| 1050 { | |
| 826 | 1051 Lisp_Char_Table *ct = XCHAR_TABLE (table); |
| 1052 | |
| 428 | 1053 switch (range->type) |
| 1054 { | |
| 1055 case CHARTAB_RANGE_ALL: | |
| 1056 fill_char_table (ct, val); | |
| 1296 | 1057 return; /* fill_char_table() recorded the table as dirty. */ |
| 428 | 1058 |
| 1059 #ifdef MULE | |
| 1060 case CHARTAB_RANGE_CHARSET: | |
| 1061 if (EQ (range->charset, Vcharset_ascii)) | |
| 1062 { | |
| 1063 int i; | |
| 1064 for (i = 0; i < 128; i++) | |
| 1065 ct->ascii[i] = val; | |
| 1066 } | |
| 1067 else if (EQ (range->charset, Vcharset_control_1)) | |
| 1068 { | |
| 1069 int i; | |
| 1070 for (i = 128; i < 160; i++) | |
| 1071 ct->ascii[i] = val; | |
| 1072 } | |
| 1073 else | |
| 1074 { | |
| 1075 int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE; | |
| 1330 | 1076 if (CHAR_TABLE_ENTRYP (ct->level1[lb]) && |
| 1077 !OBJECT_DUMPED_P (ct->level1[lb])) | |
| 3017 | 1078 FREE_LCRECORD (ct->level1[lb]); |
| 428 | 1079 ct->level1[lb] = val; |
| 1080 } | |
| 1081 break; | |
| 1082 | |
| 1083 case CHARTAB_RANGE_ROW: | |
| 1084 { | |
| 440 | 1085 Lisp_Char_Table_Entry *cte; |
| 428 | 1086 int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE; |
| 1087 /* make sure that there is a separate entry for the row. */ | |
| 1088 if (!CHAR_TABLE_ENTRYP (ct->level1[lb])) | |
| 1089 ct->level1[lb] = make_char_table_entry (ct->level1[lb]); | |
| 1090 cte = XCHAR_TABLE_ENTRY (ct->level1[lb]); | |
| 1091 cte->level2[range->row - 32] = val; | |
| 1092 } | |
| 1093 break; | |
| 1094 #endif /* MULE */ | |
| 1095 | |
| 1096 case CHARTAB_RANGE_CHAR: | |
| 1097 #ifdef MULE | |
| 1098 { | |
| 1099 Lisp_Object charset; | |
| 1100 int byte1, byte2; | |
| 1101 | |
| 867 | 1102 BREAKUP_ICHAR (range->ch, charset, byte1, byte2); |
| 428 | 1103 if (EQ (charset, Vcharset_ascii)) |
| 1104 ct->ascii[byte1] = val; | |
| 1105 else if (EQ (charset, Vcharset_control_1)) | |
| 1106 ct->ascii[byte1 + 128] = val; | |
| 1107 else | |
| 1108 { | |
| 440 | 1109 Lisp_Char_Table_Entry *cte; |
| 428 | 1110 int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE; |
| 1111 /* make sure that there is a separate entry for the row. */ | |
| 1112 if (!CHAR_TABLE_ENTRYP (ct->level1[lb])) | |
| 1113 ct->level1[lb] = make_char_table_entry (ct->level1[lb]); | |
| 1114 cte = XCHAR_TABLE_ENTRY (ct->level1[lb]); | |
| 1115 /* now CTE is a char table entry for the charset; | |
| 1116 each entry is for a single row (or character of | |
| 1117 a one-octet charset). */ | |
| 1118 if (XCHARSET_DIMENSION (charset) == 1) | |
| 1119 cte->level2[byte1 - 32] = val; | |
| 1120 else | |
| 1121 { | |
| 1122 /* assigning to one character in a two-octet charset. */ | |
| 1123 /* make sure that the charset row contains a separate | |
| 1124 entry for each character. */ | |
| 1125 if (!CHAR_TABLE_ENTRYP (cte->level2[byte1 - 32])) | |
| 1126 cte->level2[byte1 - 32] = | |
| 1127 make_char_table_entry (cte->level2[byte1 - 32]); | |
| 1128 cte = XCHAR_TABLE_ENTRY (cte->level2[byte1 - 32]); | |
| 1129 cte->level2[byte2 - 32] = val; | |
| 1130 } | |
| 1131 } | |
| 1132 } | |
| 1133 #else /* not MULE */ | |
| 1134 ct->ascii[(unsigned char) (range->ch)] = val; | |
| 1135 break; | |
| 1136 #endif /* not MULE */ | |
| 1137 } | |
| 1138 | |
| 1139 if (ct->type == CHAR_TABLE_TYPE_SYNTAX) | |
| 1296 | 1140 set_char_table_dirty (wrap_char_table (ct)); |
| 428 | 1141 } |
| 1142 | |
| 1143 DEFUN ("put-char-table", Fput_char_table, 3, 3, 0, /* | |
| 444 | 1144 Set the value for chars in RANGE to be VALUE in CHAR-TABLE. |
| 428 | 1145 |
| 1146 RANGE specifies one or more characters to be affected and should be | |
| 1147 one of the following: | |
| 1148 | |
| 1149 -- t (all characters are affected) | |
| 1150 -- A charset (only allowed when Mule support is present) | |
| 2714 | 1151 -- A vector of two elements: a two-octet charset and a row number; the row |
| 1152 must be an integer, not a character (only allowed when Mule support is | |
| 1153 present) | |
| 428 | 1154 -- A single character |
| 1155 | |
| 444 | 1156 VALUE must be a value appropriate for the type of CHAR-TABLE. |
| 800 | 1157 See `make-char-table'. |
| 428 | 1158 */ |
| 444 | 1159 (range, value, char_table)) |
| 428 | 1160 { |
| 440 | 1161 Lisp_Char_Table *ct; |
| 428 | 1162 struct chartab_range rainj; |
| 1163 | |
| 444 | 1164 CHECK_CHAR_TABLE (char_table); |
| 1165 ct = XCHAR_TABLE (char_table); | |
| 1166 check_valid_char_table_value (value, ct->type, ERROR_ME); | |
| 428 | 1167 decode_char_table_range (range, &rainj); |
| 444 | 1168 value = canonicalize_char_table_value (value, ct->type); |
| 826 | 1169 put_char_table (char_table, &rainj, value); |
| 1170 return Qnil; | |
| 1171 } | |
| 1172 | |
| 1173 DEFUN ("remove-char-table", Fremove_char_table, 2, 2, 0, /* | |
| 1174 Remove any value from chars in RANGE in CHAR-TABLE. | |
| 1175 | |
| 1176 RANGE specifies one or more characters to be affected and should be | |
| 1177 one of the following: | |
| 1178 | |
| 1179 -- t (all characters are affected) | |
| 1180 -- A charset (only allowed when Mule support is present) | |
| 1181 -- A vector of two elements: a two-octet charset and a row number | |
| 1182 (only allowed when Mule support is present) | |
| 1183 -- A single character | |
| 1184 | |
| 2726 | 1185 With all values removed, the default value will be returned by |
| 1186 `get-char-table' and `get-range-char-table'. | |
| 826 | 1187 */ |
| 1188 (range, char_table)) | |
| 1189 { | |
| 1190 struct chartab_range rainj; | |
| 1191 | |
| 1192 CHECK_CHAR_TABLE (char_table); | |
| 1193 decode_char_table_range (range, &rainj); | |
| 1194 put_char_table (char_table, &rainj, Qunbound); | |
| 428 | 1195 return Qnil; |
| 1196 } | |
| 1197 | |
| 1198 /* Map FN over the ASCII chars in CT. */ | |
| 1199 | |
| 1200 static int | |
| 826 | 1201 map_over_charset_ascii_1 (Lisp_Char_Table *ct, |
| 1202 int start, int stop, | |
| 1203 int (*fn) (struct chartab_range *range, | |
| 1204 Lisp_Object table, Lisp_Object val, | |
| 1205 void *arg), | |
| 1206 void *arg) | |
| 1207 { | |
| 1208 struct chartab_range rainj; | |
| 1209 int i, retval; | |
| 1210 | |
| 1211 rainj.type = CHARTAB_RANGE_CHAR; | |
| 1212 | |
| 1213 for (i = start, retval = 0; i <= stop && retval == 0; i++) | |
| 1214 { | |
| 867 | 1215 rainj.ch = (Ichar) i; |
| 826 | 1216 if (!UNBOUNDP (ct->ascii[i])) |
| 1217 retval = (fn) (&rainj, wrap_char_table (ct), ct->ascii[i], arg); | |
| 1218 } | |
| 1219 | |
| 1220 return retval; | |
| 1221 } | |
| 1222 | |
| 1223 | |
| 1224 /* Map FN over the ASCII chars in CT. */ | |
| 1225 | |
| 1226 static int | |
| 440 | 1227 map_over_charset_ascii (Lisp_Char_Table *ct, |
| 428 | 1228 int (*fn) (struct chartab_range *range, |
| 826 | 1229 Lisp_Object table, Lisp_Object val, |
| 1230 void *arg), | |
| 428 | 1231 void *arg) |
| 1232 { | |
| 826 | 1233 return map_over_charset_ascii_1 (ct, 0, |
| 428 | 1234 #ifdef MULE |
| 826 | 1235 127, |
| 428 | 1236 #else |
| 826 | 1237 255, |
| 428 | 1238 #endif |
| 826 | 1239 fn, arg); |
| 428 | 1240 } |
| 1241 | |
| 1242 #ifdef MULE | |
| 1243 | |
| 1244 /* Map FN over the Control-1 chars in CT. */ | |
| 1245 | |
| 1246 static int | |
| 440 | 1247 map_over_charset_control_1 (Lisp_Char_Table *ct, |
| 428 | 1248 int (*fn) (struct chartab_range *range, |
| 826 | 1249 Lisp_Object table, Lisp_Object val, |
| 1250 void *arg), | |
| 428 | 1251 void *arg) |
| 1252 { | |
| 826 | 1253 return map_over_charset_ascii_1 (ct, 128, 159, fn, arg); |
| 428 | 1254 } |
| 1255 | |
| 1256 /* Map FN over the row ROW of two-byte charset CHARSET. | |
| 1257 There must be a separate value for that row in the char table. | |
| 1258 CTE specifies the char table entry for CHARSET. */ | |
| 1259 | |
| 1260 static int | |
| 826 | 1261 map_over_charset_row (Lisp_Char_Table *ct, |
| 1262 Lisp_Char_Table_Entry *cte, | |
| 428 | 1263 Lisp_Object charset, int row, |
| 1264 int (*fn) (struct chartab_range *range, | |
| 826 | 1265 Lisp_Object table, Lisp_Object val, |
| 1266 void *arg), | |
| 428 | 1267 void *arg) |
| 1268 { | |
| 1269 Lisp_Object val = cte->level2[row - 32]; | |
| 1270 | |
| 826 | 1271 if (UNBOUNDP (val)) |
| 1272 return 0; | |
| 1273 else if (!CHAR_TABLE_ENTRYP (val)) | |
| 428 | 1274 { |
| 1275 struct chartab_range rainj; | |
| 826 | 1276 |
| 428 | 1277 rainj.type = CHARTAB_RANGE_ROW; |
| 1278 rainj.charset = charset; | |
| 1279 rainj.row = row; | |
| 826 | 1280 return (fn) (&rainj, wrap_char_table (ct), val, arg); |
| 428 | 1281 } |
| 1282 else | |
| 1283 { | |
| 1284 struct chartab_range rainj; | |
| 1285 int i, retval; | |
| 826 | 1286 int start, stop; |
| 1287 | |
| 1288 get_charset_limits (charset, &start, &stop); | |
| 428 | 1289 |
| 1290 cte = XCHAR_TABLE_ENTRY (val); | |
| 1291 | |
| 1292 rainj.type = CHARTAB_RANGE_CHAR; | |
| 1293 | |
| 826 | 1294 for (i = start, retval = 0; i <= stop && retval == 0; i++) |
| 428 | 1295 { |
| 867 | 1296 rainj.ch = make_ichar (charset, row, i); |
| 826 | 1297 if (!UNBOUNDP (cte->level2[i - 32])) |
| 1298 retval = (fn) (&rainj, wrap_char_table (ct), cte->level2[i - 32], | |
| 1299 arg); | |
| 428 | 1300 } |
| 1301 return retval; | |
| 1302 } | |
| 1303 } | |
| 1304 | |
| 1305 | |
| 1306 static int | |
| 440 | 1307 map_over_other_charset (Lisp_Char_Table *ct, int lb, |
| 428 | 1308 int (*fn) (struct chartab_range *range, |
| 826 | 1309 Lisp_Object table, Lisp_Object val, |
| 1310 void *arg), | |
| 428 | 1311 void *arg) |
| 1312 { | |
| 1313 Lisp_Object val = ct->level1[lb - MIN_LEADING_BYTE]; | |
| 826 | 1314 Lisp_Object charset = charset_by_leading_byte (lb); |
| 428 | 1315 |
| 1316 if (!CHARSETP (charset) | |
| 1317 || lb == LEADING_BYTE_ASCII | |
| 1318 || lb == LEADING_BYTE_CONTROL_1) | |
| 1319 return 0; | |
| 1320 | |
| 826 | 1321 if (UNBOUNDP (val)) |
| 1322 return 0; | |
| 428 | 1323 if (!CHAR_TABLE_ENTRYP (val)) |
| 1324 { | |
| 1325 struct chartab_range rainj; | |
| 1326 | |
| 1327 rainj.type = CHARTAB_RANGE_CHARSET; | |
| 1328 rainj.charset = charset; | |
| 826 | 1329 return (fn) (&rainj, wrap_char_table (ct), val, arg); |
| 428 | 1330 } |
| 1331 { | |
| 440 | 1332 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val); |
| 826 | 1333 int start, stop; |
| 428 | 1334 int i, retval; |
| 1335 | |
| 826 | 1336 get_charset_limits (charset, &start, &stop); |
| 428 | 1337 if (XCHARSET_DIMENSION (charset) == 1) |
| 1338 { | |
| 1339 struct chartab_range rainj; | |
| 1340 rainj.type = CHARTAB_RANGE_CHAR; | |
| 1341 | |
| 826 | 1342 for (i = start, retval = 0; i <= stop && retval == 0; i++) |
| 428 | 1343 { |
| 867 | 1344 rainj.ch = make_ichar (charset, i, 0); |
| 826 | 1345 if (!UNBOUNDP (cte->level2[i - 32])) |
| 1346 retval = (fn) (&rainj, wrap_char_table (ct), cte->level2[i - 32], | |
| 1347 arg); | |
| 428 | 1348 } |
| 1349 } | |
| 1350 else | |
| 1351 { | |
| 826 | 1352 for (i = start, retval = 0; i <= stop && retval == 0; i++) |
| 1353 retval = map_over_charset_row (ct, cte, charset, i, fn, arg); | |
| 428 | 1354 } |
| 1355 | |
| 1356 return retval; | |
| 1357 } | |
| 1358 } | |
| 1359 | |
| 1360 #endif /* MULE */ | |
| 1361 | |
| 1362 /* Map FN (with client data ARG) over range RANGE in char table CT. | |
| 1363 Mapping stops the first time FN returns non-zero, and that value | |
| 826 | 1364 becomes the return value of map_char_table(). |
| 1365 | |
| 1366 #### This mapping code is way ugly. The FSF version, in contrast, | |
| 1367 is short and sweet, and much more recursive. There should be some way | |
| 1368 of cleaning this up. */ | |
| 428 | 1369 |
| 1370 int | |
| 826 | 1371 map_char_table (Lisp_Object table, |
| 428 | 1372 struct chartab_range *range, |
| 1373 int (*fn) (struct chartab_range *range, | |
| 826 | 1374 Lisp_Object table, Lisp_Object val, void *arg), |
| 428 | 1375 void *arg) |
| 1376 { | |
| 826 | 1377 Lisp_Char_Table *ct = XCHAR_TABLE (table); |
| 428 | 1378 switch (range->type) |
| 1379 { | |
| 1380 case CHARTAB_RANGE_ALL: | |
| 1381 { | |
| 1382 int retval; | |
| 1383 | |
| 1384 retval = map_over_charset_ascii (ct, fn, arg); | |
| 1385 if (retval) | |
| 1386 return retval; | |
| 1387 #ifdef MULE | |
| 1388 retval = map_over_charset_control_1 (ct, fn, arg); | |
| 1389 if (retval) | |
| 1390 return retval; | |
| 1391 { | |
| 1392 int i; | |
| 1393 int start = MIN_LEADING_BYTE; | |
| 1394 int stop = start + NUM_LEADING_BYTES; | |
| 1395 | |
| 1396 for (i = start, retval = 0; i < stop && retval == 0; i++) | |
| 1397 { | |
| 771 | 1398 if (i != LEADING_BYTE_ASCII && i != LEADING_BYTE_CONTROL_1) |
| 1399 retval = map_over_other_charset (ct, i, fn, arg); | |
| 428 | 1400 } |
| 1401 } | |
| 1402 #endif /* MULE */ | |
| 1403 return retval; | |
| 1404 } | |
| 1405 | |
| 1406 #ifdef MULE | |
| 1407 case CHARTAB_RANGE_CHARSET: | |
| 1408 return map_over_other_charset (ct, | |
| 1409 XCHARSET_LEADING_BYTE (range->charset), | |
| 1410 fn, arg); | |
| 1411 | |
| 1412 case CHARTAB_RANGE_ROW: | |
| 1413 { | |
| 771 | 1414 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (range->charset) - |
| 1415 MIN_LEADING_BYTE]; | |
| 826 | 1416 |
| 1417 if (CHAR_TABLE_ENTRYP (val)) | |
| 1418 return map_over_charset_row (ct, XCHAR_TABLE_ENTRY (val), | |
| 1419 range->charset, range->row, fn, arg); | |
| 1420 else if (!UNBOUNDP (val)) | |
| 428 | 1421 { |
| 1422 struct chartab_range rainj; | |
| 1423 | |
| 1424 rainj.type = CHARTAB_RANGE_ROW; | |
| 1425 rainj.charset = range->charset; | |
| 1426 rainj.row = range->row; | |
| 826 | 1427 return (fn) (&rainj, table, val, arg); |
| 428 | 1428 } |
| 1429 else | |
| 826 | 1430 return 0; |
| 428 | 1431 } |
| 1432 #endif /* MULE */ | |
| 1433 | |
| 1434 case CHARTAB_RANGE_CHAR: | |
| 1435 { | |
| 867 | 1436 Ichar ch = range->ch; |
| 826 | 1437 Lisp_Object val = get_char_table (ch, table); |
| 428 | 1438 struct chartab_range rainj; |
| 1439 | |
| 826 | 1440 if (!UNBOUNDP (val)) |
| 1441 { | |
| 1442 rainj.type = CHARTAB_RANGE_CHAR; | |
| 1443 rainj.ch = ch; | |
| 1444 return (fn) (&rainj, table, val, arg); | |
| 1445 } | |
| 1446 else | |
| 1447 return 0; | |
| 428 | 1448 } |
| 1449 | |
| 1450 default: | |
| 2500 | 1451 ABORT (); |
| 428 | 1452 } |
| 1453 | |
| 1454 return 0; | |
| 1455 } | |
| 1456 | |
| 1457 struct slow_map_char_table_arg | |
| 1458 { | |
| 1459 Lisp_Object function; | |
| 1460 Lisp_Object retval; | |
| 1461 }; | |
| 1462 | |
| 1463 static int | |
| 1464 slow_map_char_table_fun (struct chartab_range *range, | |
| 2286 | 1465 Lisp_Object UNUSED (table), Lisp_Object val, |
| 1466 void *arg) | |
| 428 | 1467 { |
| 1468 struct slow_map_char_table_arg *closure = | |
| 1469 (struct slow_map_char_table_arg *) arg; | |
| 1470 | |
| 826 | 1471 closure->retval = call2 (closure->function, encode_char_table_range (range), |
| 1472 val); | |
| 428 | 1473 return !NILP (closure->retval); |
| 1474 } | |
| 1475 | |
| 1476 DEFUN ("map-char-table", Fmap_char_table, 2, 3, 0, /* | |
| 2726 | 1477 Map FUNCTION over CHAR-TABLE until it returns non-nil; return that value. |
| 1478 FUNCTION is called with two arguments, each key and entry in the table. | |
| 1479 | |
| 1480 RANGE specifies a subrange to map over. If omitted or t, it defaults to | |
| 1481 the entire table. | |
| 428 | 1482 |
| 2726 | 1483 Both RANGE and the keys passed to FUNCTION are in the same format as the |
| 1484 RANGE argument to `put-char-table'. N.B. This function does NOT map over | |
| 1485 all characters in RANGE, but over the subranges that have been assigned to. | |
| 1486 Thus this function is most suitable for searching a char-table, or for | |
| 1487 populating one char-table based on the contents of another. The current | |
| 1488 implementation does not coalesce ranges all of whose values are the same. | |
| 428 | 1489 */ |
| 444 | 1490 (function, char_table, range)) |
| 428 | 1491 { |
| 1492 struct slow_map_char_table_arg slarg; | |
| 1493 struct gcpro gcpro1, gcpro2; | |
| 1494 struct chartab_range rainj; | |
| 1495 | |
| 444 | 1496 CHECK_CHAR_TABLE (char_table); |
| 428 | 1497 if (NILP (range)) |
| 1498 range = Qt; | |
| 1499 decode_char_table_range (range, &rainj); | |
| 1500 slarg.function = function; | |
| 1501 slarg.retval = Qnil; | |
| 1502 GCPRO2 (slarg.function, slarg.retval); | |
| 826 | 1503 map_char_table (char_table, &rainj, slow_map_char_table_fun, &slarg); |
| 428 | 1504 UNGCPRO; |
| 1505 | |
| 1506 return slarg.retval; | |
| 1507 } | |
| 1508 | |
| 1509 | |
| 1510 | |
| 1511 /************************************************************************/ | |
| 1512 /* Char table read syntax */ | |
| 1513 /************************************************************************/ | |
| 1514 | |
| 1515 static int | |
| 2286 | 1516 chartab_type_validate (Lisp_Object UNUSED (keyword), Lisp_Object value, |
| 1517 Error_Behavior UNUSED (errb)) | |
| 428 | 1518 { |
| 1519 /* #### should deal with ERRB */ | |
| 1520 symbol_to_char_table_type (value); | |
| 1521 return 1; | |
| 1522 } | |
| 1523 | |
| 826 | 1524 /* #### Document the print/read format; esp. what's this cons element? */ |
| 1525 | |
| 428 | 1526 static int |
| 2286 | 1527 chartab_data_validate (Lisp_Object UNUSED (keyword), Lisp_Object value, |
| 1528 Error_Behavior UNUSED (errb)) | |
| 428 | 1529 { |
| 1530 /* #### should deal with ERRB */ | |
| 2367 | 1531 EXTERNAL_PROPERTY_LIST_LOOP_3 (range, data, value) |
| 428 | 1532 { |
| 1533 struct chartab_range dummy; | |
| 1534 | |
| 1535 if (CONSP (range)) | |
| 1536 { | |
| 1537 if (!CONSP (XCDR (range)) | |
| 1538 || !NILP (XCDR (XCDR (range)))) | |
| 563 | 1539 sferror ("Invalid range format", range); |
| 428 | 1540 decode_char_table_range (XCAR (range), &dummy); |
| 1541 decode_char_table_range (XCAR (XCDR (range)), &dummy); | |
| 1542 } | |
| 1543 else | |
| 1544 decode_char_table_range (range, &dummy); | |
| 1545 } | |
| 1546 | |
| 1547 return 1; | |
| 1548 } | |
| 1549 | |
| 1550 static Lisp_Object | |
| 1551 chartab_instantiate (Lisp_Object data) | |
| 1552 { | |
| 1553 Lisp_Object chartab; | |
| 1554 Lisp_Object type = Qgeneric; | |
| 1555 Lisp_Object dataval = Qnil; | |
| 1556 | |
| 1557 while (!NILP (data)) | |
| 1558 { | |
| 1559 Lisp_Object keyw = Fcar (data); | |
| 1560 Lisp_Object valw; | |
| 1561 | |
| 1562 data = Fcdr (data); | |
| 1563 valw = Fcar (data); | |
| 1564 data = Fcdr (data); | |
| 1565 if (EQ (keyw, Qtype)) | |
| 1566 type = valw; | |
| 1567 else if (EQ (keyw, Qdata)) | |
| 1568 dataval = valw; | |
| 1569 } | |
| 1570 | |
| 1571 chartab = Fmake_char_table (type); | |
| 1572 | |
| 1573 data = dataval; | |
| 1574 while (!NILP (data)) | |
| 1575 { | |
| 1576 Lisp_Object range = Fcar (data); | |
| 1577 Lisp_Object val = Fcar (Fcdr (data)); | |
| 1578 | |
| 1579 data = Fcdr (Fcdr (data)); | |
| 1580 if (CONSP (range)) | |
| 1581 { | |
| 1582 if (CHAR_OR_CHAR_INTP (XCAR (range))) | |
| 1583 { | |
| 867 | 1584 Ichar first = XCHAR_OR_CHAR_INT (Fcar (range)); |
| 1585 Ichar last = XCHAR_OR_CHAR_INT (Fcar (Fcdr (range))); | |
| 1586 Ichar i; | |
| 428 | 1587 |
| 1588 for (i = first; i <= last; i++) | |
| 1589 Fput_char_table (make_char (i), val, chartab); | |
| 1590 } | |
| 1591 else | |
| 2500 | 1592 ABORT (); |
| 428 | 1593 } |
| 1594 else | |
| 1595 Fput_char_table (range, val, chartab); | |
| 1596 } | |
| 1597 | |
| 1598 return chartab; | |
| 1599 } | |
| 1600 | |
| 1601 #ifdef MULE | |
| 1602 | |
| 1603 | |
| 1604 /************************************************************************/ | |
| 1605 /* Category Tables, specifically */ | |
| 1606 /************************************************************************/ | |
| 1607 | |
| 1608 DEFUN ("category-table-p", Fcategory_table_p, 1, 1, 0, /* | |
| 444 | 1609 Return t if OBJECT is a category table. |
| 428 | 1610 A category table is a type of char table used for keeping track of |
| 1611 categories. Categories are used for classifying characters for use | |
| 1612 in regexps -- you can refer to a category rather than having to use | |
| 1613 a complicated [] expression (and category lookups are significantly | |
| 1614 faster). | |
| 1615 | |
| 1616 There are 95 different categories available, one for each printable | |
| 1617 character (including space) in the ASCII charset. Each category | |
| 1618 is designated by one such character, called a "category designator". | |
| 1619 They are specified in a regexp using the syntax "\\cX", where X is | |
| 1620 a category designator. | |
| 1621 | |
| 1622 A category table specifies, for each character, the categories that | |
| 1623 the character is in. Note that a character can be in more than one | |
| 1624 category. More specifically, a category table maps from a character | |
| 1625 to either the value nil (meaning the character is in no categories) | |
| 1626 or a 95-element bit vector, specifying for each of the 95 categories | |
| 1627 whether the character is in that category. | |
| 1628 | |
| 1629 Special Lisp functions are provided that abstract this, so you do not | |
| 1630 have to directly manipulate bit vectors. | |
| 1631 */ | |
| 444 | 1632 (object)) |
| 428 | 1633 { |
| 444 | 1634 return (CHAR_TABLEP (object) && |
| 1635 XCHAR_TABLE_TYPE (object) == CHAR_TABLE_TYPE_CATEGORY) ? | |
| 428 | 1636 Qt : Qnil; |
| 1637 } | |
| 1638 | |
| 1639 static Lisp_Object | |
| 444 | 1640 check_category_table (Lisp_Object object, Lisp_Object default_) |
| 428 | 1641 { |
| 444 | 1642 if (NILP (object)) |
| 1643 object = default_; | |
| 1644 while (NILP (Fcategory_table_p (object))) | |
| 1645 object = wrong_type_argument (Qcategory_table_p, object); | |
| 1646 return object; | |
| 428 | 1647 } |
| 1648 | |
| 1649 int | |
| 867 | 1650 check_category_char (Ichar ch, Lisp_Object table, |
| 647 | 1651 int designator, int not_p) |
| 428 | 1652 { |
| 1653 REGISTER Lisp_Object temp; | |
| 1654 if (NILP (Fcategory_table_p (table))) | |
| 563 | 1655 wtaerror ("Expected category table", table); |
| 826 | 1656 temp = get_char_table (ch, table); |
| 428 | 1657 if (NILP (temp)) |
| 458 | 1658 return not_p; |
| 428 | 1659 |
| 1660 designator -= ' '; | |
| 458 | 1661 return bit_vector_bit (XBIT_VECTOR (temp), designator) ? !not_p : not_p; |
| 428 | 1662 } |
| 1663 | |
| 1664 DEFUN ("check-category-at", Fcheck_category_at, 2, 4, 0, /* | |
| 444 | 1665 Return t if category of the character at POSITION includes DESIGNATOR. |
| 1666 Optional third arg BUFFER specifies which buffer to use, and defaults | |
| 1667 to the current buffer. | |
| 1668 Optional fourth arg CATEGORY-TABLE specifies the category table to | |
| 1669 use, and defaults to BUFFER's category table. | |
| 428 | 1670 */ |
| 444 | 1671 (position, designator, buffer, category_table)) |
| 428 | 1672 { |
| 1673 Lisp_Object ctbl; | |
| 867 | 1674 Ichar ch; |
| 647 | 1675 int des; |
| 428 | 1676 struct buffer *buf = decode_buffer (buffer, 0); |
| 1677 | |
| 444 | 1678 CHECK_INT (position); |
| 428 | 1679 CHECK_CATEGORY_DESIGNATOR (designator); |
| 1680 des = XCHAR (designator); | |
| 788 | 1681 ctbl = check_category_table (category_table, buf->category_table); |
| 444 | 1682 ch = BUF_FETCH_CHAR (buf, XINT (position)); |
| 428 | 1683 return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil; |
| 1684 } | |
| 1685 | |
| 1686 DEFUN ("char-in-category-p", Fchar_in_category_p, 2, 3, 0, /* | |
| 788 | 1687 Return non-nil if category of CHARACTER includes DESIGNATOR. |
| 444 | 1688 Optional third arg CATEGORY-TABLE specifies the category table to use, |
| 788 | 1689 and defaults to the current buffer's category table. |
| 428 | 1690 */ |
| 444 | 1691 (character, designator, category_table)) |
| 428 | 1692 { |
| 1693 Lisp_Object ctbl; | |
| 867 | 1694 Ichar ch; |
| 647 | 1695 int des; |
| 428 | 1696 |
| 1697 CHECK_CATEGORY_DESIGNATOR (designator); | |
| 1698 des = XCHAR (designator); | |
| 444 | 1699 CHECK_CHAR (character); |
| 1700 ch = XCHAR (character); | |
| 788 | 1701 ctbl = check_category_table (category_table, current_buffer->category_table); |
| 428 | 1702 return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil; |
| 1703 } | |
| 1704 | |
| 1705 DEFUN ("category-table", Fcategory_table, 0, 1, 0, /* | |
| 444 | 1706 Return BUFFER's current category table. |
| 1707 BUFFER defaults to the current buffer. | |
| 428 | 1708 */ |
| 1709 (buffer)) | |
| 1710 { | |
| 1711 return decode_buffer (buffer, 0)->category_table; | |
| 1712 } | |
| 1713 | |
| 1714 DEFUN ("standard-category-table", Fstandard_category_table, 0, 0, 0, /* | |
| 1715 Return the standard category table. | |
| 1716 This is the one used for new buffers. | |
| 1717 */ | |
| 1718 ()) | |
| 1719 { | |
| 1720 return Vstandard_category_table; | |
| 1721 } | |
| 1722 | |
| 1723 DEFUN ("copy-category-table", Fcopy_category_table, 0, 1, 0, /* | |
| 444 | 1724 Return a new category table which is a copy of CATEGORY-TABLE. |
| 1725 CATEGORY-TABLE defaults to the standard category table. | |
| 428 | 1726 */ |
| 444 | 1727 (category_table)) |
| 428 | 1728 { |
| 1729 if (NILP (Vstandard_category_table)) | |
| 1730 return Fmake_char_table (Qcategory); | |
| 1731 | |
| 444 | 1732 category_table = |
| 1733 check_category_table (category_table, Vstandard_category_table); | |
| 1734 return Fcopy_char_table (category_table); | |
| 428 | 1735 } |
| 1736 | |
| 1737 DEFUN ("set-category-table", Fset_category_table, 1, 2, 0, /* | |
| 444 | 1738 Select CATEGORY-TABLE as the new category table for BUFFER. |
| 428 | 1739 BUFFER defaults to the current buffer if omitted. |
| 1740 */ | |
| 444 | 1741 (category_table, buffer)) |
| 428 | 1742 { |
| 1743 struct buffer *buf = decode_buffer (buffer, 0); | |
| 444 | 1744 category_table = check_category_table (category_table, Qnil); |
| 1745 buf->category_table = category_table; | |
| 428 | 1746 /* Indicate that this buffer now has a specified category table. */ |
| 1747 buf->local_var_flags |= XINT (buffer_local_flags.category_table); | |
| 444 | 1748 return category_table; |
| 428 | 1749 } |
| 1750 | |
| 1751 DEFUN ("category-designator-p", Fcategory_designator_p, 1, 1, 0, /* | |
| 444 | 1752 Return t if OBJECT is a category designator (a char in the range ' ' to '~'). |
| 428 | 1753 */ |
| 444 | 1754 (object)) |
| 428 | 1755 { |
| 444 | 1756 return CATEGORY_DESIGNATORP (object) ? Qt : Qnil; |
| 428 | 1757 } |
| 1758 | |
| 1759 DEFUN ("category-table-value-p", Fcategory_table_value_p, 1, 1, 0, /* | |
| 444 | 1760 Return t if OBJECT is a category table value. |
| 428 | 1761 Valid values are nil or a bit vector of size 95. |
| 1762 */ | |
| 444 | 1763 (object)) |
| 428 | 1764 { |
| 444 | 1765 return CATEGORY_TABLE_VALUEP (object) ? Qt : Qnil; |
| 428 | 1766 } |
| 1767 | |
| 1768 | |
| 1769 #define CATEGORYP(x) \ | |
| 1770 (CHARP (x) && XCHAR (x) >= 0x20 && XCHAR (x) <= 0x7E) | |
| 1771 | |
| 826 | 1772 #define CATEGORY_SET(c) get_char_table (c, current_buffer->category_table) |
| 428 | 1773 |
| 1774 /* Return 1 if CATEGORY_SET contains CATEGORY, else return 0. | |
| 1775 The faster version of `!NILP (Faref (category_set, category))'. */ | |
| 1776 #define CATEGORY_MEMBER(category, category_set) \ | |
| 1777 (bit_vector_bit(XBIT_VECTOR (category_set), category - 32)) | |
| 1778 | |
| 1779 /* Return 1 if there is a word boundary between two word-constituent | |
| 1780 characters C1 and C2 if they appear in this order, else return 0. | |
| 1781 Use the macro WORD_BOUNDARY_P instead of calling this function | |
| 1782 directly. */ | |
| 1783 | |
| 1784 int | |
| 867 | 1785 word_boundary_p (Ichar c1, Ichar c2) |
| 428 | 1786 { |
| 1787 Lisp_Object category_set1, category_set2; | |
| 1788 Lisp_Object tail; | |
| 1789 int default_result; | |
| 1790 | |
| 1791 #if 0 | |
| 1792 if (COMPOSITE_CHAR_P (c1)) | |
| 1793 c1 = cmpchar_component (c1, 0, 1); | |
| 1794 if (COMPOSITE_CHAR_P (c2)) | |
| 1795 c2 = cmpchar_component (c2, 0, 1); | |
| 1796 #endif | |
| 1797 | |
| 867 | 1798 if (EQ (ichar_charset (c1), ichar_charset (c2))) |
| 428 | 1799 { |
| 1800 tail = Vword_separating_categories; | |
| 1801 default_result = 0; | |
| 1802 } | |
| 1803 else | |
| 1804 { | |
| 1805 tail = Vword_combining_categories; | |
| 1806 default_result = 1; | |
| 1807 } | |
| 1808 | |
| 1809 category_set1 = CATEGORY_SET (c1); | |
| 1810 if (NILP (category_set1)) | |
| 1811 return default_result; | |
| 1812 category_set2 = CATEGORY_SET (c2); | |
| 1813 if (NILP (category_set2)) | |
| 1814 return default_result; | |
| 1815 | |
| 853 | 1816 for (; CONSP (tail); tail = XCDR (tail)) |
| 428 | 1817 { |
| 853 | 1818 Lisp_Object elt = XCAR (tail); |
| 428 | 1819 |
| 1820 if (CONSP (elt) | |
| 853 | 1821 && CATEGORYP (XCAR (elt)) |
| 1822 && CATEGORYP (XCDR (elt)) | |
| 1823 && CATEGORY_MEMBER (XCHAR (XCAR (elt)), category_set1) | |
| 1824 && CATEGORY_MEMBER (XCHAR (XCDR (elt)), category_set2)) | |
| 428 | 1825 return !default_result; |
| 1826 } | |
| 1827 return default_result; | |
| 1828 } | |
| 1829 #endif /* MULE */ | |
| 1830 | |
| 1831 | |
| 1832 void | |
| 1833 syms_of_chartab (void) | |
| 1834 { | |
| 442 | 1835 INIT_LRECORD_IMPLEMENTATION (char_table); |
| 1836 | |
| 428 | 1837 #ifdef MULE |
| 442 | 1838 INIT_LRECORD_IMPLEMENTATION (char_table_entry); |
| 1839 | |
| 563 | 1840 DEFSYMBOL (Qcategory_table_p); |
| 1841 DEFSYMBOL (Qcategory_designator_p); | |
| 1842 DEFSYMBOL (Qcategory_table_value_p); | |
| 428 | 1843 #endif /* MULE */ |
| 1844 | |
| 563 | 1845 DEFSYMBOL (Qchar_table); |
| 1846 DEFSYMBOL_MULTIWORD_PREDICATE (Qchar_tablep); | |
| 428 | 1847 |
| 1848 DEFSUBR (Fchar_table_p); | |
| 1849 DEFSUBR (Fchar_table_type_list); | |
| 1850 DEFSUBR (Fvalid_char_table_type_p); | |
| 1851 DEFSUBR (Fchar_table_type); | |
| 826 | 1852 DEFSUBR (Fchar_table_default); |
| 1853 DEFSUBR (Fset_char_table_default); | |
| 428 | 1854 DEFSUBR (Freset_char_table); |
| 1855 DEFSUBR (Fmake_char_table); | |
| 1856 DEFSUBR (Fcopy_char_table); | |
| 1857 DEFSUBR (Fget_char_table); | |
| 1858 DEFSUBR (Fget_range_char_table); | |
| 1859 DEFSUBR (Fvalid_char_table_value_p); | |
| 1860 DEFSUBR (Fcheck_valid_char_table_value); | |
| 1861 DEFSUBR (Fput_char_table); | |
| 826 | 1862 DEFSUBR (Fremove_char_table); |
| 428 | 1863 DEFSUBR (Fmap_char_table); |
| 1864 | |
| 1865 #ifdef MULE | |
| 1866 DEFSUBR (Fcategory_table_p); | |
| 1867 DEFSUBR (Fcategory_table); | |
| 1868 DEFSUBR (Fstandard_category_table); | |
| 1869 DEFSUBR (Fcopy_category_table); | |
| 1870 DEFSUBR (Fset_category_table); | |
| 1871 DEFSUBR (Fcheck_category_at); | |
| 1872 DEFSUBR (Fchar_in_category_p); | |
| 1873 DEFSUBR (Fcategory_designator_p); | |
| 1874 DEFSUBR (Fcategory_table_value_p); | |
| 1875 #endif /* MULE */ | |
| 1876 | |
| 1877 } | |
| 1878 | |
| 1879 void | |
| 1880 vars_of_chartab (void) | |
| 1881 { | |
| 1882 /* DO NOT staticpro this. It works just like Vweak_hash_tables. */ | |
| 1883 Vall_syntax_tables = Qnil; | |
| 452 | 1884 dump_add_weak_object_chain (&Vall_syntax_tables); |
| 428 | 1885 } |
| 1886 | |
| 1887 void | |
| 1888 structure_type_create_chartab (void) | |
| 1889 { | |
| 1890 struct structure_type *st; | |
| 1891 | |
| 1892 st = define_structure_type (Qchar_table, 0, chartab_instantiate); | |
| 1893 | |
| 1894 define_structure_type_keyword (st, Qtype, chartab_type_validate); | |
| 1895 define_structure_type_keyword (st, Qdata, chartab_data_validate); | |
| 1896 } | |
| 1897 | |
| 1898 void | |
| 1899 complex_vars_of_chartab (void) | |
| 1900 { | |
| 1901 #ifdef MULE | |
| 1902 /* Set this now, so first buffer creation can refer to it. */ | |
| 1903 /* Make it nil before calling copy-category-table | |
| 1904 so that copy-category-table will know not to try to copy from garbage */ | |
| 1905 Vstandard_category_table = Qnil; | |
| 1906 Vstandard_category_table = Fcopy_category_table (Qnil); | |
| 1907 staticpro (&Vstandard_category_table); | |
| 1908 | |
| 1909 DEFVAR_LISP ("word-combining-categories", &Vword_combining_categories /* | |
| 1910 List of pair (cons) of categories to determine word boundary. | |
| 1911 | |
| 1912 Emacs treats a sequence of word constituent characters as a single | |
| 1913 word (i.e. finds no word boundary between them) iff they belongs to | |
| 1914 the same charset. But, exceptions are allowed in the following cases. | |
| 1915 | |
| 444 | 1916 \(1) The case that characters are in different charsets is controlled |
| 428 | 1917 by the variable `word-combining-categories'. |
| 1918 | |
| 1919 Emacs finds no word boundary between characters of different charsets | |
| 1920 if they have categories matching some element of this list. | |
| 1921 | |
| 1922 More precisely, if an element of this list is a cons of category CAT1 | |
| 1923 and CAT2, and a multibyte character C1 which has CAT1 is followed by | |
| 1924 C2 which has CAT2, there's no word boundary between C1 and C2. | |
| 1925 | |
| 1926 For instance, to tell that ASCII characters and Latin-1 characters can | |
| 1927 form a single word, the element `(?l . ?l)' should be in this list | |
| 1928 because both characters have the category `l' (Latin characters). | |
| 1929 | |
| 444 | 1930 \(2) The case that character are in the same charset is controlled by |
| 428 | 1931 the variable `word-separating-categories'. |
| 1932 | |
| 1933 Emacs find a word boundary between characters of the same charset | |
| 1934 if they have categories matching some element of this list. | |
| 1935 | |
| 1936 More precisely, if an element of this list is a cons of category CAT1 | |
| 1937 and CAT2, and a multibyte character C1 which has CAT1 is followed by | |
| 1938 C2 which has CAT2, there's a word boundary between C1 and C2. | |
| 1939 | |
| 1940 For instance, to tell that there's a word boundary between Japanese | |
| 1941 Hiragana and Japanese Kanji (both are in the same charset), the | |
| 1942 element `(?H . ?C) should be in this list. | |
| 1943 */ ); | |
| 1944 | |
| 1945 Vword_combining_categories = Qnil; | |
| 1946 | |
| 1947 DEFVAR_LISP ("word-separating-categories", &Vword_separating_categories /* | |
| 1948 List of pair (cons) of categories to determine word boundary. | |
| 1949 See the documentation of the variable `word-combining-categories'. | |
| 1950 */ ); | |
| 1951 | |
| 1952 Vword_separating_categories = Qnil; | |
| 1953 #endif /* MULE */ | |
| 1954 } |