comparison src/chartab.c @ 800:a5954632b187

[xemacs-hg @ 2002-03-31 08:27:14 by ben] more fixes, first crack at finishing behavior implementation TODO.ben-mule-21-5: Update. configure.in: Fix for new error-checking types. make-mswin-unicode.pl: Don't be fucked up by CRLF. Output code to force errors when nonintercepted Windows calls issued. behavior.el, dumped-lisp.el, menubar-items.el: Add support for saving using custom. Load into a dumped XEmacs. Correct :title to :short-doc in accordance with behavior-defs.el. Add a submenu under Options for turning on/off behaviors. cl-macs.el: Properly document `loop'. Fix a minor bug in keymap iteration and add support for bit-vector iteration. lisp-mode.el: Rearrange and add items for macro expanding. menubar-items.el: Document connection between these two functions. window.el: Port stuff from GNU 21.1. config.inc.samp, xemacs.mak: Separate out and add new variable for controlling error-checking. s/windowsnt.h: Use new ERROR_CHECK_ALL; not related to DEBUG_XEMACS. alloc.c, backtrace.h, buffer.c, buffer.h, bytecode.c, callproc.c, casetab.c, charset.h, chartab.c, cmdloop.c, config.h.in, console-msw.c, console-stream.c, console-tty.c, console.c, console.h, data.c, device-msw.c, device.c, device.h, dired-msw.c, dired.c, dumper.c, editfns.c, eldap.c, elhash.c, emacs.c, eval.c, event-Xt.c, event-gtk.c, event-msw.c, event-stream.c, events.c, extents.c, faces.c, file-coding.c, file-coding.h, fileio.c, frame-msw.c, frame.c, frame.h, glyphs-gtk.c, glyphs-msw.c, glyphs-shared.c, glyphs-widget.c, glyphs-x.c, glyphs.c, glyphs.h, insdel.c, intl-auto-encap-win32.c, intl-auto-encap-win32.h, intl-encap-win32.c, intl-win32.c, keymap.c, lisp-union.h, lisp.h, lread.c, lrecord.h, lstream.c, lstream.h, macros.c, marker.c, md5.c, menubar-x.c, menubar.c, mule-coding.c, ntproc.c, objects-gtk.c, objects-msw.c, objects-x.c, objects.c, opaque.c, print.c, process-nt.c, process-unix.c, process.c, rangetab.c, redisplay-msw.c, redisplay-output.c, redisplay.c, regex.c, scrollbar-msw.c, select-msw.c, signal.c, specifier.c, specifier.h, symbols.c, sysdep.c, syswindows.h, text.c, text.h, toolbar-msw.c, tooltalk.c, ui-gtk.c, unicode.c, window.c: Redo error-checking macros: ERROR_CHECK_TYPECHECK -> ERROR_CHECK_TYPES, ERROR_CHECK_CHARBPOS -> ERROR_CHECK_TEXT, add ERROR_CHECK_DISPLAY, ERROR_CHECK_STRUCTURES. Document these in config.h.in. Fix code to follow docs. Fix *_checking_assert() in accordance with new names. Attempt to fix periodic redisplay crash freeing display line structures. Add first implementation of sledgehammer redisplay check. Redo print_*() to use write_fmt_string(), write_fmt_string_lisp(). Fix bug in md5 handling. Rename character-to-unicode to char-to-unicode; same for unicode-to-char{acter}. Move chartab documentation to `make-char-table'. Some header cleanup. Clean up remaining places where nonintercepted Windows calls are being used. automated/mule-tests.el: Fix for new Unicode support.
author ben
date Sun, 31 Mar 2002 08:30:17 +0000
parents e38acbeb1cae
children 2b676dc88c66
comparison
equal deleted inserted replaced
799:03d9f9084848 800:a5954632b187
220 static void 220 static void
221 print_chartab_range (Emchar first, Emchar last, Lisp_Object val, 221 print_chartab_range (Emchar first, Emchar last, Lisp_Object val,
222 Lisp_Object printcharfun) 222 Lisp_Object printcharfun)
223 { 223 {
224 if (first != last) 224 if (first != last)
225 { 225 write_fmt_string_lisp (printcharfun, " (%s %s)", 2,
226 write_c_string (" (", printcharfun); 226 make_char (first), make_char (last));
227 print_internal (make_char (first), printcharfun, 0);
228 write_c_string (" ", printcharfun);
229 print_internal (make_char (last), printcharfun, 0);
230 write_c_string (") ", printcharfun);
231 }
232 else 227 else
233 { 228 write_fmt_string_lisp (printcharfun, " %s ", 1, make_char (first));
234 write_c_string (" ", printcharfun);
235 print_internal (make_char (first), printcharfun, 0);
236 write_c_string (" ", printcharfun);
237 }
238 print_internal (val, printcharfun, 1); 229 print_internal (val, printcharfun, 1);
239 } 230 }
240 231
241 #ifdef MULE 232 #ifdef MULE
242 233
300 { 291 {
301 Lisp_Object jen = cte->level2[i - 32]; 292 Lisp_Object jen = cte->level2[i - 32];
302 293
303 if (!CHAR_TABLE_ENTRYP (jen)) 294 if (!CHAR_TABLE_ENTRYP (jen))
304 { 295 {
305 char buf[100]; 296 write_fmt_string_lisp (printcharfun, " [%s %d] %s",
306 297 3, XCHARSET_NAME (charset),
307 write_c_string (" [", printcharfun); 298 make_int (i), jen);
308 print_internal (XCHARSET_NAME (charset), printcharfun, 0);
309 sprintf (buf, " %d] ", i);
310 write_c_string (buf, printcharfun);
311 print_internal (jen, printcharfun, 0);
312 } 299 }
313 else 300 else
314 print_chartab_charset_row (charset, i, XCHAR_TABLE_ENTRY (jen), 301 print_chartab_charset_row (charset, i, XCHAR_TABLE_ENTRY (jen),
315 printcharfun); 302 printcharfun);
316 } 303 }
366 if (!CHARSETP (charset) || i == LEADING_BYTE_ASCII 353 if (!CHARSETP (charset) || i == LEADING_BYTE_ASCII
367 || i == LEADING_BYTE_CONTROL_1) 354 || i == LEADING_BYTE_CONTROL_1)
368 continue; 355 continue;
369 if (!CHAR_TABLE_ENTRYP (ann)) 356 if (!CHAR_TABLE_ENTRYP (ann))
370 { 357 {
371 write_c_string (" ", printcharfun); 358 write_fmt_string_lisp (printcharfun, " %s %s", 2,
372 print_internal (XCHARSET_NAME (charset), 359 XCHARSET_NAME (charset), ann);
373 printcharfun, 0);
374 write_c_string (" ", printcharfun);
375 print_internal (ann, printcharfun, 0);
376 } 360 }
377 else 361 else
378 { 362 {
379 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (ann); 363 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (ann);
380 if (XCHARSET_DIMENSION (charset) == 1) 364 if (XCHARSET_DIMENSION (charset) == 1)
443 char_table_description, 427 char_table_description,
444 Lisp_Char_Table); 428 Lisp_Char_Table);
445 429
446 DEFUN ("char-table-p", Fchar_table_p, 1, 1, 0, /* 430 DEFUN ("char-table-p", Fchar_table_p, 1, 1, 0, /*
447 Return non-nil if OBJECT is a char table. 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.
448 528
449 A char table is a table that maps characters (or ranges of characters) 529 A char table is a table that maps characters (or ranges of characters)
450 to values. Char tables are specialized for characters, only allowing 530 to values. Char tables are specialized for characters, only allowing
451 particular sorts of ranges to be assigned values. Although this 531 particular sorts of ranges to be assigned values. Although this
452 loses in generality, it makes for extremely fast (constant-time) 532 loses in generality, it makes for extremely fast (constant-time)
471 551
472 To create a char table, use `make-char-table'. 552 To create a char table, use `make-char-table'.
473 To modify a char table, use `put-char-table' or `remove-char-table'. 553 To modify a char table, use `put-char-table' or `remove-char-table'.
474 To retrieve the value for a particular character, use `get-char-table'. 554 To retrieve the value for a particular character, use `get-char-table'.
475 See also `map-char-table', `clear-char-table', `copy-char-table', 555 See also `map-char-table', `clear-char-table', `copy-char-table',
476 `valid-char-table-type-p', `char-table-type-list', 556 `char-table-p', `valid-char-table-type-p', `char-table-type-list',
477 `valid-char-table-value-p', and `check-char-table-value'. 557 `valid-char-table-value-p', and `check-char-table-value'.
478 */
479 (object))
480 {
481 return CHAR_TABLEP (object) ? Qt : Qnil;
482 }
483
484 DEFUN ("char-table-type-list", Fchar_table_type_list, 0, 0, 0, /*
485 Return a list of the recognized char table types.
486 See `valid-char-table-type-p'.
487 */
488 ())
489 {
490 #ifdef MULE
491 return list5 (Qchar, Qcategory, Qdisplay, Qgeneric, Qsyntax);
492 #else
493 return list4 (Qchar, Qdisplay, Qgeneric, Qsyntax);
494 #endif
495 }
496
497 DEFUN ("valid-char-table-type-p", Fvalid_char_table_type_p, 1, 1, 0, /*
498 Return t if TYPE if a recognized char table type.
499 558
500 Each char table type is used for a different purpose and allows different 559 Each char table type is used for a different purpose and allows different
501 sorts of values. The different char table types are 560 sorts of values. The different char table types are
502 561
503 `category' 562 `category'
518 is to appear when displayed. #### Not yet implemented. 577 is to appear when displayed. #### Not yet implemented.
519 `syntax' 578 `syntax'
520 Used for syntax tables, which specify the syntax of a particular 579 Used for syntax tables, which specify the syntax of a particular
521 character. Higher-level Lisp functions are provided for 580 character. Higher-level Lisp functions are provided for
522 working with syntax tables. The valid values are integers. 581 working with syntax tables. The valid values are integers.
523
524 */
525 (type))
526 {
527 return (EQ (type, Qchar) ||
528 #ifdef MULE
529 EQ (type, Qcategory) ||
530 #endif
531 EQ (type, Qdisplay) ||
532 EQ (type, Qgeneric) ||
533 EQ (type, Qsyntax)) ? Qt : Qnil;
534 }
535
536 DEFUN ("char-table-type", Fchar_table_type, 1, 1, 0, /*
537 Return the type of CHAR-TABLE.
538 See `valid-char-table-type-p'.
539 */
540 (char_table))
541 {
542 CHECK_CHAR_TABLE (char_table);
543 return char_table_type_to_symbol (XCHAR_TABLE (char_table)->type);
544 }
545
546 void
547 fill_char_table (Lisp_Char_Table *ct, Lisp_Object value)
548 {
549 int i;
550
551 for (i = 0; i < NUM_ASCII_CHARS; i++)
552 ct->ascii[i] = value;
553 #ifdef MULE
554 for (i = 0; i < NUM_LEADING_BYTES; i++)
555 ct->level1[i] = value;
556 #endif /* MULE */
557
558 if (ct->type == CHAR_TABLE_TYPE_SYNTAX)
559 update_syntax_table (ct);
560 }
561
562 DEFUN ("reset-char-table", Freset_char_table, 1, 1, 0, /*
563 Reset CHAR-TABLE to its default state.
564 */
565 (char_table))
566 {
567 Lisp_Char_Table *ct;
568
569 CHECK_CHAR_TABLE (char_table);
570 ct = XCHAR_TABLE (char_table);
571
572 switch (ct->type)
573 {
574 case CHAR_TABLE_TYPE_CHAR:
575 fill_char_table (ct, make_char (0));
576 break;
577 case CHAR_TABLE_TYPE_DISPLAY:
578 case CHAR_TABLE_TYPE_GENERIC:
579 #ifdef MULE
580 case CHAR_TABLE_TYPE_CATEGORY:
581 #endif /* MULE */
582 fill_char_table (ct, Qnil);
583 break;
584
585 case CHAR_TABLE_TYPE_SYNTAX:
586 fill_char_table (ct, make_int (Sinherit));
587 break;
588
589 default:
590 abort ();
591 }
592
593 return Qnil;
594 }
595
596 DEFUN ("make-char-table", Fmake_char_table, 1, 1, 0, /*
597 Return a new, empty char table of type TYPE.
598 Currently recognized types are 'char, 'category, 'display, 'generic,
599 and 'syntax. See `valid-char-table-type-p'.
600 */ 582 */
601 (type)) 583 (type))
602 { 584 {
603 Lisp_Char_Table *ct; 585 Lisp_Char_Table *ct;
604 Lisp_Object obj; 586 Lisp_Object obj;
1147 -- A vector of two elements: a two-octet charset and a row number 1129 -- A vector of two elements: a two-octet charset and a row number
1148 (only allowed when Mule support is present) 1130 (only allowed when Mule support is present)
1149 -- A single character 1131 -- A single character
1150 1132
1151 VALUE must be a value appropriate for the type of CHAR-TABLE. 1133 VALUE must be a value appropriate for the type of CHAR-TABLE.
1152 See `valid-char-table-type-p'. 1134 See `make-char-table'.
1153 */ 1135 */
1154 (range, value, char_table)) 1136 (range, value, char_table))
1155 { 1137 {
1156 Lisp_Char_Table *ct; 1138 Lisp_Char_Table *ct;
1157 struct chartab_range rainj; 1139 struct chartab_range rainj;
1617 check_category_char (Emchar ch, Lisp_Object table, 1599 check_category_char (Emchar ch, Lisp_Object table,
1618 int designator, int not_p) 1600 int designator, int not_p)
1619 { 1601 {
1620 REGISTER Lisp_Object temp; 1602 REGISTER Lisp_Object temp;
1621 Lisp_Char_Table *ctbl; 1603 Lisp_Char_Table *ctbl;
1622 #ifdef ERROR_CHECK_TYPECHECK
1623 if (NILP (Fcategory_table_p (table))) 1604 if (NILP (Fcategory_table_p (table)))
1624 wtaerror ("Expected category table", table); 1605 wtaerror ("Expected category table", table);
1625 #endif
1626 ctbl = XCHAR_TABLE (table); 1606 ctbl = XCHAR_TABLE (table);
1627 temp = get_char_table (ch, ctbl); 1607 temp = get_char_table (ch, ctbl);
1628 if (NILP (temp)) 1608 if (NILP (temp))
1629 return not_p; 1609 return not_p;
1630 1610