Mercurial > hg > xemacs-beta

comparison src/chartab.c @ 272:c5d627a313b1 r21-0b34

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0b34
author cvs
date Mon, 13 Aug 2007 10:28:48 +0200
parents 677f6a0ee643
children 19dcec799385
comparison
equal deleted inserted replaced
271:c7b7086b0a39 272:c5d627a313b1
88 /* Char Table object */ 88 /* Char Table object */
89 /************************************************************************/ 89 /************************************************************************/
90 90
91 #ifdef MULE 91 #ifdef MULE
92 92
93 static Lisp_Object mark_char_table_entry (Lisp_Object, void (*) (Lisp_Object)); 93 static Lisp_Object
94 static int char_table_entry_equal (Lisp_Object, Lisp_Object, int depth); 94 mark_char_table_entry (Lisp_Object obj, void (*markobj) (Lisp_Object))
95 static unsigned long char_table_entry_hash (Lisp_Object obj, int depth); 95 {
96 struct Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj);
97 int i;
98
99 for (i = 0; i < 96; i++)
100 {
101 (markobj) (cte->level2[i]);
102 }
103 return Qnil;
104 }
105
106 static int
107 char_table_entry_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
108 {
109 struct Lisp_Char_Table_Entry *cte1 = XCHAR_TABLE_ENTRY (obj1);
110 struct Lisp_Char_Table_Entry *cte2 = XCHAR_TABLE_ENTRY (obj2);
111 int i;
112
113 for (i = 0; i < 96; i++)
114 if (!internal_equal (cte1->level2[i], cte2->level2[i], depth + 1))
115 return 0;
116
117 return 1;
118 }
119
120 static unsigned long
121 char_table_entry_hash (Lisp_Object obj, int depth)
122 {
123 struct Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj);
124
125 return internal_array_hash (cte->level2, 96, depth);
126 }
127
96 DEFINE_LRECORD_IMPLEMENTATION ("char-table-entry", char_table_entry, 128 DEFINE_LRECORD_IMPLEMENTATION ("char-table-entry", char_table_entry,
97 mark_char_table_entry, internal_object_printer, 129 mark_char_table_entry, internal_object_printer,
98 0, char_table_entry_equal, 130 0, char_table_entry_equal,
99 char_table_entry_hash, 131 char_table_entry_hash,
100 struct Lisp_Char_Table_Entry); 132 struct Lisp_Char_Table_Entry);
101 133 #endif /* MULE */
102 static Lisp_Object
103 mark_char_table_entry (Lisp_Object obj, void (*markobj) (Lisp_Object))
104 {
105 struct Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj);
106 int i;
107
108 for (i = 0; i < 96; i++)
109 {
110 (markobj) (cte->level2[i]);
111 }
112 return Qnil;
113 }
114
115 static int
116 char_table_entry_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
117 {
118 struct Lisp_Char_Table_Entry *cte1 = XCHAR_TABLE_ENTRY (obj1);
119 struct Lisp_Char_Table_Entry *cte2 = XCHAR_TABLE_ENTRY (obj2);
120 int i;
121
122 for (i = 0; i < 96; i++)
123 if (!internal_equal (cte1->level2[i], cte2->level2[i], depth + 1))
124 return 0;
125
126 return 1;
127 }
128
129 static unsigned long
130 char_table_entry_hash (Lisp_Object obj, int depth)
131 {
132 struct Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj);
133
134 return internal_array_hash (cte->level2, 96, depth);
135 }
136
137 #endif /* MULE */
138
139 static Lisp_Object mark_char_table (Lisp_Object, void (*) (Lisp_Object));
140 static void print_char_table (Lisp_Object, Lisp_Object, int);
141 static int char_table_equal (Lisp_Object, Lisp_Object, int depth);
142 static unsigned long char_table_hash (Lisp_Object obj, int depth);
143 DEFINE_LRECORD_IMPLEMENTATION ("char-table", char_table,
144 mark_char_table, print_char_table, 0,
145 char_table_equal, char_table_hash,
146 struct Lisp_Char_Table);
147 134
148 static Lisp_Object 135 static Lisp_Object
149 mark_char_table (Lisp_Object obj, void (*markobj) (Lisp_Object)) 136 mark_char_table (Lisp_Object obj, void (*markobj) (Lisp_Object))
150 { 137 {
151 struct Lisp_Char_Table *ct = XCHAR_TABLE (obj); 138 struct Lisp_Char_Table *ct = XCHAR_TABLE (obj);
429 internal_array_hash (ct->level1, NUM_LEADING_BYTES, depth)); 416 internal_array_hash (ct->level1, NUM_LEADING_BYTES, depth));
430 #endif /* MULE */ 417 #endif /* MULE */
431 return hashval; 418 return hashval;
432 } 419 }
433 420
421 DEFINE_LRECORD_IMPLEMENTATION ("char-table", char_table,
422 mark_char_table, print_char_table, 0,
423 char_table_equal, char_table_hash,
424 struct Lisp_Char_Table);
425
434 DEFUN ("char-table-p", Fchar_table_p, 1, 1, 0, /* 426 DEFUN ("char-table-p", Fchar_table_p, 1, 1, 0, /*
435 Return non-nil if OBJECT is a char table. 427 Return non-nil if OBJECT is a char table.
436 428
437 A char table is a table that maps characters (or ranges of characters) 429 A char table is a table that maps characters (or ranges of characters)
438 to values. Char tables are specialized for characters, only allowing 430 to values. Char tables are specialized for characters, only allowing
578 570
579 return Qnil; 571 return Qnil;
580 } 572 }
581 573
582 DEFUN ("make-char-table", Fmake_char_table, 1, 1, 0, /* 574 DEFUN ("make-char-table", Fmake_char_table, 1, 1, 0, /*
583 Make a new, empty char table of type TYPE. 575 Return a new, empty char table of type TYPE.
584 Currently recognized types are 'char, 'category, 'display, 'generic, 576 Currently recognized types are 'char, 'category, 'display, 'generic,
585 and 'syntax. See `valid-char-table-type-p'. 577 and 'syntax. See `valid-char-table-type-p'.
586 */ 578 */
587 (type)) 579 (type))
588 { 580 {
589 struct Lisp_Char_Table *ct; 581 struct Lisp_Char_Table *ct;
590 Lisp_Object obj = Qnil; 582 Lisp_Object obj;
591 enum char_table_type ty = symbol_to_char_table_type (type); 583 enum char_table_type ty = symbol_to_char_table_type (type);
592 584
593 ct = alloc_lcrecord_type (struct Lisp_Char_Table, lrecord_char_table); 585 ct = alloc_lcrecord_type (struct Lisp_Char_Table, lrecord_char_table);
594 ct->type = ty; 586 ct->type = ty;
595 if (ty == CHAR_TABLE_TYPE_SYNTAX) 587 if (ty == CHAR_TABLE_TYPE_SYNTAX)
596 { 588 {
597 ct->mirror_table = Fmake_char_table (Qgeneric); 589 ct->mirror_table = Fmake_char_table (Qgeneric);
598 fill_char_table (XCHAR_TABLE (ct->mirror_table), 590 fill_char_table (XCHAR_TABLE (ct->mirror_table),
599 make_int (Spunct)); 591 make_int (Spunct));
600 } 592 }
601 else 593 else
602 ct->mirror_table = Qnil; 594 ct->mirror_table = Qnil;
603 ct->next_table = Qnil; 595 ct->next_table = Qnil;
604 XSETCHAR_TABLE (obj, ct); 596 XSETCHAR_TABLE (obj, ct);
614 #ifdef MULE 606 #ifdef MULE
615 607
616 static Lisp_Object 608 static Lisp_Object
617 make_char_table_entry (Lisp_Object initval) 609 make_char_table_entry (Lisp_Object initval)
618 { 610 {
619 struct Lisp_Char_Table_Entry *cte; 611 Lisp_Object obj;
620 Lisp_Object obj = Qnil;
621 int i; 612 int i;
622 613 struct Lisp_Char_Table_Entry *cte =
623 cte = alloc_lcrecord_type (struct Lisp_Char_Table_Entry, 614 alloc_lcrecord_type (struct Lisp_Char_Table_Entry,
624 lrecord_char_table_entry); 615 lrecord_char_table_entry);
616
625 for (i = 0; i < 96; i++) 617 for (i = 0; i < 96; i++)
626 cte->level2[i] = initval; 618 cte->level2[i] = initval;
619
627 XSETCHAR_TABLE_ENTRY (obj, cte); 620 XSETCHAR_TABLE_ENTRY (obj, cte);
628 return obj; 621 return obj;
629 } 622 }
630 623
631 static Lisp_Object 624 static Lisp_Object
632 copy_char_table_entry (Lisp_Object entry) 625 copy_char_table_entry (Lisp_Object entry)
633 { 626 {
634 struct Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (entry); 627 struct Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (entry);
635 Lisp_Object obj = Qnil; 628 Lisp_Object obj;
636 int i; 629 int i;
637 struct Lisp_Char_Table_Entry *ctenew = 630 struct Lisp_Char_Table_Entry *ctenew =
638 alloc_lcrecord_type (struct Lisp_Char_Table_Entry, 631 alloc_lcrecord_type (struct Lisp_Char_Table_Entry,
639 lrecord_char_table_entry); 632 lrecord_char_table_entry);
640 633
659 as OLD-TABLE. The values will not themselves be copied. 652 as OLD-TABLE. The values will not themselves be copied.
660 */ 653 */
661 (old_table)) 654 (old_table))
662 { 655 {
663 struct Lisp_Char_Table *ct, *ctnew; 656 struct Lisp_Char_Table *ct, *ctnew;
664 Lisp_Object obj = Qnil; 657 Lisp_Object obj;
665 int i; 658 int i;
666 659
667 CHECK_CHAR_TABLE (old_table); 660 CHECK_CHAR_TABLE (old_table);
668 ct = XCHAR_TABLE (old_table); 661 ct = XCHAR_TABLE (old_table);
669 ctnew = alloc_lcrecord_type (struct Lisp_Char_Table, lrecord_char_table); 662 ctnew = alloc_lcrecord_type (struct Lisp_Char_Table, lrecord_char_table);
1600 if (NILP (Fcategory_table_p (table))) 1593 if (NILP (Fcategory_table_p (table)))
1601 signal_simple_error ("Expected category table", table); 1594 signal_simple_error ("Expected category table", table);
1602 #endif 1595 #endif
1603 ctbl = XCHAR_TABLE (table); 1596 ctbl = XCHAR_TABLE (table);
1604 temp = get_char_table (ch, ctbl); 1597 temp = get_char_table (ch, ctbl);
1605 if (EQ (temp, Qnil)) return not; 1598 if (NILP (temp))
1599 return not;
1606 1600
1607 designator -= ' '; 1601 designator -= ' ';
1608 return bit_vector_bit (XBIT_VECTOR (temp), designator) ? !not : not; 1602 return bit_vector_bit (XBIT_VECTOR (temp), designator) ? !not : not;
1609 } 1603 }
1610 1604
1611 DEFUN ("check-category-at", Fcheck_category_at, 2, 4, 0, /* 1605 DEFUN ("check-category-at", Fcheck_category_at, 2, 4, 0, /*
1612 Return t if category of a character at POS includes DESIGNATOR, 1606 Return t if category of a character at POS includes DESIGNATOR,
1613 else return nil. Optional third arg specifies which buffer 1607 else return nil. Optional third arg specifies which buffer
1614 (defaulting to current), and fourth specifies the CATEGORY-TABLE, 1608 \(defaulting to current), and fourth specifies the CATEGORY-TABLE,
1615 (defaulting to the buffer's category table). 1609 \(defaulting to the buffer's category table).
1616 */ 1610 */
1617 (pos, designator, buffer, category_table)) 1611 (pos, designator, buffer, category_table))
1618 { 1612 {
1619 Lisp_Object ctbl; 1613 Lisp_Object ctbl;
1620 Emchar ch; 1614 Emchar ch;