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);