Mercurial > hg > xemacs-beta

comparison src/chartab.c @ 5140:e5380fdaf8f1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
merge
author Ben Wing <ben@xemacs.org>
date Sat, 13 Mar 2010 05:38:34 -0600
parents a9c41067dd88
children 71ee43b8a74d
comparison
equal deleted inserted replaced
5139:a48ef26d87ee 5140:e5380fdaf8f1
138 static const struct memory_description char_table_entry_description[] = { 138 static const struct memory_description char_table_entry_description[] = {
139 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table_Entry, level2), 96 }, 139 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table_Entry, level2), 96 },
140 { XD_END } 140 { XD_END }
141 }; 141 };
142 142
143 DEFINE_LRECORD_IMPLEMENTATION ("char-table-entry", char_table_entry, 143 DEFINE_DUMPABLE_LISP_OBJECT ("char-table-entry", char_table_entry,
144 1, /* dumpable flag */ 144 mark_char_table_entry, internal_object_printer,
145 mark_char_table_entry, internal_object_printer, 145 0, char_table_entry_equal,
146 0, char_table_entry_equal, 146 char_table_entry_hash,
147 char_table_entry_hash, 147 char_table_entry_description,
148 char_table_entry_description, 148 Lisp_Char_Table_Entry);
149 Lisp_Char_Table_Entry);
150 149
151 #endif /* MULE */ 150 #endif /* MULE */
152 151
153 static Lisp_Object 152 static Lisp_Object
154 mark_char_table (Lisp_Object obj) 153 mark_char_table (Lisp_Object obj)
393 { XD_LISP_OBJECT, offsetof (Lisp_Char_Table, mirror_table) }, 392 { XD_LISP_OBJECT, offsetof (Lisp_Char_Table, mirror_table) },
394 { XD_LO_LINK, offsetof (Lisp_Char_Table, next_table) }, 393 { XD_LO_LINK, offsetof (Lisp_Char_Table, next_table) },
395 { XD_END } 394 { XD_END }
396 }; 395 };
397 396
398 DEFINE_LRECORD_IMPLEMENTATION ("char-table", char_table, 397 DEFINE_DUMPABLE_LISP_OBJECT ("char-table", char_table,
399 1, /*dumpable-flag*/ 398 mark_char_table, print_char_table, 0,
400 mark_char_table, print_char_table, 0, 399 char_table_equal, char_table_hash,
401 char_table_equal, char_table_hash, 400 char_table_description,
402 char_table_description, 401 Lisp_Char_Table);
403 Lisp_Char_Table);
404 402
405 DEFUN ("char-table-p", Fchar_table_p, 1, 1, 0, /* 403 DEFUN ("char-table-p", Fchar_table_p, 1, 1, 0, /*
406 Return non-nil if OBJECT is a char table. 404 Return non-nil if OBJECT is a char table.
407 */ 405 */
408 (object)) 406 (object))
477 /* Don't get stymied when initting the table, or when trying to 475 /* Don't get stymied when initting the table, or when trying to
478 free a pdump object. */ 476 free a pdump object. */
479 if (!EQ (ct->level1[i], Qnull_pointer) && 477 if (!EQ (ct->level1[i], Qnull_pointer) &&
480 CHAR_TABLE_ENTRYP (ct->level1[i]) && 478 CHAR_TABLE_ENTRYP (ct->level1[i]) &&
481 !OBJECT_DUMPED_P (ct->level1[1])) 479 !OBJECT_DUMPED_P (ct->level1[1]))
482 FREE_LCRECORD (ct->level1[i]); 480 free_normal_lisp_object (ct->level1[i]);
483 ct->level1[i] = value; 481 ct->level1[i] = value;
484 } 482 }
485 #endif /* MULE */ 483 #endif /* MULE */
486 484
487 if (ct->type == CHAR_TABLE_TYPE_SYNTAX) 485 if (ct->type == CHAR_TABLE_TYPE_SYNTAX)
596 default result given by `get-char-table' is the syntax code for 594 default result given by `get-char-table' is the syntax code for
597 `inherit'. 595 `inherit'.
598 */ 596 */
599 (type)) 597 (type))
600 { 598 {
601 Lisp_Char_Table *ct; 599 Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (char_table);
602 Lisp_Object obj; 600 Lisp_Char_Table *ct = XCHAR_TABLE (obj);
603 enum char_table_type ty = symbol_to_char_table_type (type); 601 enum char_table_type ty = symbol_to_char_table_type (type);
604 602
605 ct = ALLOC_LCRECORD_TYPE (Lisp_Char_Table, &lrecord_char_table);
606 ct->type = ty; 603 ct->type = ty;
607 obj = wrap_char_table (ct);
608 if (ty == CHAR_TABLE_TYPE_SYNTAX) 604 if (ty == CHAR_TABLE_TYPE_SYNTAX)
609 { 605 {
610 /* Qgeneric not Qsyntax because a syntax table has a mirror table 606 /* Qgeneric not Qsyntax because a syntax table has a mirror table
611 and we don't want infinite recursion */ 607 and we don't want infinite recursion */
612 ct->mirror_table = Fmake_char_table (Qgeneric); 608 ct->mirror_table = Fmake_char_table (Qgeneric);
632 628
633 static Lisp_Object 629 static Lisp_Object
634 make_char_table_entry (Lisp_Object initval) 630 make_char_table_entry (Lisp_Object initval)
635 { 631 {
636 int i; 632 int i;
637 Lisp_Char_Table_Entry *cte = 633 Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (char_table_entry);
638 ALLOC_LCRECORD_TYPE (Lisp_Char_Table_Entry, &lrecord_char_table_entry); 634 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj);
639 635
640 for (i = 0; i < 96; i++) 636 for (i = 0; i < 96; i++)
641 cte->level2[i] = initval; 637 cte->level2[i] = initval;
642 638
643 return wrap_char_table_entry (cte); 639 return obj;
644 } 640 }
645 641
646 static Lisp_Object 642 static Lisp_Object
647 copy_char_table_entry (Lisp_Object entry) 643 copy_char_table_entry (Lisp_Object entry)
648 { 644 {
649 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (entry); 645 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (entry);
650 int i; 646 int i;
651 Lisp_Char_Table_Entry *ctenew = 647 Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (char_table_entry);
652 ALLOC_LCRECORD_TYPE (Lisp_Char_Table_Entry, &lrecord_char_table_entry); 648 Lisp_Char_Table_Entry *ctenew = XCHAR_TABLE_ENTRY (obj);
653 649
654 for (i = 0; i < 96; i++) 650 for (i = 0; i < 96; i++)
655 { 651 {
656 Lisp_Object new_ = cte->level2[i]; 652 Lisp_Object new_ = cte->level2[i];
657 if (CHAR_TABLE_ENTRYP (new_)) 653 if (CHAR_TABLE_ENTRYP (new_))
658 ctenew->level2[i] = copy_char_table_entry (new_); 654 ctenew->level2[i] = copy_char_table_entry (new_);
659 else 655 else
660 ctenew->level2[i] = new_; 656 ctenew->level2[i] = new_;
661 } 657 }
662 658
663 return wrap_char_table_entry (ctenew); 659 return obj;
664 } 660 }
665 661
666 #endif /* MULE */ 662 #endif /* MULE */
667 663
668 DEFUN ("copy-char-table", Fcopy_char_table, 1, 1, 0, /* 664 DEFUN ("copy-char-table", Fcopy_char_table, 1, 1, 0, /*
677 int i; 673 int i;
678 674
679 CHECK_CHAR_TABLE (char_table); 675 CHECK_CHAR_TABLE (char_table);
680 ct = XCHAR_TABLE (char_table); 676 ct = XCHAR_TABLE (char_table);
681 assert(!ct->mirror_table_p); 677 assert(!ct->mirror_table_p);
682 ctnew = ALLOC_LCRECORD_TYPE (Lisp_Char_Table, &lrecord_char_table); 678 obj = ALLOC_NORMAL_LISP_OBJECT (char_table);
679 ctnew = XCHAR_TABLE (obj);
683 ctnew->type = ct->type; 680 ctnew->type = ct->type;
684 ctnew->parent = ct->parent; 681 ctnew->parent = ct->parent;
685 ctnew->default_ = ct->default_; 682 ctnew->default_ = ct->default_;
686 ctnew->mirror_table_p = 0; 683 ctnew->mirror_table_p = 0;
687 obj = wrap_char_table (ctnew);
688 684
689 for (i = 0; i < NUM_ASCII_CHARS; i++) 685 for (i = 0; i < NUM_ASCII_CHARS; i++)
690 { 686 {
691 Lisp_Object new_ = ct->ascii[i]; 687 Lisp_Object new_ = ct->ascii[i];
692 #ifdef MULE 688 #ifdef MULE
1073 else 1069 else
1074 { 1070 {
1075 int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE; 1071 int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE;
1076 if (CHAR_TABLE_ENTRYP (ct->level1[lb]) && 1072 if (CHAR_TABLE_ENTRYP (ct->level1[lb]) &&
1077 !OBJECT_DUMPED_P (ct->level1[lb])) 1073 !OBJECT_DUMPED_P (ct->level1[lb]))
1078 FREE_LCRECORD (ct->level1[lb]); 1074 free_normal_lisp_object (ct->level1[lb]);
1079 ct->level1[lb] = val; 1075 ct->level1[lb] = val;
1080 } 1076 }
1081 break; 1077 break;
1082 1078
1083 case CHARTAB_RANGE_ROW: 1079 case CHARTAB_RANGE_ROW:
1830 1826
1831 1827
1832 void 1828 void
1833 syms_of_chartab (void) 1829 syms_of_chartab (void)
1834 { 1830 {
1835 INIT_LRECORD_IMPLEMENTATION (char_table); 1831 INIT_LISP_OBJECT (char_table);
1836 1832
1837 #ifdef MULE 1833 #ifdef MULE
1838 INIT_LRECORD_IMPLEMENTATION (char_table_entry); 1834 INIT_LISP_OBJECT (char_table_entry);
1839 1835
1840 DEFSYMBOL (Qcategory_table_p); 1836 DEFSYMBOL (Qcategory_table_p);
1841 DEFSYMBOL (Qcategory_designator_p); 1837 DEFSYMBOL (Qcategory_designator_p);
1842 DEFSYMBOL (Qcategory_table_value_p); 1838 DEFSYMBOL (Qcategory_table_value_p);
1843 #endif /* MULE */ 1839 #endif /* MULE */