|
428
|
1 /* XEmacs routines to deal with case tables.
|
|
|
2 Copyright (C) 1987, 1992, 1993, 1994 Free Software Foundation, Inc.
|
|
|
3 Copyright (C) 1995 Sun Microsystems, Inc.
|
|
793
|
4 Copyright (C) 2002 Ben Wing.
|
|
428
|
5
|
|
|
6 This file is part of XEmacs.
|
|
|
7
|
|
|
8 XEmacs is free software; you can redistribute it and/or modify it
|
|
|
9 under the terms of the GNU General Public License as published by the
|
|
|
10 Free Software Foundation; either version 2, or (at your option) any
|
|
|
11 later version.
|
|
|
12
|
|
|
13 XEmacs is distributed in the hope that it will be useful, but WITHOUT
|
|
|
14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
|
|
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
|
|
|
16 for more details.
|
|
|
17
|
|
|
18 You should have received a copy of the GNU General Public License
|
|
|
19 along with XEmacs; see the file COPYING. If not, write to
|
|
|
20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
21 Boston, MA 02111-1307, USA. */
|
|
|
22
|
|
771
|
23 /* Synched up with: FSF 19.28. Between FSF 19.28 and 19.30, casetab.c
|
|
428
|
24 was rewritten to use junky FSF char tables. Meanwhile I rewrote it
|
|
771
|
25 to use more logical char tables. --ben */
|
|
428
|
26
|
|
|
27 /* Written by Howard Gayle. See some mythical and not-in-the-Emacs-
|
|
|
28 distribution file chartab.c for details. */
|
|
|
29
|
|
|
30 /* Modified for Mule by Ben Wing. */
|
|
|
31
|
|
771
|
32 /* #### Someone (Yoshiki?) wrote the following comment, which I don't
|
|
|
33 understand.
|
|
|
34
|
|
|
35 Case tables consist of four char-tables. These are for downcase,
|
|
446
|
36 upcase, canonical and equivalent respectively.
|
|
|
37
|
|
771
|
38 The entries are like this:
|
|
446
|
39
|
|
|
40 downcase: a -> a, A -> a.
|
|
|
41 upcase: a -> A, A -> a. (The latter is for NOCASEP.)
|
|
|
42 canon: a -> a, A -> a.
|
|
|
43 eqv: a -> A, A -> a.
|
|
|
44 */
|
|
428
|
45
|
|
|
46 #include <config.h>
|
|
|
47 #include "lisp.h"
|
|
|
48 #include "buffer.h"
|
|
|
49 #include "opaque.h"
|
|
446
|
50 #include "chartab.h"
|
|
|
51 #include "casetab.h"
|
|
428
|
52
|
|
446
|
53 Lisp_Object Qcase_tablep, Qdowncase, Qupcase;
|
|
|
54 Lisp_Object Vstandard_case_table;
|
|
428
|
55
|
|
|
56 static void compute_trt_inverse (Lisp_Object trt, Lisp_Object inverse);
|
|
446
|
57 Lisp_Object case_table_char (Lisp_Object ch, Lisp_Object table);
|
|
428
|
58
|
|
446
|
59 #define STRING256_P(obj) ((STRINGP (obj) && XSTRING_CHAR_LENGTH (obj) == 256))
|
|
|
60
|
|
|
61 static Lisp_Object
|
|
|
62 mark_case_table (Lisp_Object obj)
|
|
|
63 {
|
|
|
64 Lisp_Case_Table *ct = XCASE_TABLE (obj);
|
|
|
65
|
|
|
66 mark_object (CASE_TABLE_DOWNCASE (ct));
|
|
|
67 mark_object (CASE_TABLE_UPCASE (ct));
|
|
|
68 mark_object (CASE_TABLE_CANON (ct));
|
|
|
69 mark_object (CASE_TABLE_EQV (ct));
|
|
|
70 return Qnil;
|
|
|
71 }
|
|
|
72
|
|
|
73 static void
|
|
|
74 print_case_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
|
|
|
75 {
|
|
|
76 Lisp_Case_Table *ct = XCASE_TABLE (obj);
|
|
|
77 char buf[200];
|
|
|
78 if (print_readably)
|
|
563
|
79 printing_unreadable_object ("#<case-table 0x%x", ct->header.uid);
|
|
446
|
80 write_c_string ("#<case-table ", printcharfun);
|
|
|
81 sprintf (buf, "0x%x>", ct->header.uid);
|
|
|
82 write_c_string (buf, printcharfun);
|
|
|
83 }
|
|
|
84
|
|
|
85 static const struct lrecord_description case_table_description [] = {
|
|
|
86 { XD_LISP_OBJECT, offsetof (Lisp_Case_Table, downcase_table) },
|
|
|
87 { XD_LISP_OBJECT, offsetof (Lisp_Case_Table, upcase_table) },
|
|
|
88 { XD_LISP_OBJECT, offsetof (Lisp_Case_Table, case_canon_table) },
|
|
|
89 { XD_LISP_OBJECT, offsetof (Lisp_Case_Table, case_eqv_table) },
|
|
|
90 { XD_END }
|
|
|
91 };
|
|
|
92
|
|
|
93 DEFINE_LRECORD_IMPLEMENTATION ("case-table", case_table,
|
|
|
94 mark_case_table, print_case_table, 0,
|
|
|
95 0, 0, case_table_description, Lisp_Case_Table);
|
|
|
96
|
|
|
97 static Lisp_Object
|
|
|
98 allocate_case_table (void)
|
|
|
99 {
|
|
|
100 Lisp_Case_Table *ct =
|
|
|
101 alloc_lcrecord_type (Lisp_Case_Table, &lrecord_case_table);
|
|
|
102
|
|
|
103 SET_CASE_TABLE_DOWNCASE (ct, Qnil);
|
|
|
104 SET_CASE_TABLE_UPCASE (ct, Qnil);
|
|
|
105 SET_CASE_TABLE_CANON (ct, Qnil);
|
|
|
106 SET_CASE_TABLE_EQV (ct, Qnil);
|
|
|
107
|
|
793
|
108 return wrap_case_table (ct);
|
|
446
|
109 }
|
|
428
|
110
|
|
|
111 DEFUN ("case-table-p", Fcase_table_p, 1, 1, 0, /*
|
|
444
|
112 Return t if OBJECT is a case table.
|
|
428
|
113 See `set-case-table' for more information on these data structures.
|
|
|
114 */
|
|
444
|
115 (object))
|
|
428
|
116 {
|
|
446
|
117 if (CASE_TABLEP (object))
|
|
|
118 return Qt;
|
|
|
119 else
|
|
|
120 {
|
|
|
121 Lisp_Object down, up, canon, eqv;
|
|
|
122 if (!CONSP (object))
|
|
|
123 return Qnil;
|
|
|
124 down = XCAR (object); object = XCDR (object);
|
|
|
125 if (!CONSP (object))
|
|
|
126 return Qnil;
|
|
|
127 up = XCAR (object); object = XCDR (object);
|
|
|
128 if (!CONSP (object))
|
|
|
129 return Qnil;
|
|
|
130 canon = XCAR (object); object = XCDR (object);
|
|
|
131 if (!CONSP (object))
|
|
|
132 return Qnil;
|
|
|
133 eqv = XCAR (object);
|
|
428
|
134
|
|
446
|
135 return ((STRING256_P (down)
|
|
|
136 && (NILP (up) || STRING256_P (up))
|
|
|
137 && ((NILP (canon) && NILP (eqv))
|
|
|
138 || STRING256_P (canon))
|
|
|
139 && (NILP (eqv) || STRING256_P (eqv)))
|
|
|
140 ? Qt : Qnil);
|
|
|
141
|
|
|
142 }
|
|
428
|
143 }
|
|
|
144
|
|
|
145 static Lisp_Object
|
|
444
|
146 check_case_table (Lisp_Object object)
|
|
428
|
147 {
|
|
446
|
148 /* This function can GC */
|
|
444
|
149 while (NILP (Fcase_table_p (object)))
|
|
|
150 object = wrong_type_argument (Qcase_tablep, object);
|
|
|
151 return object;
|
|
428
|
152 }
|
|
|
153
|
|
446
|
154 Lisp_Object
|
|
|
155 case_table_char (Lisp_Object ch, Lisp_Object table)
|
|
|
156 {
|
|
|
157 Lisp_Object ct_char;
|
|
|
158 ct_char = get_char_table (XCHAR (ch), XCHAR_TABLE (table));
|
|
|
159 if (NILP (ct_char))
|
|
|
160 return ch;
|
|
|
161 else
|
|
|
162 return ct_char;
|
|
|
163 }
|
|
|
164
|
|
|
165 DEFUN ("get-case-table", Fget_case_table, 3, 3, 0, /*
|
|
|
166 Return CHAR-CASE version of CHARACTER in CASE-TABLE.
|
|
|
167
|
|
|
168 CHAR-CASE is either downcase or upcase.
|
|
|
169 */
|
|
|
170 (char_case, character, case_table))
|
|
|
171 {
|
|
|
172 CHECK_CHAR (character);
|
|
|
173 CHECK_CASE_TABLE (case_table);
|
|
|
174 if (EQ (char_case, Qdowncase))
|
|
|
175 return case_table_char (character, XCASE_TABLE_DOWNCASE (case_table));
|
|
|
176 else if (EQ (char_case, Qupcase))
|
|
|
177 return case_table_char (character, XCASE_TABLE_UPCASE (case_table));
|
|
|
178 else
|
|
563
|
179 invalid_constant ("Char case must be downcase or upcase", char_case);
|
|
446
|
180
|
|
|
181 return Qnil; /* Not reached. */
|
|
|
182 }
|
|
|
183
|
|
|
184 DEFUN ("put-case-table", Fput_case_table, 4, 4, 0, /*
|
|
|
185 Set CHAR-CASE version of CHARACTER to be VALUE in CASE-TABLE.
|
|
|
186
|
|
|
187 CHAR-CASE is either downcase or upcase.
|
|
|
188 See also `put-case-table-pair'.
|
|
|
189 */
|
|
|
190 (char_case, character, value, case_table))
|
|
|
191 {
|
|
|
192 CHECK_CHAR (character);
|
|
|
193 CHECK_CHAR (value);
|
|
|
194
|
|
|
195 if (EQ (char_case, Qdowncase))
|
|
|
196 {
|
|
|
197 Fput_char_table (character, value, XCASE_TABLE_DOWNCASE (case_table));
|
|
|
198 /* This one is not at all intuitive. */
|
|
|
199 Fput_char_table (character, value, XCASE_TABLE_UPCASE (case_table));
|
|
|
200 Fput_char_table (character, value, XCASE_TABLE_CANON (case_table));
|
|
|
201 Fput_char_table (value, value, XCASE_TABLE_CANON (case_table));
|
|
|
202 Fput_char_table (value, character, XCASE_TABLE_EQV (case_table));
|
|
|
203 Fput_char_table (character, value, XCASE_TABLE_EQV (case_table));
|
|
|
204 }
|
|
|
205 else if (EQ (char_case, Qupcase))
|
|
|
206 {
|
|
|
207 Fput_char_table (character, value, XCASE_TABLE_UPCASE (case_table));
|
|
|
208 Fput_char_table (character, character, XCASE_TABLE_DOWNCASE (case_table));
|
|
|
209 Fput_char_table (character, character, XCASE_TABLE_CANON (case_table));
|
|
|
210 Fput_char_table (value, character, XCASE_TABLE_CANON (case_table));
|
|
|
211 Fput_char_table (value, character, XCASE_TABLE_EQV (case_table));
|
|
|
212 Fput_char_table (character, value, XCASE_TABLE_EQV (case_table));
|
|
|
213 }
|
|
|
214 else
|
|
563
|
215 invalid_constant ("Char case must be downcase or upcase", char_case);
|
|
446
|
216
|
|
|
217 return Qnil;
|
|
|
218 }
|
|
|
219
|
|
|
220 DEFUN ("put-case-table-pair", Fput_case_table_pair, 3, 3, 0, /*
|
|
|
221 Make UC and LC a pair of inter-case-converting letters in CASE-TABLE.
|
|
|
222 UC is an uppercase character and LC is a downcase character.
|
|
|
223 */
|
|
|
224 (uc, lc, case_table))
|
|
|
225 {
|
|
|
226 CHECK_CHAR (uc);
|
|
|
227 CHECK_CHAR (lc);
|
|
|
228 CHECK_CASE_TABLE (case_table);
|
|
|
229
|
|
|
230 Fput_char_table (lc, lc, XCASE_TABLE_DOWNCASE (case_table));
|
|
|
231 Fput_char_table (uc, lc, XCASE_TABLE_UPCASE (case_table));
|
|
|
232 Fput_char_table (uc, lc, XCASE_TABLE_DOWNCASE (case_table));
|
|
|
233 Fput_char_table (lc, uc, XCASE_TABLE_UPCASE (case_table));
|
|
|
234
|
|
|
235 Fput_char_table (lc, lc, XCASE_TABLE_CANON (case_table));
|
|
|
236 Fput_char_table (uc, lc, XCASE_TABLE_CANON (case_table));
|
|
|
237 Fput_char_table (uc, lc, XCASE_TABLE_EQV (case_table));
|
|
|
238 Fput_char_table (lc, uc, XCASE_TABLE_EQV (case_table));
|
|
|
239 return Qnil;
|
|
|
240 }
|
|
|
241
|
|
|
242 DEFUN ("copy-case-table", Fcopy_case_table, 1, 1, 0, /*
|
|
|
243 Return a new case table which is a copy of CASE-TABLE
|
|
|
244 */
|
|
|
245 (case_table))
|
|
|
246 {
|
|
|
247 Lisp_Object new_obj;
|
|
|
248 CHECK_CASE_TABLE (case_table);
|
|
|
249
|
|
|
250 new_obj = allocate_case_table ();
|
|
|
251 XSET_CASE_TABLE_DOWNCASE
|
|
|
252 (new_obj, Fcopy_char_table (XCASE_TABLE_DOWNCASE (case_table)));
|
|
|
253 XSET_CASE_TABLE_UPCASE
|
|
|
254 (new_obj, Fcopy_char_table (XCASE_TABLE_UPCASE (case_table)));
|
|
|
255 XSET_CASE_TABLE_CANON
|
|
|
256 (new_obj, Fcopy_char_table (XCASE_TABLE_CANON (case_table)));
|
|
|
257 XSET_CASE_TABLE_EQV
|
|
|
258 (new_obj, Fcopy_char_table (XCASE_TABLE_EQV (case_table)));
|
|
|
259 return new_obj;
|
|
|
260 }
|
|
|
261
|
|
428
|
262 DEFUN ("current-case-table", Fcurrent_case_table, 0, 1, 0, /*
|
|
|
263 Return the case table of BUFFER, which defaults to the current buffer.
|
|
|
264 */
|
|
|
265 (buffer))
|
|
|
266 {
|
|
|
267 struct buffer *buf = decode_buffer (buffer, 0);
|
|
|
268
|
|
446
|
269 return buf->case_table;
|
|
428
|
270 }
|
|
|
271
|
|
|
272 DEFUN ("standard-case-table", Fstandard_case_table, 0, 0, 0, /*
|
|
|
273 Return the standard case table.
|
|
|
274 This is the one used for new buffers.
|
|
|
275 */
|
|
|
276 ())
|
|
|
277 {
|
|
446
|
278 return Vstandard_case_table;
|
|
428
|
279 }
|
|
|
280
|
|
|
281 static Lisp_Object set_case_table (Lisp_Object table, int standard);
|
|
|
282
|
|
|
283 DEFUN ("set-case-table", Fset_case_table, 1, 1, 0, /*
|
|
444
|
284 Select CASE-TABLE as the new case table for the current buffer.
|
|
446
|
285 A case table is a case-table object or list
|
|
|
286 (DOWNCASE UPCASE CANONICALIZE EQUIVALENCES)
|
|
428
|
287 where each element is either nil or a string of length 256.
|
|
446
|
288 The latter is provided for backward-compatibility.
|
|
428
|
289 DOWNCASE maps each character to its lower-case equivalent.
|
|
|
290 UPCASE maps each character to its upper-case equivalent;
|
|
|
291 if lower and upper case characters are in 1-1 correspondence,
|
|
|
292 you may use nil and the upcase table will be deduced from DOWNCASE.
|
|
|
293 CANONICALIZE maps each character to a canonical equivalent;
|
|
|
294 any two characters that are related by case-conversion have the same
|
|
|
295 canonical equivalent character; it may be nil, in which case it is
|
|
|
296 deduced from DOWNCASE and UPCASE.
|
|
|
297 EQUIVALENCES is a map that cyclicly permutes each equivalence class
|
|
|
298 (of characters with the same canonical equivalent); it may be nil,
|
|
|
299 in which case it is deduced from CANONICALIZE.
|
|
|
300
|
|
446
|
301 See also `get-case-table', `put-case-table' and `put-case-table-pair'.
|
|
428
|
302 */
|
|
444
|
303 (case_table))
|
|
428
|
304 {
|
|
446
|
305 /* This function can GC */
|
|
444
|
306 return set_case_table (case_table, 0);
|
|
428
|
307 }
|
|
|
308
|
|
|
309 DEFUN ("set-standard-case-table", Fset_standard_case_table, 1, 1, 0, /*
|
|
444
|
310 Select CASE-TABLE as the new standard case table for new buffers.
|
|
428
|
311 See `set-case-table' for more info on case tables.
|
|
|
312 */
|
|
444
|
313 (case_table))
|
|
428
|
314 {
|
|
446
|
315 /* This function can GC */
|
|
444
|
316 return set_case_table (case_table, 1);
|
|
428
|
317 }
|
|
|
318
|
|
|
319 static Lisp_Object
|
|
|
320 set_case_table (Lisp_Object table, int standard)
|
|
|
321 {
|
|
446
|
322 /* This function can GC */
|
|
442
|
323 struct buffer *buf =
|
|
|
324 standard ? XBUFFER(Vbuffer_defaults) : current_buffer;
|
|
428
|
325
|
|
|
326 check_case_table (table);
|
|
|
327
|
|
446
|
328 if (CASE_TABLEP (table))
|
|
|
329 {
|
|
|
330 if (standard)
|
|
|
331 Vstandard_case_table = table;
|
|
428
|
332
|
|
446
|
333 buf->case_table = table;
|
|
428
|
334 }
|
|
446
|
335 else
|
|
428
|
336 {
|
|
446
|
337 /* For backward compatibility. */
|
|
|
338 Lisp_Object down, up, canon, eqv, tail = table;
|
|
|
339 Lisp_Object temp;
|
|
|
340 int i;
|
|
|
341
|
|
|
342 down = XCAR (tail); tail = XCDR (tail);
|
|
|
343 up = XCAR (tail); tail = XCDR (tail);
|
|
|
344 canon = XCAR (tail); tail = XCDR (tail);
|
|
|
345 eqv = XCAR (tail);
|
|
|
346
|
|
|
347 temp = down;
|
|
|
348 down = MAKE_TRT_TABLE ();
|
|
|
349 for (i = 0; i < 256; i++)
|
|
793
|
350 SET_TRT_TABLE_CHAR_1 (down, i, XSTRING_CHAR (temp, i));
|
|
428
|
351
|
|
446
|
352 if (NILP (up))
|
|
|
353 {
|
|
|
354 up = MAKE_TRT_TABLE ();
|
|
|
355 compute_trt_inverse (down, up);
|
|
|
356 }
|
|
|
357 else
|
|
|
358 {
|
|
|
359 temp = up;
|
|
|
360 up = MAKE_TRT_TABLE ();
|
|
|
361 for (i = 0; i < 256; i++)
|
|
793
|
362 SET_TRT_TABLE_CHAR_1 (up, i, XSTRING_CHAR (temp, i));
|
|
446
|
363 }
|
|
|
364 if (NILP (canon))
|
|
|
365 {
|
|
|
366 canon = MAKE_TRT_TABLE ();
|
|
428
|
367
|
|
446
|
368 /* Set up the CANON table; for each character,
|
|
|
369 this sequence of upcasing and downcasing ought to
|
|
|
370 get the "preferred" lowercase equivalent. */
|
|
|
371 for (i = 0; i < 256; i++)
|
|
|
372 SET_TRT_TABLE_CHAR_1 (canon, i,
|
|
|
373 TRT_TABLE_CHAR_1
|
|
|
374 (down,
|
|
|
375 TRT_TABLE_CHAR_1
|
|
|
376 (up,
|
|
|
377 TRT_TABLE_CHAR_1 (down, i))));
|
|
|
378 }
|
|
|
379 else
|
|
|
380 {
|
|
|
381 temp = canon;
|
|
|
382 canon = MAKE_TRT_TABLE ();
|
|
|
383 for (i = 0; i < 256; i++)
|
|
793
|
384 SET_TRT_TABLE_CHAR_1 (canon, i, XSTRING_CHAR (temp, i));
|
|
446
|
385 }
|
|
|
386
|
|
|
387 if (NILP (eqv))
|
|
|
388 {
|
|
|
389 eqv = MAKE_TRT_TABLE ();
|
|
|
390 compute_trt_inverse (canon, eqv);
|
|
|
391 }
|
|
|
392 else
|
|
|
393 {
|
|
|
394 temp = eqv;
|
|
|
395 eqv = MAKE_TRT_TABLE ();
|
|
|
396 for (i = 0; i < 256; i++)
|
|
793
|
397 SET_TRT_TABLE_CHAR_1 (eqv, i, XSTRING_CHAR (temp, i));
|
|
446
|
398 }
|
|
|
399
|
|
|
400 if (standard)
|
|
|
401 {
|
|
|
402 XSET_CASE_TABLE_DOWNCASE (Vstandard_case_table, down);
|
|
|
403 XSET_CASE_TABLE_UPCASE (Vstandard_case_table, up);
|
|
|
404 XSET_CASE_TABLE_CANON (Vstandard_case_table, canon);
|
|
|
405 XSET_CASE_TABLE_EQV (Vstandard_case_table, eqv);
|
|
|
406 }
|
|
|
407
|
|
|
408 buf->case_table = allocate_case_table ();
|
|
|
409 XSET_CASE_TABLE_DOWNCASE (buf->case_table, down);
|
|
|
410 XSET_CASE_TABLE_UPCASE (buf->case_table, up);
|
|
|
411 XSET_CASE_TABLE_CANON (buf->case_table, canon);
|
|
|
412 XSET_CASE_TABLE_EQV (buf->case_table, eqv);
|
|
428
|
413 }
|
|
|
414
|
|
446
|
415 return buf->case_table;
|
|
428
|
416 }
|
|
|
417
|
|
|
418 /* Given a translate table TRT, store the inverse mapping into INVERSE.
|
|
|
419 Since TRT is not one-to-one, INVERSE is not a simple mapping.
|
|
|
420 Instead, it divides the space of characters into equivalence classes.
|
|
|
421 All characters in a given class form one circular list, chained through
|
|
|
422 the elements of INVERSE. */
|
|
|
423
|
|
|
424 static void
|
|
|
425 compute_trt_inverse (Lisp_Object trt, Lisp_Object inverse)
|
|
|
426 {
|
|
|
427 Charcount i = 0400;
|
|
|
428 Emchar c, q;
|
|
|
429
|
|
|
430 while (--i)
|
|
|
431 SET_TRT_TABLE_CHAR_1 (inverse, i, (Emchar) i);
|
|
|
432 i = 0400;
|
|
|
433 while (--i)
|
|
|
434 {
|
|
|
435 if ((q = TRT_TABLE_CHAR_1 (trt, i)) != (Emchar) i)
|
|
|
436 {
|
|
|
437 c = TRT_TABLE_CHAR_1 (inverse, q);
|
|
|
438 SET_TRT_TABLE_CHAR_1 (inverse, q, (Emchar) i);
|
|
|
439 SET_TRT_TABLE_CHAR_1 (inverse, i, c);
|
|
|
440 }
|
|
|
441 }
|
|
|
442 }
|
|
|
443
|
|
|
444
|
|
|
445 void
|
|
|
446 syms_of_casetab (void)
|
|
|
447 {
|
|
446
|
448 INIT_LRECORD_IMPLEMENTATION (case_table);
|
|
|
449
|
|
563
|
450 DEFSYMBOL_MULTIWORD_PREDICATE (Qcase_tablep);
|
|
|
451 DEFSYMBOL (Qdowncase);
|
|
|
452 DEFSYMBOL (Qupcase);
|
|
428
|
453
|
|
|
454 DEFSUBR (Fcase_table_p);
|
|
446
|
455 DEFSUBR (Fget_case_table);
|
|
|
456 DEFSUBR (Fput_case_table);
|
|
|
457 DEFSUBR (Fput_case_table_pair);
|
|
428
|
458 DEFSUBR (Fcurrent_case_table);
|
|
|
459 DEFSUBR (Fstandard_case_table);
|
|
446
|
460 DEFSUBR (Fcopy_case_table);
|
|
428
|
461 DEFSUBR (Fset_case_table);
|
|
|
462 DEFSUBR (Fset_standard_case_table);
|
|
|
463 }
|
|
|
464
|
|
|
465 void
|
|
|
466 complex_vars_of_casetab (void)
|
|
|
467 {
|
|
|
468 REGISTER Emchar i;
|
|
|
469 Lisp_Object tem;
|
|
|
470
|
|
446
|
471 staticpro (&Vstandard_case_table);
|
|
428
|
472
|
|
446
|
473 Vstandard_case_table = allocate_case_table ();
|
|
428
|
474
|
|
|
475 tem = MAKE_TRT_TABLE ();
|
|
446
|
476 XSET_CASE_TABLE_DOWNCASE (Vstandard_case_table, tem);
|
|
|
477 XSET_CASE_TABLE_CANON (Vstandard_case_table, tem);
|
|
428
|
478
|
|
|
479 /* Under Mule, can't do set_string_char() until Vcharset_control_1
|
|
|
480 and Vcharset_ascii are initialized. */
|
|
|
481 for (i = 0; i < 256; i++)
|
|
|
482 {
|
|
|
483 unsigned char lowered = tolower (i);
|
|
|
484
|
|
|
485 SET_TRT_TABLE_CHAR_1 (tem, i, lowered);
|
|
|
486 }
|
|
|
487
|
|
|
488 tem = MAKE_TRT_TABLE ();
|
|
446
|
489 XSET_CASE_TABLE_UPCASE (Vstandard_case_table, tem);
|
|
|
490 XSET_CASE_TABLE_EQV (Vstandard_case_table, tem);
|
|
428
|
491
|
|
|
492 for (i = 0; i < 256; i++)
|
|
|
493 {
|
|
|
494 unsigned char flipped = (isupper (i) ? tolower (i)
|
|
|
495 : (islower (i) ? toupper (i) : i));
|
|
|
496
|
|
|
497 SET_TRT_TABLE_CHAR_1 (tem, i, flipped);
|
|
|
498 }
|
|
|
499 }
|
