comparison src/casetab.c @ 17804:5977a67b9356

Include charset.h. (compute_trt_inverse): Totally rewritten. Args are now Lisp_Object. Callers changed. (compute_trt_identity, compute_trt_shuffle): New subroutines. (init_casetab_once): Use XSETFASTINT to store into case table; use CHAR_TABLE_SINGLE_BYTE_SLOTS to end the loop.
author Karl Heuer <kwzh@gnu.org>
date Thu, 15 May 1997 02:23:20 +0000
parents 64722b193f14
children 8a8e26aa76ed
comparison
equal deleted inserted replaced
17803:906dcb974266 17804:5977a67b9356
21 /* Written by Howard Gayle. See chartab.c for details. */ 21 /* Written by Howard Gayle. See chartab.c for details. */
22 22
23 #include <config.h> 23 #include <config.h>
24 #include "lisp.h" 24 #include "lisp.h"
25 #include "buffer.h" 25 #include "buffer.h"
26 #include "charset.h"
26 27
27 Lisp_Object Qcase_table_p, Qcase_table; 28 Lisp_Object Qcase_table_p, Qcase_table;
28 Lisp_Object Vascii_downcase_table, Vascii_upcase_table; 29 Lisp_Object Vascii_downcase_table, Vascii_upcase_table;
29 Lisp_Object Vascii_canon_table, Vascii_eqv_table; 30 Lisp_Object Vascii_canon_table, Vascii_eqv_table;
30 31
127 eqv = XCHAR_TABLE (table)->extras[2]; 128 eqv = XCHAR_TABLE (table)->extras[2];
128 129
129 if (NILP (up)) 130 if (NILP (up))
130 { 131 {
131 up = Fmake_char_table (Qcase_table, Qnil); 132 up = Fmake_char_table (Qcase_table, Qnil);
132 compute_trt_inverse (XCHAR_TABLE (table), XCHAR_TABLE (up)); 133 compute_trt_inverse (table, up);
133 XCHAR_TABLE (table)->extras[0] = up; 134 XCHAR_TABLE (table)->extras[0] = up;
134 } 135 }
135 136
136 if (NILP (canon)) 137 if (NILP (canon))
137 { 138 {
142 canon = Fmake_char_table (Qcase_table, Qnil); 143 canon = Fmake_char_table (Qcase_table, Qnil);
143 144
144 /* Set up the CANON vector; for each character, 145 /* Set up the CANON vector; for each character,
145 this sequence of upcasing and downcasing ought to 146 this sequence of upcasing and downcasing ought to
146 get the "preferred" lowercase equivalent. */ 147 get the "preferred" lowercase equivalent. */
147 for (i = 0; i < 256; i++) 148 for (i = 0; i < CHAR_TABLE_SINGLE_BYTE_SLOTS; i++)
148 XCHAR_TABLE (canon)->contents[i] = downvec[upvec[downvec[i]]]; 149 XCHAR_TABLE (canon)->contents[i] = downvec[upvec[downvec[i]]];
149 XCHAR_TABLE (table)->extras[1] = canon; 150 XCHAR_TABLE (table)->extras[1] = canon;
150 } 151 }
151 152
152 if (NILP (eqv)) 153 if (NILP (eqv))
153 { 154 {
154 eqv = Fmake_char_table (Qcase_table, Qnil); 155 eqv = Fmake_char_table (Qcase_table, Qnil);
155 compute_trt_inverse (XCHAR_TABLE (canon), XCHAR_TABLE (eqv)); 156 compute_trt_inverse (canon, eqv);
156 XCHAR_TABLE (table)->extras[2] = eqv; 157 XCHAR_TABLE (table)->extras[2] = eqv;
157 } 158 }
158 159
159 if (standard) 160 if (standard)
160 Vascii_downcase_table = table; 161 Vascii_downcase_table = table;
167 } 168 }
168 169
169 return table; 170 return table;
170 } 171 }
171 172
173 static void
174 compute_trt_identity (bytes, depth, trt, inverse)
175 unsigned char *bytes;
176 int depth;
177 struct Lisp_Char_Table *trt, *inverse;
178 {
179 register int i;
180
181 for (i = 0; i < CHAR_TABLE_ORDINARY_SLOTS; i++)
182 {
183 if (NATNUMP (trt->contents[i]))
184 {
185 bytes[depth] = i;
186 XSETFASTINT (inverse->contents[i],
187 (depth == 0 && i < CHAR_TABLE_SINGLE_BYTE_SLOTS ? i
188 : MAKE_NON_ASCII_CHAR (bytes[0]-128,
189 bytes[1], bytes[2])));
190 }
191 else if (CHAR_TABLE_P (trt->contents[i]))
192 {
193 bytes[depth] = i;
194 inverse->contents[i] = Fmake_char_table (Qnil, Qnil);
195 compute_trt_identity (bytes, depth + 1,
196 XCHAR_TABLE (trt->contents[i]),
197 XCHAR_TABLE (inverse->contents[i]));
198 }
199 else /* must be Qnil or Qidentity */
200 inverse->contents[i] = trt->contents[i];
201 }
202 }
203
204 static void
205 compute_trt_shuffle (bytes, depth, ibase, trt, inverse)
206 unsigned char *bytes;
207 int depth;
208 Lisp_Object ibase;
209 struct Lisp_Char_Table *trt, *inverse;
210 {
211 register int i;
212 Lisp_Object j, tem, q;
213
214 for (i = 0; i < CHAR_TABLE_SINGLE_BYTE_SLOTS; i++)
215 {
216 bytes[depth] = i;
217 XSETFASTINT (j,
218 (depth == 0 && i < CHAR_TABLE_SINGLE_BYTE_SLOTS ? i
219 : MAKE_NON_ASCII_CHAR (bytes[0]-128,
220 bytes[1], bytes[2])));
221 q = trt->contents[i];
222 if (NATNUMP (q) && XFASTINT (q) != XFASTINT (j))
223 {
224 tem = Faref (ibase, q);
225 Faset (ibase, q, j);
226 Faset (ibase, j, tem);
227 }
228 else if (CHAR_TABLE_P (q))
229 {
230 bytes[depth] = i;
231 compute_trt_shuffle (bytes, depth + 1, ibase,
232 XCHAR_TABLE (trt->contents[i]),
233 XCHAR_TABLE (inverse->contents[i]));
234 }
235 }
236 }
237
172 /* Given a translate table TRT, store the inverse mapping into INVERSE. 238 /* Given a translate table TRT, store the inverse mapping into INVERSE.
173 Since TRT is not one-to-one, INVERSE is not a simple mapping. 239 Since TRT is not one-to-one, INVERSE is not a simple mapping.
174 Instead, it divides the space of characters into equivalence classes. 240 Instead, it divides the space of characters into equivalence classes.
175 All characters in a given class form one circular list, chained through 241 All characters in a given class form one circular list, chained through
176 the elements of INVERSE. */ 242 the elements of INVERSE. */
177 243
178 static void 244 static void
179 compute_trt_inverse (trt, inverse) 245 compute_trt_inverse (trt, inv)
180 struct Lisp_Char_Table *trt, *inverse; 246 Lisp_Object trt, inv;
181 { 247 {
182 register int i = 0400; 248 unsigned char bytes[3];
183 register unsigned char c, q; 249 compute_trt_identity (bytes, 0, XCHAR_TABLE (trt), XCHAR_TABLE (inv));
184 250 compute_trt_shuffle (bytes, 0, inv, XCHAR_TABLE (trt), XCHAR_TABLE (inv));
185 while (i--)
186 inverse->contents[i] = i;
187 i = 0400;
188 while (i--)
189 {
190 if ((q = trt->contents[i]) != (unsigned char) i)
191 {
192 c = inverse->contents[q];
193 inverse->contents[q] = i;
194 inverse->contents[i] = c;
195 }
196 }
197 } 251 }
198 252
199 init_casetab_once () 253 init_casetab_once ()
200 { 254 {
201 register int i; 255 register int i;
214 268
215 down = Fmake_char_table (Qcase_table, Qnil); 269 down = Fmake_char_table (Qcase_table, Qnil);
216 Vascii_downcase_table = down; 270 Vascii_downcase_table = down;
217 XCHAR_TABLE (down)->purpose = Qcase_table; 271 XCHAR_TABLE (down)->purpose = Qcase_table;
218 272
219 for (i = 0; i < 256; i++) 273 for (i = 0; i < CHAR_TABLE_SINGLE_BYTE_SLOTS; i++)
220 XCHAR_TABLE (down)->contents[i] = (i >= 'A' && i <= 'Z') ? i + 040 : i; 274 XSETFASTINT (XCHAR_TABLE (down)->contents[i],
275 (i >= 'A' && i <= 'Z') ? i + ('a' - 'A') : i);
221 276
222 XCHAR_TABLE (down)->extras[1] = Fcopy_sequence (down); 277 XCHAR_TABLE (down)->extras[1] = Fcopy_sequence (down);
223 278
224 up = Fmake_char_table (Qcase_table, Qnil); 279 up = Fmake_char_table (Qcase_table, Qnil);
225 XCHAR_TABLE (down)->extras[0] = up; 280 XCHAR_TABLE (down)->extras[0] = up;
226 281
227 for (i = 0; i < 256; i++) 282 for (i = 0; i < CHAR_TABLE_SINGLE_BYTE_SLOTS; i++)
228 XCHAR_TABLE (up)->contents[i] 283 XSETFASTINT (XCHAR_TABLE (up)->contents[i],
229 = ((i >= 'A' && i <= 'Z') 284 ((i >= 'A' && i <= 'Z')
230 ? i + ('a' - 'A') 285 ? i + ('a' - 'A')
231 : ((i >= 'a' && i <= 'z') 286 : ((i >= 'a' && i <= 'z')
232 ? i + ('A' - 'a') 287 ? i + ('A' - 'a')
233 : i)); 288 : i)));
234 289
235 XCHAR_TABLE (down)->extras[2] = Fcopy_sequence (up); 290 XCHAR_TABLE (down)->extras[2] = Fcopy_sequence (up);
236 } 291 }
237 292
238 syms_of_casetab () 293 syms_of_casetab ()