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