Mercurial > hg > xemacs-beta
annotate src/chartab.c @ 5797:a1808d52a34a
If the position of a window's cached point is deleted, use buffer point instead
src/ChangeLog addition:
2014-06-17 Aidan Kehoe <kehoea@parhasard.net>
* extents.h:
* window.c:
* window.c (unshow_buffer):
* window.c (Fset_window_buffer):
Use extents, rather than markers, for the window buffer point
cache, so that when the text containing that window buffer point
is deleted, the window display code uses the buffer's actual point
instead of the position that the marker had been moved to.
Fixes Michael Heinrich's problem of
http://mid.gmane.org/6zr42uxtf5.fsf@elektra.science-computing.de ,
introduced by Ben's patch of
https://bitbucket.org/xemacs/xemacs/commits/047d37eb70d70f43803 .
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Tue, 17 Jun 2014 20:55:45 +0100 |
| parents | 3192994c49ca |
| children | 2dc8711af537 |
| rev | line source |
|---|---|
| 428 | 1 /* XEmacs routines to deal with char tables. |
| 2 Copyright (C) 1992, 1995 Free Software Foundation, Inc. | |
| 3 Copyright (C) 1995 Sun Microsystems, Inc. | |
| 1296 | 4 Copyright (C) 1995, 1996, 2002, 2003 Ben Wing. |
| 428 | 5 Copyright (C) 1995, 1997, 1999 Electrotechnical Laboratory, JAPAN. |
| 6 Licensed to the Free Software Foundation. | |
| 7 | |
| 8 This file is part of XEmacs. | |
| 9 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5259
diff
changeset
|
10 XEmacs is free software: you can redistribute it and/or modify it |
| 428 | 11 under the terms of the GNU General Public License as published by the |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5259
diff
changeset
|
12 Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5259
diff
changeset
|
13 option) any later version. |
| 428 | 14 |
| 15 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 16 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 17 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 18 for more details. | |
| 19 | |
| 20 You should have received a copy of the GNU General Public License | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5259
diff
changeset
|
21 along with XEmacs. If not, see <http://www.gnu.org/licenses/>. */ |
| 428 | 22 |
| 23 /* Synched up with: Mule 2.3. Not synched with FSF. | |
| 24 | |
| 25 This file was written independently of the FSF implementation, | |
| 26 and is not compatible. */ | |
| 27 | |
| 28 /* Authorship: | |
| 29 | |
| 30 Ben Wing: wrote, for 19.13 (Mule). Some category table stuff | |
| 31 loosely based on the original Mule. | |
| 32 Jareth Hein: fixed a couple of bugs in the implementation, and | |
| 33 added regex support for categories with check_category_at | |
| 34 */ | |
| 35 | |
| 36 #include <config.h> | |
| 37 #include "lisp.h" | |
| 38 | |
| 39 #include "buffer.h" | |
| 40 #include "chartab.h" | |
| 41 #include "syntax.h" | |
| 42 | |
|
5320
31be2a3d121d
Move Qcount, Q_default, Q_test to general-slots.h; add SYMBOL_KEYWORD_GENERAL()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
43 Lisp_Object Qchar_tablep, Qchar_table; |
| 428 | 44 |
| 45 Lisp_Object Vall_syntax_tables; | |
| 46 | |
| 47 #ifdef MULE | |
| 48 Lisp_Object Qcategory_table_p; | |
| 49 Lisp_Object Qcategory_designator_p; | |
| 50 Lisp_Object Qcategory_table_value_p; | |
| 51 | |
| 52 Lisp_Object Vstandard_category_table; | |
| 53 | |
| 54 /* Variables to determine word boundary. */ | |
| 55 Lisp_Object Vword_combining_categories, Vword_separating_categories; | |
| 56 #endif /* MULE */ | |
| 57 | |
| 826 | 58 static int check_valid_char_table_value (Lisp_Object value, |
| 59 enum char_table_type type, | |
| 60 Error_Behavior errb); | |
| 61 | |
| 428 | 62 |
| 63 /* A char table maps from ranges of characters to values. | |
| 64 | |
| 65 Implementing a general data structure that maps from arbitrary | |
| 66 ranges of numbers to values is tricky to do efficiently. As it | |
| 67 happens, it should suffice (and is usually more convenient, anyway) | |
| 68 when dealing with characters to restrict the sorts of ranges that | |
| 69 can be assigned values, as follows: | |
| 70 | |
| 71 1) All characters. | |
| 72 2) All characters in a charset. | |
| 73 3) All characters in a particular row of a charset, where a "row" | |
| 74 means all characters with the same first byte. | |
| 75 4) A particular character in a charset. | |
| 76 | |
| 77 We use char tables to generalize the 256-element vectors now | |
| 78 littering the Emacs code. | |
| 79 | |
| 80 Possible uses (all should be converted at some point): | |
| 81 | |
| 82 1) category tables | |
| 83 2) syntax tables | |
| 84 3) display tables | |
| 85 4) case tables | |
| 86 5) keyboard-translate-table? | |
| 87 | |
| 88 We provide an | |
| 89 abstract type to generalize the Emacs vectors and Mule | |
| 90 vectors-of-vectors goo. | |
| 91 */ | |
| 92 | |
| 93 /************************************************************************/ | |
| 94 /* Char Table object */ | |
| 95 /************************************************************************/ | |
| 96 | |
|
5560
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
97 static int |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
98 print_preprocess_mapper (struct chartab_range * UNUSED (range), |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
99 Lisp_Object UNUSED (table), Lisp_Object val, |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
100 void *extra_arg) |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
101 { |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
102 print_preprocess (val, ((preprocess_info_t *) extra_arg)->table, |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
103 ((preprocess_info_t *) extra_arg)->count); |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
104 return 0; |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
105 } |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
106 |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
107 static void |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
108 char_table_print_preprocess (Lisp_Object object, Lisp_Object print_number_table, |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
109 Elemcount *seen_object_count) |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
110 { |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
111 struct chartab_range ctr = { CHARTAB_RANGE_ALL, 0, Qnil, 0 }; |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
112 preprocess_info_t preprocess_info = { print_number_table, seen_object_count }; |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
113 map_char_table (object, &ctr, print_preprocess_mapper, &preprocess_info); |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
114 } |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
115 |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
116 static void decode_char_table_range (Lisp_Object range, |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
117 struct chartab_range *outrange); |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
118 |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
119 static int |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
120 nsubst_structures_mapper (struct chartab_range * range, Lisp_Object table, |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
121 Lisp_Object value, void *extra_arg) |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
122 { |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
123 Lisp_Object number_table |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
124 = ((nsubst_structures_info_t *) extra_arg)->number_table; |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
125 Lisp_Object new_ = ((nsubst_structures_info_t *) extra_arg)->new_; |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
126 Lisp_Object old = ((nsubst_structures_info_t *) extra_arg)->old; |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
127 Boolint test_not_unboundp |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
128 = ((nsubst_structures_info_t *) extra_arg)->test_not_unboundp; |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
129 struct chartab_range changed = { range->type, range->ch, range->charset, |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
130 range->row }; |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
131 |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
132 switch (range->type) |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
133 { |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
134 case CHARTAB_RANGE_ALL: |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
135 { |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
136 if (EQ (old, Qt) == test_not_unboundp) |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
137 { |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
138 decode_char_table_range (new_, &changed); |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
139 |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
140 put_char_table (table, range, Qunbound); |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
141 put_char_table (table, &changed, value); |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
142 } |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
143 break; |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
144 } |
|
5563
309e5631e4c8
Don't use MULE-only cases in non-MULE build.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
5560
diff
changeset
|
145 #ifdef MULE |
|
5560
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
146 case CHARTAB_RANGE_CHARSET: |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
147 { |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
148 if (EQ (old, range->charset) == test_not_unboundp) |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
149 { |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
150 CHECK_CHARSET (new_); |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
151 changed.charset = new_; |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
152 |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
153 put_char_table (table, range, Qunbound); |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
154 put_char_table (table, &changed, value); |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
155 } |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
156 else assert (!HAS_OBJECT_METH_P (range->charset, |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
157 nsubst_structures_descend)); |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
158 break; |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
159 } |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
160 case CHARTAB_RANGE_ROW: |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
161 { |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5563
diff
changeset
|
162 if (EQ (old, make_fixnum (range->row)) == test_not_unboundp) |
|
5560
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
163 { |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5563
diff
changeset
|
164 CHECK_FIXNUM (new_); |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5563
diff
changeset
|
165 changed.row = XFIXNUM (new_); |
|
5560
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
166 |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
167 put_char_table (table, range, Qunbound); |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
168 put_char_table (table, &changed, value); |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
169 } |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
170 break; |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
171 } |
|
5563
309e5631e4c8
Don't use MULE-only cases in non-MULE build.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
5560
diff
changeset
|
172 #endif |
|
5560
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
173 case CHARTAB_RANGE_CHAR: |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
174 { |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
175 if (EQ (old, make_char (range->ch)) == test_not_unboundp) |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
176 { |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
177 CHECK_CHAR (new_); |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
178 changed.ch = XCHAR (new_); |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
179 |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
180 put_char_table (table, range, Qunbound); |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
181 put_char_table (table, &changed, value); |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
182 } |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
183 break; |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
184 } |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
185 } |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
186 |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
187 if (EQ (old, value) == test_not_unboundp) |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
188 { |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
189 put_char_table (table, &changed, new_); |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
190 } |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
191 else if (LRECORDP (value) && |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
192 HAS_OBJECT_METH_P (value, nsubst_structures_descend)) |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
193 { |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
194 nsubst_structures_descend (new_, old, value, number_table, |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
195 test_not_unboundp); |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
196 } |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
197 |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
198 return 0; |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
199 } |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
200 |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
201 static void |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
202 char_table_nsubst_structures_descend (Lisp_Object new_, Lisp_Object old, |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
203 Lisp_Object object, |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
204 Lisp_Object number_table, |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
205 Boolint test_not_unboundp) |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
206 { |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
207 struct chartab_range ctr = { CHARTAB_RANGE_ALL, 0, Qnil, 0 }; |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
208 nsubst_structures_info_t nsubst_structures_info |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
209 = { number_table, new_, old, object, test_not_unboundp }; |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
210 |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
211 map_char_table (object, &ctr, nsubst_structures_mapper, |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
212 &nsubst_structures_info); |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
213 } |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
214 |
| 428 | 215 #ifdef MULE |
| 216 | |
| 217 static Lisp_Object | |
| 218 mark_char_table_entry (Lisp_Object obj) | |
| 219 { | |
| 440 | 220 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj); |
| 428 | 221 int i; |
| 222 | |
| 223 for (i = 0; i < 96; i++) | |
| 224 { | |
| 225 mark_object (cte->level2[i]); | |
| 226 } | |
| 227 return Qnil; | |
| 228 } | |
| 229 | |
| 230 static int | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4580
diff
changeset
|
231 char_table_entry_equal (Lisp_Object obj1, Lisp_Object obj2, int depth, |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4580
diff
changeset
|
232 int foldcase) |
| 428 | 233 { |
| 440 | 234 Lisp_Char_Table_Entry *cte1 = XCHAR_TABLE_ENTRY (obj1); |
| 235 Lisp_Char_Table_Entry *cte2 = XCHAR_TABLE_ENTRY (obj2); | |
| 428 | 236 int i; |
| 237 | |
| 238 for (i = 0; i < 96; i++) | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4580
diff
changeset
|
239 if (!internal_equal_0 (cte1->level2[i], cte2->level2[i], depth + 1, |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4580
diff
changeset
|
240 foldcase)) |
| 428 | 241 return 0; |
| 242 | |
| 243 return 1; | |
| 244 } | |
| 245 | |
| 665 | 246 static Hashcode |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5127
diff
changeset
|
247 char_table_entry_hash (Lisp_Object obj, int depth, Boolint equalp) |
| 428 | 248 { |
| 440 | 249 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj); |
| 428 | 250 |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5127
diff
changeset
|
251 return internal_array_hash (cte->level2, 96, depth + 1, equalp); |
| 428 | 252 } |
| 253 | |
| 1204 | 254 static const struct memory_description char_table_entry_description[] = { |
| 440 | 255 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table_Entry, level2), 96 }, |
| 428 | 256 { XD_END } |
| 257 }; | |
| 258 | |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
259 DEFINE_DUMPABLE_LISP_OBJECT ("char-table-entry", char_table_entry, |
|
5124
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
260 mark_char_table_entry, internal_object_printer, |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
261 0, char_table_entry_equal, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
262 char_table_entry_hash, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
263 char_table_entry_description, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
264 Lisp_Char_Table_Entry); |
| 934 | 265 |
| 428 | 266 #endif /* MULE */ |
| 267 | |
| 268 static Lisp_Object | |
| 269 mark_char_table (Lisp_Object obj) | |
| 270 { | |
| 440 | 271 Lisp_Char_Table *ct = XCHAR_TABLE (obj); |
| 428 | 272 int i; |
| 273 | |
| 274 for (i = 0; i < NUM_ASCII_CHARS; i++) | |
| 275 mark_object (ct->ascii[i]); | |
| 276 #ifdef MULE | |
| 277 for (i = 0; i < NUM_LEADING_BYTES; i++) | |
| 278 mark_object (ct->level1[i]); | |
| 279 #endif | |
| 793 | 280 mark_object (ct->parent); |
| 281 mark_object (ct->default_); | |
| 428 | 282 return ct->mirror_table; |
| 283 } | |
| 284 | |
| 285 /* WARNING: All functions of this nature need to be written extremely | |
| 286 carefully to avoid crashes during GC. Cf. prune_specifiers() | |
| 287 and prune_weak_hash_tables(). */ | |
| 288 | |
| 289 void | |
| 290 prune_syntax_tables (void) | |
| 291 { | |
| 292 Lisp_Object rest, prev = Qnil; | |
| 293 | |
| 294 for (rest = Vall_syntax_tables; | |
| 295 !NILP (rest); | |
| 296 rest = XCHAR_TABLE (rest)->next_table) | |
| 297 { | |
| 298 if (! marked_p (rest)) | |
| 299 { | |
| 300 /* This table is garbage. Remove it from the list. */ | |
| 301 if (NILP (prev)) | |
| 302 Vall_syntax_tables = XCHAR_TABLE (rest)->next_table; | |
| 303 else | |
| 304 XCHAR_TABLE (prev)->next_table = | |
| 305 XCHAR_TABLE (rest)->next_table; | |
| 306 } | |
| 307 } | |
| 308 } | |
| 309 | |
| 310 static Lisp_Object | |
| 311 char_table_type_to_symbol (enum char_table_type type) | |
| 312 { | |
| 313 switch (type) | |
| 314 { | |
| 2500 | 315 default: ABORT(); |
| 428 | 316 case CHAR_TABLE_TYPE_GENERIC: return Qgeneric; |
| 317 case CHAR_TABLE_TYPE_SYNTAX: return Qsyntax; | |
| 318 case CHAR_TABLE_TYPE_DISPLAY: return Qdisplay; | |
| 319 case CHAR_TABLE_TYPE_CHAR: return Qchar; | |
| 320 #ifdef MULE | |
| 321 case CHAR_TABLE_TYPE_CATEGORY: return Qcategory; | |
| 322 #endif | |
| 323 } | |
| 324 } | |
| 325 | |
| 326 static enum char_table_type | |
| 327 symbol_to_char_table_type (Lisp_Object symbol) | |
| 328 { | |
| 329 CHECK_SYMBOL (symbol); | |
| 330 | |
| 331 if (EQ (symbol, Qgeneric)) return CHAR_TABLE_TYPE_GENERIC; | |
| 332 if (EQ (symbol, Qsyntax)) return CHAR_TABLE_TYPE_SYNTAX; | |
| 333 if (EQ (symbol, Qdisplay)) return CHAR_TABLE_TYPE_DISPLAY; | |
| 334 if (EQ (symbol, Qchar)) return CHAR_TABLE_TYPE_CHAR; | |
| 335 #ifdef MULE | |
| 336 if (EQ (symbol, Qcategory)) return CHAR_TABLE_TYPE_CATEGORY; | |
| 337 #endif | |
| 338 | |
| 563 | 339 invalid_constant ("Unrecognized char table type", symbol); |
| 1204 | 340 RETURN_NOT_REACHED (CHAR_TABLE_TYPE_GENERIC); |
| 428 | 341 } |
| 342 | |
| 343 static void | |
| 826 | 344 decode_char_table_range (Lisp_Object range, struct chartab_range *outrange) |
| 428 | 345 { |
| 4932 | 346 xzero (*outrange); |
| 826 | 347 if (EQ (range, Qt)) |
| 348 outrange->type = CHARTAB_RANGE_ALL; | |
| 349 else if (CHAR_OR_CHAR_INTP (range)) | |
| 350 { | |
| 351 outrange->type = CHARTAB_RANGE_CHAR; | |
| 352 outrange->ch = XCHAR_OR_CHAR_INT (range); | |
| 353 } | |
| 354 #ifndef MULE | |
| 428 | 355 else |
| 826 | 356 sferror ("Range must be t or a character", range); |
| 357 #else /* MULE */ | |
| 358 else if (VECTORP (range)) | |
| 359 { | |
| 360 Lisp_Vector *vec = XVECTOR (range); | |
| 361 Lisp_Object *elts = vector_data (vec); | |
| 362 if (vector_length (vec) != 2) | |
| 363 sferror ("Length of charset row vector must be 2", | |
| 364 range); | |
| 365 outrange->type = CHARTAB_RANGE_ROW; | |
| 366 outrange->charset = Fget_charset (elts[0]); | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5563
diff
changeset
|
367 CHECK_FIXNUM (elts[1]); |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5563
diff
changeset
|
368 outrange->row = XFIXNUM (elts[1]); |
| 826 | 369 switch (XCHARSET_TYPE (outrange->charset)) |
| 370 { | |
| 371 case CHARSET_TYPE_94: | |
| 372 case CHARSET_TYPE_96: | |
| 373 sferror ("Charset in row vector must be multi-byte", | |
| 374 outrange->charset); | |
| 375 case CHARSET_TYPE_94X94: | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5563
diff
changeset
|
376 check_integer_range (make_fixnum (outrange->row), make_fixnum (33), |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5563
diff
changeset
|
377 make_fixnum (126)); |
| 826 | 378 break; |
| 379 case CHARSET_TYPE_96X96: | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5563
diff
changeset
|
380 check_integer_range (make_fixnum (outrange->row), make_fixnum (32), |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5563
diff
changeset
|
381 make_fixnum (127)); |
| 826 | 382 break; |
| 383 default: | |
| 2500 | 384 ABORT (); |
| 826 | 385 } |
| 386 } | |
| 387 else | |
| 388 { | |
| 389 if (!CHARSETP (range) && !SYMBOLP (range)) | |
| 390 sferror | |
| 391 ("Char table range must be t, charset, char, or vector", range); | |
| 392 outrange->type = CHARTAB_RANGE_CHARSET; | |
| 393 outrange->charset = Fget_charset (range); | |
| 394 } | |
| 395 #endif /* MULE */ | |
| 428 | 396 } |
| 397 | |
| 826 | 398 static Lisp_Object |
| 399 encode_char_table_range (struct chartab_range *range) | |
| 428 | 400 { |
| 826 | 401 switch (range->type) |
| 428 | 402 { |
| 826 | 403 case CHARTAB_RANGE_ALL: |
| 404 return Qt; | |
| 405 | |
| 406 #ifdef MULE | |
| 407 case CHARTAB_RANGE_CHARSET: | |
| 408 return XCHARSET_NAME (Fget_charset (range->charset)); | |
| 428 | 409 |
| 826 | 410 case CHARTAB_RANGE_ROW: |
| 411 return vector2 (XCHARSET_NAME (Fget_charset (range->charset)), | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5563
diff
changeset
|
412 make_fixnum (range->row)); |
| 826 | 413 #endif |
| 414 case CHARTAB_RANGE_CHAR: | |
| 415 return make_char (range->ch); | |
| 416 default: | |
| 2500 | 417 ABORT (); |
| 428 | 418 } |
| 826 | 419 return Qnil; /* not reached */ |
| 428 | 420 } |
| 421 | |
|
5259
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
422 static Lisp_Object |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
423 char_table_default_for_type (enum char_table_type type) |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
424 { |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
425 switch (type) |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
426 { |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
427 case CHAR_TABLE_TYPE_CHAR: |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
428 return make_char (0); |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
429 break; |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
430 case CHAR_TABLE_TYPE_DISPLAY: |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
431 case CHAR_TABLE_TYPE_GENERIC: |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
432 #ifdef MULE |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
433 case CHAR_TABLE_TYPE_CATEGORY: |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
434 #endif /* MULE */ |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
435 return Qnil; |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
436 break; |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
437 |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
438 case CHAR_TABLE_TYPE_SYNTAX: |
|
5736
3192994c49ca
Convert C (un)signed long long values to bignums properly.
Jerry James <james@xemacs.org>
parents:
5581
diff
changeset
|
439 return make_fixnum (Sinherit); |
|
5259
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
440 break; |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
441 } |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
442 ABORT(); |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
443 return Qzero; |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
444 } |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
445 |
| 826 | 446 struct ptemap |
| 428 | 447 { |
| 826 | 448 Lisp_Object printcharfun; |
| 449 int first; | |
| 450 }; | |
| 428 | 451 |
| 826 | 452 static int |
| 2286 | 453 print_table_entry (struct chartab_range *range, Lisp_Object UNUSED (table), |
| 826 | 454 Lisp_Object val, void *arg) |
| 455 { | |
| 456 struct ptemap *a = (struct ptemap *) arg; | |
| 457 struct gcpro gcpro1; | |
| 458 Lisp_Object lisprange; | |
| 459 if (!a->first) | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
460 write_ascstring (a->printcharfun, " "); |
| 826 | 461 a->first = 0; |
| 462 lisprange = encode_char_table_range (range); | |
| 463 GCPRO1 (lisprange); | |
|
4580
1d11ecca9cd0
Print char table values correctly.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4469
diff
changeset
|
464 write_fmt_string_lisp (a->printcharfun, "%s %S", 2, lisprange, val); |
| 826 | 465 UNGCPRO; |
| 466 return 0; | |
| 428 | 467 } |
| 468 | |
| 469 static void | |
| 2286 | 470 print_char_table (Lisp_Object obj, Lisp_Object printcharfun, |
| 471 int UNUSED (escapeflag)) | |
| 428 | 472 { |
| 440 | 473 Lisp_Char_Table *ct = XCHAR_TABLE (obj); |
| 826 | 474 struct chartab_range range; |
| 475 struct ptemap arg; | |
| 476 | |
| 477 range.type = CHARTAB_RANGE_ALL; | |
| 478 arg.printcharfun = printcharfun; | |
| 479 arg.first = 1; | |
| 428 | 480 |
|
5259
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
481 write_fmt_string_lisp (printcharfun, |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
482 "#s(char-table :type %s", 1, |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
483 char_table_type_to_symbol (ct->type)); |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
484 if (!(EQ (ct->default_, char_table_default_for_type (ct->type)))) |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
485 { |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
486 write_fmt_string_lisp (printcharfun, " :default %S", 1, ct->default_); |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
487 } |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
488 |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
489 write_ascstring (printcharfun, " :data ("); |
| 826 | 490 map_char_table (obj, &range, print_table_entry, &arg); |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
491 write_ascstring (printcharfun, "))"); |
| 428 | 492 |
| 826 | 493 /* #### need to print and read the default; but that will allow the |
| 494 default to be modified, which we don't (yet) support -- but FSF does */ | |
| 428 | 495 } |
| 496 | |
| 497 static int | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4580
diff
changeset
|
498 char_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth, int foldcase) |
| 428 | 499 { |
| 440 | 500 Lisp_Char_Table *ct1 = XCHAR_TABLE (obj1); |
| 501 Lisp_Char_Table *ct2 = XCHAR_TABLE (obj2); | |
| 428 | 502 int i; |
| 503 | |
| 504 if (CHAR_TABLE_TYPE (ct1) != CHAR_TABLE_TYPE (ct2)) | |
| 505 return 0; | |
| 506 | |
| 507 for (i = 0; i < NUM_ASCII_CHARS; i++) | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4580
diff
changeset
|
508 if (!internal_equal_0 (ct1->ascii[i], ct2->ascii[i], depth + 1, foldcase)) |
| 428 | 509 return 0; |
| 510 | |
| 511 #ifdef MULE | |
| 512 for (i = 0; i < NUM_LEADING_BYTES; i++) | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4580
diff
changeset
|
513 if (!internal_equal_0 (ct1->level1[i], ct2->level1[i], depth + 1, foldcase)) |
| 428 | 514 return 0; |
| 515 #endif /* MULE */ | |
| 516 | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4580
diff
changeset
|
517 return internal_equal_0 (ct1->default_, ct2->default_, depth + 1, foldcase); |
| 428 | 518 } |
| 519 | |
| 665 | 520 static Hashcode |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5127
diff
changeset
|
521 char_table_hash (Lisp_Object obj, int depth, Boolint equalp) |
| 428 | 522 { |
| 440 | 523 Lisp_Char_Table *ct = XCHAR_TABLE (obj); |
| 665 | 524 Hashcode hashval = internal_array_hash (ct->ascii, NUM_ASCII_CHARS, |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5127
diff
changeset
|
525 depth + 1, equalp); |
| 428 | 526 #ifdef MULE |
| 527 hashval = HASH2 (hashval, | |
| 826 | 528 internal_array_hash (ct->level1, NUM_LEADING_BYTES, |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5127
diff
changeset
|
529 depth + 1, equalp)); |
| 428 | 530 #endif /* MULE */ |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5127
diff
changeset
|
531 return HASH2 (hashval, internal_hash (ct->default_, depth + 1, equalp)); |
| 428 | 532 } |
| 533 | |
| 1204 | 534 static const struct memory_description char_table_description[] = { |
| 440 | 535 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, ascii), NUM_ASCII_CHARS }, |
| 428 | 536 #ifdef MULE |
| 440 | 537 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, level1), NUM_LEADING_BYTES }, |
| 428 | 538 #endif |
| 793 | 539 { XD_LISP_OBJECT, offsetof (Lisp_Char_Table, parent) }, |
| 540 { XD_LISP_OBJECT, offsetof (Lisp_Char_Table, default_) }, | |
| 440 | 541 { XD_LISP_OBJECT, offsetof (Lisp_Char_Table, mirror_table) }, |
| 542 { XD_LO_LINK, offsetof (Lisp_Char_Table, next_table) }, | |
| 428 | 543 { XD_END } |
| 544 }; | |
| 545 | |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
546 DEFINE_DUMPABLE_LISP_OBJECT ("char-table", char_table, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
547 mark_char_table, print_char_table, 0, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
548 char_table_equal, char_table_hash, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
549 char_table_description, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
550 Lisp_Char_Table); |
| 428 | 551 |
| 552 DEFUN ("char-table-p", Fchar_table_p, 1, 1, 0, /* | |
| 553 Return non-nil if OBJECT is a char table. | |
| 554 */ | |
| 555 (object)) | |
| 556 { | |
| 557 return CHAR_TABLEP (object) ? Qt : Qnil; | |
| 558 } | |
| 559 | |
| 560 DEFUN ("char-table-type-list", Fchar_table_type_list, 0, 0, 0, /* | |
| 561 Return a list of the recognized char table types. | |
| 800 | 562 See `make-char-table'. |
| 428 | 563 */ |
| 564 ()) | |
| 565 { | |
| 566 #ifdef MULE | |
| 567 return list5 (Qchar, Qcategory, Qdisplay, Qgeneric, Qsyntax); | |
| 568 #else | |
| 569 return list4 (Qchar, Qdisplay, Qgeneric, Qsyntax); | |
| 570 #endif | |
| 571 } | |
| 572 | |
| 573 DEFUN ("valid-char-table-type-p", Fvalid_char_table_type_p, 1, 1, 0, /* | |
| 574 Return t if TYPE if a recognized char table type. | |
| 800 | 575 See `make-char-table'. |
| 428 | 576 */ |
| 577 (type)) | |
| 578 { | |
| 579 return (EQ (type, Qchar) || | |
| 580 #ifdef MULE | |
| 581 EQ (type, Qcategory) || | |
| 582 #endif | |
| 583 EQ (type, Qdisplay) || | |
| 584 EQ (type, Qgeneric) || | |
| 585 EQ (type, Qsyntax)) ? Qt : Qnil; | |
| 586 } | |
| 587 | |
| 588 DEFUN ("char-table-type", Fchar_table_type, 1, 1, 0, /* | |
| 444 | 589 Return the type of CHAR-TABLE. |
| 800 | 590 See `make-char-table'. |
| 428 | 591 */ |
| 444 | 592 (char_table)) |
| 428 | 593 { |
| 444 | 594 CHECK_CHAR_TABLE (char_table); |
| 595 return char_table_type_to_symbol (XCHAR_TABLE (char_table)->type); | |
| 428 | 596 } |
| 597 | |
| 1296 | 598 static void |
| 599 set_char_table_dirty (Lisp_Object table) | |
| 600 { | |
| 601 assert (!XCHAR_TABLE (table)->mirror_table_p); | |
| 602 XCHAR_TABLE (XCHAR_TABLE (table)->mirror_table)->dirty = 1; | |
| 603 } | |
| 604 | |
| 428 | 605 void |
| 826 | 606 set_char_table_default (Lisp_Object table, Lisp_Object value) |
| 607 { | |
| 608 Lisp_Char_Table *ct = XCHAR_TABLE (table); | |
| 609 ct->default_ = value; | |
| 610 if (ct->type == CHAR_TABLE_TYPE_SYNTAX) | |
| 1296 | 611 set_char_table_dirty (table); |
| 826 | 612 } |
| 613 | |
| 614 static void | |
| 440 | 615 fill_char_table (Lisp_Char_Table *ct, Lisp_Object value) |
| 428 | 616 { |
| 617 int i; | |
| 618 | |
| 619 for (i = 0; i < NUM_ASCII_CHARS; i++) | |
| 620 ct->ascii[i] = value; | |
| 621 #ifdef MULE | |
| 622 for (i = 0; i < NUM_LEADING_BYTES; i++) | |
| 1296 | 623 { |
| 1330 | 624 /* Don't get stymied when initting the table, or when trying to |
| 625 free a pdump object. */ | |
| 1296 | 626 if (!EQ (ct->level1[i], Qnull_pointer) && |
| 1330 | 627 CHAR_TABLE_ENTRYP (ct->level1[i]) && |
| 628 !OBJECT_DUMPED_P (ct->level1[1])) | |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
629 free_normal_lisp_object (ct->level1[i]); |
| 1296 | 630 ct->level1[i] = value; |
| 631 } | |
| 428 | 632 #endif /* MULE */ |
| 633 | |
| 634 if (ct->type == CHAR_TABLE_TYPE_SYNTAX) | |
| 1296 | 635 set_char_table_dirty (wrap_char_table (ct)); |
| 428 | 636 } |
| 637 | |
| 638 DEFUN ("reset-char-table", Freset_char_table, 1, 1, 0, /* | |
| 444 | 639 Reset CHAR-TABLE to its default state. |
| 428 | 640 */ |
| 444 | 641 (char_table)) |
| 428 | 642 { |
| 440 | 643 Lisp_Char_Table *ct; |
| 428 | 644 |
| 444 | 645 CHECK_CHAR_TABLE (char_table); |
| 646 ct = XCHAR_TABLE (char_table); | |
| 428 | 647 |
| 826 | 648 /* Avoid doubly updating the syntax table by setting the default ourselves, |
| 649 since set_char_table_default() also updates. */ | |
|
5259
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
650 ct->default_ = char_table_default_for_type (ct->type); |
| 826 | 651 fill_char_table (ct, Qunbound); |
| 652 | |
| 428 | 653 return Qnil; |
| 654 } | |
| 655 | |
| 656 DEFUN ("make-char-table", Fmake_char_table, 1, 1, 0, /* | |
| 657 Return a new, empty char table of type TYPE. | |
| 800 | 658 |
| 659 A char table is a table that maps characters (or ranges of characters) | |
| 660 to values. Char tables are specialized for characters, only allowing | |
| 661 particular sorts of ranges to be assigned values. Although this | |
| 662 loses in generality, it makes for extremely fast (constant-time) | |
| 663 lookups, and thus is feasible for applications that do an extremely | |
| 664 large number of lookups (e.g. scanning a buffer for a character in | |
| 665 a particular syntax, where a lookup in the syntax table must occur | |
| 666 once per character). | |
| 667 | |
| 668 When Mule support exists, the types of ranges that can be assigned | |
| 669 values are | |
| 670 | |
| 2714 | 671 -- all characters (represented by t) |
| 800 | 672 -- an entire charset |
| 2714 | 673 -- a single row in a two-octet charset (represented by a vector of two |
| 674 elements: a two-octet charset and a row number; the row must be an | |
| 675 integer, not a character) | |
| 800 | 676 -- a single character |
| 677 | |
| 678 When Mule support is not present, the types of ranges that can be | |
| 679 assigned values are | |
| 680 | |
| 2714 | 681 -- all characters (represented by t) |
| 800 | 682 -- a single character |
| 683 | |
| 684 To create a char table, use `make-char-table'. | |
| 685 To modify a char table, use `put-char-table' or `remove-char-table'. | |
| 686 To retrieve the value for a particular character, use `get-char-table'. | |
| 826 | 687 See also `map-char-table', `reset-char-table', `copy-char-table', |
| 800 | 688 `char-table-p', `valid-char-table-type-p', `char-table-type-list', |
| 689 `valid-char-table-value-p', and `check-char-table-value'. | |
| 690 | |
| 691 Each char table type is used for a different purpose and allows different | |
| 692 sorts of values. The different char table types are | |
| 693 | |
| 694 `category' | |
|
4469
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
695 Used for category tables, which specify the regexp categories that a |
|
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
696 character is in. The valid values are nil or a bit vector of 95 |
|
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
697 elements, and values default to nil. Higher-level Lisp functions |
|
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
698 are provided for working with category tables. Currently categories |
| 800 | 699 and category tables only exist when Mule support is present. |
| 700 `char' | |
|
4469
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
701 A generalized char table, for mapping from one character to another. |
|
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
702 Used for case tables, syntax matching tables, |
|
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
703 `keyboard-translate-table', etc. The valid values are characters, |
|
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
704 and the default result given by `get-char-table' if a value hasn't |
|
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
705 been set for a given character or for a range that includes it, is |
|
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
706 ?\x00. |
| 800 | 707 `generic' |
|
4469
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
708 An even more generalized char table, for mapping from a character to |
|
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
709 anything. The default result given by `get-char-table' is nil. |
| 800 | 710 `display' |
|
4469
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
711 Used for display tables, which specify how a particular character is |
|
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
712 to appear when displayed. #### Not yet implemented; currently, the |
|
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
713 display table code uses generic char tables, and it's not clear that |
|
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
714 implementing this char table type would be useful. |
| 800 | 715 `syntax' |
| 716 Used for syntax tables, which specify the syntax of a particular | |
| 717 character. Higher-level Lisp functions are provided for | |
|
4469
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
718 working with syntax tables. The valid values are integers, and the |
|
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
719 default result given by `get-char-table' is the syntax code for |
|
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
720 `inherit'. |
| 428 | 721 */ |
| 722 (type)) | |
| 723 { | |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
724 Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (char_table); |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
725 Lisp_Char_Table *ct = XCHAR_TABLE (obj); |
| 428 | 726 enum char_table_type ty = symbol_to_char_table_type (type); |
| 727 | |
| 728 ct->type = ty; | |
| 729 if (ty == CHAR_TABLE_TYPE_SYNTAX) | |
| 730 { | |
| 826 | 731 /* Qgeneric not Qsyntax because a syntax table has a mirror table |
| 732 and we don't want infinite recursion */ | |
| 428 | 733 ct->mirror_table = Fmake_char_table (Qgeneric); |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5563
diff
changeset
|
734 set_char_table_default (ct->mirror_table, make_fixnum (Sword)); |
| 1296 | 735 XCHAR_TABLE (ct->mirror_table)->mirror_table_p = 1; |
| 736 XCHAR_TABLE (ct->mirror_table)->mirror_table = obj; | |
| 428 | 737 } |
| 738 else | |
| 739 ct->mirror_table = Qnil; | |
| 740 ct->next_table = Qnil; | |
| 793 | 741 ct->parent = Qnil; |
| 742 ct->default_ = Qnil; | |
| 428 | 743 if (ty == CHAR_TABLE_TYPE_SYNTAX) |
| 744 { | |
| 745 ct->next_table = Vall_syntax_tables; | |
| 746 Vall_syntax_tables = obj; | |
| 747 } | |
| 748 Freset_char_table (obj); | |
| 749 return obj; | |
| 750 } | |
| 751 | |
| 752 #ifdef MULE | |
| 753 | |
| 754 static Lisp_Object | |
| 755 make_char_table_entry (Lisp_Object initval) | |
| 756 { | |
| 757 int i; | |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
758 Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (char_table_entry); |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
759 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj); |
| 428 | 760 |
| 761 for (i = 0; i < 96; i++) | |
| 762 cte->level2[i] = initval; | |
| 763 | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
764 return obj; |
| 428 | 765 } |
| 766 | |
| 767 static Lisp_Object | |
| 768 copy_char_table_entry (Lisp_Object entry) | |
| 769 { | |
| 440 | 770 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (entry); |
| 428 | 771 int i; |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
772 Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (char_table_entry); |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
773 Lisp_Char_Table_Entry *ctenew = XCHAR_TABLE_ENTRY (obj); |
| 428 | 774 |
| 775 for (i = 0; i < 96; i++) | |
| 776 { | |
| 3025 | 777 Lisp_Object new_ = cte->level2[i]; |
| 778 if (CHAR_TABLE_ENTRYP (new_)) | |
| 779 ctenew->level2[i] = copy_char_table_entry (new_); | |
| 428 | 780 else |
| 3025 | 781 ctenew->level2[i] = new_; |
| 428 | 782 } |
| 783 | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
784 return obj; |
| 428 | 785 } |
| 786 | |
| 787 #endif /* MULE */ | |
| 788 | |
| 789 DEFUN ("copy-char-table", Fcopy_char_table, 1, 1, 0, /* | |
| 444 | 790 Return a new char table which is a copy of CHAR-TABLE. |
| 428 | 791 It will contain the same values for the same characters and ranges |
| 444 | 792 as CHAR-TABLE. The values will not themselves be copied. |
| 428 | 793 */ |
| 444 | 794 (char_table)) |
| 428 | 795 { |
| 440 | 796 Lisp_Char_Table *ct, *ctnew; |
| 428 | 797 Lisp_Object obj; |
| 798 int i; | |
| 799 | |
| 444 | 800 CHECK_CHAR_TABLE (char_table); |
| 801 ct = XCHAR_TABLE (char_table); | |
| 3879 | 802 assert(!ct->mirror_table_p); |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
803 obj = ALLOC_NORMAL_LISP_OBJECT (char_table); |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
804 ctnew = XCHAR_TABLE (obj); |
| 428 | 805 ctnew->type = ct->type; |
| 793 | 806 ctnew->parent = ct->parent; |
| 807 ctnew->default_ = ct->default_; | |
| 3879 | 808 ctnew->mirror_table_p = 0; |
| 428 | 809 |
| 810 for (i = 0; i < NUM_ASCII_CHARS; i++) | |
| 811 { | |
| 3025 | 812 Lisp_Object new_ = ct->ascii[i]; |
| 428 | 813 #ifdef MULE |
| 3025 | 814 assert (! (CHAR_TABLE_ENTRYP (new_))); |
| 428 | 815 #endif /* MULE */ |
| 3025 | 816 ctnew->ascii[i] = new_; |
| 428 | 817 } |
| 818 | |
| 819 #ifdef MULE | |
| 820 | |
| 821 for (i = 0; i < NUM_LEADING_BYTES; i++) | |
| 822 { | |
| 3025 | 823 Lisp_Object new_ = ct->level1[i]; |
| 824 if (CHAR_TABLE_ENTRYP (new_)) | |
| 825 ctnew->level1[i] = copy_char_table_entry (new_); | |
| 428 | 826 else |
| 3025 | 827 ctnew->level1[i] = new_; |
| 428 | 828 } |
| 829 | |
| 830 #endif /* MULE */ | |
| 831 | |
| 3881 | 832 if (!EQ (ct->mirror_table, Qnil)) |
| 1296 | 833 { |
| 3879 | 834 ctnew->mirror_table = Fmake_char_table (Qgeneric); |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5563
diff
changeset
|
835 set_char_table_default (ctnew->mirror_table, make_fixnum (Sword)); |
| 1296 | 836 XCHAR_TABLE (ctnew->mirror_table)->mirror_table = obj; |
| 3879 | 837 XCHAR_TABLE (ctnew->mirror_table)->mirror_table_p = 1; |
| 838 XCHAR_TABLE (ctnew->mirror_table)->dirty = 1; | |
| 1296 | 839 } |
| 428 | 840 else |
| 3879 | 841 ctnew->mirror_table = Qnil; |
| 842 | |
| 428 | 843 ctnew->next_table = Qnil; |
| 844 if (ctnew->type == CHAR_TABLE_TYPE_SYNTAX) | |
| 845 { | |
| 846 ctnew->next_table = Vall_syntax_tables; | |
| 847 Vall_syntax_tables = obj; | |
| 848 } | |
| 849 return obj; | |
| 850 } | |
| 851 | |
| 852 #ifdef MULE | |
| 853 | |
| 826 | 854 /* called from get_char_table(). */ |
| 428 | 855 Lisp_Object |
| 440 | 856 get_non_ascii_char_table_value (Lisp_Char_Table *ct, int leading_byte, |
| 867 | 857 Ichar c) |
| 428 | 858 { |
| 859 Lisp_Object val; | |
| 826 | 860 Lisp_Object charset = charset_by_leading_byte (leading_byte); |
| 428 | 861 int byte1, byte2; |
| 862 | |
| 867 | 863 BREAKUP_ICHAR_1_UNSAFE (c, charset, byte1, byte2); |
| 428 | 864 val = ct->level1[leading_byte - MIN_LEADING_BYTE]; |
| 865 if (CHAR_TABLE_ENTRYP (val)) | |
| 866 { | |
| 440 | 867 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val); |
| 428 | 868 val = cte->level2[byte1 - 32]; |
| 869 if (CHAR_TABLE_ENTRYP (val)) | |
| 870 { | |
| 871 cte = XCHAR_TABLE_ENTRY (val); | |
| 872 assert (byte2 >= 32); | |
| 873 val = cte->level2[byte2 - 32]; | |
| 874 assert (!CHAR_TABLE_ENTRYP (val)); | |
| 875 } | |
| 876 } | |
| 877 | |
| 878 return val; | |
| 879 } | |
| 880 | |
| 881 #endif /* MULE */ | |
| 882 | |
| 826 | 883 DEFUN ("char-table-default", Fchar_table_default, 1, 1, 0, /* |
| 884 Return the default value for CHAR-TABLE. When an entry for a character | |
| 885 does not exist, the default is returned. | |
| 886 */ | |
| 887 (char_table)) | |
| 428 | 888 { |
| 826 | 889 CHECK_CHAR_TABLE (char_table); |
| 890 return XCHAR_TABLE (char_table)->default_; | |
| 428 | 891 } |
| 892 | |
| 826 | 893 DEFUN ("set-char-table-default", Fset_char_table_default, 2, 2, 0, /* |
| 894 Set the default value for CHAR-TABLE to DEFAULT. | |
| 895 Currently, the default value for syntax tables cannot be changed. | |
| 896 (This policy might change in the future.) | |
| 897 */ | |
| 898 (char_table, default_)) | |
| 899 { | |
| 900 CHECK_CHAR_TABLE (char_table); | |
| 901 if (XCHAR_TABLE_TYPE (char_table) == CHAR_TABLE_TYPE_SYNTAX) | |
| 902 invalid_change ("Can't change default for syntax tables", char_table); | |
| 903 check_valid_char_table_value (default_, XCHAR_TABLE_TYPE (char_table), | |
| 904 ERROR_ME); | |
| 905 set_char_table_default (char_table, default_); | |
| 906 return Qnil; | |
| 907 } | |
| 428 | 908 |
| 909 DEFUN ("get-char-table", Fget_char_table, 2, 2, 0, /* | |
| 444 | 910 Find value for CHARACTER in CHAR-TABLE. |
| 428 | 911 */ |
| 444 | 912 (character, char_table)) |
| 428 | 913 { |
| 444 | 914 CHECK_CHAR_TABLE (char_table); |
| 915 CHECK_CHAR_COERCE_INT (character); | |
| 428 | 916 |
| 826 | 917 return get_char_table (XCHAR (character), char_table); |
| 918 } | |
| 919 | |
| 920 static int | |
| 2286 | 921 copy_mapper (struct chartab_range *range, Lisp_Object UNUSED (table), |
| 826 | 922 Lisp_Object val, void *arg) |
| 923 { | |
| 5013 | 924 put_char_table (GET_LISP_FROM_VOID (arg), range, val); |
| 826 | 925 return 0; |
| 926 } | |
| 927 | |
| 928 void | |
| 929 copy_char_table_range (Lisp_Object from, Lisp_Object to, | |
| 930 struct chartab_range *range) | |
| 931 { | |
| 5013 | 932 map_char_table (from, range, copy_mapper, STORE_LISP_IN_VOID (to)); |
| 826 | 933 } |
| 934 | |
| 1296 | 935 static Lisp_Object |
| 936 get_range_char_table_1 (struct chartab_range *range, Lisp_Object table, | |
| 937 Lisp_Object multi) | |
| 826 | 938 { |
| 939 Lisp_Char_Table *ct = XCHAR_TABLE (table); | |
| 940 Lisp_Object retval = Qnil; | |
| 941 | |
| 942 switch (range->type) | |
| 943 { | |
| 944 case CHARTAB_RANGE_CHAR: | |
| 945 return get_char_table (range->ch, table); | |
| 946 | |
| 947 case CHARTAB_RANGE_ALL: | |
| 948 { | |
| 949 int i; | |
| 950 retval = ct->ascii[0]; | |
| 951 | |
| 952 for (i = 1; i < NUM_ASCII_CHARS; i++) | |
| 953 if (!EQ (retval, ct->ascii[i])) | |
| 954 return multi; | |
| 955 | |
| 956 #ifdef MULE | |
| 957 for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES; | |
| 958 i++) | |
| 959 { | |
| 960 if (!CHARSETP (charset_by_leading_byte (i)) | |
| 961 || i == LEADING_BYTE_ASCII | |
| 962 || i == LEADING_BYTE_CONTROL_1) | |
| 963 continue; | |
| 964 if (!EQ (retval, ct->level1[i - MIN_LEADING_BYTE])) | |
| 965 return multi; | |
| 966 } | |
| 967 #endif /* MULE */ | |
| 968 | |
| 969 break; | |
| 970 } | |
| 971 | |
| 972 #ifdef MULE | |
| 973 case CHARTAB_RANGE_CHARSET: | |
| 974 if (EQ (range->charset, Vcharset_ascii)) | |
| 975 { | |
| 976 int i; | |
| 977 retval = ct->ascii[0]; | |
| 978 | |
| 979 for (i = 1; i < 128; i++) | |
| 980 if (!EQ (retval, ct->ascii[i])) | |
| 981 return multi; | |
| 982 break; | |
| 983 } | |
| 984 | |
| 985 if (EQ (range->charset, Vcharset_control_1)) | |
| 986 { | |
| 987 int i; | |
| 988 retval = ct->ascii[128]; | |
| 989 | |
| 990 for (i = 129; i < 160; i++) | |
| 991 if (!EQ (retval, ct->ascii[i])) | |
| 992 return multi; | |
| 993 break; | |
| 994 } | |
| 995 | |
| 996 { | |
| 997 retval = ct->level1[XCHARSET_LEADING_BYTE (range->charset) - | |
| 998 MIN_LEADING_BYTE]; | |
| 999 if (CHAR_TABLE_ENTRYP (retval)) | |
| 1000 return multi; | |
| 1001 break; | |
| 1002 } | |
| 1003 | |
| 1004 case CHARTAB_RANGE_ROW: | |
| 1005 { | |
| 1006 retval = ct->level1[XCHARSET_LEADING_BYTE (range->charset) - | |
| 1007 MIN_LEADING_BYTE]; | |
| 1008 if (!CHAR_TABLE_ENTRYP (retval)) | |
| 1009 break; | |
| 1010 retval = XCHAR_TABLE_ENTRY (retval)->level2[range->row - 32]; | |
| 1011 if (CHAR_TABLE_ENTRYP (retval)) | |
| 1012 return multi; | |
| 1013 break; | |
| 1014 } | |
| 1015 #endif /* not MULE */ | |
| 1016 | |
| 1017 default: | |
| 2500 | 1018 ABORT (); |
| 826 | 1019 } |
| 1020 | |
| 1021 if (UNBOUNDP (retval)) | |
| 1022 return ct->default_; | |
| 1023 return retval; | |
| 428 | 1024 } |
| 1025 | |
| 1296 | 1026 Lisp_Object |
| 1027 get_range_char_table (struct chartab_range *range, Lisp_Object table, | |
| 1028 Lisp_Object multi) | |
| 1029 { | |
| 1030 if (range->type == CHARTAB_RANGE_CHAR) | |
| 1031 return get_char_table (range->ch, table); | |
| 1032 else | |
| 1033 return get_range_char_table_1 (range, table, multi); | |
| 1034 } | |
| 1035 | |
| 1036 #ifdef ERROR_CHECK_TYPES | |
| 1037 | |
| 1038 /* Only exists so as not to trip an assert in get_char_table(). */ | |
| 1039 Lisp_Object | |
| 1040 updating_mirror_get_range_char_table (struct chartab_range *range, | |
| 1041 Lisp_Object table, | |
| 1042 Lisp_Object multi) | |
| 1043 { | |
| 1044 if (range->type == CHARTAB_RANGE_CHAR) | |
| 1045 return get_char_table_1 (range->ch, table); | |
| 1046 else | |
| 1047 return get_range_char_table_1 (range, table, multi); | |
| 1048 } | |
| 1049 | |
| 1050 #endif /* ERROR_CHECK_TYPES */ | |
| 1051 | |
| 428 | 1052 DEFUN ("get-range-char-table", Fget_range_char_table, 2, 3, 0, /* |
| 2714 | 1053 Find value for RANGE in CHAR-TABLE. |
| 428 | 1054 If there is more than one value, return MULTI (defaults to nil). |
| 2714 | 1055 |
| 1056 Valid values for RANGE are single characters, charsets, a row in a | |
| 1057 two-octet charset, and all characters. See `put-char-table'. | |
| 428 | 1058 */ |
| 444 | 1059 (range, char_table, multi)) |
| 428 | 1060 { |
| 1061 struct chartab_range rainj; | |
| 1062 | |
| 1063 if (CHAR_OR_CHAR_INTP (range)) | |
| 444 | 1064 return Fget_char_table (range, char_table); |
| 1065 CHECK_CHAR_TABLE (char_table); | |
| 428 | 1066 |
| 1067 decode_char_table_range (range, &rainj); | |
| 826 | 1068 return get_range_char_table (&rainj, char_table, multi); |
| 428 | 1069 } |
| 826 | 1070 |
| 428 | 1071 static int |
| 1072 check_valid_char_table_value (Lisp_Object value, enum char_table_type type, | |
| 578 | 1073 Error_Behavior errb) |
| 428 | 1074 { |
| 1075 switch (type) | |
| 1076 { | |
| 1077 case CHAR_TABLE_TYPE_SYNTAX: | |
| 1078 if (!ERRB_EQ (errb, ERROR_ME)) | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5563
diff
changeset
|
1079 return FIXNUMP (value) || (CONSP (value) && FIXNUMP (XCAR (value)) |
| 428 | 1080 && CHAR_OR_CHAR_INTP (XCDR (value))); |
| 1081 if (CONSP (value)) | |
| 1082 { | |
| 1083 Lisp_Object cdr = XCDR (value); | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5563
diff
changeset
|
1084 CHECK_FIXNUM (XCAR (value)); |
| 428 | 1085 CHECK_CHAR_COERCE_INT (cdr); |
| 1086 } | |
| 1087 else | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5563
diff
changeset
|
1088 CHECK_FIXNUM (value); |
| 428 | 1089 break; |
| 1090 | |
| 1091 #ifdef MULE | |
| 1092 case CHAR_TABLE_TYPE_CATEGORY: | |
| 1093 if (!ERRB_EQ (errb, ERROR_ME)) | |
| 1094 return CATEGORY_TABLE_VALUEP (value); | |
| 1095 CHECK_CATEGORY_TABLE_VALUE (value); | |
| 1096 break; | |
| 1097 #endif /* MULE */ | |
| 1098 | |
| 1099 case CHAR_TABLE_TYPE_GENERIC: | |
| 1100 return 1; | |
| 1101 | |
| 1102 case CHAR_TABLE_TYPE_DISPLAY: | |
| 1103 /* #### fix this */ | |
| 563 | 1104 maybe_signal_error (Qunimplemented, |
| 1105 "Display char tables not yet implemented", | |
| 1106 value, Qchar_table, errb); | |
| 428 | 1107 return 0; |
| 1108 | |
| 1109 case CHAR_TABLE_TYPE_CHAR: | |
| 1110 if (!ERRB_EQ (errb, ERROR_ME)) | |
| 1111 return CHAR_OR_CHAR_INTP (value); | |
| 1112 CHECK_CHAR_COERCE_INT (value); | |
| 1113 break; | |
| 1114 | |
| 1115 default: | |
| 2500 | 1116 ABORT (); |
| 428 | 1117 } |
| 1118 | |
| 801 | 1119 return 0; /* not (usually) reached */ |
| 428 | 1120 } |
| 1121 | |
| 1122 static Lisp_Object | |
| 1123 canonicalize_char_table_value (Lisp_Object value, enum char_table_type type) | |
| 1124 { | |
| 1125 switch (type) | |
| 1126 { | |
| 1127 case CHAR_TABLE_TYPE_SYNTAX: | |
| 1128 if (CONSP (value)) | |
| 1129 { | |
| 1130 Lisp_Object car = XCAR (value); | |
| 1131 Lisp_Object cdr = XCDR (value); | |
| 1132 CHECK_CHAR_COERCE_INT (cdr); | |
| 1133 return Fcons (car, cdr); | |
| 1134 } | |
| 1135 break; | |
| 1136 case CHAR_TABLE_TYPE_CHAR: | |
| 1137 CHECK_CHAR_COERCE_INT (value); | |
| 1138 break; | |
| 1139 default: | |
| 1140 break; | |
| 1141 } | |
| 1142 return value; | |
| 1143 } | |
| 1144 | |
| 1145 DEFUN ("valid-char-table-value-p", Fvalid_char_table_value_p, 2, 2, 0, /* | |
| 1146 Return non-nil if VALUE is a valid value for CHAR-TABLE-TYPE. | |
| 1147 */ | |
| 1148 (value, char_table_type)) | |
| 1149 { | |
| 1150 enum char_table_type type = symbol_to_char_table_type (char_table_type); | |
| 1151 | |
| 1152 return check_valid_char_table_value (value, type, ERROR_ME_NOT) ? Qt : Qnil; | |
| 1153 } | |
| 1154 | |
| 1155 DEFUN ("check-valid-char-table-value", Fcheck_valid_char_table_value, 2, 2, 0, /* | |
| 1156 Signal an error if VALUE is not a valid value for CHAR-TABLE-TYPE. | |
| 1157 */ | |
| 1158 (value, char_table_type)) | |
| 1159 { | |
| 1160 enum char_table_type type = symbol_to_char_table_type (char_table_type); | |
| 1161 | |
| 1162 check_valid_char_table_value (value, type, ERROR_ME); | |
| 1163 return Qnil; | |
| 1164 } | |
| 1165 | |
| 826 | 1166 /* Assign VAL to all characters in RANGE in char table TABLE. */ |
| 428 | 1167 |
| 1168 void | |
| 826 | 1169 put_char_table (Lisp_Object table, struct chartab_range *range, |
| 428 | 1170 Lisp_Object val) |
| 1171 { | |
| 826 | 1172 Lisp_Char_Table *ct = XCHAR_TABLE (table); |
| 1173 | |
| 428 | 1174 switch (range->type) |
| 1175 { | |
| 1176 case CHARTAB_RANGE_ALL: | |
| 1177 fill_char_table (ct, val); | |
| 1296 | 1178 return; /* fill_char_table() recorded the table as dirty. */ |
| 428 | 1179 |
| 1180 #ifdef MULE | |
| 1181 case CHARTAB_RANGE_CHARSET: | |
| 1182 if (EQ (range->charset, Vcharset_ascii)) | |
| 1183 { | |
| 1184 int i; | |
| 1185 for (i = 0; i < 128; i++) | |
| 1186 ct->ascii[i] = val; | |
| 1187 } | |
| 1188 else if (EQ (range->charset, Vcharset_control_1)) | |
| 1189 { | |
| 1190 int i; | |
| 1191 for (i = 128; i < 160; i++) | |
| 1192 ct->ascii[i] = val; | |
| 1193 } | |
| 1194 else | |
| 1195 { | |
| 1196 int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE; | |
| 1330 | 1197 if (CHAR_TABLE_ENTRYP (ct->level1[lb]) && |
| 1198 !OBJECT_DUMPED_P (ct->level1[lb])) | |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
1199 free_normal_lisp_object (ct->level1[lb]); |
| 428 | 1200 ct->level1[lb] = val; |
| 1201 } | |
| 1202 break; | |
| 1203 | |
| 1204 case CHARTAB_RANGE_ROW: | |
| 1205 { | |
| 440 | 1206 Lisp_Char_Table_Entry *cte; |
| 428 | 1207 int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE; |
| 1208 /* make sure that there is a separate entry for the row. */ | |
| 1209 if (!CHAR_TABLE_ENTRYP (ct->level1[lb])) | |
| 1210 ct->level1[lb] = make_char_table_entry (ct->level1[lb]); | |
| 1211 cte = XCHAR_TABLE_ENTRY (ct->level1[lb]); | |
| 1212 cte->level2[range->row - 32] = val; | |
| 1213 } | |
| 1214 break; | |
| 1215 #endif /* MULE */ | |
| 1216 | |
| 1217 case CHARTAB_RANGE_CHAR: | |
| 1218 #ifdef MULE | |
| 1219 { | |
| 1220 Lisp_Object charset; | |
| 1221 int byte1, byte2; | |
| 1222 | |
| 867 | 1223 BREAKUP_ICHAR (range->ch, charset, byte1, byte2); |
| 428 | 1224 if (EQ (charset, Vcharset_ascii)) |
| 1225 ct->ascii[byte1] = val; | |
| 1226 else if (EQ (charset, Vcharset_control_1)) | |
| 1227 ct->ascii[byte1 + 128] = val; | |
| 1228 else | |
| 1229 { | |
| 440 | 1230 Lisp_Char_Table_Entry *cte; |
| 428 | 1231 int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE; |
| 1232 /* make sure that there is a separate entry for the row. */ | |
| 1233 if (!CHAR_TABLE_ENTRYP (ct->level1[lb])) | |
| 1234 ct->level1[lb] = make_char_table_entry (ct->level1[lb]); | |
| 1235 cte = XCHAR_TABLE_ENTRY (ct->level1[lb]); | |
| 1236 /* now CTE is a char table entry for the charset; | |
| 1237 each entry is for a single row (or character of | |
| 1238 a one-octet charset). */ | |
| 1239 if (XCHARSET_DIMENSION (charset) == 1) | |
| 1240 cte->level2[byte1 - 32] = val; | |
| 1241 else | |
| 1242 { | |
| 1243 /* assigning to one character in a two-octet charset. */ | |
| 1244 /* make sure that the charset row contains a separate | |
| 1245 entry for each character. */ | |
| 1246 if (!CHAR_TABLE_ENTRYP (cte->level2[byte1 - 32])) | |
| 1247 cte->level2[byte1 - 32] = | |
| 1248 make_char_table_entry (cte->level2[byte1 - 32]); | |
| 1249 cte = XCHAR_TABLE_ENTRY (cte->level2[byte1 - 32]); | |
| 1250 cte->level2[byte2 - 32] = val; | |
| 1251 } | |
| 1252 } | |
| 1253 } | |
| 1254 #else /* not MULE */ | |
| 1255 ct->ascii[(unsigned char) (range->ch)] = val; | |
| 1256 break; | |
| 1257 #endif /* not MULE */ | |
| 1258 } | |
| 1259 | |
| 1260 if (ct->type == CHAR_TABLE_TYPE_SYNTAX) | |
| 1296 | 1261 set_char_table_dirty (wrap_char_table (ct)); |
| 428 | 1262 } |
| 1263 | |
| 1264 DEFUN ("put-char-table", Fput_char_table, 3, 3, 0, /* | |
| 444 | 1265 Set the value for chars in RANGE to be VALUE in CHAR-TABLE. |
| 428 | 1266 |
| 1267 RANGE specifies one or more characters to be affected and should be | |
| 1268 one of the following: | |
| 1269 | |
| 1270 -- t (all characters are affected) | |
| 1271 -- A charset (only allowed when Mule support is present) | |
| 2714 | 1272 -- A vector of two elements: a two-octet charset and a row number; the row |
| 1273 must be an integer, not a character (only allowed when Mule support is | |
| 1274 present) | |
| 428 | 1275 -- A single character |
| 1276 | |
| 444 | 1277 VALUE must be a value appropriate for the type of CHAR-TABLE. |
| 800 | 1278 See `make-char-table'. |
| 428 | 1279 */ |
| 444 | 1280 (range, value, char_table)) |
| 428 | 1281 { |
| 440 | 1282 Lisp_Char_Table *ct; |
| 428 | 1283 struct chartab_range rainj; |
| 1284 | |
| 444 | 1285 CHECK_CHAR_TABLE (char_table); |
| 1286 ct = XCHAR_TABLE (char_table); | |
| 1287 check_valid_char_table_value (value, ct->type, ERROR_ME); | |
| 428 | 1288 decode_char_table_range (range, &rainj); |
| 444 | 1289 value = canonicalize_char_table_value (value, ct->type); |
| 826 | 1290 put_char_table (char_table, &rainj, value); |
| 1291 return Qnil; | |
| 1292 } | |
| 1293 | |
| 1294 DEFUN ("remove-char-table", Fremove_char_table, 2, 2, 0, /* | |
| 1295 Remove any value from chars in RANGE in CHAR-TABLE. | |
| 1296 | |
| 1297 RANGE specifies one or more characters to be affected and should be | |
| 1298 one of the following: | |
| 1299 | |
| 1300 -- t (all characters are affected) | |
| 1301 -- A charset (only allowed when Mule support is present) | |
| 1302 -- A vector of two elements: a two-octet charset and a row number | |
| 1303 (only allowed when Mule support is present) | |
| 1304 -- A single character | |
| 1305 | |
| 2726 | 1306 With all values removed, the default value will be returned by |
| 1307 `get-char-table' and `get-range-char-table'. | |
| 826 | 1308 */ |
| 1309 (range, char_table)) | |
| 1310 { | |
| 1311 struct chartab_range rainj; | |
| 1312 | |
| 1313 CHECK_CHAR_TABLE (char_table); | |
| 1314 decode_char_table_range (range, &rainj); | |
| 1315 put_char_table (char_table, &rainj, Qunbound); | |
| 428 | 1316 return Qnil; |
| 1317 } | |
| 1318 | |
| 1319 /* Map FN over the ASCII chars in CT. */ | |
| 1320 | |
| 1321 static int | |
| 826 | 1322 map_over_charset_ascii_1 (Lisp_Char_Table *ct, |
| 1323 int start, int stop, | |
| 1324 int (*fn) (struct chartab_range *range, | |
| 1325 Lisp_Object table, Lisp_Object val, | |
| 1326 void *arg), | |
| 1327 void *arg) | |
| 1328 { | |
| 1329 struct chartab_range rainj; | |
| 1330 int i, retval; | |
| 1331 | |
| 1332 rainj.type = CHARTAB_RANGE_CHAR; | |
| 1333 | |
| 1334 for (i = start, retval = 0; i <= stop && retval == 0; i++) | |
| 1335 { | |
| 867 | 1336 rainj.ch = (Ichar) i; |
| 826 | 1337 if (!UNBOUNDP (ct->ascii[i])) |
| 1338 retval = (fn) (&rainj, wrap_char_table (ct), ct->ascii[i], arg); | |
| 1339 } | |
| 1340 | |
| 1341 return retval; | |
| 1342 } | |
| 1343 | |
| 1344 | |
| 1345 /* Map FN over the ASCII chars in CT. */ | |
| 1346 | |
| 1347 static int | |
| 440 | 1348 map_over_charset_ascii (Lisp_Char_Table *ct, |
| 428 | 1349 int (*fn) (struct chartab_range *range, |
| 826 | 1350 Lisp_Object table, Lisp_Object val, |
| 1351 void *arg), | |
| 428 | 1352 void *arg) |
| 1353 { | |
| 826 | 1354 return map_over_charset_ascii_1 (ct, 0, |
| 428 | 1355 #ifdef MULE |
| 826 | 1356 127, |
| 428 | 1357 #else |
| 826 | 1358 255, |
| 428 | 1359 #endif |
| 826 | 1360 fn, arg); |
| 428 | 1361 } |
| 1362 | |
| 1363 #ifdef MULE | |
| 1364 | |
| 1365 /* Map FN over the Control-1 chars in CT. */ | |
| 1366 | |
| 1367 static int | |
| 440 | 1368 map_over_charset_control_1 (Lisp_Char_Table *ct, |
| 428 | 1369 int (*fn) (struct chartab_range *range, |
| 826 | 1370 Lisp_Object table, Lisp_Object val, |
| 1371 void *arg), | |
| 428 | 1372 void *arg) |
| 1373 { | |
| 826 | 1374 return map_over_charset_ascii_1 (ct, 128, 159, fn, arg); |
| 428 | 1375 } |
| 1376 | |
| 1377 /* Map FN over the row ROW of two-byte charset CHARSET. | |
| 1378 There must be a separate value for that row in the char table. | |
| 1379 CTE specifies the char table entry for CHARSET. */ | |
| 1380 | |
| 1381 static int | |
| 826 | 1382 map_over_charset_row (Lisp_Char_Table *ct, |
| 1383 Lisp_Char_Table_Entry *cte, | |
| 428 | 1384 Lisp_Object charset, int row, |
| 1385 int (*fn) (struct chartab_range *range, | |
| 826 | 1386 Lisp_Object table, Lisp_Object val, |
| 1387 void *arg), | |
| 428 | 1388 void *arg) |
| 1389 { | |
| 1390 Lisp_Object val = cte->level2[row - 32]; | |
| 1391 | |
| 826 | 1392 if (UNBOUNDP (val)) |
| 1393 return 0; | |
| 1394 else if (!CHAR_TABLE_ENTRYP (val)) | |
| 428 | 1395 { |
| 1396 struct chartab_range rainj; | |
| 826 | 1397 |
| 428 | 1398 rainj.type = CHARTAB_RANGE_ROW; |
| 1399 rainj.charset = charset; | |
| 1400 rainj.row = row; | |
| 826 | 1401 return (fn) (&rainj, wrap_char_table (ct), val, arg); |
| 428 | 1402 } |
| 1403 else | |
| 1404 { | |
| 1405 struct chartab_range rainj; | |
| 1406 int i, retval; | |
| 826 | 1407 int start, stop; |
| 1408 | |
| 1409 get_charset_limits (charset, &start, &stop); | |
| 428 | 1410 |
| 1411 cte = XCHAR_TABLE_ENTRY (val); | |
| 1412 | |
| 1413 rainj.type = CHARTAB_RANGE_CHAR; | |
| 1414 | |
| 826 | 1415 for (i = start, retval = 0; i <= stop && retval == 0; i++) |
| 428 | 1416 { |
| 867 | 1417 rainj.ch = make_ichar (charset, row, i); |
| 826 | 1418 if (!UNBOUNDP (cte->level2[i - 32])) |
| 1419 retval = (fn) (&rainj, wrap_char_table (ct), cte->level2[i - 32], | |
| 1420 arg); | |
| 428 | 1421 } |
| 1422 return retval; | |
| 1423 } | |
| 1424 } | |
| 1425 | |
| 1426 | |
| 1427 static int | |
| 440 | 1428 map_over_other_charset (Lisp_Char_Table *ct, int lb, |
| 428 | 1429 int (*fn) (struct chartab_range *range, |
| 826 | 1430 Lisp_Object table, Lisp_Object val, |
| 1431 void *arg), | |
| 428 | 1432 void *arg) |
| 1433 { | |
| 1434 Lisp_Object val = ct->level1[lb - MIN_LEADING_BYTE]; | |
| 826 | 1435 Lisp_Object charset = charset_by_leading_byte (lb); |
| 428 | 1436 |
| 1437 if (!CHARSETP (charset) | |
| 1438 || lb == LEADING_BYTE_ASCII | |
| 1439 || lb == LEADING_BYTE_CONTROL_1) | |
| 1440 return 0; | |
| 1441 | |
| 826 | 1442 if (UNBOUNDP (val)) |
| 1443 return 0; | |
| 428 | 1444 if (!CHAR_TABLE_ENTRYP (val)) |
| 1445 { | |
| 1446 struct chartab_range rainj; | |
| 1447 | |
| 1448 rainj.type = CHARTAB_RANGE_CHARSET; | |
| 1449 rainj.charset = charset; | |
| 826 | 1450 return (fn) (&rainj, wrap_char_table (ct), val, arg); |
| 428 | 1451 } |
| 1452 { | |
| 440 | 1453 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val); |
| 826 | 1454 int start, stop; |
| 428 | 1455 int i, retval; |
| 1456 | |
| 826 | 1457 get_charset_limits (charset, &start, &stop); |
| 428 | 1458 if (XCHARSET_DIMENSION (charset) == 1) |
| 1459 { | |
| 1460 struct chartab_range rainj; | |
| 1461 rainj.type = CHARTAB_RANGE_CHAR; | |
| 1462 | |
| 826 | 1463 for (i = start, retval = 0; i <= stop && retval == 0; i++) |
| 428 | 1464 { |
| 867 | 1465 rainj.ch = make_ichar (charset, i, 0); |
| 826 | 1466 if (!UNBOUNDP (cte->level2[i - 32])) |
| 1467 retval = (fn) (&rainj, wrap_char_table (ct), cte->level2[i - 32], | |
| 1468 arg); | |
| 428 | 1469 } |
| 1470 } | |
| 1471 else | |
| 1472 { | |
| 826 | 1473 for (i = start, retval = 0; i <= stop && retval == 0; i++) |
| 1474 retval = map_over_charset_row (ct, cte, charset, i, fn, arg); | |
| 428 | 1475 } |
| 1476 | |
| 1477 return retval; | |
| 1478 } | |
| 1479 } | |
| 1480 | |
| 1481 #endif /* MULE */ | |
| 1482 | |
| 1483 /* Map FN (with client data ARG) over range RANGE in char table CT. | |
| 1484 Mapping stops the first time FN returns non-zero, and that value | |
| 826 | 1485 becomes the return value of map_char_table(). |
| 1486 | |
| 1487 #### This mapping code is way ugly. The FSF version, in contrast, | |
| 1488 is short and sweet, and much more recursive. There should be some way | |
| 1489 of cleaning this up. */ | |
| 428 | 1490 |
| 1491 int | |
| 826 | 1492 map_char_table (Lisp_Object table, |
| 428 | 1493 struct chartab_range *range, |
| 1494 int (*fn) (struct chartab_range *range, | |
| 826 | 1495 Lisp_Object table, Lisp_Object val, void *arg), |
| 428 | 1496 void *arg) |
| 1497 { | |
| 826 | 1498 Lisp_Char_Table *ct = XCHAR_TABLE (table); |
| 428 | 1499 switch (range->type) |
| 1500 { | |
| 1501 case CHARTAB_RANGE_ALL: | |
| 1502 { | |
| 1503 int retval; | |
| 1504 | |
| 1505 retval = map_over_charset_ascii (ct, fn, arg); | |
| 1506 if (retval) | |
| 1507 return retval; | |
| 1508 #ifdef MULE | |
| 1509 retval = map_over_charset_control_1 (ct, fn, arg); | |
| 1510 if (retval) | |
| 1511 return retval; | |
| 1512 { | |
| 1513 int i; | |
| 1514 int start = MIN_LEADING_BYTE; | |
| 1515 int stop = start + NUM_LEADING_BYTES; | |
| 1516 | |
| 1517 for (i = start, retval = 0; i < stop && retval == 0; i++) | |
| 1518 { | |
| 771 | 1519 if (i != LEADING_BYTE_ASCII && i != LEADING_BYTE_CONTROL_1) |
| 1520 retval = map_over_other_charset (ct, i, fn, arg); | |
| 428 | 1521 } |
| 1522 } | |
| 1523 #endif /* MULE */ | |
| 1524 return retval; | |
| 1525 } | |
| 1526 | |
| 1527 #ifdef MULE | |
| 1528 case CHARTAB_RANGE_CHARSET: | |
| 1529 return map_over_other_charset (ct, | |
| 1530 XCHARSET_LEADING_BYTE (range->charset), | |
| 1531 fn, arg); | |
| 1532 | |
| 1533 case CHARTAB_RANGE_ROW: | |
| 1534 { | |
| 771 | 1535 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (range->charset) - |
| 1536 MIN_LEADING_BYTE]; | |
| 826 | 1537 |
| 1538 if (CHAR_TABLE_ENTRYP (val)) | |
| 1539 return map_over_charset_row (ct, XCHAR_TABLE_ENTRY (val), | |
| 1540 range->charset, range->row, fn, arg); | |
| 1541 else if (!UNBOUNDP (val)) | |
| 428 | 1542 { |
| 1543 struct chartab_range rainj; | |
| 1544 | |
| 1545 rainj.type = CHARTAB_RANGE_ROW; | |
| 1546 rainj.charset = range->charset; | |
| 1547 rainj.row = range->row; | |
| 826 | 1548 return (fn) (&rainj, table, val, arg); |
| 428 | 1549 } |
| 1550 else | |
| 826 | 1551 return 0; |
| 428 | 1552 } |
| 1553 #endif /* MULE */ | |
| 1554 | |
| 1555 case CHARTAB_RANGE_CHAR: | |
| 1556 { | |
| 867 | 1557 Ichar ch = range->ch; |
| 826 | 1558 Lisp_Object val = get_char_table (ch, table); |
| 428 | 1559 struct chartab_range rainj; |
| 1560 | |
| 826 | 1561 if (!UNBOUNDP (val)) |
| 1562 { | |
| 1563 rainj.type = CHARTAB_RANGE_CHAR; | |
| 1564 rainj.ch = ch; | |
| 1565 return (fn) (&rainj, table, val, arg); | |
| 1566 } | |
| 1567 else | |
| 1568 return 0; | |
| 428 | 1569 } |
| 1570 | |
| 1571 default: | |
| 2500 | 1572 ABORT (); |
| 428 | 1573 } |
| 1574 | |
| 1575 return 0; | |
| 1576 } | |
| 1577 | |
| 1578 struct slow_map_char_table_arg | |
| 1579 { | |
| 1580 Lisp_Object function; | |
| 1581 Lisp_Object retval; | |
| 1582 }; | |
| 1583 | |
| 1584 static int | |
| 1585 slow_map_char_table_fun (struct chartab_range *range, | |
| 2286 | 1586 Lisp_Object UNUSED (table), Lisp_Object val, |
| 1587 void *arg) | |
| 428 | 1588 { |
| 1589 struct slow_map_char_table_arg *closure = | |
| 1590 (struct slow_map_char_table_arg *) arg; | |
| 1591 | |
| 826 | 1592 closure->retval = call2 (closure->function, encode_char_table_range (range), |
| 1593 val); | |
| 428 | 1594 return !NILP (closure->retval); |
| 1595 } | |
| 1596 | |
| 1597 DEFUN ("map-char-table", Fmap_char_table, 2, 3, 0, /* | |
| 2726 | 1598 Map FUNCTION over CHAR-TABLE until it returns non-nil; return that value. |
| 1599 FUNCTION is called with two arguments, each key and entry in the table. | |
| 1600 | |
| 1601 RANGE specifies a subrange to map over. If omitted or t, it defaults to | |
| 1602 the entire table. | |
| 428 | 1603 |
| 2726 | 1604 Both RANGE and the keys passed to FUNCTION are in the same format as the |
| 1605 RANGE argument to `put-char-table'. N.B. This function does NOT map over | |
| 1606 all characters in RANGE, but over the subranges that have been assigned to. | |
| 1607 Thus this function is most suitable for searching a char-table, or for | |
| 1608 populating one char-table based on the contents of another. The current | |
| 1609 implementation does not coalesce ranges all of whose values are the same. | |
| 428 | 1610 */ |
| 444 | 1611 (function, char_table, range)) |
| 428 | 1612 { |
| 1613 struct slow_map_char_table_arg slarg; | |
| 1614 struct gcpro gcpro1, gcpro2; | |
| 1615 struct chartab_range rainj; | |
| 1616 | |
| 444 | 1617 CHECK_CHAR_TABLE (char_table); |
| 428 | 1618 if (NILP (range)) |
| 1619 range = Qt; | |
| 1620 decode_char_table_range (range, &rainj); | |
| 1621 slarg.function = function; | |
| 1622 slarg.retval = Qnil; | |
| 1623 GCPRO2 (slarg.function, slarg.retval); | |
| 826 | 1624 map_char_table (char_table, &rainj, slow_map_char_table_fun, &slarg); |
| 428 | 1625 UNGCPRO; |
| 1626 | |
| 1627 return slarg.retval; | |
| 1628 } | |
| 1629 | |
| 1630 | |
| 1631 | |
| 1632 /************************************************************************/ | |
| 1633 /* Char table read syntax */ | |
| 1634 /************************************************************************/ | |
| 1635 | |
| 1636 static int | |
| 2286 | 1637 chartab_type_validate (Lisp_Object UNUSED (keyword), Lisp_Object value, |
| 1638 Error_Behavior UNUSED (errb)) | |
| 428 | 1639 { |
| 1640 /* #### should deal with ERRB */ | |
| 1641 symbol_to_char_table_type (value); | |
| 1642 return 1; | |
| 1643 } | |
| 1644 | |
| 826 | 1645 /* #### Document the print/read format; esp. what's this cons element? */ |
| 1646 | |
| 428 | 1647 static int |
| 2286 | 1648 chartab_data_validate (Lisp_Object UNUSED (keyword), Lisp_Object value, |
| 1649 Error_Behavior UNUSED (errb)) | |
| 428 | 1650 { |
| 1651 /* #### should deal with ERRB */ | |
| 2367 | 1652 EXTERNAL_PROPERTY_LIST_LOOP_3 (range, data, value) |
| 428 | 1653 { |
| 1654 struct chartab_range dummy; | |
| 1655 | |
| 1656 if (CONSP (range)) | |
| 1657 { | |
| 1658 if (!CONSP (XCDR (range)) | |
| 1659 || !NILP (XCDR (XCDR (range)))) | |
| 563 | 1660 sferror ("Invalid range format", range); |
| 428 | 1661 decode_char_table_range (XCAR (range), &dummy); |
| 1662 decode_char_table_range (XCAR (XCDR (range)), &dummy); | |
| 1663 } | |
| 1664 else | |
| 1665 decode_char_table_range (range, &dummy); | |
| 1666 } | |
| 1667 | |
| 1668 return 1; | |
| 1669 } | |
| 1670 | |
|
5259
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
1671 static int |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
1672 chartab_default_validate (Lisp_Object UNUSED (keyword), |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
1673 Lisp_Object UNUSED (value), |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
1674 Error_Behavior UNUSED (errb)) |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
1675 { |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
1676 /* We can't yet validate this, since we don't know what the type of the |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
1677 char table is. We do the validation below in chartab_instantiate(). */ |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
1678 return 1; |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
1679 } |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
1680 |
| 428 | 1681 static Lisp_Object |
|
5222
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1682 chartab_instantiate (Lisp_Object plist) |
| 428 | 1683 { |
| 1684 Lisp_Object chartab; | |
| 1685 Lisp_Object type = Qgeneric; | |
|
5259
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
1686 Lisp_Object dataval = Qnil, default_ = Qunbound; |
| 428 | 1687 |
|
5222
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1688 if (KEYWORDP (Fcar (plist))) |
| 428 | 1689 { |
|
5222
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1690 PROPERTY_LIST_LOOP_3 (key, value, plist) |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1691 { |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1692 if (EQ (key, Q_data)) |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1693 { |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1694 dataval = value; |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1695 } |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1696 else if (EQ (key, Q_type)) |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1697 { |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1698 type = value; |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1699 } |
|
5320
31be2a3d121d
Move Qcount, Q_default, Q_test to general-slots.h; add SYMBOL_KEYWORD_GENERAL()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
1700 else if (EQ (key, Q_default_)) |
|
5259
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
1701 { |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
1702 default_ = value; |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
1703 } |
|
5222
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1704 else if (!KEYWORDP (key)) |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1705 { |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1706 signal_error |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1707 (Qinvalid_read_syntax, |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1708 "can't mix keyword and non-keyword structure syntax", |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1709 key); |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1710 } |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1711 else |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1712 ABORT (); |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1713 } |
| 428 | 1714 } |
|
5222
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1715 #ifdef NEED_TO_HANDLE_21_4_CODE |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1716 else |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1717 { |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1718 PROPERTY_LIST_LOOP_3 (key, value, plist) |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1719 { |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1720 if (EQ (key, Qdata)) |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1721 { |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1722 dataval = value; |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1723 } |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1724 else if (EQ (key, Qtype)) |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1725 { |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1726 type = value; |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1727 } |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1728 else if (KEYWORDP (key)) |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1729 signal_error |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1730 (Qinvalid_read_syntax, |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1731 "can't mix keyword and non-keyword structure syntax", |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1732 key); |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1733 else |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1734 ABORT (); |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1735 } |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1736 } |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1737 #endif /* NEED_TO_HANDLE_21_4_CODE */ |
| 428 | 1738 |
| 1739 chartab = Fmake_char_table (type); | |
|
5259
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
1740 if (!UNBOUNDP (default_)) |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
1741 { |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
1742 check_valid_char_table_value (default_, XCHAR_TABLE_TYPE (chartab), |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
1743 ERROR_ME); |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
1744 set_char_table_default (chartab, default_); |
|
5320
31be2a3d121d
Move Qcount, Q_default, Q_test to general-slots.h; add SYMBOL_KEYWORD_GENERAL()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
1745 if (!NILP (XCHAR_TABLE (chartab)->mirror_table)) |
|
31be2a3d121d
Move Qcount, Q_default, Q_test to general-slots.h; add SYMBOL_KEYWORD_GENERAL()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
1746 { |
|
31be2a3d121d
Move Qcount, Q_default, Q_test to general-slots.h; add SYMBOL_KEYWORD_GENERAL()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
1747 set_char_table_default (XCHAR_TABLE (chartab)->mirror_table, |
|
31be2a3d121d
Move Qcount, Q_default, Q_test to general-slots.h; add SYMBOL_KEYWORD_GENERAL()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
1748 default_); |
|
31be2a3d121d
Move Qcount, Q_default, Q_test to general-slots.h; add SYMBOL_KEYWORD_GENERAL()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
1749 } |
|
5259
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
1750 } |
| 428 | 1751 |
|
5222
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1752 while (!NILP (dataval)) |
| 428 | 1753 { |
|
5222
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1754 Lisp_Object range = Fcar (dataval); |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1755 Lisp_Object val = Fcar (Fcdr (dataval)); |
| 428 | 1756 |
|
5222
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1757 dataval = Fcdr (Fcdr (dataval)); |
| 428 | 1758 if (CONSP (range)) |
| 1759 { | |
| 1760 if (CHAR_OR_CHAR_INTP (XCAR (range))) | |
| 1761 { | |
| 867 | 1762 Ichar first = XCHAR_OR_CHAR_INT (Fcar (range)); |
| 1763 Ichar last = XCHAR_OR_CHAR_INT (Fcar (Fcdr (range))); | |
| 1764 Ichar i; | |
| 428 | 1765 |
| 1766 for (i = first; i <= last; i++) | |
| 1767 Fput_char_table (make_char (i), val, chartab); | |
| 1768 } | |
| 1769 else | |
| 2500 | 1770 ABORT (); |
| 428 | 1771 } |
| 1772 else | |
| 1773 Fput_char_table (range, val, chartab); | |
| 1774 } | |
| 1775 | |
| 1776 return chartab; | |
| 1777 } | |
| 1778 | |
| 1779 #ifdef MULE | |
| 1780 | |
| 1781 | |
| 1782 /************************************************************************/ | |
| 1783 /* Category Tables, specifically */ | |
| 1784 /************************************************************************/ | |
| 1785 | |
| 1786 DEFUN ("category-table-p", Fcategory_table_p, 1, 1, 0, /* | |
| 444 | 1787 Return t if OBJECT is a category table. |
| 428 | 1788 A category table is a type of char table used for keeping track of |
| 1789 categories. Categories are used for classifying characters for use | |
| 1790 in regexps -- you can refer to a category rather than having to use | |
| 1791 a complicated [] expression (and category lookups are significantly | |
| 1792 faster). | |
| 1793 | |
| 1794 There are 95 different categories available, one for each printable | |
| 1795 character (including space) in the ASCII charset. Each category | |
| 1796 is designated by one such character, called a "category designator". | |
| 1797 They are specified in a regexp using the syntax "\\cX", where X is | |
| 1798 a category designator. | |
| 1799 | |
| 1800 A category table specifies, for each character, the categories that | |
| 1801 the character is in. Note that a character can be in more than one | |
| 1802 category. More specifically, a category table maps from a character | |
| 1803 to either the value nil (meaning the character is in no categories) | |
| 1804 or a 95-element bit vector, specifying for each of the 95 categories | |
| 1805 whether the character is in that category. | |
| 1806 | |
| 1807 Special Lisp functions are provided that abstract this, so you do not | |
| 1808 have to directly manipulate bit vectors. | |
| 1809 */ | |
| 444 | 1810 (object)) |
| 428 | 1811 { |
| 444 | 1812 return (CHAR_TABLEP (object) && |
| 1813 XCHAR_TABLE_TYPE (object) == CHAR_TABLE_TYPE_CATEGORY) ? | |
| 428 | 1814 Qt : Qnil; |
| 1815 } | |
| 1816 | |
| 1817 static Lisp_Object | |
| 444 | 1818 check_category_table (Lisp_Object object, Lisp_Object default_) |
| 428 | 1819 { |
| 444 | 1820 if (NILP (object)) |
| 1821 object = default_; | |
| 1822 while (NILP (Fcategory_table_p (object))) | |
| 1823 object = wrong_type_argument (Qcategory_table_p, object); | |
| 1824 return object; | |
| 428 | 1825 } |
| 1826 | |
| 1827 int | |
| 867 | 1828 check_category_char (Ichar ch, Lisp_Object table, |
| 647 | 1829 int designator, int not_p) |
| 428 | 1830 { |
| 1831 REGISTER Lisp_Object temp; | |
| 1832 if (NILP (Fcategory_table_p (table))) | |
| 563 | 1833 wtaerror ("Expected category table", table); |
| 826 | 1834 temp = get_char_table (ch, table); |
| 428 | 1835 if (NILP (temp)) |
| 458 | 1836 return not_p; |
| 428 | 1837 |
| 1838 designator -= ' '; | |
| 458 | 1839 return bit_vector_bit (XBIT_VECTOR (temp), designator) ? !not_p : not_p; |
| 428 | 1840 } |
| 1841 | |
| 1842 DEFUN ("check-category-at", Fcheck_category_at, 2, 4, 0, /* | |
| 444 | 1843 Return t if category of the character at POSITION includes DESIGNATOR. |
| 1844 Optional third arg BUFFER specifies which buffer to use, and defaults | |
| 1845 to the current buffer. | |
| 1846 Optional fourth arg CATEGORY-TABLE specifies the category table to | |
| 1847 use, and defaults to BUFFER's category table. | |
| 428 | 1848 */ |
| 444 | 1849 (position, designator, buffer, category_table)) |
| 428 | 1850 { |
| 1851 Lisp_Object ctbl; | |
| 867 | 1852 Ichar ch; |
| 647 | 1853 int des; |
| 428 | 1854 struct buffer *buf = decode_buffer (buffer, 0); |
| 1855 | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5563
diff
changeset
|
1856 CHECK_FIXNUM (position); |
| 428 | 1857 CHECK_CATEGORY_DESIGNATOR (designator); |
| 1858 des = XCHAR (designator); | |
| 788 | 1859 ctbl = check_category_table (category_table, buf->category_table); |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5563
diff
changeset
|
1860 ch = BUF_FETCH_CHAR (buf, XFIXNUM (position)); |
| 428 | 1861 return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil; |
| 1862 } | |
| 1863 | |
| 1864 DEFUN ("char-in-category-p", Fchar_in_category_p, 2, 3, 0, /* | |
| 788 | 1865 Return non-nil if category of CHARACTER includes DESIGNATOR. |
| 444 | 1866 Optional third arg CATEGORY-TABLE specifies the category table to use, |
| 788 | 1867 and defaults to the current buffer's category table. |
| 428 | 1868 */ |
| 444 | 1869 (character, designator, category_table)) |
| 428 | 1870 { |
| 1871 Lisp_Object ctbl; | |
| 867 | 1872 Ichar ch; |
| 647 | 1873 int des; |
| 428 | 1874 |
| 1875 CHECK_CATEGORY_DESIGNATOR (designator); | |
| 1876 des = XCHAR (designator); | |
| 444 | 1877 CHECK_CHAR (character); |
| 1878 ch = XCHAR (character); | |
| 788 | 1879 ctbl = check_category_table (category_table, current_buffer->category_table); |
| 428 | 1880 return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil; |
| 1881 } | |
| 1882 | |
| 1883 DEFUN ("category-table", Fcategory_table, 0, 1, 0, /* | |
| 444 | 1884 Return BUFFER's current category table. |
| 1885 BUFFER defaults to the current buffer. | |
| 428 | 1886 */ |
| 1887 (buffer)) | |
| 1888 { | |
| 1889 return decode_buffer (buffer, 0)->category_table; | |
| 1890 } | |
| 1891 | |
| 1892 DEFUN ("standard-category-table", Fstandard_category_table, 0, 0, 0, /* | |
| 1893 Return the standard category table. | |
| 1894 This is the one used for new buffers. | |
| 1895 */ | |
| 1896 ()) | |
| 1897 { | |
| 1898 return Vstandard_category_table; | |
| 1899 } | |
| 1900 | |
| 1901 DEFUN ("copy-category-table", Fcopy_category_table, 0, 1, 0, /* | |
| 444 | 1902 Return a new category table which is a copy of CATEGORY-TABLE. |
| 1903 CATEGORY-TABLE defaults to the standard category table. | |
| 428 | 1904 */ |
| 444 | 1905 (category_table)) |
| 428 | 1906 { |
| 1907 if (NILP (Vstandard_category_table)) | |
| 1908 return Fmake_char_table (Qcategory); | |
| 1909 | |
| 444 | 1910 category_table = |
| 1911 check_category_table (category_table, Vstandard_category_table); | |
| 1912 return Fcopy_char_table (category_table); | |
| 428 | 1913 } |
| 1914 | |
| 1915 DEFUN ("set-category-table", Fset_category_table, 1, 2, 0, /* | |
| 444 | 1916 Select CATEGORY-TABLE as the new category table for BUFFER. |
| 428 | 1917 BUFFER defaults to the current buffer if omitted. |
| 1918 */ | |
| 444 | 1919 (category_table, buffer)) |
| 428 | 1920 { |
| 1921 struct buffer *buf = decode_buffer (buffer, 0); | |
| 444 | 1922 category_table = check_category_table (category_table, Qnil); |
| 1923 buf->category_table = category_table; | |
| 428 | 1924 /* Indicate that this buffer now has a specified category table. */ |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5563
diff
changeset
|
1925 buf->local_var_flags |= XFIXNUM (buffer_local_flags.category_table); |
| 444 | 1926 return category_table; |
| 428 | 1927 } |
| 1928 | |
| 1929 DEFUN ("category-designator-p", Fcategory_designator_p, 1, 1, 0, /* | |
| 444 | 1930 Return t if OBJECT is a category designator (a char in the range ' ' to '~'). |
| 428 | 1931 */ |
| 444 | 1932 (object)) |
| 428 | 1933 { |
| 444 | 1934 return CATEGORY_DESIGNATORP (object) ? Qt : Qnil; |
| 428 | 1935 } |
| 1936 | |
| 1937 DEFUN ("category-table-value-p", Fcategory_table_value_p, 1, 1, 0, /* | |
| 444 | 1938 Return t if OBJECT is a category table value. |
| 428 | 1939 Valid values are nil or a bit vector of size 95. |
| 1940 */ | |
| 444 | 1941 (object)) |
| 428 | 1942 { |
| 444 | 1943 return CATEGORY_TABLE_VALUEP (object) ? Qt : Qnil; |
| 428 | 1944 } |
| 1945 | |
| 1946 | |
| 1947 #define CATEGORYP(x) \ | |
| 1948 (CHARP (x) && XCHAR (x) >= 0x20 && XCHAR (x) <= 0x7E) | |
| 1949 | |
| 826 | 1950 #define CATEGORY_SET(c) get_char_table (c, current_buffer->category_table) |
| 428 | 1951 |
| 1952 /* Return 1 if CATEGORY_SET contains CATEGORY, else return 0. | |
| 1953 The faster version of `!NILP (Faref (category_set, category))'. */ | |
| 1954 #define CATEGORY_MEMBER(category, category_set) \ | |
| 1955 (bit_vector_bit(XBIT_VECTOR (category_set), category - 32)) | |
| 1956 | |
| 1957 /* Return 1 if there is a word boundary between two word-constituent | |
| 1958 characters C1 and C2 if they appear in this order, else return 0. | |
| 1959 Use the macro WORD_BOUNDARY_P instead of calling this function | |
| 1960 directly. */ | |
| 1961 | |
| 1962 int | |
| 867 | 1963 word_boundary_p (Ichar c1, Ichar c2) |
| 428 | 1964 { |
| 1965 Lisp_Object category_set1, category_set2; | |
| 1966 Lisp_Object tail; | |
| 1967 int default_result; | |
| 1968 | |
| 1969 #if 0 | |
| 1970 if (COMPOSITE_CHAR_P (c1)) | |
| 1971 c1 = cmpchar_component (c1, 0, 1); | |
| 1972 if (COMPOSITE_CHAR_P (c2)) | |
| 1973 c2 = cmpchar_component (c2, 0, 1); | |
| 1974 #endif | |
| 1975 | |
| 867 | 1976 if (EQ (ichar_charset (c1), ichar_charset (c2))) |
| 428 | 1977 { |
| 1978 tail = Vword_separating_categories; | |
| 1979 default_result = 0; | |
| 1980 } | |
| 1981 else | |
| 1982 { | |
| 1983 tail = Vword_combining_categories; | |
| 1984 default_result = 1; | |
| 1985 } | |
| 1986 | |
| 1987 category_set1 = CATEGORY_SET (c1); | |
| 1988 if (NILP (category_set1)) | |
| 1989 return default_result; | |
| 1990 category_set2 = CATEGORY_SET (c2); | |
| 1991 if (NILP (category_set2)) | |
| 1992 return default_result; | |
| 1993 | |
| 853 | 1994 for (; CONSP (tail); tail = XCDR (tail)) |
| 428 | 1995 { |
| 853 | 1996 Lisp_Object elt = XCAR (tail); |
| 428 | 1997 |
| 1998 if (CONSP (elt) | |
| 853 | 1999 && CATEGORYP (XCAR (elt)) |
| 2000 && CATEGORYP (XCDR (elt)) | |
| 2001 && CATEGORY_MEMBER (XCHAR (XCAR (elt)), category_set1) | |
| 2002 && CATEGORY_MEMBER (XCHAR (XCDR (elt)), category_set2)) | |
| 428 | 2003 return !default_result; |
| 2004 } | |
| 2005 return default_result; | |
| 2006 } | |
| 2007 #endif /* MULE */ | |
| 2008 | |
| 2009 | |
| 2010 void | |
|
5560
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
2011 chartab_objects_create (void) |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
2012 { |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
2013 OBJECT_HAS_METHOD (char_table, print_preprocess); |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
2014 OBJECT_HAS_METHOD (char_table, nsubst_structures_descend); |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
2015 } |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
2016 |
|
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5445
diff
changeset
|
2017 void |
| 428 | 2018 syms_of_chartab (void) |
| 2019 { | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
2020 INIT_LISP_OBJECT (char_table); |
| 442 | 2021 |
| 428 | 2022 #ifdef MULE |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
2023 INIT_LISP_OBJECT (char_table_entry); |
| 442 | 2024 |
| 563 | 2025 DEFSYMBOL (Qcategory_table_p); |
| 2026 DEFSYMBOL (Qcategory_designator_p); | |
| 2027 DEFSYMBOL (Qcategory_table_value_p); | |
| 428 | 2028 #endif /* MULE */ |
| 2029 | |
| 563 | 2030 DEFSYMBOL (Qchar_table); |
| 2031 DEFSYMBOL_MULTIWORD_PREDICATE (Qchar_tablep); | |
| 428 | 2032 |
| 2033 DEFSUBR (Fchar_table_p); | |
| 2034 DEFSUBR (Fchar_table_type_list); | |
| 2035 DEFSUBR (Fvalid_char_table_type_p); | |
| 2036 DEFSUBR (Fchar_table_type); | |
| 826 | 2037 DEFSUBR (Fchar_table_default); |
| 2038 DEFSUBR (Fset_char_table_default); | |
| 428 | 2039 DEFSUBR (Freset_char_table); |
| 2040 DEFSUBR (Fmake_char_table); | |
| 2041 DEFSUBR (Fcopy_char_table); | |
| 2042 DEFSUBR (Fget_char_table); | |
| 2043 DEFSUBR (Fget_range_char_table); | |
| 2044 DEFSUBR (Fvalid_char_table_value_p); | |
| 2045 DEFSUBR (Fcheck_valid_char_table_value); | |
| 2046 DEFSUBR (Fput_char_table); | |
| 826 | 2047 DEFSUBR (Fremove_char_table); |
| 428 | 2048 DEFSUBR (Fmap_char_table); |
| 2049 | |
| 2050 #ifdef MULE | |
| 2051 DEFSUBR (Fcategory_table_p); | |
| 2052 DEFSUBR (Fcategory_table); | |
| 2053 DEFSUBR (Fstandard_category_table); | |
| 2054 DEFSUBR (Fcopy_category_table); | |
| 2055 DEFSUBR (Fset_category_table); | |
| 2056 DEFSUBR (Fcheck_category_at); | |
| 2057 DEFSUBR (Fchar_in_category_p); | |
| 2058 DEFSUBR (Fcategory_designator_p); | |
| 2059 DEFSUBR (Fcategory_table_value_p); | |
| 2060 #endif /* MULE */ | |
| 2061 | |
| 2062 } | |
| 2063 | |
| 2064 void | |
| 2065 vars_of_chartab (void) | |
| 2066 { | |
| 2067 /* DO NOT staticpro this. It works just like Vweak_hash_tables. */ | |
| 2068 Vall_syntax_tables = Qnil; | |
| 452 | 2069 dump_add_weak_object_chain (&Vall_syntax_tables); |
| 428 | 2070 } |
| 2071 | |
| 2072 void | |
| 2073 structure_type_create_chartab (void) | |
| 2074 { | |
| 2075 struct structure_type *st; | |
| 2076 | |
| 2077 st = define_structure_type (Qchar_table, 0, chartab_instantiate); | |
| 2078 | |
|
5222
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
2079 #ifdef NEED_TO_HANDLE_21_4_CODE |
| 428 | 2080 define_structure_type_keyword (st, Qtype, chartab_type_validate); |
| 2081 define_structure_type_keyword (st, Qdata, chartab_data_validate); | |
|
5222
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
2082 #endif /* NEED_TO_HANDLE_21_4_CODE */ |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
2083 |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
2084 define_structure_type_keyword (st, Q_type, chartab_type_validate); |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
2085 define_structure_type_keyword (st, Q_data, chartab_data_validate); |
|
5320
31be2a3d121d
Move Qcount, Q_default, Q_test to general-slots.h; add SYMBOL_KEYWORD_GENERAL()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
2086 define_structure_type_keyword (st, Q_default_, chartab_default_validate); |
| 428 | 2087 } |
| 2088 | |
| 2089 void | |
| 2090 complex_vars_of_chartab (void) | |
| 2091 { | |
| 2092 #ifdef MULE | |
| 2093 /* Set this now, so first buffer creation can refer to it. */ | |
| 2094 /* Make it nil before calling copy-category-table | |
| 2095 so that copy-category-table will know not to try to copy from garbage */ | |
| 2096 Vstandard_category_table = Qnil; | |
| 2097 Vstandard_category_table = Fcopy_category_table (Qnil); | |
| 2098 staticpro (&Vstandard_category_table); | |
| 2099 | |
| 2100 DEFVAR_LISP ("word-combining-categories", &Vword_combining_categories /* | |
| 2101 List of pair (cons) of categories to determine word boundary. | |
| 2102 | |
| 2103 Emacs treats a sequence of word constituent characters as a single | |
| 2104 word (i.e. finds no word boundary between them) iff they belongs to | |
| 2105 the same charset. But, exceptions are allowed in the following cases. | |
| 2106 | |
| 444 | 2107 \(1) The case that characters are in different charsets is controlled |
| 428 | 2108 by the variable `word-combining-categories'. |
| 2109 | |
| 2110 Emacs finds no word boundary between characters of different charsets | |
| 2111 if they have categories matching some element of this list. | |
| 2112 | |
| 2113 More precisely, if an element of this list is a cons of category CAT1 | |
| 2114 and CAT2, and a multibyte character C1 which has CAT1 is followed by | |
| 2115 C2 which has CAT2, there's no word boundary between C1 and C2. | |
| 2116 | |
| 2117 For instance, to tell that ASCII characters and Latin-1 characters can | |
| 2118 form a single word, the element `(?l . ?l)' should be in this list | |
| 2119 because both characters have the category `l' (Latin characters). | |
| 2120 | |
| 444 | 2121 \(2) The case that character are in the same charset is controlled by |
| 428 | 2122 the variable `word-separating-categories'. |
| 2123 | |
| 2124 Emacs find a word boundary between characters of the same charset | |
| 2125 if they have categories matching some element of this list. | |
| 2126 | |
| 2127 More precisely, if an element of this list is a cons of category CAT1 | |
| 2128 and CAT2, and a multibyte character C1 which has CAT1 is followed by | |
| 2129 C2 which has CAT2, there's a word boundary between C1 and C2. | |
| 2130 | |
| 2131 For instance, to tell that there's a word boundary between Japanese | |
| 2132 Hiragana and Japanese Kanji (both are in the same charset), the | |
| 2133 element `(?H . ?C) should be in this list. | |
| 2134 */ ); | |
| 2135 | |
| 2136 Vword_combining_categories = Qnil; | |
| 2137 | |
| 2138 DEFVAR_LISP ("word-separating-categories", &Vword_separating_categories /* | |
| 2139 List of pair (cons) of categories to determine word boundary. | |
| 2140 See the documentation of the variable `word-combining-categories'. | |
| 2141 */ ); | |
| 2142 | |
| 2143 Vword_separating_categories = Qnil; | |
| 2144 #endif /* MULE */ | |
| 2145 } |