aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/casetab.c134
1 files changed, 42 insertions, 92 deletions
diff --git a/src/casetab.c b/src/casetab.c
index c5a4e7a0307..29a237cb948 100644
--- a/src/casetab.c
+++ b/src/casetab.c
@@ -29,7 +29,13 @@ Lisp_Object Qcase_table_p, Qcase_table;
29Lisp_Object Vascii_downcase_table, Vascii_upcase_table; 29Lisp_Object Vascii_downcase_table, Vascii_upcase_table;
30Lisp_Object Vascii_canon_table, Vascii_eqv_table; 30Lisp_Object Vascii_canon_table, Vascii_eqv_table;
31 31
32static void compute_trt_inverse (); 32/* Used as a temporary in DOWNCASE and other macros in lisp.h. No
33 need to mark it, since it is used only very temporarily. */
34Lisp_Object case_temp1, case_temp2;
35
36static void set_canon ();
37static void set_identity ();
38static void shuffle ();
33 39
34DEFUN ("case-table-p", Fcase_table_p, Scase_table_p, 1, 1, 0, 40DEFUN ("case-table-p", Fcase_table_p, Scase_table_p, 1, 1, 0,
35 "Return t iff OBJECT is a case table.\n\ 41 "Return t iff OBJECT is a case table.\n\
@@ -120,6 +126,7 @@ set_case_table (table, standard)
120 int standard; 126 int standard;
121{ 127{
122 Lisp_Object up, canon, eqv; 128 Lisp_Object up, canon, eqv;
129 Lisp_Object indices[3];
123 130
124 check_case_table (table); 131 check_case_table (table);
125 132
@@ -130,30 +137,23 @@ set_case_table (table, standard)
130 if (NILP (up)) 137 if (NILP (up))
131 { 138 {
132 up = Fmake_char_table (Qcase_table, Qnil); 139 up = Fmake_char_table (Qcase_table, Qnil);
133 compute_trt_inverse (table, up); 140 map_char_table (set_identity, Qnil, table, up, 0, indices);
141 map_char_table (shuffle, Qnil, table, up, 0, indices);
134 XCHAR_TABLE (table)->extras[0] = up; 142 XCHAR_TABLE (table)->extras[0] = up;
135 } 143 }
136 144
137 if (NILP (canon)) 145 if (NILP (canon))
138 { 146 {
139 register int i;
140 Lisp_Object *upvec = XCHAR_TABLE (up)->contents;
141 Lisp_Object *downvec = XCHAR_TABLE (table)->contents;
142
143 canon = Fmake_char_table (Qcase_table, Qnil); 147 canon = Fmake_char_table (Qcase_table, Qnil);
144
145 /* Set up the CANON vector; for each character,
146 this sequence of upcasing and downcasing ought to
147 get the "preferred" lowercase equivalent. */
148 for (i = 0; i < CHAR_TABLE_SINGLE_BYTE_SLOTS; i++)
149 XCHAR_TABLE (canon)->contents[i] = downvec[upvec[downvec[i]]];
150 XCHAR_TABLE (table)->extras[1] = canon; 148 XCHAR_TABLE (table)->extras[1] = canon;
149 map_char_table (set_canon, Qnil, table, table, 0, indices);
151 } 150 }
152 151
153 if (NILP (eqv)) 152 if (NILP (eqv))
154 { 153 {
155 eqv = Fmake_char_table (Qcase_table, Qnil); 154 eqv = Fmake_char_table (Qcase_table, Qnil);
156 compute_trt_inverse (canon, eqv); 155 map_char_table (set_identity, Qnil, canon, eqv, 0, indices);
156 map_char_table (shuffle, Qnil, canon, eqv, 0, indices);
157 XCHAR_TABLE (table)->extras[2] = eqv; 157 XCHAR_TABLE (table)->extras[2] = eqv;
158 } 158 }
159 159
@@ -170,99 +170,49 @@ set_case_table (table, standard)
170 return table; 170 return table;
171} 171}
172 172
173/* Using the scratch array at BYTES of which the first DEPTH elements 173/* The following functions are called in map_char_table. */
174 are already set, and using the multi-byte structure inherited from 174
175 TRT, make INVERSE be an identity mapping. That is, for each slot 175/* Set CANON char-table element for C to a translated ELT by UP and
176 that's indexed by a single byte, store that byte in INVERSE. 176 DOWN char-tables. This is done only when ELT is a character. The
177 Where TRT has a subtable, make a corresponding subtable in INVERSE 177 char-tables CANON, UP, and DOWN are in CASE_TABLE. */
178 and recursively initialize that subtable so that its elements are
179 the multi-byte characters that correspond to the index bytes.
180 This is the first step in generating an inverse mapping. */
181 178
182static void 179static void
183compute_trt_identity (bytes, depth, trt, inverse) 180set_canon (case_table, c, elt)
184 unsigned char *bytes; 181 Lisp_Object case_table, c, elt;
185 int depth;
186 struct Lisp_Char_Table *trt, *inverse;
187{ 182{
188 register int i; 183 Lisp_Object up = XCHAR_TABLE (case_table)->extras[0];
189 int lim = (depth == 0 ? CHAR_TABLE_ORDINARY_SLOTS : SUB_CHAR_TABLE_ORDINARY_SLOTS); 184 Lisp_Object canon = XCHAR_TABLE (case_table)->extras[1];
190 185
191 for (i = 0; i < lim; i++) 186 if (NATNUMP (elt))
192 { 187 Faset (canon, c, Faref (case_table, Faref (up, elt)));
193 if (NATNUMP (trt->contents[i]))
194 {
195 bytes[depth] = i;
196 XSETFASTINT (inverse->contents[i],
197 (depth == 0 && i < CHAR_TABLE_SINGLE_BYTE_SLOTS ? i
198 : MAKE_NON_ASCII_CHAR (bytes[0], bytes[1], bytes[2])));
199 }
200 else if (SUB_CHAR_TABLE_P (trt->contents[i]))
201 {
202 bytes[depth] = i - 128;
203 inverse->contents[i] = make_sub_char_table (Qnil);
204 compute_trt_identity (bytes, depth + 1,
205 XCHAR_TABLE (trt->contents[i]),
206 XCHAR_TABLE (inverse->contents[i]));
207 }
208 else /* must be Qnil or Qidentity */
209 inverse->contents[i] = trt->contents[i];
210 }
211} 188}
212 189
213/* Using the scratch array at BYTES of which the first DEPTH elements 190/* Set elements of char-table TABLE for C to C itself. This is done
214 are already set, permute the elements of INVERSE (which is initially 191 only when ELT is a character. This is called in map_char_table. */
215 an identity mapping) so that it has one cycle for each equivalence
216 class induced by the translation table TRT. IBASE is the lispy
217 version of the outermost (depth 0) instance of INVERSE. */
218 192
219static void 193static void
220compute_trt_shuffle (bytes, depth, ibase, trt, inverse) 194set_identity (table, c, elt)
221 unsigned char *bytes; 195 Lisp_Object table, c, elt;
222 int depth;
223 Lisp_Object ibase;
224 struct Lisp_Char_Table *trt, *inverse;
225{ 196{
226 register int i; 197 if (NATNUMP (elt))
227 Lisp_Object j, tem, q; 198 Faset (table, c, c);
228 int lim = (depth == 0 ? CHAR_TABLE_ORDINARY_SLOTS : SUB_CHAR_TABLE_ORDINARY_SLOTS);
229
230 for (i = 0; i < lim; i++)
231 {
232 bytes[depth] = i;
233 XSETFASTINT (j,
234 (depth == 0 && i < CHAR_TABLE_SINGLE_BYTE_SLOTS ? i
235 : MAKE_NON_ASCII_CHAR (bytes[0], bytes[1], bytes[2])));
236 q = trt->contents[i];
237 if (NATNUMP (q) && XFASTINT (q) != XFASTINT (j))
238 {
239 tem = Faref (ibase, q);
240 Faset (ibase, q, j);
241 Faset (ibase, j, tem);
242 }
243 else if (SUB_CHAR_TABLE_P (q))
244 {
245 bytes[depth] = i - 128;
246 compute_trt_shuffle (bytes, depth + 1, ibase,
247 XCHAR_TABLE (trt->contents[i]),
248 XCHAR_TABLE (inverse->contents[i]));
249 }
250 }
251} 199}
252 200
253/* Given a translate table TRT, store the inverse mapping into INVERSE. 201/* Permute the elements of TABLE (which is initially an identity
254 Since TRT is not one-to-one, INVERSE is not a simple mapping. 202 mapping) so that it has one cycle for each equivalence class
255 Instead, it divides the space of characters into equivalence classes. 203 induced by the translation table on which map_char_table is
256 All characters in a given class form one circular list, chained through 204 operated. */
257 the elements of INVERSE. */
258 205
259static void 206static void
260compute_trt_inverse (trt, inv) 207shuffle (table, c, elt)
261 Lisp_Object trt, inv; 208 Lisp_Object table, c, elt;
262{ 209{
263 unsigned char bytes[3]; 210 if (NATNUMP (elt) && c != elt)
264 compute_trt_identity (bytes, 0, XCHAR_TABLE (trt), XCHAR_TABLE (inv)); 211 {
265 compute_trt_shuffle (bytes, 0, inv, XCHAR_TABLE (trt), XCHAR_TABLE (inv)); 212 Lisp_Object tem = Faref (table, elt);
213 Faset (table, elt, c);
214 Faset (table, c, tem);
215 }
266} 216}
267 217
268init_casetab_once () 218init_casetab_once ()