comparison src/chartab.c @ 5118:e0db3c197671 ben-lisp-object

merge up to latest default branch, doesn't compile yet
author Ben Wing <ben@xemacs.org>
date Sat, 26 Dec 2009 21:18:49 -0600
parents 3742ea8250b5 1d11ecca9cd0
children d1247f3cc363
comparison
equal deleted inserted replaced
5117:3742ea8250b5 5118:e0db3c197671
136 static const struct memory_description char_table_entry_description[] = { 136 static const struct memory_description char_table_entry_description[] = {
137 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table_Entry, level2), 96 }, 137 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table_Entry, level2), 96 },
138 { XD_END } 138 { XD_END }
139 }; 139 };
140 140
141 DEFINE_LISP_OBJECT ("char-table-entry", char_table_entry, 141 DEFINE_DUMPABLE_LISP_OBJECT ("char-table-entry", char_table_entry,
142 mark_char_table_entry, 0, 142 mark_char_table_entry, 0,
143 0, char_table_entry_equal, 143 0, char_table_entry_equal,
144 char_table_entry_hash, 144 char_table_entry_hash,
145 char_table_entry_description, 145 char_table_entry_description,
146 Lisp_Char_Table_Entry); 146 Lisp_Char_Table_Entry);
147 147
148 #endif /* MULE */ 148 #endif /* MULE */
149 149
150 static Lisp_Object 150 static Lisp_Object
151 mark_char_table (Lisp_Object obj) 151 mark_char_table (Lisp_Object obj)
314 if (!a->first) 314 if (!a->first)
315 write_c_string (a->printcharfun, " "); 315 write_c_string (a->printcharfun, " ");
316 a->first = 0; 316 a->first = 0;
317 lisprange = encode_char_table_range (range); 317 lisprange = encode_char_table_range (range);
318 GCPRO1 (lisprange); 318 GCPRO1 (lisprange);
319 write_fmt_string_lisp (a->printcharfun, "%s %s", 2, lisprange, val); 319 write_fmt_string_lisp (a->printcharfun, "%s %S", 2, lisprange, val);
320 UNGCPRO; 320 UNGCPRO;
321 return 0; 321 return 0;
322 } 322 }
323 323
324 static void 324 static void
389 { XD_LISP_OBJECT, offsetof (Lisp_Char_Table, mirror_table) }, 389 { XD_LISP_OBJECT, offsetof (Lisp_Char_Table, mirror_table) },
390 { XD_LO_LINK, offsetof (Lisp_Char_Table, next_table) }, 390 { XD_LO_LINK, offsetof (Lisp_Char_Table, next_table) },
391 { XD_END } 391 { XD_END }
392 }; 392 };
393 393
394 DEFINE_LISP_OBJECT ("char-table", char_table, 394 DEFINE_DUMPABLE_LISP_OBJECT ("char-table", char_table,
395 mark_char_table, print_char_table, 0, 395 mark_char_table, print_char_table, 0,
396 char_table_equal, char_table_hash, 396 char_table_equal, char_table_hash,
397 char_table_description, 397 char_table_description,
398 Lisp_Char_Table); 398 Lisp_Char_Table);
399 399
400 DEFUN ("char-table-p", Fchar_table_p, 1, 1, 0, /* 400 DEFUN ("char-table-p", Fchar_table_p, 1, 1, 0, /*
401 Return non-nil if OBJECT is a char table. 401 Return non-nil if OBJECT is a char table.
402 */ 402 */
403 (object)) 403 (object))
562 562
563 Each char table type is used for a different purpose and allows different 563 Each char table type is used for a different purpose and allows different
564 sorts of values. The different char table types are 564 sorts of values. The different char table types are
565 565
566 `category' 566 `category'
567 Used for category tables, which specify the regexp categories 567 Used for category tables, which specify the regexp categories that a
568 that a character is in. The valid values are nil or a 568 character is in. The valid values are nil or a bit vector of 95
569 bit vector of 95 elements. Higher-level Lisp functions are 569 elements, and values default to nil. Higher-level Lisp functions
570 provided for working with category tables. Currently categories 570 are provided for working with category tables. Currently categories
571 and category tables only exist when Mule support is present. 571 and category tables only exist when Mule support is present.
572 `char' 572 `char'
573 A generalized char table, for mapping from one character to 573 A generalized char table, for mapping from one character to another.
574 another. Used for case tables, syntax matching tables, 574 Used for case tables, syntax matching tables,
575 `keyboard-translate-table', etc. The valid values are characters. 575 `keyboard-translate-table', etc. The valid values are characters,
576 and the default result given by `get-char-table' if a value hasn't
577 been set for a given character or for a range that includes it, is
578 ?\x00.
576 `generic' 579 `generic'
577 An even more generalized char table, for mapping from a 580 An even more generalized char table, for mapping from a character to
578 character to anything. 581 anything. The default result given by `get-char-table' is nil.
579 `display' 582 `display'
580 Used for display tables, which specify how a particular character 583 Used for display tables, which specify how a particular character is
581 is to appear when displayed. #### Not yet implemented. 584 to appear when displayed. #### Not yet implemented; currently, the
585 display table code uses generic char tables, and it's not clear that
586 implementing this char table type would be useful.
582 `syntax' 587 `syntax'
583 Used for syntax tables, which specify the syntax of a particular 588 Used for syntax tables, which specify the syntax of a particular
584 character. Higher-level Lisp functions are provided for 589 character. Higher-level Lisp functions are provided for
585 working with syntax tables. The valid values are integers. 590 working with syntax tables. The valid values are integers, and the
591 default result given by `get-char-table' is the syntax code for
592 `inherit'.
586 */ 593 */
587 (type)) 594 (type))
588 { 595 {
589 Lisp_Object obj = ALLOC_LISP_OBJECT (char_table); 596 Lisp_Object obj = ALLOC_LISP_OBJECT (char_table);
590 Lisp_Char_Table *ct = XCHAR_TABLE (obj); 597 Lisp_Char_Table *ct = XCHAR_TABLE (obj);
594 if (ty == CHAR_TABLE_TYPE_SYNTAX) 601 if (ty == CHAR_TABLE_TYPE_SYNTAX)
595 { 602 {
596 /* Qgeneric not Qsyntax because a syntax table has a mirror table 603 /* Qgeneric not Qsyntax because a syntax table has a mirror table
597 and we don't want infinite recursion */ 604 and we don't want infinite recursion */
598 ct->mirror_table = Fmake_char_table (Qgeneric); 605 ct->mirror_table = Fmake_char_table (Qgeneric);
599 set_char_table_default (ct->mirror_table, make_int (Spunct)); 606 set_char_table_default (ct->mirror_table, make_int (Sword));
600 XCHAR_TABLE (ct->mirror_table)->mirror_table_p = 1; 607 XCHAR_TABLE (ct->mirror_table)->mirror_table_p = 1;
601 XCHAR_TABLE (ct->mirror_table)->mirror_table = obj; 608 XCHAR_TABLE (ct->mirror_table)->mirror_table = obj;
602 } 609 }
603 else 610 else
604 ct->mirror_table = Qnil; 611 ct->mirror_table = Qnil;
662 Lisp_Object obj; 669 Lisp_Object obj;
663 int i; 670 int i;
664 671
665 CHECK_CHAR_TABLE (char_table); 672 CHECK_CHAR_TABLE (char_table);
666 ct = XCHAR_TABLE (char_table); 673 ct = XCHAR_TABLE (char_table);
674 assert(!ct->mirror_table_p);
667 obj = ALLOC_LISP_OBJECT (char_table); 675 obj = ALLOC_LISP_OBJECT (char_table);
668 ctnew = XCHAR_TABLE (obj); 676 ctnew = XCHAR_TABLE (obj);
669 ctnew->type = ct->type; 677 ctnew->type = ct->type;
670 ctnew->parent = ct->parent; 678 ctnew->parent = ct->parent;
671 ctnew->default_ = ct->default_; 679 ctnew->default_ = ct->default_;
672 ctnew->mirror_table_p = ct->mirror_table_p; 680 ctnew->mirror_table_p = 0;
673 681
674 for (i = 0; i < NUM_ASCII_CHARS; i++) 682 for (i = 0; i < NUM_ASCII_CHARS; i++)
675 { 683 {
676 Lisp_Object new_ = ct->ascii[i]; 684 Lisp_Object new_ = ct->ascii[i];
677 #ifdef MULE 685 #ifdef MULE
691 ctnew->level1[i] = new_; 699 ctnew->level1[i] = new_;
692 } 700 }
693 701
694 #endif /* MULE */ 702 #endif /* MULE */
695 703
696 if (!ct->mirror_table_p && CHAR_TABLEP (ct->mirror_table)) 704 if (!EQ (ct->mirror_table, Qnil))
697 { 705 {
698 ctnew->mirror_table = Fcopy_char_table (ct->mirror_table); 706 ctnew->mirror_table = Fmake_char_table (Qgeneric);
707 set_char_table_default (ctnew->mirror_table, make_int (Sword));
699 XCHAR_TABLE (ctnew->mirror_table)->mirror_table = obj; 708 XCHAR_TABLE (ctnew->mirror_table)->mirror_table = obj;
709 XCHAR_TABLE (ctnew->mirror_table)->mirror_table_p = 1;
710 XCHAR_TABLE (ctnew->mirror_table)->dirty = 1;
700 } 711 }
701 else 712 else
702 ctnew->mirror_table = ct->mirror_table; 713 ctnew->mirror_table = Qnil;
714
703 ctnew->next_table = Qnil; 715 ctnew->next_table = Qnil;
704 if (ctnew->type == CHAR_TABLE_TYPE_SYNTAX) 716 if (ctnew->type == CHAR_TABLE_TYPE_SYNTAX)
705 { 717 {
706 ctnew->next_table = Vall_syntax_tables; 718 ctnew->next_table = Vall_syntax_tables;
707 Vall_syntax_tables = obj; 719 Vall_syntax_tables = obj;