comparison src/chartab.c @ 398:74fd4e045ea6 r21-2-29

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