Mercurial > hg > xemacs-beta
comparison src/chartab.c @ 826:6728e641994e
[xemacs-hg @ 2002-05-05 11:30:15 by ben]
syntax cache, 8-bit-format, lots of code cleanup
README.packages: Update info about --package-path.
i.c: Create an inheritable event and pass it on to XEmacs, so that ^C
can be handled properly. Intercept ^C and signal the event.
"Stop Build" in VC++ now works.
bytecomp-runtime.el: Doc string changes.
compat.el: Some attempts to redo this to
make it truly useful and fix the "multiple versions interacting
with each other" problem. Not yet done. Currently doesn't work.
files.el: Use with-obsolete-variable to avoid warnings in new revert-buffer code.
xemacs.mak: Split up CFLAGS into a version without flags specifying the C
library. The problem seems to be that minitar depends on zlib,
which depends specifically on libc.lib, not on any of the other C
libraries. Unless you compile with libc.lib, you get errors --
specifically, no _errno in the other libraries, which must make it
something other than an int. (#### But this doesn't seem to obtain
in XEmacs, which also uses zlib, and can be linked with any of the
C libraries. Maybe zlib is used differently and doesn't need
errno, or maybe XEmacs provides an int errno; ... I don't
understand.
Makefile.in.in: Fix so that packages are around when testing.
abbrev.c, alloc.c, buffer.c, buffer.h, bytecode.c, callint.c, casefiddle.c, casetab.c, casetab.h, charset.h, chartab.c, chartab.h, cmds.c, console-msw.h, console-stream.c, console-x.c, console.c, console.h, data.c, device-msw.c, device.c, device.h, dialog-msw.c, dialog-x.c, dired-msw.c, dired.c, doc.c, doprnt.c, dumper.c, editfns.c, elhash.c, emacs.c, eval.c, event-Xt.c, event-gtk.c, event-msw.c, event-stream.c, events.c, events.h, extents.c, extents.h, faces.c, file-coding.c, file-coding.h, fileio.c, fns.c, font-lock.c, frame-gtk.c, frame-msw.c, frame-x.c, frame.c, frame.h, glade.c, glyphs-gtk.c, glyphs-msw.c, glyphs-msw.h, glyphs-x.c, glyphs.c, glyphs.h, gui-msw.c, gui-x.c, gui.h, gutter.h, hash.h, indent.c, insdel.c, intl-win32.c, intl.c, keymap.c, lisp-disunion.h, lisp-union.h, lisp.h, lread.c, lrecord.h, lstream.c, lstream.h, marker.c, menubar-gtk.c, menubar-msw.c, menubar-x.c, menubar.c, minibuf.c, mule-ccl.c, mule-charset.c, mule-coding.c, mule-wnnfns.c, nas.c, objects-msw.c, objects-x.c, opaque.c, postgresql.c, print.c, process-nt.c, process-unix.c, process.c, process.h, profile.c, rangetab.c, redisplay-gtk.c, redisplay-msw.c, redisplay-output.c, redisplay-x.c, redisplay.c, redisplay.h, regex.c, regex.h, scrollbar-msw.c, search.c, select-x.c, specifier.c, specifier.h, symbols.c, symsinit.h, syntax.c, syntax.h, syswindows.h, tests.c, text.c, text.h, tooltalk.c, ui-byhand.c, ui-gtk.c, unicode.c, win32.c, window.c: Another big Ben patch.
-- FUNCTIONALITY CHANGES:
add partial support for 8-bit-fixed, 16-bit-fixed, and
32-bit-fixed formats. not quite done yet. (in particular, needs
functions to actually convert the buffer.) NOTE: lots of changes
to regex.c here. also, many new *_fmt() inline funs that take an
Internal_Format argument.
redo syntax cache code. make the cache per-buffer; keep the cache
valid across calls to functions that use it. also keep it valid
across insertions/deletions and extent changes, as much as is
possible. eliminate the junky regex-reentrancy code by passing in
the relevant lisp info to the regex routines as local vars.
add general mechanism in extents code for signalling extent changes.
fix numerous problems with the case-table implementation; yoshiki
never properly transferred many algorithms from old-style to
new-style case tables.
redo char tables to support a default argument, so that mapping
only occurs over changed args. change many chartab functions to
accept Lisp_Object instead of Lisp_Char_Table *.
comment out the code in font-lock.c by default, because
font-lock.el no longer uses it. we should consider eliminating it
entirely.
Don't output bell as ^G in console-stream when not a TTY.
add -mswindows-termination-handle to interface with i.c, so we can
properly kill a build.
add more error-checking to buffer/string macros.
add some additional buffer_or_string_() funs.
-- INTERFACE CHANGES AFFECTING MORE CODE:
switch the arguments of write_c_string and friends to be
consistent with write_fmt_string, which must have printcharfun
first.
change BI_* macros to BYTE_* for increased clarity; similarly for
bi_* local vars.
change VOID_TO_LISP to be a one-argument function. eliminate
no-longer-needed CVOID_TO_LISP.
-- char/string macro changes:
rename MAKE_CHAR() to make_emchar() for slightly less confusion
with make_char(). (The former generates an Emchar, the latter a
Lisp object. Conceivably we should rename make_char() -> wrap_char()
and similarly for make_int(), make_float().)
Similar changes for other *CHAR* macros -- we now consistently use
names with `emchar' whenever we are working with Emchars. Any
remaining name with just `char' always refers to a Lisp object.
rename macros with XSTRING_* to string_* except for those that
reference actual fields in the Lisp_String object, following
conventions used elsewhere.
rename set_string_{data,length} macros (the only ones to work with
a Lisp_String_* instead of a Lisp_Object) to set_lispstringp_*
to make the difference clear.
try to be consistent about caps vs. lowercase in macro/inline-fun
names for chars and such, which wasn't the case before. we now
reserve caps either for XFOO_ macros that reference object fields
(e.g. XSTRING_DATA) or for things that have non-function semantics,
e.g. directly modifying an arg (BREAKUP_EMCHAR) or evaluating an
arg (any arg) more than once. otherwise, use lowercase.
here is a summary of most of the macros/inline funs changed by all
of the above changes:
BYTE_*_P -> byte_*_p
XSTRING_BYTE -> string_byte
set_string_data/length -> set_lispstringp_data/length
XSTRING_CHAR_LENGTH -> string_char_length
XSTRING_CHAR -> string_emchar
INTBYTE_FIRST_BYTE_P -> intbyte_first_byte_p
INTBYTE_LEADING_BYTE_P -> intbyte_leading_byte_p
charptr_copy_char -> charptr_copy_emchar
LEADING_BYTE_* -> leading_byte_*
CHAR_* -> EMCHAR_*
*_CHAR_* -> *_EMCHAR_*
*_CHAR -> *_EMCHAR
CHARSET_BY_ -> charset_by_*
BYTE_SHIFT_JIS* -> byte_shift_jis*
BYTE_BIG5* -> byte_big5*
REP_BYTES_BY_FIRST_BYTE -> rep_bytes_by_first_byte
char_to_unicode -> emchar_to_unicode
valid_char_p -> valid_emchar_p
Change intbyte_strcmp -> qxestrcmp_c (duplicated functionality).
-- INTERFACE CHANGES AFFECTING LESS CODE:
use DECLARE_INLINE_HEADER in various places.
remove '#ifdef emacs' from XEmacs-only files.
eliminate CHAR_TABLE_VALUE(), which duplicated the functionality
of get_char_table().
add BUFFER_TEXT_LOOP to simplify iterations over buffer text.
define typedefs for signed and unsigned types of fixed sizes
(INT_32_BIT, UINT_32_BIT, etc.).
create ALIGN_FOR_TYPE as a higher-level interface onto ALIGN_SIZE;
fix code to use it.
add charptr_emchar_len to return the text length of the character
pointed to by a ptr; use it in place of
charcount_to_bytecount(..., 1). add emchar_len to return the text
length of a given character.
add types Bytexpos and Charxpos to generalize Bytebpos/Bytecount
and Charbpos/Charcount, in code (particularly, the extents code
and redisplay code) that works with either kind of index. rename
redisplay struct params with names such as `charbpos' to
e.g. `charpos' when they are e.g. a Charxpos, not a Charbpos.
eliminate xxDEFUN in place of DEFUN; no longer necessary with
changes awhile back to doc.c.
split up big ugly combined list of EXFUNs in lisp.h on a
file-by-file basis, since other prototypes are similarly split.
rewrite some "*_UNSAFE" macros as inline funs and eliminate the
_UNSAFE suffix.
move most string code from lisp.h to text.h; the string code and
text.h code is now intertwined in such a fashion that they need
to be in the same place and partially interleaved. (you can't
create forward references for inline funs)
automated/lisp-tests.el, automated/symbol-tests.el, automated/test-harness.el: Fix test harness to output FAIL messages to stderr when in
batch mode.
Fix up some problems in lisp-tests/symbol-tests that were
causing spurious failures.
author | ben |
---|---|
date | Sun, 05 May 2002 11:33:57 +0000 |
parents | 2b676dc88c66 |
children | 2b6fa2618f76 |
comparison
equal
deleted
inserted
replaced
825:eb3bc15a6e0f | 826:6728e641994e |
---|---|
55 | 55 |
56 /* Variables to determine word boundary. */ | 56 /* Variables to determine word boundary. */ |
57 Lisp_Object Vword_combining_categories, Vword_separating_categories; | 57 Lisp_Object Vword_combining_categories, Vword_separating_categories; |
58 #endif /* MULE */ | 58 #endif /* MULE */ |
59 | 59 |
60 static int check_valid_char_table_value (Lisp_Object value, | |
61 enum char_table_type type, | |
62 Error_Behavior errb); | |
63 | |
60 | 64 |
61 /* A char table maps from ranges of characters to values. | 65 /* A char table maps from ranges of characters to values. |
62 | 66 |
63 Implementing a general data structure that maps from arbitrary | 67 Implementing a general data structure that maps from arbitrary |
64 ranges of numbers to values is tricky to do efficiently. As it | 68 ranges of numbers to values is tricky to do efficiently. As it |
124 static Hashcode | 128 static Hashcode |
125 char_table_entry_hash (Lisp_Object obj, int depth) | 129 char_table_entry_hash (Lisp_Object obj, int depth) |
126 { | 130 { |
127 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj); | 131 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj); |
128 | 132 |
129 return internal_array_hash (cte->level2, 96, depth); | 133 return internal_array_hash (cte->level2, 96, depth + 1); |
130 } | 134 } |
131 | 135 |
132 static const struct lrecord_description char_table_entry_description[] = { | 136 static const struct lrecord_description char_table_entry_description[] = { |
133 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table_Entry, level2), 96 }, | 137 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table_Entry, level2), 96 }, |
134 { XD_END } | 138 { XD_END } |
213 if (EQ (symbol, Qcategory)) return CHAR_TABLE_TYPE_CATEGORY; | 217 if (EQ (symbol, Qcategory)) return CHAR_TABLE_TYPE_CATEGORY; |
214 #endif | 218 #endif |
215 | 219 |
216 invalid_constant ("Unrecognized char table type", symbol); | 220 invalid_constant ("Unrecognized char table type", symbol); |
217 RETURN_NOT_REACHED (CHAR_TABLE_TYPE_GENERIC) | 221 RETURN_NOT_REACHED (CHAR_TABLE_TYPE_GENERIC) |
218 } | |
219 | |
220 static void | |
221 print_chartab_range (Emchar first, Emchar last, Lisp_Object val, | |
222 Lisp_Object printcharfun) | |
223 { | |
224 if (first != last) | |
225 write_fmt_string_lisp (printcharfun, " (%s %s)", 2, | |
226 make_char (first), make_char (last)); | |
227 else | |
228 write_fmt_string_lisp (printcharfun, " %s ", 1, make_char (first)); | |
229 print_internal (val, printcharfun, 1); | |
230 } | |
231 | |
232 #ifdef MULE | |
233 | |
234 static void | |
235 print_chartab_charset_row (Lisp_Object charset, | |
236 int row, | |
237 Lisp_Char_Table_Entry *cte, | |
238 Lisp_Object printcharfun) | |
239 { | |
240 int i; | |
241 Lisp_Object cat = Qunbound; | |
242 int first = -1; | |
243 | |
244 for (i = 32; i < 128; i++) | |
245 { | |
246 Lisp_Object pam = cte->level2[i - 32]; | |
247 | |
248 if (first == -1) | |
249 { | |
250 first = i; | |
251 cat = pam; | |
252 continue; | |
253 } | |
254 | |
255 if (!EQ (cat, pam)) | |
256 { | |
257 if (row == -1) | |
258 print_chartab_range (MAKE_CHAR (charset, first, 0), | |
259 MAKE_CHAR (charset, i - 1, 0), | |
260 cat, printcharfun); | |
261 else | |
262 print_chartab_range (MAKE_CHAR (charset, row, first), | |
263 MAKE_CHAR (charset, row, i - 1), | |
264 cat, printcharfun); | |
265 first = -1; | |
266 i--; | |
267 } | |
268 } | |
269 | |
270 if (first != -1) | |
271 { | |
272 if (row == -1) | |
273 print_chartab_range (MAKE_CHAR (charset, first, 0), | |
274 MAKE_CHAR (charset, i - 1, 0), | |
275 cat, printcharfun); | |
276 else | |
277 print_chartab_range (MAKE_CHAR (charset, row, first), | |
278 MAKE_CHAR (charset, row, i - 1), | |
279 cat, printcharfun); | |
280 } | |
281 } | |
282 | |
283 static void | |
284 print_chartab_two_byte_charset (Lisp_Object charset, | |
285 Lisp_Char_Table_Entry *cte, | |
286 Lisp_Object printcharfun) | |
287 { | |
288 int i; | |
289 | |
290 for (i = 32; i < 128; i++) | |
291 { | |
292 Lisp_Object jen = cte->level2[i - 32]; | |
293 | |
294 if (!CHAR_TABLE_ENTRYP (jen)) | |
295 { | |
296 write_fmt_string_lisp (printcharfun, " [%s %d] %s", | |
297 3, XCHARSET_NAME (charset), | |
298 make_int (i), jen); | |
299 } | |
300 else | |
301 print_chartab_charset_row (charset, i, XCHAR_TABLE_ENTRY (jen), | |
302 printcharfun); | |
303 } | |
304 } | |
305 | |
306 #endif /* MULE */ | |
307 | |
308 static void | |
309 print_char_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) | |
310 { | |
311 Lisp_Char_Table *ct = XCHAR_TABLE (obj); | |
312 | |
313 write_fmt_string_lisp (printcharfun, "#s(char-table type %s data (", | |
314 1, char_table_type_to_symbol (ct->type)); | |
315 | |
316 /* Now write out the ASCII/Control-1 stuff. */ | |
317 { | |
318 int i; | |
319 int first = -1; | |
320 Lisp_Object val = Qunbound; | |
321 | |
322 for (i = 0; i < NUM_ASCII_CHARS; i++) | |
323 { | |
324 if (first == -1) | |
325 { | |
326 first = i; | |
327 val = ct->ascii[i]; | |
328 continue; | |
329 } | |
330 | |
331 if (!EQ (ct->ascii[i], val)) | |
332 { | |
333 print_chartab_range (first, i - 1, val, printcharfun); | |
334 first = -1; | |
335 i--; | |
336 } | |
337 } | |
338 | |
339 if (first != -1) | |
340 print_chartab_range (first, i - 1, val, printcharfun); | |
341 } | |
342 | |
343 #ifdef MULE | |
344 { | |
345 int i; | |
346 | |
347 for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES; | |
348 i++) | |
349 { | |
350 Lisp_Object ann = ct->level1[i - MIN_LEADING_BYTE]; | |
351 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (i); | |
352 | |
353 if (!CHARSETP (charset) || i == LEADING_BYTE_ASCII | |
354 || i == LEADING_BYTE_CONTROL_1) | |
355 continue; | |
356 if (!CHAR_TABLE_ENTRYP (ann)) | |
357 { | |
358 write_fmt_string_lisp (printcharfun, " %s %s", 2, | |
359 XCHARSET_NAME (charset), ann); | |
360 } | |
361 else | |
362 { | |
363 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (ann); | |
364 if (XCHARSET_DIMENSION (charset) == 1) | |
365 print_chartab_charset_row (charset, -1, cte, printcharfun); | |
366 else | |
367 print_chartab_two_byte_charset (charset, cte, printcharfun); | |
368 } | |
369 } | |
370 } | |
371 #endif /* MULE */ | |
372 | |
373 write_c_string ("))", printcharfun); | |
374 } | |
375 | |
376 static int | |
377 char_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) | |
378 { | |
379 Lisp_Char_Table *ct1 = XCHAR_TABLE (obj1); | |
380 Lisp_Char_Table *ct2 = XCHAR_TABLE (obj2); | |
381 int i; | |
382 | |
383 if (CHAR_TABLE_TYPE (ct1) != CHAR_TABLE_TYPE (ct2)) | |
384 return 0; | |
385 | |
386 for (i = 0; i < NUM_ASCII_CHARS; i++) | |
387 if (!internal_equal (ct1->ascii[i], ct2->ascii[i], depth + 1)) | |
388 return 0; | |
389 | |
390 #ifdef MULE | |
391 for (i = 0; i < NUM_LEADING_BYTES; i++) | |
392 if (!internal_equal (ct1->level1[i], ct2->level1[i], depth + 1)) | |
393 return 0; | |
394 #endif /* MULE */ | |
395 | |
396 return 1; | |
397 } | |
398 | |
399 static Hashcode | |
400 char_table_hash (Lisp_Object obj, int depth) | |
401 { | |
402 Lisp_Char_Table *ct = XCHAR_TABLE (obj); | |
403 Hashcode hashval = internal_array_hash (ct->ascii, NUM_ASCII_CHARS, | |
404 depth); | |
405 #ifdef MULE | |
406 hashval = HASH2 (hashval, | |
407 internal_array_hash (ct->level1, NUM_LEADING_BYTES, depth)); | |
408 #endif /* MULE */ | |
409 return hashval; | |
410 } | |
411 | |
412 static const struct lrecord_description char_table_description[] = { | |
413 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, ascii), NUM_ASCII_CHARS }, | |
414 #ifdef MULE | |
415 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, level1), NUM_LEADING_BYTES }, | |
416 #endif | |
417 { XD_LISP_OBJECT, offsetof (Lisp_Char_Table, parent) }, | |
418 { XD_LISP_OBJECT, offsetof (Lisp_Char_Table, default_) }, | |
419 { XD_LISP_OBJECT, offsetof (Lisp_Char_Table, mirror_table) }, | |
420 { XD_LO_LINK, offsetof (Lisp_Char_Table, next_table) }, | |
421 { XD_END } | |
422 }; | |
423 | |
424 DEFINE_LRECORD_IMPLEMENTATION ("char-table", char_table, | |
425 mark_char_table, print_char_table, 0, | |
426 char_table_equal, char_table_hash, | |
427 char_table_description, | |
428 Lisp_Char_Table); | |
429 | |
430 DEFUN ("char-table-p", Fchar_table_p, 1, 1, 0, /* | |
431 Return non-nil if OBJECT is a char table. | |
432 */ | |
433 (object)) | |
434 { | |
435 return CHAR_TABLEP (object) ? Qt : Qnil; | |
436 } | |
437 | |
438 DEFUN ("char-table-type-list", Fchar_table_type_list, 0, 0, 0, /* | |
439 Return a list of the recognized char table types. | |
440 See `make-char-table'. | |
441 */ | |
442 ()) | |
443 { | |
444 #ifdef MULE | |
445 return list5 (Qchar, Qcategory, Qdisplay, Qgeneric, Qsyntax); | |
446 #else | |
447 return list4 (Qchar, Qdisplay, Qgeneric, Qsyntax); | |
448 #endif | |
449 } | |
450 | |
451 DEFUN ("valid-char-table-type-p", Fvalid_char_table_type_p, 1, 1, 0, /* | |
452 Return t if TYPE if a recognized char table type. | |
453 See `make-char-table'. | |
454 */ | |
455 (type)) | |
456 { | |
457 return (EQ (type, Qchar) || | |
458 #ifdef MULE | |
459 EQ (type, Qcategory) || | |
460 #endif | |
461 EQ (type, Qdisplay) || | |
462 EQ (type, Qgeneric) || | |
463 EQ (type, Qsyntax)) ? Qt : Qnil; | |
464 } | |
465 | |
466 DEFUN ("char-table-type", Fchar_table_type, 1, 1, 0, /* | |
467 Return the type of CHAR-TABLE. | |
468 See `make-char-table'. | |
469 */ | |
470 (char_table)) | |
471 { | |
472 CHECK_CHAR_TABLE (char_table); | |
473 return char_table_type_to_symbol (XCHAR_TABLE (char_table)->type); | |
474 } | |
475 | |
476 void | |
477 fill_char_table (Lisp_Char_Table *ct, Lisp_Object value) | |
478 { | |
479 int i; | |
480 | |
481 for (i = 0; i < NUM_ASCII_CHARS; i++) | |
482 ct->ascii[i] = value; | |
483 #ifdef MULE | |
484 for (i = 0; i < NUM_LEADING_BYTES; i++) | |
485 ct->level1[i] = value; | |
486 #endif /* MULE */ | |
487 | |
488 if (ct->type == CHAR_TABLE_TYPE_SYNTAX) | |
489 update_syntax_table (ct); | |
490 } | |
491 | |
492 DEFUN ("reset-char-table", Freset_char_table, 1, 1, 0, /* | |
493 Reset CHAR-TABLE to its default state. | |
494 */ | |
495 (char_table)) | |
496 { | |
497 Lisp_Char_Table *ct; | |
498 | |
499 CHECK_CHAR_TABLE (char_table); | |
500 ct = XCHAR_TABLE (char_table); | |
501 | |
502 switch (ct->type) | |
503 { | |
504 case CHAR_TABLE_TYPE_CHAR: | |
505 fill_char_table (ct, make_char (0)); | |
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 */ | |
512 fill_char_table (ct, Qnil); | |
513 break; | |
514 | |
515 case CHAR_TABLE_TYPE_SYNTAX: | |
516 fill_char_table (ct, make_int (Sinherit)); | |
517 break; | |
518 | |
519 default: | |
520 abort (); | |
521 } | |
522 | |
523 return Qnil; | |
524 } | |
525 | |
526 DEFUN ("make-char-table", Fmake_char_table, 1, 1, 0, /* | |
527 Return a new, empty char table of type TYPE. | |
528 | |
529 A char table is a table that maps characters (or ranges of characters) | |
530 to values. Char tables are specialized for characters, only allowing | |
531 particular sorts of ranges to be assigned values. Although this | |
532 loses in generality, it makes for extremely fast (constant-time) | |
533 lookups, and thus is feasible for applications that do an extremely | |
534 large number of lookups (e.g. scanning a buffer for a character in | |
535 a particular syntax, where a lookup in the syntax table must occur | |
536 once per character). | |
537 | |
538 When Mule support exists, the types of ranges that can be assigned | |
539 values are | |
540 | |
541 -- all characters | |
542 -- an entire charset | |
543 -- a single row in a two-octet charset | |
544 -- a single character | |
545 | |
546 When Mule support is not present, the types of ranges that can be | |
547 assigned values are | |
548 | |
549 -- all characters | |
550 -- a single character | |
551 | |
552 To create a char table, use `make-char-table'. | |
553 To modify a char table, use `put-char-table' or `remove-char-table'. | |
554 To retrieve the value for a particular character, use `get-char-table'. | |
555 See also `map-char-table', `clear-char-table', `copy-char-table', | |
556 `char-table-p', `valid-char-table-type-p', `char-table-type-list', | |
557 `valid-char-table-value-p', and `check-char-table-value'. | |
558 | |
559 Each char table type is used for a different purpose and allows different | |
560 sorts of values. The different char table types are | |
561 | |
562 `category' | |
563 Used for category tables, which specify the regexp categories | |
564 that a character is in. The valid values are nil or a | |
565 bit vector of 95 elements. Higher-level Lisp functions are | |
566 provided for working with category tables. Currently categories | |
567 and category tables only exist when Mule support is present. | |
568 `char' | |
569 A generalized char table, for mapping from one character to | |
570 another. Used for case tables, syntax matching tables, | |
571 `keyboard-translate-table', etc. The valid values are characters. | |
572 `generic' | |
573 An even more generalized char table, for mapping from a | |
574 character to anything. | |
575 `display' | |
576 Used for display tables, which specify how a particular character | |
577 is to appear when displayed. #### Not yet implemented. | |
578 `syntax' | |
579 Used for syntax tables, which specify the syntax of a particular | |
580 character. Higher-level Lisp functions are provided for | |
581 working with syntax tables. The valid values are integers. | |
582 */ | |
583 (type)) | |
584 { | |
585 Lisp_Char_Table *ct; | |
586 Lisp_Object obj; | |
587 enum char_table_type ty = symbol_to_char_table_type (type); | |
588 | |
589 ct = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table); | |
590 ct->type = ty; | |
591 if (ty == CHAR_TABLE_TYPE_SYNTAX) | |
592 { | |
593 ct->mirror_table = Fmake_char_table (Qgeneric); | |
594 fill_char_table (XCHAR_TABLE (ct->mirror_table), | |
595 make_int (Spunct)); | |
596 } | |
597 else | |
598 ct->mirror_table = Qnil; | |
599 ct->next_table = Qnil; | |
600 ct->parent = Qnil; | |
601 ct->default_ = Qnil; | |
602 obj = wrap_char_table (ct); | |
603 if (ty == CHAR_TABLE_TYPE_SYNTAX) | |
604 { | |
605 ct->next_table = Vall_syntax_tables; | |
606 Vall_syntax_tables = obj; | |
607 } | |
608 Freset_char_table (obj); | |
609 return obj; | |
610 } | |
611 | |
612 #ifdef MULE | |
613 | |
614 static Lisp_Object | |
615 make_char_table_entry (Lisp_Object initval) | |
616 { | |
617 int i; | |
618 Lisp_Char_Table_Entry *cte = | |
619 alloc_lcrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry); | |
620 | |
621 for (i = 0; i < 96; i++) | |
622 cte->level2[i] = initval; | |
623 | |
624 return wrap_char_table_entry (cte); | |
625 } | |
626 | |
627 static Lisp_Object | |
628 copy_char_table_entry (Lisp_Object entry) | |
629 { | |
630 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (entry); | |
631 int i; | |
632 Lisp_Char_Table_Entry *ctenew = | |
633 alloc_lcrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry); | |
634 | |
635 for (i = 0; i < 96; i++) | |
636 { | |
637 Lisp_Object new = cte->level2[i]; | |
638 if (CHAR_TABLE_ENTRYP (new)) | |
639 ctenew->level2[i] = copy_char_table_entry (new); | |
640 else | |
641 ctenew->level2[i] = new; | |
642 } | |
643 | |
644 return wrap_char_table_entry (ctenew); | |
645 } | |
646 | |
647 #endif /* MULE */ | |
648 | |
649 DEFUN ("copy-char-table", Fcopy_char_table, 1, 1, 0, /* | |
650 Return a new char table which is a copy of CHAR-TABLE. | |
651 It will contain the same values for the same characters and ranges | |
652 as CHAR-TABLE. The values will not themselves be copied. | |
653 */ | |
654 (char_table)) | |
655 { | |
656 Lisp_Char_Table *ct, *ctnew; | |
657 Lisp_Object obj; | |
658 int i; | |
659 | |
660 CHECK_CHAR_TABLE (char_table); | |
661 ct = XCHAR_TABLE (char_table); | |
662 ctnew = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table); | |
663 ctnew->type = ct->type; | |
664 ctnew->parent = ct->parent; | |
665 ctnew->default_ = ct->default_; | |
666 | |
667 for (i = 0; i < NUM_ASCII_CHARS; i++) | |
668 { | |
669 Lisp_Object new = ct->ascii[i]; | |
670 #ifdef MULE | |
671 assert (! (CHAR_TABLE_ENTRYP (new))); | |
672 #endif /* MULE */ | |
673 ctnew->ascii[i] = new; | |
674 } | |
675 | |
676 #ifdef MULE | |
677 | |
678 for (i = 0; i < NUM_LEADING_BYTES; i++) | |
679 { | |
680 Lisp_Object new = ct->level1[i]; | |
681 if (CHAR_TABLE_ENTRYP (new)) | |
682 ctnew->level1[i] = copy_char_table_entry (new); | |
683 else | |
684 ctnew->level1[i] = new; | |
685 } | |
686 | |
687 #endif /* MULE */ | |
688 | |
689 if (CHAR_TABLEP (ct->mirror_table)) | |
690 ctnew->mirror_table = Fcopy_char_table (ct->mirror_table); | |
691 else | |
692 ctnew->mirror_table = ct->mirror_table; | |
693 ctnew->next_table = Qnil; | |
694 obj = wrap_char_table (ctnew); | |
695 if (ctnew->type == CHAR_TABLE_TYPE_SYNTAX) | |
696 { | |
697 ctnew->next_table = Vall_syntax_tables; | |
698 Vall_syntax_tables = obj; | |
699 } | |
700 return obj; | |
701 } | 222 } |
702 | 223 |
703 static void | 224 static void |
704 decode_char_table_range (Lisp_Object range, struct chartab_range *outrange) | 225 decode_char_table_range (Lisp_Object range, struct chartab_range *outrange) |
705 { | 226 { |
750 outrange->charset = Fget_charset (range); | 271 outrange->charset = Fget_charset (range); |
751 } | 272 } |
752 #endif /* MULE */ | 273 #endif /* MULE */ |
753 } | 274 } |
754 | 275 |
755 #ifdef MULE | 276 static Lisp_Object |
756 | 277 encode_char_table_range (struct chartab_range *range) |
757 /* called from CHAR_TABLE_VALUE(). */ | 278 { |
279 switch (range->type) | |
280 { | |
281 case CHARTAB_RANGE_ALL: | |
282 return Qt; | |
283 | |
284 #ifdef MULE | |
285 case CHARTAB_RANGE_CHARSET: | |
286 return XCHARSET_NAME (Fget_charset (range->charset)); | |
287 | |
288 case CHARTAB_RANGE_ROW: | |
289 return vector2 (XCHARSET_NAME (Fget_charset (range->charset)), | |
290 make_int (range->row)); | |
291 #endif | |
292 case CHARTAB_RANGE_CHAR: | |
293 return make_char (range->ch); | |
294 default: | |
295 abort (); | |
296 } | |
297 return Qnil; /* not reached */ | |
298 } | |
299 | |
300 struct ptemap | |
301 { | |
302 Lisp_Object printcharfun; | |
303 int first; | |
304 }; | |
305 | |
306 static int | |
307 print_table_entry (struct chartab_range *range, Lisp_Object table, | |
308 Lisp_Object val, void *arg) | |
309 { | |
310 struct ptemap *a = (struct ptemap *) arg; | |
311 struct gcpro gcpro1; | |
312 Lisp_Object lisprange; | |
313 if (!a->first) | |
314 write_c_string (a->printcharfun, " "); | |
315 a->first = 0; | |
316 lisprange = encode_char_table_range (range); | |
317 GCPRO1 (lisprange); | |
318 write_fmt_string_lisp (a->printcharfun, "%s %s", 2, lisprange, val); | |
319 UNGCPRO; | |
320 return 0; | |
321 } | |
322 | |
323 static void | |
324 print_char_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) | |
325 { | |
326 Lisp_Char_Table *ct = XCHAR_TABLE (obj); | |
327 struct chartab_range range; | |
328 struct ptemap arg; | |
329 | |
330 range.type = CHARTAB_RANGE_ALL; | |
331 arg.printcharfun = printcharfun; | |
332 arg.first = 1; | |
333 | |
334 write_fmt_string_lisp (printcharfun, "#s(char-table type %s data (", | |
335 1, char_table_type_to_symbol (ct->type)); | |
336 map_char_table (obj, &range, print_table_entry, &arg); | |
337 write_c_string (printcharfun, "))"); | |
338 | |
339 /* #### need to print and read the default; but that will allow the | |
340 default to be modified, which we don't (yet) support -- but FSF does */ | |
341 } | |
342 | |
343 static int | |
344 char_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) | |
345 { | |
346 Lisp_Char_Table *ct1 = XCHAR_TABLE (obj1); | |
347 Lisp_Char_Table *ct2 = XCHAR_TABLE (obj2); | |
348 int i; | |
349 | |
350 if (CHAR_TABLE_TYPE (ct1) != CHAR_TABLE_TYPE (ct2)) | |
351 return 0; | |
352 | |
353 for (i = 0; i < NUM_ASCII_CHARS; i++) | |
354 if (!internal_equal (ct1->ascii[i], ct2->ascii[i], depth + 1)) | |
355 return 0; | |
356 | |
357 #ifdef MULE | |
358 for (i = 0; i < NUM_LEADING_BYTES; i++) | |
359 if (!internal_equal (ct1->level1[i], ct2->level1[i], depth + 1)) | |
360 return 0; | |
361 #endif /* MULE */ | |
362 | |
363 return internal_equal (ct1->default_, ct2->default_, depth + 1); | |
364 } | |
365 | |
366 static Hashcode | |
367 char_table_hash (Lisp_Object obj, int depth) | |
368 { | |
369 Lisp_Char_Table *ct = XCHAR_TABLE (obj); | |
370 Hashcode hashval = internal_array_hash (ct->ascii, NUM_ASCII_CHARS, | |
371 depth + 1); | |
372 #ifdef MULE | |
373 hashval = HASH2 (hashval, | |
374 internal_array_hash (ct->level1, NUM_LEADING_BYTES, | |
375 depth + 1)); | |
376 #endif /* MULE */ | |
377 return HASH2 (hashval, internal_hash (ct->default_, depth + 1)); | |
378 } | |
379 | |
380 static const struct lrecord_description char_table_description[] = { | |
381 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, ascii), NUM_ASCII_CHARS }, | |
382 #ifdef MULE | |
383 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, level1), NUM_LEADING_BYTES }, | |
384 #endif | |
385 { XD_LISP_OBJECT, offsetof (Lisp_Char_Table, parent) }, | |
386 { XD_LISP_OBJECT, offsetof (Lisp_Char_Table, default_) }, | |
387 { XD_LISP_OBJECT, offsetof (Lisp_Char_Table, mirror_table) }, | |
388 { XD_LO_LINK, offsetof (Lisp_Char_Table, next_table) }, | |
389 { XD_END } | |
390 }; | |
391 | |
392 DEFINE_LRECORD_IMPLEMENTATION ("char-table", char_table, | |
393 mark_char_table, print_char_table, 0, | |
394 char_table_equal, char_table_hash, | |
395 char_table_description, | |
396 Lisp_Char_Table); | |
397 | |
398 DEFUN ("char-table-p", Fchar_table_p, 1, 1, 0, /* | |
399 Return non-nil if OBJECT is a char table. | |
400 */ | |
401 (object)) | |
402 { | |
403 return CHAR_TABLEP (object) ? Qt : Qnil; | |
404 } | |
405 | |
406 DEFUN ("char-table-type-list", Fchar_table_type_list, 0, 0, 0, /* | |
407 Return a list of the recognized char table types. | |
408 See `make-char-table'. | |
409 */ | |
410 ()) | |
411 { | |
412 #ifdef MULE | |
413 return list5 (Qchar, Qcategory, Qdisplay, Qgeneric, Qsyntax); | |
414 #else | |
415 return list4 (Qchar, Qdisplay, Qgeneric, Qsyntax); | |
416 #endif | |
417 } | |
418 | |
419 DEFUN ("valid-char-table-type-p", Fvalid_char_table_type_p, 1, 1, 0, /* | |
420 Return t if TYPE if a recognized char table type. | |
421 See `make-char-table'. | |
422 */ | |
423 (type)) | |
424 { | |
425 return (EQ (type, Qchar) || | |
426 #ifdef MULE | |
427 EQ (type, Qcategory) || | |
428 #endif | |
429 EQ (type, Qdisplay) || | |
430 EQ (type, Qgeneric) || | |
431 EQ (type, Qsyntax)) ? Qt : Qnil; | |
432 } | |
433 | |
434 DEFUN ("char-table-type", Fchar_table_type, 1, 1, 0, /* | |
435 Return the type of CHAR-TABLE. | |
436 See `make-char-table'. | |
437 */ | |
438 (char_table)) | |
439 { | |
440 CHECK_CHAR_TABLE (char_table); | |
441 return char_table_type_to_symbol (XCHAR_TABLE (char_table)->type); | |
442 } | |
443 | |
444 void | |
445 set_char_table_default (Lisp_Object table, Lisp_Object value) | |
446 { | |
447 Lisp_Char_Table *ct = XCHAR_TABLE (table); | |
448 ct->default_ = value; | |
449 if (ct->type == CHAR_TABLE_TYPE_SYNTAX) | |
450 update_syntax_table (table); | |
451 } | |
452 | |
453 static void | |
454 fill_char_table (Lisp_Char_Table *ct, Lisp_Object value) | |
455 { | |
456 int i; | |
457 | |
458 for (i = 0; i < NUM_ASCII_CHARS; i++) | |
459 ct->ascii[i] = value; | |
460 #ifdef MULE | |
461 for (i = 0; i < NUM_LEADING_BYTES; i++) | |
462 ct->level1[i] = value; | |
463 #endif /* MULE */ | |
464 | |
465 if (ct->type == CHAR_TABLE_TYPE_SYNTAX) | |
466 update_syntax_table (wrap_char_table (ct)); | |
467 } | |
468 | |
469 DEFUN ("reset-char-table", Freset_char_table, 1, 1, 0, /* | |
470 Reset CHAR-TABLE to its default state. | |
471 */ | |
472 (char_table)) | |
473 { | |
474 Lisp_Char_Table *ct; | |
475 Lisp_Object def; | |
476 | |
477 CHECK_CHAR_TABLE (char_table); | |
478 ct = XCHAR_TABLE (char_table); | |
479 | |
480 switch (ct->type) | |
481 { | |
482 case CHAR_TABLE_TYPE_CHAR: | |
483 def = make_char (0); | |
484 break; | |
485 case CHAR_TABLE_TYPE_DISPLAY: | |
486 case CHAR_TABLE_TYPE_GENERIC: | |
487 #ifdef MULE | |
488 case CHAR_TABLE_TYPE_CATEGORY: | |
489 #endif /* MULE */ | |
490 def = Qnil; | |
491 break; | |
492 | |
493 case CHAR_TABLE_TYPE_SYNTAX: | |
494 def = make_int (Sinherit); | |
495 break; | |
496 | |
497 default: | |
498 abort (); | |
499 def = Qnil; | |
500 break; | |
501 } | |
502 | |
503 /* Avoid doubly updating the syntax table by setting the default ourselves, | |
504 since set_char_table_default() also updates. */ | |
505 ct->default_ = def; | |
506 fill_char_table (ct, Qunbound); | |
507 | |
508 return Qnil; | |
509 } | |
510 | |
511 DEFUN ("make-char-table", Fmake_char_table, 1, 1, 0, /* | |
512 Return a new, empty char table of type TYPE. | |
513 | |
514 A char table is a table that maps characters (or ranges of characters) | |
515 to values. Char tables are specialized for characters, only allowing | |
516 particular sorts of ranges to be assigned values. Although this | |
517 loses in generality, it makes for extremely fast (constant-time) | |
518 lookups, and thus is feasible for applications that do an extremely | |
519 large number of lookups (e.g. scanning a buffer for a character in | |
520 a particular syntax, where a lookup in the syntax table must occur | |
521 once per character). | |
522 | |
523 When Mule support exists, the types of ranges that can be assigned | |
524 values are | |
525 | |
526 -- all characters | |
527 -- an entire charset | |
528 -- a single row in a two-octet charset | |
529 -- a single character | |
530 | |
531 When Mule support is not present, the types of ranges that can be | |
532 assigned values are | |
533 | |
534 -- all characters | |
535 -- a single character | |
536 | |
537 To create a char table, use `make-char-table'. | |
538 To modify a char table, use `put-char-table' or `remove-char-table'. | |
539 To retrieve the value for a particular character, use `get-char-table'. | |
540 See also `map-char-table', `reset-char-table', `copy-char-table', | |
541 `char-table-p', `valid-char-table-type-p', `char-table-type-list', | |
542 `valid-char-table-value-p', and `check-char-table-value'. | |
543 | |
544 Each char table type is used for a different purpose and allows different | |
545 sorts of values. The different char table types are | |
546 | |
547 `category' | |
548 Used for category tables, which specify the regexp categories | |
549 that a character is in. The valid values are nil or a | |
550 bit vector of 95 elements. Higher-level Lisp functions are | |
551 provided for working with category tables. Currently categories | |
552 and category tables only exist when Mule support is present. | |
553 `char' | |
554 A generalized char table, for mapping from one character to | |
555 another. Used for case tables, syntax matching tables, | |
556 `keyboard-translate-table', etc. The valid values are characters. | |
557 `generic' | |
558 An even more generalized char table, for mapping from a | |
559 character to anything. | |
560 `display' | |
561 Used for display tables, which specify how a particular character | |
562 is to appear when displayed. #### Not yet implemented. | |
563 `syntax' | |
564 Used for syntax tables, which specify the syntax of a particular | |
565 character. Higher-level Lisp functions are provided for | |
566 working with syntax tables. The valid values are integers. | |
567 */ | |
568 (type)) | |
569 { | |
570 Lisp_Char_Table *ct; | |
571 Lisp_Object obj; | |
572 enum char_table_type ty = symbol_to_char_table_type (type); | |
573 | |
574 ct = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table); | |
575 ct->type = ty; | |
576 if (ty == CHAR_TABLE_TYPE_SYNTAX) | |
577 { | |
578 /* Qgeneric not Qsyntax because a syntax table has a mirror table | |
579 and we don't want infinite recursion */ | |
580 ct->mirror_table = Fmake_char_table (Qgeneric); | |
581 set_char_table_default (ct->mirror_table, make_int (Spunct)); | |
582 } | |
583 else | |
584 ct->mirror_table = Qnil; | |
585 ct->next_table = Qnil; | |
586 ct->parent = Qnil; | |
587 ct->default_ = Qnil; | |
588 obj = wrap_char_table (ct); | |
589 if (ty == CHAR_TABLE_TYPE_SYNTAX) | |
590 { | |
591 ct->next_table = Vall_syntax_tables; | |
592 Vall_syntax_tables = obj; | |
593 } | |
594 Freset_char_table (obj); | |
595 return obj; | |
596 } | |
597 | |
598 #ifdef MULE | |
599 | |
600 static Lisp_Object | |
601 make_char_table_entry (Lisp_Object initval) | |
602 { | |
603 int i; | |
604 Lisp_Char_Table_Entry *cte = | |
605 alloc_lcrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry); | |
606 | |
607 for (i = 0; i < 96; i++) | |
608 cte->level2[i] = initval; | |
609 | |
610 return wrap_char_table_entry (cte); | |
611 } | |
612 | |
613 static Lisp_Object | |
614 copy_char_table_entry (Lisp_Object entry) | |
615 { | |
616 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (entry); | |
617 int i; | |
618 Lisp_Char_Table_Entry *ctenew = | |
619 alloc_lcrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry); | |
620 | |
621 for (i = 0; i < 96; i++) | |
622 { | |
623 Lisp_Object new = cte->level2[i]; | |
624 if (CHAR_TABLE_ENTRYP (new)) | |
625 ctenew->level2[i] = copy_char_table_entry (new); | |
626 else | |
627 ctenew->level2[i] = new; | |
628 } | |
629 | |
630 return wrap_char_table_entry (ctenew); | |
631 } | |
632 | |
633 #endif /* MULE */ | |
634 | |
635 DEFUN ("copy-char-table", Fcopy_char_table, 1, 1, 0, /* | |
636 Return a new char table which is a copy of CHAR-TABLE. | |
637 It will contain the same values for the same characters and ranges | |
638 as CHAR-TABLE. The values will not themselves be copied. | |
639 */ | |
640 (char_table)) | |
641 { | |
642 Lisp_Char_Table *ct, *ctnew; | |
643 Lisp_Object obj; | |
644 int i; | |
645 | |
646 CHECK_CHAR_TABLE (char_table); | |
647 ct = XCHAR_TABLE (char_table); | |
648 ctnew = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table); | |
649 ctnew->type = ct->type; | |
650 ctnew->parent = ct->parent; | |
651 ctnew->default_ = ct->default_; | |
652 | |
653 for (i = 0; i < NUM_ASCII_CHARS; i++) | |
654 { | |
655 Lisp_Object new = ct->ascii[i]; | |
656 #ifdef MULE | |
657 assert (! (CHAR_TABLE_ENTRYP (new))); | |
658 #endif /* MULE */ | |
659 ctnew->ascii[i] = new; | |
660 } | |
661 | |
662 #ifdef MULE | |
663 | |
664 for (i = 0; i < NUM_LEADING_BYTES; i++) | |
665 { | |
666 Lisp_Object new = ct->level1[i]; | |
667 if (CHAR_TABLE_ENTRYP (new)) | |
668 ctnew->level1[i] = copy_char_table_entry (new); | |
669 else | |
670 ctnew->level1[i] = new; | |
671 } | |
672 | |
673 #endif /* MULE */ | |
674 | |
675 if (CHAR_TABLEP (ct->mirror_table)) | |
676 ctnew->mirror_table = Fcopy_char_table (ct->mirror_table); | |
677 else | |
678 ctnew->mirror_table = ct->mirror_table; | |
679 ctnew->next_table = Qnil; | |
680 obj = wrap_char_table (ctnew); | |
681 if (ctnew->type == CHAR_TABLE_TYPE_SYNTAX) | |
682 { | |
683 ctnew->next_table = Vall_syntax_tables; | |
684 Vall_syntax_tables = obj; | |
685 } | |
686 return obj; | |
687 } | |
688 | |
689 #ifdef MULE | |
690 | |
691 /* called from get_char_table(). */ | |
758 Lisp_Object | 692 Lisp_Object |
759 get_non_ascii_char_table_value (Lisp_Char_Table *ct, int leading_byte, | 693 get_non_ascii_char_table_value (Lisp_Char_Table *ct, int leading_byte, |
760 Emchar c) | 694 Emchar c) |
761 { | 695 { |
762 Lisp_Object val; | 696 Lisp_Object val; |
763 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (leading_byte); | 697 Lisp_Object charset = charset_by_leading_byte (leading_byte); |
764 int byte1, byte2; | 698 int byte1, byte2; |
765 | 699 |
766 BREAKUP_CHAR_1_UNSAFE (c, charset, byte1, byte2); | 700 BREAKUP_EMCHAR_1_UNSAFE (c, charset, byte1, byte2); |
767 val = ct->level1[leading_byte - MIN_LEADING_BYTE]; | 701 val = ct->level1[leading_byte - MIN_LEADING_BYTE]; |
768 if (CHAR_TABLE_ENTRYP (val)) | 702 if (CHAR_TABLE_ENTRYP (val)) |
769 { | 703 { |
770 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val); | 704 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val); |
771 val = cte->level2[byte1 - 32]; | 705 val = cte->level2[byte1 - 32]; |
781 return val; | 715 return val; |
782 } | 716 } |
783 | 717 |
784 #endif /* MULE */ | 718 #endif /* MULE */ |
785 | 719 |
786 Lisp_Object | 720 DEFUN ("char-table-default", Fchar_table_default, 1, 1, 0, /* |
787 get_char_table (Emchar ch, Lisp_Char_Table *ct) | 721 Return the default value for CHAR-TABLE. When an entry for a character |
788 { | 722 does not exist, the default is returned. |
789 #ifdef MULE | 723 */ |
790 { | 724 (char_table)) |
791 Lisp_Object charset; | 725 { |
792 int byte1, byte2; | 726 CHECK_CHAR_TABLE (char_table); |
793 Lisp_Object val; | 727 return XCHAR_TABLE (char_table)->default_; |
794 | 728 } |
795 BREAKUP_CHAR (ch, charset, byte1, byte2); | 729 |
796 | 730 DEFUN ("set-char-table-default", Fset_char_table_default, 2, 2, 0, /* |
797 if (EQ (charset, Vcharset_ascii)) | 731 Set the default value for CHAR-TABLE to DEFAULT. |
798 val = ct->ascii[byte1]; | 732 Currently, the default value for syntax tables cannot be changed. |
799 else if (EQ (charset, Vcharset_control_1)) | 733 (This policy might change in the future.) |
800 val = ct->ascii[byte1 + 128]; | 734 */ |
801 else | 735 (char_table, default_)) |
802 { | 736 { |
803 int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE; | 737 CHECK_CHAR_TABLE (char_table); |
804 val = ct->level1[lb]; | 738 if (XCHAR_TABLE_TYPE (char_table) == CHAR_TABLE_TYPE_SYNTAX) |
805 if (CHAR_TABLE_ENTRYP (val)) | 739 invalid_change ("Can't change default for syntax tables", char_table); |
806 { | 740 check_valid_char_table_value (default_, XCHAR_TABLE_TYPE (char_table), |
807 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val); | 741 ERROR_ME); |
808 val = cte->level2[byte1 - 32]; | 742 set_char_table_default (char_table, default_); |
809 if (CHAR_TABLE_ENTRYP (val)) | 743 return Qnil; |
810 { | 744 } |
811 cte = XCHAR_TABLE_ENTRY (val); | |
812 assert (byte2 >= 32); | |
813 val = cte->level2[byte2 - 32]; | |
814 assert (!CHAR_TABLE_ENTRYP (val)); | |
815 } | |
816 } | |
817 } | |
818 | |
819 return val; | |
820 } | |
821 #else /* not MULE */ | |
822 return ct->ascii[(unsigned char)ch]; | |
823 #endif /* not MULE */ | |
824 } | |
825 | |
826 | 745 |
827 DEFUN ("get-char-table", Fget_char_table, 2, 2, 0, /* | 746 DEFUN ("get-char-table", Fget_char_table, 2, 2, 0, /* |
828 Find value for CHARACTER in CHAR-TABLE. | 747 Find value for CHARACTER in CHAR-TABLE. |
829 */ | 748 */ |
830 (character, char_table)) | 749 (character, char_table)) |
831 { | 750 { |
832 CHECK_CHAR_TABLE (char_table); | 751 CHECK_CHAR_TABLE (char_table); |
833 CHECK_CHAR_COERCE_INT (character); | 752 CHECK_CHAR_COERCE_INT (character); |
834 | 753 |
835 return get_char_table (XCHAR (character), XCHAR_TABLE (char_table)); | 754 return get_char_table (XCHAR (character), char_table); |
755 } | |
756 | |
757 static int | |
758 copy_mapper (struct chartab_range *range, Lisp_Object table, | |
759 Lisp_Object val, void *arg) | |
760 { | |
761 put_char_table (VOID_TO_LISP (arg), range, val); | |
762 return 0; | |
763 } | |
764 | |
765 void | |
766 copy_char_table_range (Lisp_Object from, Lisp_Object to, | |
767 struct chartab_range *range) | |
768 { | |
769 map_char_table (from, range, copy_mapper, LISP_TO_VOID (to)); | |
770 } | |
771 | |
772 Lisp_Object | |
773 get_range_char_table (struct chartab_range *range, Lisp_Object table, | |
774 Lisp_Object multi) | |
775 { | |
776 Lisp_Char_Table *ct = XCHAR_TABLE (table); | |
777 Lisp_Object retval = Qnil; | |
778 | |
779 switch (range->type) | |
780 { | |
781 case CHARTAB_RANGE_CHAR: | |
782 return get_char_table (range->ch, table); | |
783 | |
784 case CHARTAB_RANGE_ALL: | |
785 { | |
786 int i; | |
787 retval = ct->ascii[0]; | |
788 | |
789 for (i = 1; i < NUM_ASCII_CHARS; i++) | |
790 if (!EQ (retval, ct->ascii[i])) | |
791 return multi; | |
792 | |
793 #ifdef MULE | |
794 for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES; | |
795 i++) | |
796 { | |
797 if (!CHARSETP (charset_by_leading_byte (i)) | |
798 || i == LEADING_BYTE_ASCII | |
799 || i == LEADING_BYTE_CONTROL_1) | |
800 continue; | |
801 if (!EQ (retval, ct->level1[i - MIN_LEADING_BYTE])) | |
802 return multi; | |
803 } | |
804 #endif /* MULE */ | |
805 | |
806 break; | |
807 } | |
808 | |
809 #ifdef MULE | |
810 case CHARTAB_RANGE_CHARSET: | |
811 if (EQ (range->charset, Vcharset_ascii)) | |
812 { | |
813 int i; | |
814 retval = ct->ascii[0]; | |
815 | |
816 for (i = 1; i < 128; i++) | |
817 if (!EQ (retval, ct->ascii[i])) | |
818 return multi; | |
819 break; | |
820 } | |
821 | |
822 if (EQ (range->charset, Vcharset_control_1)) | |
823 { | |
824 int i; | |
825 retval = ct->ascii[128]; | |
826 | |
827 for (i = 129; i < 160; i++) | |
828 if (!EQ (retval, ct->ascii[i])) | |
829 return multi; | |
830 break; | |
831 } | |
832 | |
833 { | |
834 retval = ct->level1[XCHARSET_LEADING_BYTE (range->charset) - | |
835 MIN_LEADING_BYTE]; | |
836 if (CHAR_TABLE_ENTRYP (retval)) | |
837 return multi; | |
838 break; | |
839 } | |
840 | |
841 case CHARTAB_RANGE_ROW: | |
842 { | |
843 retval = ct->level1[XCHARSET_LEADING_BYTE (range->charset) - | |
844 MIN_LEADING_BYTE]; | |
845 if (!CHAR_TABLE_ENTRYP (retval)) | |
846 break; | |
847 retval = XCHAR_TABLE_ENTRY (retval)->level2[range->row - 32]; | |
848 if (CHAR_TABLE_ENTRYP (retval)) | |
849 return multi; | |
850 break; | |
851 } | |
852 #endif /* not MULE */ | |
853 | |
854 default: | |
855 abort (); | |
856 } | |
857 | |
858 if (UNBOUNDP (retval)) | |
859 return ct->default_; | |
860 return retval; | |
836 } | 861 } |
837 | 862 |
838 DEFUN ("get-range-char-table", Fget_range_char_table, 2, 3, 0, /* | 863 DEFUN ("get-range-char-table", Fget_range_char_table, 2, 3, 0, /* |
839 Find value for a range in CHAR-TABLE. | 864 Find value for a range in CHAR-TABLE. |
840 If there is more than one value, return MULTI (defaults to nil). | 865 If there is more than one value, return MULTI (defaults to nil). |
841 */ | 866 */ |
842 (range, char_table, multi)) | 867 (range, char_table, multi)) |
843 { | 868 { |
844 Lisp_Char_Table *ct; | |
845 struct chartab_range rainj; | 869 struct chartab_range rainj; |
846 | 870 |
847 if (CHAR_OR_CHAR_INTP (range)) | 871 if (CHAR_OR_CHAR_INTP (range)) |
848 return Fget_char_table (range, char_table); | 872 return Fget_char_table (range, char_table); |
849 CHECK_CHAR_TABLE (char_table); | 873 CHECK_CHAR_TABLE (char_table); |
850 ct = XCHAR_TABLE (char_table); | |
851 | 874 |
852 decode_char_table_range (range, &rainj); | 875 decode_char_table_range (range, &rainj); |
853 switch (rainj.type) | 876 return get_range_char_table (&rainj, char_table, multi); |
854 { | 877 } |
855 case CHARTAB_RANGE_ALL: | 878 |
856 { | |
857 int i; | |
858 Lisp_Object first = ct->ascii[0]; | |
859 | |
860 for (i = 1; i < NUM_ASCII_CHARS; i++) | |
861 if (!EQ (first, ct->ascii[i])) | |
862 return multi; | |
863 | |
864 #ifdef MULE | |
865 for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES; | |
866 i++) | |
867 { | |
868 if (!CHARSETP (CHARSET_BY_LEADING_BYTE (i)) | |
869 || i == LEADING_BYTE_ASCII | |
870 || i == LEADING_BYTE_CONTROL_1) | |
871 continue; | |
872 if (!EQ (first, ct->level1[i - MIN_LEADING_BYTE])) | |
873 return multi; | |
874 } | |
875 #endif /* MULE */ | |
876 | |
877 return first; | |
878 } | |
879 | |
880 #ifdef MULE | |
881 case CHARTAB_RANGE_CHARSET: | |
882 if (EQ (rainj.charset, Vcharset_ascii)) | |
883 { | |
884 int i; | |
885 Lisp_Object first = ct->ascii[0]; | |
886 | |
887 for (i = 1; i < 128; i++) | |
888 if (!EQ (first, ct->ascii[i])) | |
889 return multi; | |
890 return first; | |
891 } | |
892 | |
893 if (EQ (rainj.charset, Vcharset_control_1)) | |
894 { | |
895 int i; | |
896 Lisp_Object first = ct->ascii[128]; | |
897 | |
898 for (i = 129; i < 160; i++) | |
899 if (!EQ (first, ct->ascii[i])) | |
900 return multi; | |
901 return first; | |
902 } | |
903 | |
904 { | |
905 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (rainj.charset) - | |
906 MIN_LEADING_BYTE]; | |
907 if (CHAR_TABLE_ENTRYP (val)) | |
908 return multi; | |
909 return val; | |
910 } | |
911 | |
912 case CHARTAB_RANGE_ROW: | |
913 { | |
914 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (rainj.charset) - | |
915 MIN_LEADING_BYTE]; | |
916 if (!CHAR_TABLE_ENTRYP (val)) | |
917 return val; | |
918 val = XCHAR_TABLE_ENTRY (val)->level2[rainj.row - 32]; | |
919 if (CHAR_TABLE_ENTRYP (val)) | |
920 return multi; | |
921 return val; | |
922 } | |
923 #endif /* not MULE */ | |
924 | |
925 default: | |
926 abort (); | |
927 } | |
928 | |
929 return Qnil; /* not (usually) reached */ | |
930 } | |
931 | |
932 static int | 879 static int |
933 check_valid_char_table_value (Lisp_Object value, enum char_table_type type, | 880 check_valid_char_table_value (Lisp_Object value, enum char_table_type type, |
934 Error_Behavior errb) | 881 Error_Behavior errb) |
935 { | 882 { |
936 switch (type) | 883 switch (type) |
1022 | 969 |
1023 check_valid_char_table_value (value, type, ERROR_ME); | 970 check_valid_char_table_value (value, type, ERROR_ME); |
1024 return Qnil; | 971 return Qnil; |
1025 } | 972 } |
1026 | 973 |
1027 /* Assign VAL to all characters in RANGE in char table CT. */ | 974 /* Assign VAL to all characters in RANGE in char table TABLE. */ |
1028 | 975 |
1029 void | 976 void |
1030 put_char_table (Lisp_Char_Table *ct, struct chartab_range *range, | 977 put_char_table (Lisp_Object table, struct chartab_range *range, |
1031 Lisp_Object val) | 978 Lisp_Object val) |
1032 { | 979 { |
980 Lisp_Char_Table *ct = XCHAR_TABLE (table); | |
981 | |
1033 switch (range->type) | 982 switch (range->type) |
1034 { | 983 { |
1035 case CHARTAB_RANGE_ALL: | 984 case CHARTAB_RANGE_ALL: |
1036 fill_char_table (ct, val); | 985 fill_char_table (ct, val); |
1037 return; /* avoid the duplicate call to update_syntax_table() below, | 986 return; /* avoid the duplicate call to update_syntax_table() below, |
1075 #ifdef MULE | 1024 #ifdef MULE |
1076 { | 1025 { |
1077 Lisp_Object charset; | 1026 Lisp_Object charset; |
1078 int byte1, byte2; | 1027 int byte1, byte2; |
1079 | 1028 |
1080 BREAKUP_CHAR (range->ch, charset, byte1, byte2); | 1029 BREAKUP_EMCHAR (range->ch, charset, byte1, byte2); |
1081 if (EQ (charset, Vcharset_ascii)) | 1030 if (EQ (charset, Vcharset_ascii)) |
1082 ct->ascii[byte1] = val; | 1031 ct->ascii[byte1] = val; |
1083 else if (EQ (charset, Vcharset_control_1)) | 1032 else if (EQ (charset, Vcharset_control_1)) |
1084 ct->ascii[byte1 + 128] = val; | 1033 ct->ascii[byte1 + 128] = val; |
1085 else | 1034 else |
1113 break; | 1062 break; |
1114 #endif /* not MULE */ | 1063 #endif /* not MULE */ |
1115 } | 1064 } |
1116 | 1065 |
1117 if (ct->type == CHAR_TABLE_TYPE_SYNTAX) | 1066 if (ct->type == CHAR_TABLE_TYPE_SYNTAX) |
1118 update_syntax_table (ct); | 1067 update_syntax_table (wrap_char_table (ct)); |
1119 } | 1068 } |
1120 | 1069 |
1121 DEFUN ("put-char-table", Fput_char_table, 3, 3, 0, /* | 1070 DEFUN ("put-char-table", Fput_char_table, 3, 3, 0, /* |
1122 Set the value for chars in RANGE to be VALUE in CHAR-TABLE. | 1071 Set the value for chars in RANGE to be VALUE in CHAR-TABLE. |
1123 | 1072 |
1141 CHECK_CHAR_TABLE (char_table); | 1090 CHECK_CHAR_TABLE (char_table); |
1142 ct = XCHAR_TABLE (char_table); | 1091 ct = XCHAR_TABLE (char_table); |
1143 check_valid_char_table_value (value, ct->type, ERROR_ME); | 1092 check_valid_char_table_value (value, ct->type, ERROR_ME); |
1144 decode_char_table_range (range, &rainj); | 1093 decode_char_table_range (range, &rainj); |
1145 value = canonicalize_char_table_value (value, ct->type); | 1094 value = canonicalize_char_table_value (value, ct->type); |
1146 put_char_table (ct, &rainj, value); | 1095 put_char_table (char_table, &rainj, value); |
1147 return Qnil; | 1096 return Qnil; |
1148 } | 1097 } |
1098 | |
1099 DEFUN ("remove-char-table", Fremove_char_table, 2, 2, 0, /* | |
1100 Remove any value from chars in RANGE in CHAR-TABLE. | |
1101 | |
1102 RANGE specifies one or more characters to be affected and should be | |
1103 one of the following: | |
1104 | |
1105 -- t (all characters are affected) | |
1106 -- A charset (only allowed when Mule support is present) | |
1107 -- A vector of two elements: a two-octet charset and a row number | |
1108 (only allowed when Mule support is present) | |
1109 -- A single character | |
1110 | |
1111 With the values removed, the default value will be returned. | |
1112 */ | |
1113 (range, char_table)) | |
1114 { | |
1115 struct chartab_range rainj; | |
1116 | |
1117 CHECK_CHAR_TABLE (char_table); | |
1118 decode_char_table_range (range, &rainj); | |
1119 put_char_table (char_table, &rainj, Qunbound); | |
1120 return Qnil; | |
1121 } | |
1122 | |
1123 /* Map FN over the ASCII chars in CT. */ | |
1124 | |
1125 static int | |
1126 map_over_charset_ascii_1 (Lisp_Char_Table *ct, | |
1127 int start, int stop, | |
1128 int (*fn) (struct chartab_range *range, | |
1129 Lisp_Object table, Lisp_Object val, | |
1130 void *arg), | |
1131 void *arg) | |
1132 { | |
1133 struct chartab_range rainj; | |
1134 int i, retval; | |
1135 | |
1136 rainj.type = CHARTAB_RANGE_CHAR; | |
1137 | |
1138 for (i = start, retval = 0; i <= stop && retval == 0; i++) | |
1139 { | |
1140 rainj.ch = (Emchar) i; | |
1141 if (!UNBOUNDP (ct->ascii[i])) | |
1142 retval = (fn) (&rainj, wrap_char_table (ct), ct->ascii[i], arg); | |
1143 } | |
1144 | |
1145 return retval; | |
1146 } | |
1147 | |
1149 | 1148 |
1150 /* Map FN over the ASCII chars in CT. */ | 1149 /* Map FN over the ASCII chars in CT. */ |
1151 | 1150 |
1152 static int | 1151 static int |
1153 map_over_charset_ascii (Lisp_Char_Table *ct, | 1152 map_over_charset_ascii (Lisp_Char_Table *ct, |
1154 int (*fn) (struct chartab_range *range, | 1153 int (*fn) (struct chartab_range *range, |
1155 Lisp_Object val, void *arg), | 1154 Lisp_Object table, Lisp_Object val, |
1155 void *arg), | |
1156 void *arg) | 1156 void *arg) |
1157 { | 1157 { |
1158 struct chartab_range rainj; | 1158 return map_over_charset_ascii_1 (ct, 0, |
1159 int i, retval; | 1159 #ifdef MULE |
1160 int start = 0; | 1160 127, |
1161 #ifdef MULE | |
1162 int stop = 128; | |
1163 #else | 1161 #else |
1164 int stop = 256; | 1162 255, |
1165 #endif | 1163 #endif |
1166 | 1164 fn, arg); |
1167 rainj.type = CHARTAB_RANGE_CHAR; | |
1168 | |
1169 for (i = start, retval = 0; i < stop && retval == 0; i++) | |
1170 { | |
1171 rainj.ch = (Emchar) i; | |
1172 retval = (fn) (&rainj, ct->ascii[i], arg); | |
1173 } | |
1174 | |
1175 return retval; | |
1176 } | 1165 } |
1177 | 1166 |
1178 #ifdef MULE | 1167 #ifdef MULE |
1179 | 1168 |
1180 /* Map FN over the Control-1 chars in CT. */ | 1169 /* Map FN over the Control-1 chars in CT. */ |
1181 | 1170 |
1182 static int | 1171 static int |
1183 map_over_charset_control_1 (Lisp_Char_Table *ct, | 1172 map_over_charset_control_1 (Lisp_Char_Table *ct, |
1184 int (*fn) (struct chartab_range *range, | 1173 int (*fn) (struct chartab_range *range, |
1185 Lisp_Object val, void *arg), | 1174 Lisp_Object table, Lisp_Object val, |
1175 void *arg), | |
1186 void *arg) | 1176 void *arg) |
1187 { | 1177 { |
1188 struct chartab_range rainj; | 1178 return map_over_charset_ascii_1 (ct, 128, 159, fn, arg); |
1189 int i, retval; | |
1190 int start = 128; | |
1191 int stop = start + 32; | |
1192 | |
1193 rainj.type = CHARTAB_RANGE_CHAR; | |
1194 | |
1195 for (i = start, retval = 0; i < stop && retval == 0; i++) | |
1196 { | |
1197 rainj.ch = (Emchar) (i); | |
1198 retval = (fn) (&rainj, ct->ascii[i], arg); | |
1199 } | |
1200 | |
1201 return retval; | |
1202 } | 1179 } |
1203 | 1180 |
1204 /* Map FN over the row ROW of two-byte charset CHARSET. | 1181 /* Map FN over the row ROW of two-byte charset CHARSET. |
1205 There must be a separate value for that row in the char table. | 1182 There must be a separate value for that row in the char table. |
1206 CTE specifies the char table entry for CHARSET. */ | 1183 CTE specifies the char table entry for CHARSET. */ |
1207 | 1184 |
1208 static int | 1185 static int |
1209 map_over_charset_row (Lisp_Char_Table_Entry *cte, | 1186 map_over_charset_row (Lisp_Char_Table *ct, |
1187 Lisp_Char_Table_Entry *cte, | |
1210 Lisp_Object charset, int row, | 1188 Lisp_Object charset, int row, |
1211 int (*fn) (struct chartab_range *range, | 1189 int (*fn) (struct chartab_range *range, |
1212 Lisp_Object val, void *arg), | 1190 Lisp_Object table, Lisp_Object val, |
1191 void *arg), | |
1213 void *arg) | 1192 void *arg) |
1214 { | 1193 { |
1215 Lisp_Object val = cte->level2[row - 32]; | 1194 Lisp_Object val = cte->level2[row - 32]; |
1216 | 1195 |
1217 if (!CHAR_TABLE_ENTRYP (val)) | 1196 if (UNBOUNDP (val)) |
1197 return 0; | |
1198 else if (!CHAR_TABLE_ENTRYP (val)) | |
1218 { | 1199 { |
1219 struct chartab_range rainj; | 1200 struct chartab_range rainj; |
1220 | 1201 |
1221 rainj.type = CHARTAB_RANGE_ROW; | 1202 rainj.type = CHARTAB_RANGE_ROW; |
1222 rainj.charset = charset; | 1203 rainj.charset = charset; |
1223 rainj.row = row; | 1204 rainj.row = row; |
1224 return (fn) (&rainj, val, arg); | 1205 return (fn) (&rainj, wrap_char_table (ct), val, arg); |
1225 } | 1206 } |
1226 else | 1207 else |
1227 { | 1208 { |
1228 struct chartab_range rainj; | 1209 struct chartab_range rainj; |
1229 int i, retval; | 1210 int i, retval; |
1230 int charset94_p = (XCHARSET_CHARS (charset) == 94); | 1211 int start, stop; |
1231 int start = charset94_p ? 33 : 32; | 1212 |
1232 int stop = charset94_p ? 127 : 128; | 1213 get_charset_limits (charset, &start, &stop); |
1233 | 1214 |
1234 cte = XCHAR_TABLE_ENTRY (val); | 1215 cte = XCHAR_TABLE_ENTRY (val); |
1235 | 1216 |
1236 rainj.type = CHARTAB_RANGE_CHAR; | 1217 rainj.type = CHARTAB_RANGE_CHAR; |
1237 | 1218 |
1238 for (i = start, retval = 0; i < stop && retval == 0; i++) | 1219 for (i = start, retval = 0; i <= stop && retval == 0; i++) |
1239 { | 1220 { |
1240 rainj.ch = MAKE_CHAR (charset, row, i); | 1221 rainj.ch = make_emchar (charset, row, i); |
1241 retval = (fn) (&rainj, cte->level2[i - 32], arg); | 1222 if (!UNBOUNDP (cte->level2[i - 32])) |
1223 retval = (fn) (&rainj, wrap_char_table (ct), cte->level2[i - 32], | |
1224 arg); | |
1242 } | 1225 } |
1243 return retval; | 1226 return retval; |
1244 } | 1227 } |
1245 } | 1228 } |
1246 | 1229 |
1247 | 1230 |
1248 static int | 1231 static int |
1249 map_over_other_charset (Lisp_Char_Table *ct, int lb, | 1232 map_over_other_charset (Lisp_Char_Table *ct, int lb, |
1250 int (*fn) (struct chartab_range *range, | 1233 int (*fn) (struct chartab_range *range, |
1251 Lisp_Object val, void *arg), | 1234 Lisp_Object table, Lisp_Object val, |
1235 void *arg), | |
1252 void *arg) | 1236 void *arg) |
1253 { | 1237 { |
1254 Lisp_Object val = ct->level1[lb - MIN_LEADING_BYTE]; | 1238 Lisp_Object val = ct->level1[lb - MIN_LEADING_BYTE]; |
1255 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (lb); | 1239 Lisp_Object charset = charset_by_leading_byte (lb); |
1256 | 1240 |
1257 if (!CHARSETP (charset) | 1241 if (!CHARSETP (charset) |
1258 || lb == LEADING_BYTE_ASCII | 1242 || lb == LEADING_BYTE_ASCII |
1259 || lb == LEADING_BYTE_CONTROL_1) | 1243 || lb == LEADING_BYTE_CONTROL_1) |
1260 return 0; | 1244 return 0; |
1261 | 1245 |
1246 if (UNBOUNDP (val)) | |
1247 return 0; | |
1262 if (!CHAR_TABLE_ENTRYP (val)) | 1248 if (!CHAR_TABLE_ENTRYP (val)) |
1263 { | 1249 { |
1264 struct chartab_range rainj; | 1250 struct chartab_range rainj; |
1265 | 1251 |
1266 rainj.type = CHARTAB_RANGE_CHARSET; | 1252 rainj.type = CHARTAB_RANGE_CHARSET; |
1267 rainj.charset = charset; | 1253 rainj.charset = charset; |
1268 return (fn) (&rainj, val, arg); | 1254 return (fn) (&rainj, wrap_char_table (ct), val, arg); |
1269 } | 1255 } |
1270 | |
1271 { | 1256 { |
1272 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val); | 1257 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val); |
1273 int charset94_p = (XCHARSET_CHARS (charset) == 94); | 1258 int start, stop; |
1274 int start = charset94_p ? 33 : 32; | |
1275 int stop = charset94_p ? 127 : 128; | |
1276 int i, retval; | 1259 int i, retval; |
1277 | 1260 |
1261 get_charset_limits (charset, &start, &stop); | |
1278 if (XCHARSET_DIMENSION (charset) == 1) | 1262 if (XCHARSET_DIMENSION (charset) == 1) |
1279 { | 1263 { |
1280 struct chartab_range rainj; | 1264 struct chartab_range rainj; |
1281 rainj.type = CHARTAB_RANGE_CHAR; | 1265 rainj.type = CHARTAB_RANGE_CHAR; |
1282 | 1266 |
1283 for (i = start, retval = 0; i < stop && retval == 0; i++) | 1267 for (i = start, retval = 0; i <= stop && retval == 0; i++) |
1284 { | 1268 { |
1285 rainj.ch = MAKE_CHAR (charset, i, 0); | 1269 rainj.ch = make_emchar (charset, i, 0); |
1286 retval = (fn) (&rainj, cte->level2[i - 32], arg); | 1270 if (!UNBOUNDP (cte->level2[i - 32])) |
1271 retval = (fn) (&rainj, wrap_char_table (ct), cte->level2[i - 32], | |
1272 arg); | |
1287 } | 1273 } |
1288 } | 1274 } |
1289 else | 1275 else |
1290 { | 1276 { |
1291 for (i = start, retval = 0; i < stop && retval == 0; i++) | 1277 for (i = start, retval = 0; i <= stop && retval == 0; i++) |
1292 retval = map_over_charset_row (cte, charset, i, fn, arg); | 1278 retval = map_over_charset_row (ct, cte, charset, i, fn, arg); |
1293 } | 1279 } |
1294 | 1280 |
1295 return retval; | 1281 return retval; |
1296 } | 1282 } |
1297 } | 1283 } |
1298 | 1284 |
1299 #endif /* MULE */ | 1285 #endif /* MULE */ |
1300 | 1286 |
1301 /* Map FN (with client data ARG) over range RANGE in char table CT. | 1287 /* Map FN (with client data ARG) over range RANGE in char table CT. |
1302 Mapping stops the first time FN returns non-zero, and that value | 1288 Mapping stops the first time FN returns non-zero, and that value |
1303 becomes the return value of map_char_table(). */ | 1289 becomes the return value of map_char_table(). |
1290 | |
1291 #### This mapping code is way ugly. The FSF version, in contrast, | |
1292 is short and sweet, and much more recursive. There should be some way | |
1293 of cleaning this up. */ | |
1304 | 1294 |
1305 int | 1295 int |
1306 map_char_table (Lisp_Char_Table *ct, | 1296 map_char_table (Lisp_Object table, |
1307 struct chartab_range *range, | 1297 struct chartab_range *range, |
1308 int (*fn) (struct chartab_range *range, | 1298 int (*fn) (struct chartab_range *range, |
1309 Lisp_Object val, void *arg), | 1299 Lisp_Object table, Lisp_Object val, void *arg), |
1310 void *arg) | 1300 void *arg) |
1311 { | 1301 { |
1302 Lisp_Char_Table *ct = XCHAR_TABLE (table); | |
1312 switch (range->type) | 1303 switch (range->type) |
1313 { | 1304 { |
1314 case CHARTAB_RANGE_ALL: | 1305 case CHARTAB_RANGE_ALL: |
1315 { | 1306 { |
1316 int retval; | 1307 int retval; |
1345 | 1336 |
1346 case CHARTAB_RANGE_ROW: | 1337 case CHARTAB_RANGE_ROW: |
1347 { | 1338 { |
1348 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (range->charset) - | 1339 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (range->charset) - |
1349 MIN_LEADING_BYTE]; | 1340 MIN_LEADING_BYTE]; |
1350 if (!CHAR_TABLE_ENTRYP (val)) | 1341 |
1342 if (CHAR_TABLE_ENTRYP (val)) | |
1343 return map_over_charset_row (ct, XCHAR_TABLE_ENTRY (val), | |
1344 range->charset, range->row, fn, arg); | |
1345 else if (!UNBOUNDP (val)) | |
1351 { | 1346 { |
1352 struct chartab_range rainj; | 1347 struct chartab_range rainj; |
1353 | 1348 |
1354 rainj.type = CHARTAB_RANGE_ROW; | 1349 rainj.type = CHARTAB_RANGE_ROW; |
1355 rainj.charset = range->charset; | 1350 rainj.charset = range->charset; |
1356 rainj.row = range->row; | 1351 rainj.row = range->row; |
1357 return (fn) (&rainj, val, arg); | 1352 return (fn) (&rainj, table, val, arg); |
1358 } | 1353 } |
1359 else | 1354 else |
1360 return map_over_charset_row (XCHAR_TABLE_ENTRY (val), | 1355 return 0; |
1361 range->charset, range->row, | |
1362 fn, arg); | |
1363 } | 1356 } |
1364 #endif /* MULE */ | 1357 #endif /* MULE */ |
1365 | 1358 |
1366 case CHARTAB_RANGE_CHAR: | 1359 case CHARTAB_RANGE_CHAR: |
1367 { | 1360 { |
1368 Emchar ch = range->ch; | 1361 Emchar ch = range->ch; |
1369 Lisp_Object val = CHAR_TABLE_VALUE_UNSAFE (ct, ch); | 1362 Lisp_Object val = get_char_table (ch, table); |
1370 struct chartab_range rainj; | 1363 struct chartab_range rainj; |
1371 | 1364 |
1372 rainj.type = CHARTAB_RANGE_CHAR; | 1365 if (!UNBOUNDP (val)) |
1373 rainj.ch = ch; | 1366 { |
1374 return (fn) (&rainj, val, arg); | 1367 rainj.type = CHARTAB_RANGE_CHAR; |
1368 rainj.ch = ch; | |
1369 return (fn) (&rainj, table, val, arg); | |
1370 } | |
1371 else | |
1372 return 0; | |
1375 } | 1373 } |
1376 | 1374 |
1377 default: | 1375 default: |
1378 abort (); | 1376 abort (); |
1379 } | 1377 } |
1387 Lisp_Object retval; | 1385 Lisp_Object retval; |
1388 }; | 1386 }; |
1389 | 1387 |
1390 static int | 1388 static int |
1391 slow_map_char_table_fun (struct chartab_range *range, | 1389 slow_map_char_table_fun (struct chartab_range *range, |
1392 Lisp_Object val, void *arg) | 1390 Lisp_Object table, Lisp_Object val, void *arg) |
1393 { | 1391 { |
1394 Lisp_Object ranjarg = Qnil; | |
1395 struct slow_map_char_table_arg *closure = | 1392 struct slow_map_char_table_arg *closure = |
1396 (struct slow_map_char_table_arg *) arg; | 1393 (struct slow_map_char_table_arg *) arg; |
1397 | 1394 |
1398 switch (range->type) | 1395 closure->retval = call2 (closure->function, encode_char_table_range (range), |
1399 { | 1396 val); |
1400 case CHARTAB_RANGE_ALL: | |
1401 ranjarg = Qt; | |
1402 break; | |
1403 | |
1404 #ifdef MULE | |
1405 case CHARTAB_RANGE_CHARSET: | |
1406 ranjarg = XCHARSET_NAME (range->charset); | |
1407 break; | |
1408 | |
1409 case CHARTAB_RANGE_ROW: | |
1410 ranjarg = vector2 (XCHARSET_NAME (range->charset), | |
1411 make_int (range->row)); | |
1412 break; | |
1413 #endif /* MULE */ | |
1414 case CHARTAB_RANGE_CHAR: | |
1415 ranjarg = make_char (range->ch); | |
1416 break; | |
1417 default: | |
1418 abort (); | |
1419 } | |
1420 | |
1421 closure->retval = call2 (closure->function, ranjarg, val); | |
1422 return !NILP (closure->retval); | 1397 return !NILP (closure->retval); |
1423 } | 1398 } |
1424 | 1399 |
1425 DEFUN ("map-char-table", Fmap_char_table, 2, 3, 0, /* | 1400 DEFUN ("map-char-table", Fmap_char_table, 2, 3, 0, /* |
1426 Map FUNCTION over entries in CHAR-TABLE, calling it with two args, | 1401 Map FUNCTION over entries in CHAR-TABLE, calling it with two args, |
1430 the RANGE argument to `put-range-table'. If omitted or t, it defaults to | 1405 the RANGE argument to `put-range-table'. If omitted or t, it defaults to |
1431 the entire table. | 1406 the entire table. |
1432 */ | 1407 */ |
1433 (function, char_table, range)) | 1408 (function, char_table, range)) |
1434 { | 1409 { |
1435 Lisp_Char_Table *ct; | |
1436 struct slow_map_char_table_arg slarg; | 1410 struct slow_map_char_table_arg slarg; |
1437 struct gcpro gcpro1, gcpro2; | 1411 struct gcpro gcpro1, gcpro2; |
1438 struct chartab_range rainj; | 1412 struct chartab_range rainj; |
1439 | 1413 |
1440 CHECK_CHAR_TABLE (char_table); | 1414 CHECK_CHAR_TABLE (char_table); |
1441 ct = XCHAR_TABLE (char_table); | |
1442 if (NILP (range)) | 1415 if (NILP (range)) |
1443 range = Qt; | 1416 range = Qt; |
1444 decode_char_table_range (range, &rainj); | 1417 decode_char_table_range (range, &rainj); |
1445 slarg.function = function; | 1418 slarg.function = function; |
1446 slarg.retval = Qnil; | 1419 slarg.retval = Qnil; |
1447 GCPRO2 (slarg.function, slarg.retval); | 1420 GCPRO2 (slarg.function, slarg.retval); |
1448 map_char_table (ct, &rainj, slow_map_char_table_fun, &slarg); | 1421 map_char_table (char_table, &rainj, slow_map_char_table_fun, &slarg); |
1449 UNGCPRO; | 1422 UNGCPRO; |
1450 | 1423 |
1451 return slarg.retval; | 1424 return slarg.retval; |
1452 } | 1425 } |
1453 | 1426 |
1463 { | 1436 { |
1464 /* #### should deal with ERRB */ | 1437 /* #### should deal with ERRB */ |
1465 symbol_to_char_table_type (value); | 1438 symbol_to_char_table_type (value); |
1466 return 1; | 1439 return 1; |
1467 } | 1440 } |
1441 | |
1442 /* #### Document the print/read format; esp. what's this cons element? */ | |
1468 | 1443 |
1469 static int | 1444 static int |
1470 chartab_data_validate (Lisp_Object keyword, Lisp_Object value, | 1445 chartab_data_validate (Lisp_Object keyword, Lisp_Object value, |
1471 Error_Behavior errb) | 1446 Error_Behavior errb) |
1472 { | 1447 { |
1598 int | 1573 int |
1599 check_category_char (Emchar ch, Lisp_Object table, | 1574 check_category_char (Emchar ch, Lisp_Object table, |
1600 int designator, int not_p) | 1575 int designator, int not_p) |
1601 { | 1576 { |
1602 REGISTER Lisp_Object temp; | 1577 REGISTER Lisp_Object temp; |
1603 Lisp_Char_Table *ctbl; | |
1604 if (NILP (Fcategory_table_p (table))) | 1578 if (NILP (Fcategory_table_p (table))) |
1605 wtaerror ("Expected category table", table); | 1579 wtaerror ("Expected category table", table); |
1606 ctbl = XCHAR_TABLE (table); | 1580 temp = get_char_table (ch, table); |
1607 temp = get_char_table (ch, ctbl); | |
1608 if (NILP (temp)) | 1581 if (NILP (temp)) |
1609 return not_p; | 1582 return not_p; |
1610 | 1583 |
1611 designator -= ' '; | 1584 designator -= ' '; |
1612 return bit_vector_bit (XBIT_VECTOR (temp), designator) ? !not_p : not_p; | 1585 return bit_vector_bit (XBIT_VECTOR (temp), designator) ? !not_p : not_p; |
1718 | 1691 |
1719 | 1692 |
1720 #define CATEGORYP(x) \ | 1693 #define CATEGORYP(x) \ |
1721 (CHARP (x) && XCHAR (x) >= 0x20 && XCHAR (x) <= 0x7E) | 1694 (CHARP (x) && XCHAR (x) >= 0x20 && XCHAR (x) <= 0x7E) |
1722 | 1695 |
1723 #define CATEGORY_SET(c) \ | 1696 #define CATEGORY_SET(c) get_char_table (c, current_buffer->category_table) |
1724 (get_char_table(c, XCHAR_TABLE(current_buffer->category_table))) | |
1725 | 1697 |
1726 /* Return 1 if CATEGORY_SET contains CATEGORY, else return 0. | 1698 /* Return 1 if CATEGORY_SET contains CATEGORY, else return 0. |
1727 The faster version of `!NILP (Faref (category_set, category))'. */ | 1699 The faster version of `!NILP (Faref (category_set, category))'. */ |
1728 #define CATEGORY_MEMBER(category, category_set) \ | 1700 #define CATEGORY_MEMBER(category, category_set) \ |
1729 (bit_vector_bit(XBIT_VECTOR (category_set), category - 32)) | 1701 (bit_vector_bit(XBIT_VECTOR (category_set), category - 32)) |
1731 /* Return 1 if there is a word boundary between two word-constituent | 1703 /* Return 1 if there is a word boundary between two word-constituent |
1732 characters C1 and C2 if they appear in this order, else return 0. | 1704 characters C1 and C2 if they appear in this order, else return 0. |
1733 Use the macro WORD_BOUNDARY_P instead of calling this function | 1705 Use the macro WORD_BOUNDARY_P instead of calling this function |
1734 directly. */ | 1706 directly. */ |
1735 | 1707 |
1736 int word_boundary_p (Emchar c1, Emchar c2); | |
1737 int | 1708 int |
1738 word_boundary_p (Emchar c1, Emchar c2) | 1709 word_boundary_p (Emchar c1, Emchar c2) |
1739 { | 1710 { |
1740 Lisp_Object category_set1, category_set2; | 1711 Lisp_Object category_set1, category_set2; |
1741 Lisp_Object tail; | 1712 Lisp_Object tail; |
1746 c1 = cmpchar_component (c1, 0, 1); | 1717 c1 = cmpchar_component (c1, 0, 1); |
1747 if (COMPOSITE_CHAR_P (c2)) | 1718 if (COMPOSITE_CHAR_P (c2)) |
1748 c2 = cmpchar_component (c2, 0, 1); | 1719 c2 = cmpchar_component (c2, 0, 1); |
1749 #endif | 1720 #endif |
1750 | 1721 |
1751 if (EQ (CHAR_CHARSET (c1), CHAR_CHARSET (c2))) | 1722 if (EQ (emchar_charset (c1), emchar_charset (c2))) |
1752 { | 1723 { |
1753 tail = Vword_separating_categories; | 1724 tail = Vword_separating_categories; |
1754 default_result = 0; | 1725 default_result = 0; |
1755 } | 1726 } |
1756 else | 1727 else |
1800 | 1771 |
1801 DEFSUBR (Fchar_table_p); | 1772 DEFSUBR (Fchar_table_p); |
1802 DEFSUBR (Fchar_table_type_list); | 1773 DEFSUBR (Fchar_table_type_list); |
1803 DEFSUBR (Fvalid_char_table_type_p); | 1774 DEFSUBR (Fvalid_char_table_type_p); |
1804 DEFSUBR (Fchar_table_type); | 1775 DEFSUBR (Fchar_table_type); |
1776 DEFSUBR (Fchar_table_default); | |
1777 DEFSUBR (Fset_char_table_default); | |
1805 DEFSUBR (Freset_char_table); | 1778 DEFSUBR (Freset_char_table); |
1806 DEFSUBR (Fmake_char_table); | 1779 DEFSUBR (Fmake_char_table); |
1807 DEFSUBR (Fcopy_char_table); | 1780 DEFSUBR (Fcopy_char_table); |
1808 DEFSUBR (Fget_char_table); | 1781 DEFSUBR (Fget_char_table); |
1809 DEFSUBR (Fget_range_char_table); | 1782 DEFSUBR (Fget_range_char_table); |
1810 DEFSUBR (Fvalid_char_table_value_p); | 1783 DEFSUBR (Fvalid_char_table_value_p); |
1811 DEFSUBR (Fcheck_valid_char_table_value); | 1784 DEFSUBR (Fcheck_valid_char_table_value); |
1812 DEFSUBR (Fput_char_table); | 1785 DEFSUBR (Fput_char_table); |
1786 DEFSUBR (Fremove_char_table); | |
1813 DEFSUBR (Fmap_char_table); | 1787 DEFSUBR (Fmap_char_table); |
1814 | 1788 |
1815 #ifdef MULE | 1789 #ifdef MULE |
1816 DEFSUBR (Fcategory_table_p); | 1790 DEFSUBR (Fcategory_table_p); |
1817 DEFSUBR (Fcategory_table); | 1791 DEFSUBR (Fcategory_table); |