comparison src/chartab.c @ 412:697ef44129c6 r21-2-14

Import from CVS: tag r21-2-14
author cvs
date Mon, 13 Aug 2007 11:20:41 +0200
parents a86b2b5e0111
children da8ed4261e83
comparison
equal deleted inserted replaced
411:12e008d41344 412:697ef44129c6
1 /* XEmacs routines to deal with char tables. 1 /* XEmacs routines to deal with char tables.
2 Copyright (C) 1992, 1995 Free Software Foundation, Inc. 2 Copyright (C) 1992, 1995 Free Software Foundation, Inc.
3 Copyright (C) 1995 Sun Microsystems, Inc. 3 Copyright (C) 1995 Sun Microsystems, Inc.
4 Copyright (C) 1995, 1996 Ben Wing. 4 Copyright (C) 1995, 1996 Ben Wing.
5 Copyright (C) 1995, 1997, 1999 Electrotechnical Laboratory, JAPAN.
6 Licensed to the Free Software Foundation.
7 5
8 This file is part of XEmacs. 6 This file is part of XEmacs.
9 7
10 XEmacs is free software; you can redistribute it and/or modify it 8 XEmacs is free software; you can redistribute it and/or modify it
11 under the terms of the GNU General Public License as published by the 9 under the terms of the GNU General Public License as published by the
50 Lisp_Object Qcategory_table_p; 48 Lisp_Object Qcategory_table_p;
51 Lisp_Object Qcategory_designator_p; 49 Lisp_Object Qcategory_designator_p;
52 Lisp_Object Qcategory_table_value_p; 50 Lisp_Object Qcategory_table_value_p;
53 51
54 Lisp_Object Vstandard_category_table; 52 Lisp_Object Vstandard_category_table;
55
56 /* Variables to determine word boundary. */
57 Lisp_Object Vword_combining_categories, Vword_separating_categories;
58 #endif /* MULE */ 53 #endif /* MULE */
59 54
60 55
61 /* A char table maps from ranges of characters to values. 56 /* A char table maps from ranges of characters to values.
62 57
93 /************************************************************************/ 88 /************************************************************************/
94 89
95 #ifdef MULE 90 #ifdef MULE
96 91
97 static Lisp_Object 92 static Lisp_Object
98 mark_char_table_entry (Lisp_Object obj) 93 mark_char_table_entry (Lisp_Object obj, void (*markobj) (Lisp_Object))
99 { 94 {
100 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj); 95 struct Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj);
101 int i; 96 int i;
102 97
103 for (i = 0; i < 96; i++) 98 for (i = 0; i < 96; i++)
104 { 99 {
105 mark_object (cte->level2[i]); 100 markobj (cte->level2[i]);
106 } 101 }
107 return Qnil; 102 return Qnil;
108 } 103 }
109 104
110 static int 105 static int
111 char_table_entry_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) 106 char_table_entry_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
112 { 107 {
113 Lisp_Char_Table_Entry *cte1 = XCHAR_TABLE_ENTRY (obj1); 108 struct Lisp_Char_Table_Entry *cte1 = XCHAR_TABLE_ENTRY (obj1);
114 Lisp_Char_Table_Entry *cte2 = XCHAR_TABLE_ENTRY (obj2); 109 struct Lisp_Char_Table_Entry *cte2 = XCHAR_TABLE_ENTRY (obj2);
115 int i; 110 int i;
116 111
117 for (i = 0; i < 96; i++) 112 for (i = 0; i < 96; i++)
118 if (!internal_equal (cte1->level2[i], cte2->level2[i], depth + 1)) 113 if (!internal_equal (cte1->level2[i], cte2->level2[i], depth + 1))
119 return 0; 114 return 0;
122 } 117 }
123 118
124 static unsigned long 119 static unsigned long
125 char_table_entry_hash (Lisp_Object obj, int depth) 120 char_table_entry_hash (Lisp_Object obj, int depth)
126 { 121 {
127 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj); 122 struct Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj);
128 123
129 return internal_array_hash (cte->level2, 96, depth); 124 return internal_array_hash (cte->level2, 96, depth);
130 } 125 }
131
132 static const struct lrecord_description char_table_entry_description[] = {
133 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table_Entry, level2), 96 },
134 { XD_END }
135 };
136 126
137 DEFINE_LRECORD_IMPLEMENTATION ("char-table-entry", char_table_entry, 127 DEFINE_LRECORD_IMPLEMENTATION ("char-table-entry", char_table_entry,
138 mark_char_table_entry, internal_object_printer, 128 mark_char_table_entry, internal_object_printer,
139 0, char_table_entry_equal, 129 0, char_table_entry_equal,
140 char_table_entry_hash, 130 char_table_entry_hash,
141 char_table_entry_description, 131 struct Lisp_Char_Table_Entry);
142 Lisp_Char_Table_Entry);
143 #endif /* MULE */ 132 #endif /* MULE */
144 133
145 static Lisp_Object 134 static Lisp_Object
146 mark_char_table (Lisp_Object obj) 135 mark_char_table (Lisp_Object obj, void (*markobj) (Lisp_Object))
147 { 136 {
148 Lisp_Char_Table *ct = XCHAR_TABLE (obj); 137 struct Lisp_Char_Table *ct = XCHAR_TABLE (obj);
149 int i; 138 int i;
150 139
151 for (i = 0; i < NUM_ASCII_CHARS; i++) 140 for (i = 0; i < NUM_ASCII_CHARS; i++)
152 mark_object (ct->ascii[i]); 141 markobj (ct->ascii[i]);
153 #ifdef MULE 142 #ifdef MULE
154 for (i = 0; i < NUM_LEADING_BYTES; i++) 143 for (i = 0; i < NUM_LEADING_BYTES; i++)
155 mark_object (ct->level1[i]); 144 markobj (ct->level1[i]);
156 #endif 145 #endif
157 return ct->mirror_table; 146 return ct->mirror_table;
158 } 147 }
159 148
160 /* WARNING: All functions of this nature need to be written extremely 149 /* WARNING: All functions of this nature need to be written extremely
161 carefully to avoid crashes during GC. Cf. prune_specifiers() 150 carefully to avoid crashes during GC. Cf. prune_specifiers()
162 and prune_weak_hash_tables(). */ 151 and prune_weak_hash_tables(). */
163 152
164 void 153 void
165 prune_syntax_tables (void) 154 prune_syntax_tables (int (*obj_marked_p) (Lisp_Object))
166 { 155 {
167 Lisp_Object rest, prev = Qnil; 156 Lisp_Object rest, prev = Qnil;
168 157
169 for (rest = Vall_syntax_tables; 158 for (rest = Vall_syntax_tables;
170 !NILP (rest); 159 !GC_NILP (rest);
171 rest = XCHAR_TABLE (rest)->next_table) 160 rest = XCHAR_TABLE (rest)->next_table)
172 { 161 {
173 if (! marked_p (rest)) 162 if (! obj_marked_p (rest))
174 { 163 {
175 /* This table is garbage. Remove it from the list. */ 164 /* This table is garbage. Remove it from the list. */
176 if (NILP (prev)) 165 if (GC_NILP (prev))
177 Vall_syntax_tables = XCHAR_TABLE (rest)->next_table; 166 Vall_syntax_tables = XCHAR_TABLE (rest)->next_table;
178 else 167 else
179 XCHAR_TABLE (prev)->next_table = 168 XCHAR_TABLE (prev)->next_table =
180 XCHAR_TABLE (rest)->next_table; 169 XCHAR_TABLE (rest)->next_table;
181 } 170 }
239 #ifdef MULE 228 #ifdef MULE
240 229
241 static void 230 static void
242 print_chartab_charset_row (Lisp_Object charset, 231 print_chartab_charset_row (Lisp_Object charset,
243 int row, 232 int row,
244 Lisp_Char_Table_Entry *cte, 233 struct Lisp_Char_Table_Entry *cte,
245 Lisp_Object printcharfun) 234 Lisp_Object printcharfun)
246 { 235 {
247 int i; 236 int i;
248 Lisp_Object cat = Qunbound; 237 Lisp_Object cat = Qunbound;
249 int first = -1; 238 int first = -1;
287 } 276 }
288 } 277 }
289 278
290 static void 279 static void
291 print_chartab_two_byte_charset (Lisp_Object charset, 280 print_chartab_two_byte_charset (Lisp_Object charset,
292 Lisp_Char_Table_Entry *cte, 281 struct Lisp_Char_Table_Entry *cte,
293 Lisp_Object printcharfun) 282 Lisp_Object printcharfun)
294 { 283 {
295 int i; 284 int i;
296 285
297 for (i = 32; i < 128; i++) 286 for (i = 32; i < 128; i++)
317 #endif /* MULE */ 306 #endif /* MULE */
318 307
319 static void 308 static void
320 print_char_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) 309 print_char_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
321 { 310 {
322 Lisp_Char_Table *ct = XCHAR_TABLE (obj); 311 struct Lisp_Char_Table *ct = XCHAR_TABLE (obj);
323 char buf[200]; 312 char buf[200];
324 313
325 sprintf (buf, "#s(char-table type %s data (", 314 sprintf (buf, "#s(char-table type %s data (",
326 string_data (symbol_name (XSYMBOL 315 string_data (symbol_name (XSYMBOL
327 (char_table_type_to_symbol (ct->type))))); 316 (char_table_type_to_symbol (ct->type)))));
375 write_c_string (" ", printcharfun); 364 write_c_string (" ", printcharfun);
376 print_internal (ann, printcharfun, 0); 365 print_internal (ann, printcharfun, 0);
377 } 366 }
378 else 367 else
379 { 368 {
380 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (ann); 369 struct Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (ann);
381 if (XCHARSET_DIMENSION (charset) == 1) 370 if (XCHARSET_DIMENSION (charset) == 1)
382 print_chartab_charset_row (charset, -1, cte, printcharfun); 371 print_chartab_charset_row (charset, -1, cte, printcharfun);
383 else 372 else
384 print_chartab_two_byte_charset (charset, cte, printcharfun); 373 print_chartab_two_byte_charset (charset, cte, printcharfun);
385 } 374 }
391 } 380 }
392 381
393 static int 382 static int
394 char_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) 383 char_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
395 { 384 {
396 Lisp_Char_Table *ct1 = XCHAR_TABLE (obj1); 385 struct Lisp_Char_Table *ct1 = XCHAR_TABLE (obj1);
397 Lisp_Char_Table *ct2 = XCHAR_TABLE (obj2); 386 struct Lisp_Char_Table *ct2 = XCHAR_TABLE (obj2);
398 int i; 387 int i;
399 388
400 if (CHAR_TABLE_TYPE (ct1) != CHAR_TABLE_TYPE (ct2)) 389 if (CHAR_TABLE_TYPE (ct1) != CHAR_TABLE_TYPE (ct2))
401 return 0; 390 return 0;
402 391
414 } 403 }
415 404
416 static unsigned long 405 static unsigned long
417 char_table_hash (Lisp_Object obj, int depth) 406 char_table_hash (Lisp_Object obj, int depth)
418 { 407 {
419 Lisp_Char_Table *ct = XCHAR_TABLE (obj); 408 struct Lisp_Char_Table *ct = XCHAR_TABLE (obj);
420 unsigned long hashval = internal_array_hash (ct->ascii, NUM_ASCII_CHARS, 409 unsigned long hashval = internal_array_hash (ct->ascii, NUM_ASCII_CHARS,
421 depth); 410 depth);
422 #ifdef MULE 411 #ifdef MULE
423 hashval = HASH2 (hashval, 412 hashval = HASH2 (hashval,
424 internal_array_hash (ct->level1, NUM_LEADING_BYTES, depth)); 413 internal_array_hash (ct->level1, NUM_LEADING_BYTES, depth));
425 #endif /* MULE */ 414 #endif /* MULE */
426 return hashval; 415 return hashval;
427 } 416 }
428
429 static const struct lrecord_description char_table_description[] = {
430 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, ascii), NUM_ASCII_CHARS },
431 #ifdef MULE
432 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, level1), NUM_LEADING_BYTES },
433 #endif
434 { XD_LISP_OBJECT, offsetof (Lisp_Char_Table, mirror_table) },
435 { XD_LO_LINK, offsetof (Lisp_Char_Table, next_table) },
436 { XD_END }
437 };
438 417
439 DEFINE_LRECORD_IMPLEMENTATION ("char-table", char_table, 418 DEFINE_LRECORD_IMPLEMENTATION ("char-table", char_table,
440 mark_char_table, print_char_table, 0, 419 mark_char_table, print_char_table, 0,
441 char_table_equal, char_table_hash, 420 char_table_equal, char_table_hash,
442 char_table_description, 421 struct Lisp_Char_Table);
443 Lisp_Char_Table);
444 422
445 DEFUN ("char-table-p", Fchar_table_p, 1, 1, 0, /* 423 DEFUN ("char-table-p", Fchar_table_p, 1, 1, 0, /*
446 Return non-nil if OBJECT is a char table. 424 Return non-nil if OBJECT is a char table.
447 425
448 A char table is a table that maps characters (or ranges of characters) 426 A char table is a table that maps characters (or ranges of characters)
541 CHECK_CHAR_TABLE (table); 519 CHECK_CHAR_TABLE (table);
542 return char_table_type_to_symbol (XCHAR_TABLE (table)->type); 520 return char_table_type_to_symbol (XCHAR_TABLE (table)->type);
543 } 521 }
544 522
545 void 523 void
546 fill_char_table (Lisp_Char_Table *ct, Lisp_Object value) 524 fill_char_table (struct Lisp_Char_Table *ct, Lisp_Object value)
547 { 525 {
548 int i; 526 int i;
549 527
550 for (i = 0; i < NUM_ASCII_CHARS; i++) 528 for (i = 0; i < NUM_ASCII_CHARS; i++)
551 ct->ascii[i] = value; 529 ct->ascii[i] = value;
561 DEFUN ("reset-char-table", Freset_char_table, 1, 1, 0, /* 539 DEFUN ("reset-char-table", Freset_char_table, 1, 1, 0, /*
562 Reset a char table to its default state. 540 Reset a char table to its default state.
563 */ 541 */
564 (table)) 542 (table))
565 { 543 {
566 Lisp_Char_Table *ct; 544 struct Lisp_Char_Table *ct;
567 545
568 CHECK_CHAR_TABLE (table); 546 CHECK_CHAR_TABLE (table);
569 ct = XCHAR_TABLE (table); 547 ct = XCHAR_TABLE (table);
570 548
571 switch (ct->type) 549 switch (ct->type)
597 Currently recognized types are 'char, 'category, 'display, 'generic, 575 Currently recognized types are 'char, 'category, 'display, 'generic,
598 and 'syntax. See `valid-char-table-type-p'. 576 and 'syntax. See `valid-char-table-type-p'.
599 */ 577 */
600 (type)) 578 (type))
601 { 579 {
602 Lisp_Char_Table *ct; 580 struct Lisp_Char_Table *ct;
603 Lisp_Object obj; 581 Lisp_Object obj;
604 enum char_table_type ty = symbol_to_char_table_type (type); 582 enum char_table_type ty = symbol_to_char_table_type (type);
605 583
606 ct = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table); 584 ct = alloc_lcrecord_type (struct Lisp_Char_Table, &lrecord_char_table);
607 ct->type = ty; 585 ct->type = ty;
608 if (ty == CHAR_TABLE_TYPE_SYNTAX) 586 if (ty == CHAR_TABLE_TYPE_SYNTAX)
609 { 587 {
610 ct->mirror_table = Fmake_char_table (Qgeneric); 588 ct->mirror_table = Fmake_char_table (Qgeneric);
611 fill_char_table (XCHAR_TABLE (ct->mirror_table), 589 fill_char_table (XCHAR_TABLE (ct->mirror_table),
629 static Lisp_Object 607 static Lisp_Object
630 make_char_table_entry (Lisp_Object initval) 608 make_char_table_entry (Lisp_Object initval)
631 { 609 {
632 Lisp_Object obj; 610 Lisp_Object obj;
633 int i; 611 int i;
634 Lisp_Char_Table_Entry *cte = 612 struct Lisp_Char_Table_Entry *cte =
635 alloc_lcrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry); 613 alloc_lcrecord_type (struct Lisp_Char_Table_Entry,
614 &lrecord_char_table_entry);
636 615
637 for (i = 0; i < 96; i++) 616 for (i = 0; i < 96; i++)
638 cte->level2[i] = initval; 617 cte->level2[i] = initval;
639 618
640 XSETCHAR_TABLE_ENTRY (obj, cte); 619 XSETCHAR_TABLE_ENTRY (obj, cte);
642 } 621 }
643 622
644 static Lisp_Object 623 static Lisp_Object
645 copy_char_table_entry (Lisp_Object entry) 624 copy_char_table_entry (Lisp_Object entry)
646 { 625 {
647 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (entry); 626 struct Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (entry);
648 Lisp_Object obj; 627 Lisp_Object obj;
649 int i; 628 int i;
650 Lisp_Char_Table_Entry *ctenew = 629 struct Lisp_Char_Table_Entry *ctenew =
651 alloc_lcrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry); 630 alloc_lcrecord_type (struct Lisp_Char_Table_Entry,
631 &lrecord_char_table_entry);
652 632
653 for (i = 0; i < 96; i++) 633 for (i = 0; i < 96; i++)
654 { 634 {
655 Lisp_Object new = cte->level2[i]; 635 Lisp_Object new = cte->level2[i];
656 if (CHAR_TABLE_ENTRYP (new)) 636 if (CHAR_TABLE_ENTRYP (new))
670 It will contain the same values for the same characters and ranges 650 It will contain the same values for the same characters and ranges
671 as OLD-TABLE. The values will not themselves be copied. 651 as OLD-TABLE. The values will not themselves be copied.
672 */ 652 */
673 (old_table)) 653 (old_table))
674 { 654 {
675 Lisp_Char_Table *ct, *ctnew; 655 struct Lisp_Char_Table *ct, *ctnew;
676 Lisp_Object obj; 656 Lisp_Object obj;
677 int i; 657 int i;
678 658
679 CHECK_CHAR_TABLE (old_table); 659 CHECK_CHAR_TABLE (old_table);
680 ct = XCHAR_TABLE (old_table); 660 ct = XCHAR_TABLE (old_table);
681 ctnew = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table); 661 ctnew = alloc_lcrecord_type (struct Lisp_Char_Table, &lrecord_char_table);
682 ctnew->type = ct->type; 662 ctnew->type = ct->type;
683 663
684 for (i = 0; i < NUM_ASCII_CHARS; i++) 664 for (i = 0; i < NUM_ASCII_CHARS; i++)
685 { 665 {
686 Lisp_Object new = ct->ascii[i]; 666 Lisp_Object new = ct->ascii[i];
705 685
706 if (CHAR_TABLEP (ct->mirror_table)) 686 if (CHAR_TABLEP (ct->mirror_table))
707 ctnew->mirror_table = Fcopy_char_table (ct->mirror_table); 687 ctnew->mirror_table = Fcopy_char_table (ct->mirror_table);
708 else 688 else
709 ctnew->mirror_table = ct->mirror_table; 689 ctnew->mirror_table = ct->mirror_table;
710 ctnew->next_table = Qnil;
711 XSETCHAR_TABLE (obj, ctnew); 690 XSETCHAR_TABLE (obj, ctnew);
712 if (ctnew->type == CHAR_TABLE_TYPE_SYNTAX)
713 {
714 ctnew->next_table = Vall_syntax_tables;
715 Vall_syntax_tables = obj;
716 }
717 return obj; 691 return obj;
718 } 692 }
719 693
720 static void 694 static void
721 decode_char_table_range (Lisp_Object range, struct chartab_range *outrange) 695 decode_char_table_range (Lisp_Object range, struct chartab_range *outrange)
731 else 705 else
732 signal_simple_error ("Range must be t or a character", range); 706 signal_simple_error ("Range must be t or a character", range);
733 #else /* MULE */ 707 #else /* MULE */
734 else if (VECTORP (range)) 708 else if (VECTORP (range))
735 { 709 {
736 Lisp_Vector *vec = XVECTOR (range); 710 struct Lisp_Vector *vec = XVECTOR (range);
737 Lisp_Object *elts = vector_data (vec); 711 Lisp_Object *elts = vector_data (vec);
738 if (vector_length (vec) != 2) 712 if (vector_length (vec) != 2)
739 signal_simple_error ("Length of charset row vector must be 2", 713 signal_simple_error ("Length of charset row vector must be 2",
740 range); 714 range);
741 outrange->type = CHARTAB_RANGE_ROW; 715 outrange->type = CHARTAB_RANGE_ROW;
771 745
772 #ifdef MULE 746 #ifdef MULE
773 747
774 /* called from CHAR_TABLE_VALUE(). */ 748 /* called from CHAR_TABLE_VALUE(). */
775 Lisp_Object 749 Lisp_Object
776 get_non_ascii_char_table_value (Lisp_Char_Table *ct, int leading_byte, 750 get_non_ascii_char_table_value (struct Lisp_Char_Table *ct, int leading_byte,
777 Emchar c) 751 Emchar c)
778 { 752 {
779 Lisp_Object val; 753 Lisp_Object val;
780 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (leading_byte); 754 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (leading_byte);
781 int byte1, byte2; 755 int byte1, byte2;
782 756
783 BREAKUP_CHAR_1_UNSAFE (c, charset, byte1, byte2); 757 BREAKUP_CHAR_1_UNSAFE (c, charset, byte1, byte2);
784 val = ct->level1[leading_byte - MIN_LEADING_BYTE]; 758 val = ct->level1[leading_byte - MIN_LEADING_BYTE];
785 if (CHAR_TABLE_ENTRYP (val)) 759 if (CHAR_TABLE_ENTRYP (val))
786 { 760 {
787 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val); 761 struct Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
788 val = cte->level2[byte1 - 32]; 762 val = cte->level2[byte1 - 32];
789 if (CHAR_TABLE_ENTRYP (val)) 763 if (CHAR_TABLE_ENTRYP (val))
790 { 764 {
791 cte = XCHAR_TABLE_ENTRY (val); 765 cte = XCHAR_TABLE_ENTRY (val);
792 assert (byte2 >= 32); 766 assert (byte2 >= 32);
799 } 773 }
800 774
801 #endif /* MULE */ 775 #endif /* MULE */
802 776
803 Lisp_Object 777 Lisp_Object
804 get_char_table (Emchar ch, Lisp_Char_Table *ct) 778 get_char_table (Emchar ch, struct Lisp_Char_Table *ct)
805 { 779 {
806 #ifdef MULE 780 #ifdef MULE
807 { 781 {
808 Lisp_Object charset; 782 Lisp_Object charset;
809 int byte1, byte2; 783 int byte1, byte2;
819 { 793 {
820 int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE; 794 int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE;
821 val = ct->level1[lb]; 795 val = ct->level1[lb];
822 if (CHAR_TABLE_ENTRYP (val)) 796 if (CHAR_TABLE_ENTRYP (val))
823 { 797 {
824 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val); 798 struct Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
825 val = cte->level2[byte1 - 32]; 799 val = cte->level2[byte1 - 32];
826 if (CHAR_TABLE_ENTRYP (val)) 800 if (CHAR_TABLE_ENTRYP (val))
827 { 801 {
828 cte = XCHAR_TABLE_ENTRY (val); 802 cte = XCHAR_TABLE_ENTRY (val);
829 assert (byte2 >= 32); 803 assert (byte2 >= 32);
844 DEFUN ("get-char-table", Fget_char_table, 2, 2, 0, /* 818 DEFUN ("get-char-table", Fget_char_table, 2, 2, 0, /*
845 Find value for char CH in TABLE. 819 Find value for char CH in TABLE.
846 */ 820 */
847 (ch, table)) 821 (ch, table))
848 { 822 {
849 Lisp_Char_Table *ct; 823 struct Lisp_Char_Table *ct;
850 824
851 CHECK_CHAR_TABLE (table); 825 CHECK_CHAR_TABLE (table);
852 ct = XCHAR_TABLE (table); 826 ct = XCHAR_TABLE (table);
853 CHECK_CHAR_COERCE_INT (ch); 827 CHECK_CHAR_COERCE_INT (ch);
854 828
859 Find value for a range in TABLE. 833 Find value for a range in TABLE.
860 If there is more than one value, return MULTI (defaults to nil). 834 If there is more than one value, return MULTI (defaults to nil).
861 */ 835 */
862 (range, table, multi)) 836 (range, table, multi))
863 { 837 {
864 Lisp_Char_Table *ct; 838 struct Lisp_Char_Table *ct;
865 struct chartab_range rainj; 839 struct chartab_range rainj;
866 840
867 if (CHAR_OR_CHAR_INTP (range)) 841 if (CHAR_OR_CHAR_INTP (range))
868 return Fget_char_table (range, table); 842 return Fget_char_table (range, table);
869 CHECK_CHAR_TABLE (table); 843 CHECK_CHAR_TABLE (table);
1044 } 1018 }
1045 1019
1046 /* Assign VAL to all characters in RANGE in char table CT. */ 1020 /* Assign VAL to all characters in RANGE in char table CT. */
1047 1021
1048 void 1022 void
1049 put_char_table (Lisp_Char_Table *ct, struct chartab_range *range, 1023 put_char_table (struct Lisp_Char_Table *ct, struct chartab_range *range,
1050 Lisp_Object val) 1024 Lisp_Object val)
1051 { 1025 {
1052 switch (range->type) 1026 switch (range->type)
1053 { 1027 {
1054 case CHARTAB_RANGE_ALL: 1028 case CHARTAB_RANGE_ALL:
1077 } 1051 }
1078 break; 1052 break;
1079 1053
1080 case CHARTAB_RANGE_ROW: 1054 case CHARTAB_RANGE_ROW:
1081 { 1055 {
1082 Lisp_Char_Table_Entry *cte; 1056 struct Lisp_Char_Table_Entry *cte;
1083 int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE; 1057 int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE;
1084 /* make sure that there is a separate entry for the row. */ 1058 /* make sure that there is a separate entry for the row. */
1085 if (!CHAR_TABLE_ENTRYP (ct->level1[lb])) 1059 if (!CHAR_TABLE_ENTRYP (ct->level1[lb]))
1086 ct->level1[lb] = make_char_table_entry (ct->level1[lb]); 1060 ct->level1[lb] = make_char_table_entry (ct->level1[lb]);
1087 cte = XCHAR_TABLE_ENTRY (ct->level1[lb]); 1061 cte = XCHAR_TABLE_ENTRY (ct->level1[lb]);
1101 ct->ascii[byte1] = val; 1075 ct->ascii[byte1] = val;
1102 else if (EQ (charset, Vcharset_control_1)) 1076 else if (EQ (charset, Vcharset_control_1))
1103 ct->ascii[byte1 + 128] = val; 1077 ct->ascii[byte1 + 128] = val;
1104 else 1078 else
1105 { 1079 {
1106 Lisp_Char_Table_Entry *cte; 1080 struct Lisp_Char_Table_Entry *cte;
1107 int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE; 1081 int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE;
1108 /* make sure that there is a separate entry for the row. */ 1082 /* make sure that there is a separate entry for the row. */
1109 if (!CHAR_TABLE_ENTRYP (ct->level1[lb])) 1083 if (!CHAR_TABLE_ENTRYP (ct->level1[lb]))
1110 ct->level1[lb] = make_char_table_entry (ct->level1[lb]); 1084 ct->level1[lb] = make_char_table_entry (ct->level1[lb]);
1111 cte = XCHAR_TABLE_ENTRY (ct->level1[lb]); 1085 cte = XCHAR_TABLE_ENTRY (ct->level1[lb]);
1152 VAL must be a value appropriate for the type of TABLE. 1126 VAL must be a value appropriate for the type of TABLE.
1153 See `valid-char-table-type-p'. 1127 See `valid-char-table-type-p'.
1154 */ 1128 */
1155 (range, val, table)) 1129 (range, val, table))
1156 { 1130 {
1157 Lisp_Char_Table *ct; 1131 struct Lisp_Char_Table *ct;
1158 struct chartab_range rainj; 1132 struct chartab_range rainj;
1159 1133
1160 CHECK_CHAR_TABLE (table); 1134 CHECK_CHAR_TABLE (table);
1161 ct = XCHAR_TABLE (table); 1135 ct = XCHAR_TABLE (table);
1162 check_valid_char_table_value (val, ct->type, ERROR_ME); 1136 check_valid_char_table_value (val, ct->type, ERROR_ME);
1167 } 1141 }
1168 1142
1169 /* Map FN over the ASCII chars in CT. */ 1143 /* Map FN over the ASCII chars in CT. */
1170 1144
1171 static int 1145 static int
1172 map_over_charset_ascii (Lisp_Char_Table *ct, 1146 map_over_charset_ascii (struct Lisp_Char_Table *ct,
1173 int (*fn) (struct chartab_range *range, 1147 int (*fn) (struct chartab_range *range,
1174 Lisp_Object val, void *arg), 1148 Lisp_Object val, void *arg),
1175 void *arg) 1149 void *arg)
1176 { 1150 {
1177 struct chartab_range rainj; 1151 struct chartab_range rainj;
1197 #ifdef MULE 1171 #ifdef MULE
1198 1172
1199 /* Map FN over the Control-1 chars in CT. */ 1173 /* Map FN over the Control-1 chars in CT. */
1200 1174
1201 static int 1175 static int
1202 map_over_charset_control_1 (Lisp_Char_Table *ct, 1176 map_over_charset_control_1 (struct Lisp_Char_Table *ct,
1203 int (*fn) (struct chartab_range *range, 1177 int (*fn) (struct chartab_range *range,
1204 Lisp_Object val, void *arg), 1178 Lisp_Object val, void *arg),
1205 void *arg) 1179 void *arg)
1206 { 1180 {
1207 struct chartab_range rainj; 1181 struct chartab_range rainj;
1223 /* Map FN over the row ROW of two-byte charset CHARSET. 1197 /* Map FN over the row ROW of two-byte charset CHARSET.
1224 There must be a separate value for that row in the char table. 1198 There must be a separate value for that row in the char table.
1225 CTE specifies the char table entry for CHARSET. */ 1199 CTE specifies the char table entry for CHARSET. */
1226 1200
1227 static int 1201 static int
1228 map_over_charset_row (Lisp_Char_Table_Entry *cte, 1202 map_over_charset_row (struct Lisp_Char_Table_Entry *cte,
1229 Lisp_Object charset, int row, 1203 Lisp_Object charset, int row,
1230 int (*fn) (struct chartab_range *range, 1204 int (*fn) (struct chartab_range *range,
1231 Lisp_Object val, void *arg), 1205 Lisp_Object val, void *arg),
1232 void *arg) 1206 void *arg)
1233 { 1207 {
1263 } 1237 }
1264 } 1238 }
1265 1239
1266 1240
1267 static int 1241 static int
1268 map_over_other_charset (Lisp_Char_Table *ct, int lb, 1242 map_over_other_charset (struct Lisp_Char_Table *ct, int lb,
1269 int (*fn) (struct chartab_range *range, 1243 int (*fn) (struct chartab_range *range,
1270 Lisp_Object val, void *arg), 1244 Lisp_Object val, void *arg),
1271 void *arg) 1245 void *arg)
1272 { 1246 {
1273 Lisp_Object val = ct->level1[lb - MIN_LEADING_BYTE]; 1247 Lisp_Object val = ct->level1[lb - MIN_LEADING_BYTE];
1286 rainj.charset = charset; 1260 rainj.charset = charset;
1287 return (fn) (&rainj, val, arg); 1261 return (fn) (&rainj, val, arg);
1288 } 1262 }
1289 1263
1290 { 1264 {
1291 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val); 1265 struct Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
1292 int charset94_p = (XCHARSET_CHARS (charset) == 94); 1266 int charset94_p = (XCHARSET_CHARS (charset) == 94);
1293 int start = charset94_p ? 33 : 32; 1267 int start = charset94_p ? 33 : 32;
1294 int stop = charset94_p ? 127 : 128; 1268 int stop = charset94_p ? 127 : 128;
1295 int i, retval; 1269 int i, retval;
1296 1270
1320 /* Map FN (with client data ARG) over range RANGE in char table CT. 1294 /* Map FN (with client data ARG) over range RANGE in char table CT.
1321 Mapping stops the first time FN returns non-zero, and that value 1295 Mapping stops the first time FN returns non-zero, and that value
1322 becomes the return value of map_char_table(). */ 1296 becomes the return value of map_char_table(). */
1323 1297
1324 int 1298 int
1325 map_char_table (Lisp_Char_Table *ct, 1299 map_char_table (struct Lisp_Char_Table *ct,
1326 struct chartab_range *range, 1300 struct chartab_range *range,
1327 int (*fn) (struct chartab_range *range, 1301 int (*fn) (struct chartab_range *range,
1328 Lisp_Object val, void *arg), 1302 Lisp_Object val, void *arg),
1329 void *arg) 1303 void *arg)
1330 { 1304 {
1447 the RANGE argument to `put-range-table'. If omitted or t, it defaults to 1421 the RANGE argument to `put-range-table'. If omitted or t, it defaults to
1448 the entire table. 1422 the entire table.
1449 */ 1423 */
1450 (function, table, range)) 1424 (function, table, range))
1451 { 1425 {
1452 Lisp_Char_Table *ct; 1426 struct Lisp_Char_Table *ct;
1453 struct slow_map_char_table_arg slarg; 1427 struct slow_map_char_table_arg slarg;
1454 struct gcpro gcpro1, gcpro2; 1428 struct gcpro gcpro1, gcpro2;
1455 struct chartab_range rainj; 1429 struct chartab_range rainj;
1456 1430
1457 CHECK_CHAR_TABLE (table); 1431 CHECK_CHAR_TABLE (table);
1615 int 1589 int
1616 check_category_char (Emchar ch, Lisp_Object table, 1590 check_category_char (Emchar ch, Lisp_Object table,
1617 unsigned int designator, unsigned int not) 1591 unsigned int designator, unsigned int not)
1618 { 1592 {
1619 REGISTER Lisp_Object temp; 1593 REGISTER Lisp_Object temp;
1620 Lisp_Char_Table *ctbl; 1594 struct Lisp_Char_Table *ctbl;
1621 #ifdef ERROR_CHECK_TYPECHECK 1595 #ifdef ERROR_CHECK_TYPECHECK
1622 if (NILP (Fcategory_table_p (table))) 1596 if (NILP (Fcategory_table_p (table)))
1623 signal_simple_error ("Expected category table", table); 1597 signal_simple_error ("Expected category table", table);
1624 #endif 1598 #endif
1625 ctbl = XCHAR_TABLE (table); 1599 ctbl = XCHAR_TABLE (table);
1733 (obj)) 1707 (obj))
1734 { 1708 {
1735 return CATEGORY_TABLE_VALUEP (obj) ? Qt : Qnil; 1709 return CATEGORY_TABLE_VALUEP (obj) ? Qt : Qnil;
1736 } 1710 }
1737 1711
1738
1739 #define CATEGORYP(x) \
1740 (CHARP (x) && XCHAR (x) >= 0x20 && XCHAR (x) <= 0x7E)
1741
1742 #define CATEGORY_SET(c) \
1743 (get_char_table(c, XCHAR_TABLE(current_buffer->category_table)))
1744
1745 /* Return 1 if CATEGORY_SET contains CATEGORY, else return 0.
1746 The faster version of `!NILP (Faref (category_set, category))'. */
1747 #define CATEGORY_MEMBER(category, category_set) \
1748 (bit_vector_bit(XBIT_VECTOR (category_set), category - 32))
1749
1750 /* Return 1 if there is a word boundary between two word-constituent
1751 characters C1 and C2 if they appear in this order, else return 0.
1752 Use the macro WORD_BOUNDARY_P instead of calling this function
1753 directly. */
1754
1755 int word_boundary_p (Emchar c1, Emchar c2);
1756 int
1757 word_boundary_p (Emchar c1, Emchar c2)
1758 {
1759 Lisp_Object category_set1, category_set2;
1760 Lisp_Object tail;
1761 int default_result;
1762
1763 #if 0
1764 if (COMPOSITE_CHAR_P (c1))
1765 c1 = cmpchar_component (c1, 0, 1);
1766 if (COMPOSITE_CHAR_P (c2))
1767 c2 = cmpchar_component (c2, 0, 1);
1768 #endif
1769
1770 if (EQ (CHAR_CHARSET (c1), CHAR_CHARSET (c2)))
1771 {
1772 tail = Vword_separating_categories;
1773 default_result = 0;
1774 }
1775 else
1776 {
1777 tail = Vword_combining_categories;
1778 default_result = 1;
1779 }
1780
1781 category_set1 = CATEGORY_SET (c1);
1782 if (NILP (category_set1))
1783 return default_result;
1784 category_set2 = CATEGORY_SET (c2);
1785 if (NILP (category_set2))
1786 return default_result;
1787
1788 for (; CONSP (tail); tail = XCONS (tail)->cdr)
1789 {
1790 Lisp_Object elt = XCONS(tail)->car;
1791
1792 if (CONSP (elt)
1793 && CATEGORYP (XCONS (elt)->car)
1794 && CATEGORYP (XCONS (elt)->cdr)
1795 && CATEGORY_MEMBER (XCHAR (XCONS (elt)->car), category_set1)
1796 && CATEGORY_MEMBER (XCHAR (XCONS (elt)->cdr), category_set2))
1797 return !default_result;
1798 }
1799 return default_result;
1800 }
1801 #endif /* MULE */ 1712 #endif /* MULE */
1802 1713
1803 1714
1804 void 1715 void
1805 syms_of_chartab (void) 1716 syms_of_chartab (void)
1806 { 1717 {
1807 INIT_LRECORD_IMPLEMENTATION (char_table); 1718 #ifdef MULE
1808
1809 #ifdef MULE
1810 INIT_LRECORD_IMPLEMENTATION (char_table_entry);
1811
1812 defsymbol (&Qcategory_table_p, "category-table-p"); 1719 defsymbol (&Qcategory_table_p, "category-table-p");
1813 defsymbol (&Qcategory_designator_p, "category-designator-p"); 1720 defsymbol (&Qcategory_designator_p, "category-designator-p");
1814 defsymbol (&Qcategory_table_value_p, "category-table-value-p"); 1721 defsymbol (&Qcategory_table_value_p, "category-table-value-p");
1815 #endif /* MULE */ 1722 #endif /* MULE */
1816 1723
1841 DEFSUBR (Fchar_in_category_p); 1748 DEFSUBR (Fchar_in_category_p);
1842 DEFSUBR (Fcategory_designator_p); 1749 DEFSUBR (Fcategory_designator_p);
1843 DEFSUBR (Fcategory_table_value_p); 1750 DEFSUBR (Fcategory_table_value_p);
1844 #endif /* MULE */ 1751 #endif /* MULE */
1845 1752
1846 }
1847
1848 void
1849 vars_of_chartab (void)
1850 {
1851 /* DO NOT staticpro this. It works just like Vweak_hash_tables. */ 1753 /* DO NOT staticpro this. It works just like Vweak_hash_tables. */
1852 Vall_syntax_tables = Qnil; 1754 Vall_syntax_tables = Qnil;
1853 pdump_wire_list (&Vall_syntax_tables);
1854 } 1755 }
1855 1756
1856 void 1757 void
1857 structure_type_create_chartab (void) 1758 structure_type_create_chartab (void)
1858 { 1759 {
1872 /* Make it nil before calling copy-category-table 1773 /* Make it nil before calling copy-category-table
1873 so that copy-category-table will know not to try to copy from garbage */ 1774 so that copy-category-table will know not to try to copy from garbage */
1874 Vstandard_category_table = Qnil; 1775 Vstandard_category_table = Qnil;
1875 Vstandard_category_table = Fcopy_category_table (Qnil); 1776 Vstandard_category_table = Fcopy_category_table (Qnil);
1876 staticpro (&Vstandard_category_table); 1777 staticpro (&Vstandard_category_table);
1877 1778 #endif /* MULE */
1878 DEFVAR_LISP ("word-combining-categories", &Vword_combining_categories /* 1779 }
1879 List of pair (cons) of categories to determine word boundary.
1880
1881 Emacs treats a sequence of word constituent characters as a single
1882 word (i.e. finds no word boundary between them) iff they belongs to
1883 the same charset. But, exceptions are allowed in the following cases.
1884
1885 (1) The case that characters are in different charsets is controlled
1886 by the variable `word-combining-categories'.
1887
1888 Emacs finds no word boundary between characters of different charsets
1889 if they have categories matching some element of this list.
1890
1891 More precisely, if an element of this list is a cons of category CAT1
1892 and CAT2, and a multibyte character C1 which has CAT1 is followed by
1893 C2 which has CAT2, there's no word boundary between C1 and C2.
1894
1895 For instance, to tell that ASCII characters and Latin-1 characters can
1896 form a single word, the element `(?l . ?l)' should be in this list
1897 because both characters have the category `l' (Latin characters).
1898
1899 (2) The case that character are in the same charset is controlled by
1900 the variable `word-separating-categories'.
1901
1902 Emacs find a word boundary between characters of the same charset
1903 if they have categories matching some element of this list.
1904
1905 More precisely, if an element of this list is a cons of category CAT1
1906 and CAT2, and a multibyte character C1 which has CAT1 is followed by
1907 C2 which has CAT2, there's a word boundary between C1 and C2.
1908
1909 For instance, to tell that there's a word boundary between Japanese
1910 Hiragana and Japanese Kanji (both are in the same charset), the
1911 element `(?H . ?C) should be in this list.
1912 */ );
1913
1914 Vword_combining_categories = Qnil;
1915
1916 DEFVAR_LISP ("word-separating-categories", &Vword_separating_categories /*
1917 List of pair (cons) of categories to determine word boundary.
1918 See the documentation of the variable `word-combining-categories'.
1919 */ );
1920
1921 Vword_separating_categories = Qnil;
1922 #endif /* MULE */
1923 }