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