Mercurial > hg > xemacs-beta
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 } |