aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
authorRichard M. Stallman1995-10-19 00:14:14 +0000
committerRichard M. Stallman1995-10-19 00:14:14 +0000
commit7f7fef044cc38f5457d91de2ed35d8f142b86a0a (patch)
treec46811d778e35572b9d157230187ada524ba8ab0 /src
parentc6a3c83c505cfe9924ea160c54c78c7562d065ab (diff)
downloademacs-7f7fef044cc38f5457d91de2ed35d8f142b86a0a.tar.gz
emacs-7f7fef044cc38f5457d91de2ed35d8f142b86a0a.zip
Case tables are now char-tables,
and the case table is stored in the downcase_table slot only. (Fcurrent_case_table, Fstandard_case_table, set_case_table) (compute_trt_inverse, init_casetab_once): Use new data format.
Diffstat (limited to 'src')
-rw-r--r--src/casetab.c142
1 files changed, 66 insertions, 76 deletions
diff --git a/src/casetab.c b/src/casetab.c
index 417597543e3..fa6ad91a155 100644
--- a/src/casetab.c
+++ b/src/casetab.c
@@ -23,11 +23,11 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
23#include "lisp.h" 23#include "lisp.h"
24#include "buffer.h" 24#include "buffer.h"
25 25
26Lisp_Object Qcase_table_p; 26Lisp_Object Qcase_table_p, Qcase_table;
27Lisp_Object Vascii_downcase_table, Vascii_upcase_table; 27Lisp_Object Vascii_downcase_table, Vascii_upcase_table;
28Lisp_Object Vascii_canon_table, Vascii_eqv_table; 28Lisp_Object Vascii_canon_table, Vascii_eqv_table;
29 29
30void compute_trt_inverse (); 30static void compute_trt_inverse ();
31 31
32DEFUN ("case-table-p", Fcase_table_p, Scase_table_p, 1, 1, 0, 32DEFUN ("case-table-p", Fcase_table_p, Scase_table_p, 1, 1, 0,
33 "Return t iff ARG is a case table.\n\ 33 "Return t iff ARG is a case table.\n\
@@ -36,18 +36,20 @@ See `set-case-table' for more information on these data structures.")
36 Lisp_Object table; 36 Lisp_Object table;
37{ 37{
38 Lisp_Object down, up, canon, eqv; 38 Lisp_Object down, up, canon, eqv;
39 down = Fcar_safe (table);
40 up = Fcar_safe (Fcdr_safe (table));
41 canon = Fcar_safe (Fcdr_safe (Fcdr_safe (table)));
42 eqv = Fcar_safe (Fcdr_safe (Fcdr_safe (Fcdr_safe (table))));
43 39
44#define STRING256_P(obj) (STRINGP (obj) && XSTRING (obj)->size == 256) 40 if (! CHAR_TABLE_P (table))
41 return Qnil;
42 if (! EQ (XCHAR_TABLE (table)->purpose, Qcase_table))
43 return Qnil;
45 44
46 return (STRING256_P (down) 45 up = XCHAR_TABLE (table)->extras[0];
47 && (NILP (up) || STRING256_P (up)) 46 canon = XCHAR_TABLE (table)->extras[1];
47 eqv = XCHAR_TABLE (table)->extras[2];
48
49 return ((NILP (up) || CHAR_TABLE_P (up))
48 && ((NILP (canon) && NILP (eqv)) 50 && ((NILP (canon) && NILP (eqv))
49 || (STRING256_P (canon) 51 || (CHAR_TABLE_P (canon)
50 && (NILP (eqv) || STRING256_P (eqv)))) 52 && (NILP (eqv) || CHAR_TABLE_P (eqv))))
51 ? Qt : Qnil); 53 ? Qt : Qnil);
52} 54}
53 55
@@ -68,12 +70,7 @@ DEFUN ("current-case-table", Fcurrent_case_table, Scurrent_case_table, 0, 0, 0,
68{ 70{
69 Lisp_Object down, up, canon, eqv; 71 Lisp_Object down, up, canon, eqv;
70 72
71 down = current_buffer->downcase_table; 73 return current_buffer->downcase_table;
72 up = current_buffer->upcase_table;
73 canon = current_buffer->case_canon_table;
74 eqv = current_buffer->case_eqv_table;
75
76 return Fcons (down, Fcons (up, Fcons (canon, Fcons (eqv, Qnil))));
77} 74}
78 75
79DEFUN ("standard-case-table", Fstandard_case_table, Sstandard_case_table, 0, 0, 0, 76DEFUN ("standard-case-table", Fstandard_case_table, Sstandard_case_table, 0, 0, 0,
@@ -81,19 +78,17 @@ DEFUN ("standard-case-table", Fstandard_case_table, Sstandard_case_table, 0, 0,
81This is the one used for new buffers.") 78This is the one used for new buffers.")
82 () 79 ()
83{ 80{
84 return Fcons (Vascii_downcase_table, 81 return Vascii_downcase_table;
85 Fcons (Vascii_upcase_table,
86 Fcons (Vascii_canon_table,
87 Fcons (Vascii_eqv_table, Qnil))));
88} 82}
89 83
90static Lisp_Object set_case_table (); 84static Lisp_Object set_case_table ();
91 85
92DEFUN ("set-case-table", Fset_case_table, Sset_case_table, 1, 1, 0, 86DEFUN ("set-case-table", Fset_case_table, Sset_case_table, 1, 1, 0,
93 "Select a new case table for the current buffer.\n\ 87 "Select a new case table for the current buffer.\n\
94A case table is a list (DOWNCASE UPCASE CANONICALIZE EQUIVALENCES)\n\ 88A case table is a char-table which maps characters
95 where each element is either nil or a string of length 256.\n\ 89to their lower-case equivalents. It also has three \"extra\" slots
96DOWNCASE maps each character to its lower-case equivalent.\n\ 90which may be additional char-tables or nil.
91These slots are called UPCASE, CANONICALIZE and EQUIVALENCES.\n\
97UPCASE maps each character to its upper-case equivalent;\n\ 92UPCASE maps each character to its upper-case equivalent;\n\
98 if lower and upper case characters are in 1-1 correspondence,\n\ 93 if lower and upper case characters are in 1-1 correspondence,\n\
99 you may use nil and the upcase table will be deduced from DOWNCASE.\n\ 94 you may use nil and the upcase table will be deduced from DOWNCASE.\n\
@@ -128,53 +123,45 @@ set_case_table (table, standard)
128 123
129 check_case_table (table); 124 check_case_table (table);
130 125
131 down = Fcar_safe (table); 126 up = XCHAR_TABLE (table)->extras[0];
132 up = Fcar_safe (Fcdr_safe (table)); 127 canon = XCHAR_TABLE (table)->extras[1];
133 canon = Fcar_safe (Fcdr_safe (Fcdr_safe (table))); 128 eqv = XCHAR_TABLE (table)->extras[2];
134 eqv = Fcar_safe (Fcdr_safe (Fcdr_safe (Fcdr_safe (table))));
135 129
136 if (NILP (up)) 130 if (NILP (up))
137 { 131 {
138 up = Fmake_string (make_number (256), make_number (0)); 132 up = Fmake_char_table (Qcase_table, Qnil);
139 compute_trt_inverse (XSTRING (down)->data, XSTRING (up)->data); 133 compute_trt_inverse (XCHAR_TABLE (down), XCHAR_TABLE (up));
134 XCHAR_TABLE (table)->extras[0] = up;
140 } 135 }
141 136
142 if (NILP (canon)) 137 if (NILP (canon))
143 { 138 {
144 register int i; 139 register int i;
145 unsigned char *upvec = XSTRING (up)->data; 140 Lisp_Object *upvec = XCHAR_TABLE (up)->contents;
146 unsigned char *downvec = XSTRING (down)->data; 141 Lisp_Object *downvec = XCHAR_TABLE (down)->contents;
147 142
148 canon = Fmake_string (make_number (256), make_number (0)); 143 up = Fmake_char_table (Qcase_table, Qnil);
149 144
150 /* Set up the CANON vector; for each character, 145 /* Set up the CANON vector; for each character,
151 this sequence of upcasing and downcasing ought to 146 this sequence of upcasing and downcasing ought to
152 get the "preferred" lowercase equivalent. */ 147 get the "preferred" lowercase equivalent. */
153 for (i = 0; i < 256; i++) 148 for (i = 0; i < 256; i++)
154 XSTRING (canon)->data[i] = downvec[upvec[downvec[i]]]; 149 XCHAR_TABLE (canon)->contents[i] = downvec[upvec[downvec[i]]];
150 XCHAR_TABLE (table)->extras[1] = canon;
155 } 151 }
156 152
157 if (NILP (eqv)) 153 if (NILP (eqv))
158 { 154 {
159 eqv = Fmake_string (make_number (256), make_number (0)); 155 eqv = Fmake_char_table (Qcase_table, Qnil);
160 156 compute_trt_inverse (XCHAR_TABLE (canon), XCHAR_TABLE (eqv));
161 compute_trt_inverse (XSTRING (canon)->data, XSTRING (eqv)->data); 157 XCHAR_TABLE (table)->extras[0] = eqv;
162 } 158 }
163 159
164 if (standard) 160 if (standard)
165 { 161 Vascii_downcase_table = down;
166 Vascii_downcase_table = down;
167 Vascii_upcase_table = up;
168 Vascii_canon_table = canon;
169 Vascii_eqv_table = eqv;
170 }
171 else 162 else
172 { 163 current_buffer->downcase_table = down;
173 current_buffer->downcase_table = down; 164
174 current_buffer->upcase_table = up;
175 current_buffer->case_canon_table = canon;
176 current_buffer->case_eqv_table = eqv;
177 }
178 return table; 165 return table;
179} 166}
180 167
@@ -184,24 +171,23 @@ set_case_table (table, standard)
184 All characters in a given class form one circular list, chained through 171 All characters in a given class form one circular list, chained through
185 the elements of INVERSE. */ 172 the elements of INVERSE. */
186 173
187void 174static void
188compute_trt_inverse (trt, inverse) 175compute_trt_inverse (trt, inverse)
189 register unsigned char *trt; 176 struct Lisp_Char_Table *trt, *inverse;
190 register unsigned char *inverse;
191{ 177{
192 register int i = 0400; 178 register int i = 0400;
193 register unsigned char c, q; 179 register unsigned char c, q;
194 180
195 while (i--) 181 while (i--)
196 inverse[i] = i; 182 inverse->contents[i] = i;
197 i = 0400; 183 i = 0400;
198 while (i--) 184 while (i--)
199 { 185 {
200 if ((q = trt[i]) != (unsigned char) i) 186 if ((q = trt->contents[i]) != (unsigned char) i)
201 { 187 {
202 c = inverse[q]; 188 c = inverse->contents[q];
203 inverse[q] = i; 189 inverse->contents[q] = i;
204 inverse[i] = c; 190 inverse->contents[i] = c;
205 } 191 }
206 } 192 }
207} 193}
@@ -209,47 +195,51 @@ compute_trt_inverse (trt, inverse)
209init_casetab_once () 195init_casetab_once ()
210{ 196{
211 register int i; 197 register int i;
212 Lisp_Object tem; 198 Lisp_Object down, up;
199 Qcase_table = intern ("case-table");
200 staticpro (&Qcase_table);
201
202 /* Intern this now in case it isn't already done.
203 Setting this variable twice is harmless.
204 But don't staticpro it here--that is done in alloc.c. */
205 Qchar_table_extra_slots = intern ("char-table-extra-slots");
213 206
214 tem = Fmake_string (make_number (256), make_number (0)); 207 /* Now we are ready to set up this property, so we can
215 Vascii_downcase_table = tem; 208 create char tables. */
216 Vascii_canon_table = tem; 209 Fput (Qcase_table, Qchar_table_extra_slots, make_number (4));
210
211 down = Fmake_char_table (Qcase_table, Qnil);
212 Vascii_downcase_table = down;
217 213
218 for (i = 0; i < 256; i++) 214 for (i = 0; i < 256; i++)
219 XSTRING (tem)->data[i] = (i >= 'A' && i <= 'Z') ? i + 040 : i; 215 XCHAR_TABLE (down)->contents[i] = (i >= 'A' && i <= 'Z') ? i + 040 : i;
216
217 XCHAR_TABLE (down)->extras[1] = Fcopy_sequence (down);
220 218
221 tem = Fmake_string (make_number (256), make_number (0)); 219 up = Fmake_char_table (Qcase_table, Qnil);
222 Vascii_upcase_table = tem; 220 XCHAR_TABLE (down)->extras[0] = up;
223 Vascii_eqv_table = tem;
224 221
225 for (i = 0; i < 256; i++) 222 for (i = 0; i < 256; i++)
226 XSTRING (tem)->data[i] 223 XCHAR_TABLE (up)->contents[i]
227 = ((i >= 'A' && i <= 'Z') 224 = ((i >= 'A' && i <= 'Z')
228 ? i + ('a' - 'A') 225 ? i + ('a' - 'A')
229 : ((i >= 'a' && i <= 'z') 226 : ((i >= 'a' && i <= 'z')
230 ? i + ('A' - 'a') 227 ? i + ('A' - 'a')
231 : i)); 228 : i));
229
230 XCHAR_TABLE (down)->extras[2] = Fcopy_sequence (up);
232} 231}
233 232
234syms_of_casetab () 233syms_of_casetab ()
235{ 234{
236 Qcase_table_p = intern ("case-table-p"); 235 Qcase_table_p = intern ("case-table-p");
237 staticpro (&Qcase_table_p); 236 staticpro (&Qcase_table_p);
237
238 staticpro (&Vascii_downcase_table); 238 staticpro (&Vascii_downcase_table);
239 staticpro (&Vascii_upcase_table);
240 staticpro (&Vascii_canon_table);
241 staticpro (&Vascii_eqv_table);
242 239
243 defsubr (&Scase_table_p); 240 defsubr (&Scase_table_p);
244 defsubr (&Scurrent_case_table); 241 defsubr (&Scurrent_case_table);
245 defsubr (&Sstandard_case_table); 242 defsubr (&Sstandard_case_table);
246 defsubr (&Sset_case_table); 243 defsubr (&Sset_case_table);
247 defsubr (&Sset_standard_case_table); 244 defsubr (&Sset_standard_case_table);
248
249#if 0
250 DEFVAR_LISP ("ascii-downcase-table", &Vascii_downcase_table,
251 "String mapping ASCII characters to lowercase equivalents.");
252 DEFVAR_LISP ("ascii-upcase-table", &Vascii_upcase_table,
253 "String mapping ASCII characters to uppercase equivalents.");
254#endif
255} 245}