|
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
|
|
826
|
27 /* Written by Howard Gayle. */
|
|
428
|
28
|
|
|
29 /* Modified for Mule by Ben Wing. */
|
|
|
30
|
|
826
|
31 /* The four tables in a case table are downcase, upcase, canon, and eqv.
|
|
|
32 Each is a char-table. Their workings are rather non-obvious.
|
|
|
33
|
|
|
34 (1) `downcase' is the only obvious table: Map a character to its
|
|
|
35 lowercase equivalent.
|
|
771
|
36
|
|
826
|
37 (2) `upcase' does *NOT* map a character to its uppercase equivalent,
|
|
|
38 despite its name. Rather, it maps lowercase characters to their
|
|
|
39 uppercase equivalent, and uppercase characters to *ANYTHING BUT* their
|
|
|
40 uppercase equivalent (currently, their lowercase equivalent), and
|
|
|
41 characters without case to themselves. It is used to determine if a
|
|
|
42 character "has no case" (no uppercase or lowercase mapping). #### This
|
|
|
43 is way bogus. Just use the obvious implementation of uppercase mapping
|
|
|
44 and of NOCASE_P.
|
|
446
|
45
|
|
826
|
46 (3) `canon' maps each character to a "canonical" lowercase, such that if
|
|
|
47 two different uppercase characters map to the same lowercase character,
|
|
|
48 or vice versa, both characters will have the same entry in the canon
|
|
|
49 table.
|
|
446
|
50
|
|
826
|
51 (4) `equiv' lists the "equivalence classes" defined by `canon'. Imagine
|
|
|
52 that all characters are divided into groups having the same `canon'
|
|
|
53 entry; these groups are called "equivalence classes" and `equiv' lists
|
|
|
54 them by linking the characters in each equivalence class together in a
|
|
|
55 circular list.
|
|
|
56
|
|
|
57 `canon' is used when doing case-insensitive comparisons. `equiv' is
|
|
|
58 used in the Boyer-Moore search code.
|
|
|
59 */
|
|
428
|
60
|
|
|
61 #include <config.h>
|
|
|
62 #include "lisp.h"
|
|
|
63 #include "buffer.h"
|
|
|
64 #include "opaque.h"
|
|
446
|
65 #include "chartab.h"
|
|
|
66 #include "casetab.h"
|
|
428
|
67
|
|
446
|
68 Lisp_Object Qcase_tablep, Qdowncase, Qupcase;
|
|
|
69 Lisp_Object Vstandard_case_table;
|
|
428
|
70
|
|
446
|
71 Lisp_Object case_table_char (Lisp_Object ch, Lisp_Object table);
|
|
428
|
72
|
|
826
|
73 #define STRING256_P(obj) ((STRINGP (obj) && string_char_length (obj) == 256))
|
|
446
|
74
|
|
|
75 static Lisp_Object
|
|
|
76 mark_case_table (Lisp_Object obj)
|
|
|
77 {
|
|
|
78 Lisp_Case_Table *ct = XCASE_TABLE (obj);
|
|
|
79
|
|
|
80 mark_object (CASE_TABLE_DOWNCASE (ct));
|
|
|
81 mark_object (CASE_TABLE_UPCASE (ct));
|
|
|
82 mark_object (CASE_TABLE_CANON (ct));
|
|
|
83 mark_object (CASE_TABLE_EQV (ct));
|
|
|
84 return Qnil;
|
|
|
85 }
|
|
|
86
|
|
|
87 static void
|
|
2286
|
88 print_case_table (Lisp_Object obj, Lisp_Object printcharfun,
|
|
|
89 int UNUSED (escapeflag))
|
|
446
|
90 {
|
|
|
91 Lisp_Case_Table *ct = XCASE_TABLE (obj);
|
|
|
92 if (print_readably)
|
|
826
|
93 printing_unreadable_object ("#<case-table 0x%x>", ct->header.uid);
|
|
|
94 write_fmt_string_lisp
|
|
|
95 (printcharfun, "#<case-table downcase=%s upcase=%s canon=%s eqv=%s ", 4,
|
|
|
96 CASE_TABLE_DOWNCASE (ct), CASE_TABLE_UPCASE (ct),
|
|
|
97 CASE_TABLE_CANON (ct), CASE_TABLE_EQV (ct));
|
|
|
98 write_fmt_string (printcharfun, "0x%x>", ct->header.uid);
|
|
446
|
99 }
|
|
|
100
|
|
1204
|
101 static const struct memory_description case_table_description [] = {
|
|
446
|
102 { XD_LISP_OBJECT, offsetof (Lisp_Case_Table, downcase_table) },
|
|
|
103 { XD_LISP_OBJECT, offsetof (Lisp_Case_Table, upcase_table) },
|
|
|
104 { XD_LISP_OBJECT, offsetof (Lisp_Case_Table, case_canon_table) },
|
|
|
105 { XD_LISP_OBJECT, offsetof (Lisp_Case_Table, case_eqv_table) },
|
|
|
106 { XD_END }
|
|
|
107 };
|
|
|
108
|
|
934
|
109
|
|
|
110 DEFINE_LRECORD_IMPLEMENTATION("case-table", case_table,
|
|
|
111 1, /*dumpable-flag*/
|
|
|
112 mark_case_table, print_case_table, 0,
|
|
|
113 0, 0, case_table_description, Lisp_Case_Table);
|
|
446
|
114
|
|
|
115 static Lisp_Object
|
|
826
|
116 allocate_case_table (int init_tables)
|
|
446
|
117 {
|
|
|
118 Lisp_Case_Table *ct =
|
|
2720
|
119 #ifdef MC_ALLOC
|
|
|
120 alloc_lrecord_type (Lisp_Case_Table, &lrecord_case_table);
|
|
|
121 #else /* not MC_ALLOC */
|
|
446
|
122 alloc_lcrecord_type (Lisp_Case_Table, &lrecord_case_table);
|
|
2720
|
123 #endif /* not MC_ALLOC */
|
|
446
|
124
|
|
826
|
125 if (init_tables)
|
|
|
126 {
|
|
|
127 SET_CASE_TABLE_DOWNCASE (ct, MAKE_TRT_TABLE ());
|
|
|
128 SET_CASE_TABLE_UPCASE (ct, MAKE_TRT_TABLE ());
|
|
|
129 SET_CASE_TABLE_CANON (ct, MAKE_TRT_TABLE ());
|
|
|
130 SET_CASE_TABLE_EQV (ct, MAKE_TRT_TABLE ());
|
|
|
131 }
|
|
|
132 else
|
|
|
133 {
|
|
|
134 SET_CASE_TABLE_DOWNCASE (ct, Qnil);
|
|
|
135 SET_CASE_TABLE_UPCASE (ct, Qnil);
|
|
|
136 SET_CASE_TABLE_CANON (ct, Qnil);
|
|
|
137 SET_CASE_TABLE_EQV (ct, Qnil);
|
|
|
138 }
|
|
|
139 return wrap_case_table (ct);
|
|
|
140 }
|
|
446
|
141
|
|
826
|
142 DEFUN ("make-case-table", Fmake_case_table, 0, 0, 0, /*
|
|
|
143 Create a new, empty case table.
|
|
|
144 */
|
|
|
145 ())
|
|
|
146 {
|
|
|
147 return allocate_case_table (1);
|
|
446
|
148 }
|
|
428
|
149
|
|
|
150 DEFUN ("case-table-p", Fcase_table_p, 1, 1, 0, /*
|
|
444
|
151 Return t if OBJECT is a case table.
|
|
428
|
152 See `set-case-table' for more information on these data structures.
|
|
|
153 */
|
|
444
|
154 (object))
|
|
428
|
155 {
|
|
446
|
156 if (CASE_TABLEP (object))
|
|
|
157 return Qt;
|
|
|
158 else
|
|
|
159 {
|
|
|
160 Lisp_Object down, up, canon, eqv;
|
|
|
161 if (!CONSP (object))
|
|
|
162 return Qnil;
|
|
|
163 down = XCAR (object); object = XCDR (object);
|
|
|
164 if (!CONSP (object))
|
|
|
165 return Qnil;
|
|
|
166 up = XCAR (object); object = XCDR (object);
|
|
|
167 if (!CONSP (object))
|
|
|
168 return Qnil;
|
|
|
169 canon = XCAR (object); object = XCDR (object);
|
|
|
170 if (!CONSP (object))
|
|
|
171 return Qnil;
|
|
|
172 eqv = XCAR (object);
|
|
428
|
173
|
|
446
|
174 return ((STRING256_P (down)
|
|
|
175 && (NILP (up) || STRING256_P (up))
|
|
|
176 && ((NILP (canon) && NILP (eqv))
|
|
|
177 || STRING256_P (canon))
|
|
|
178 && (NILP (eqv) || STRING256_P (eqv)))
|
|
|
179 ? Qt : Qnil);
|
|
|
180
|
|
|
181 }
|
|
428
|
182 }
|
|
|
183
|
|
|
184 static Lisp_Object
|
|
444
|
185 check_case_table (Lisp_Object object)
|
|
428
|
186 {
|
|
446
|
187 /* This function can GC */
|
|
444
|
188 while (NILP (Fcase_table_p (object)))
|
|
|
189 object = wrong_type_argument (Qcase_tablep, object);
|
|
|
190 return object;
|
|
428
|
191 }
|
|
|
192
|
|
446
|
193 Lisp_Object
|
|
|
194 case_table_char (Lisp_Object ch, Lisp_Object table)
|
|
|
195 {
|
|
|
196 Lisp_Object ct_char;
|
|
826
|
197 ct_char = get_char_table (XCHAR (ch), table);
|
|
446
|
198 if (NILP (ct_char))
|
|
|
199 return ch;
|
|
|
200 else
|
|
|
201 return ct_char;
|
|
|
202 }
|
|
|
203
|
|
|
204 DEFUN ("get-case-table", Fget_case_table, 3, 3, 0, /*
|
|
|
205 Return CHAR-CASE version of CHARACTER in CASE-TABLE.
|
|
|
206
|
|
826
|
207 CHAR-CASE is either `downcase' or `upcase'.
|
|
446
|
208 */
|
|
|
209 (char_case, character, case_table))
|
|
|
210 {
|
|
|
211 CHECK_CHAR (character);
|
|
|
212 CHECK_CASE_TABLE (case_table);
|
|
|
213 if (EQ (char_case, Qdowncase))
|
|
|
214 return case_table_char (character, XCASE_TABLE_DOWNCASE (case_table));
|
|
|
215 else if (EQ (char_case, Qupcase))
|
|
|
216 return case_table_char (character, XCASE_TABLE_UPCASE (case_table));
|
|
|
217 else
|
|
563
|
218 invalid_constant ("Char case must be downcase or upcase", char_case);
|
|
446
|
219
|
|
|
220 return Qnil; /* Not reached. */
|
|
|
221 }
|
|
|
222
|
|
|
223 DEFUN ("put-case-table", Fput_case_table, 4, 4, 0, /*
|
|
|
224 Set CHAR-CASE version of CHARACTER to be VALUE in CASE-TABLE.
|
|
|
225
|
|
826
|
226 CHAR-CASE is either `downcase' or `upcase'.
|
|
446
|
227 See also `put-case-table-pair'.
|
|
|
228 */
|
|
|
229 (char_case, character, value, case_table))
|
|
|
230 {
|
|
|
231 CHECK_CHAR (character);
|
|
|
232 CHECK_CHAR (value);
|
|
|
233
|
|
|
234 if (EQ (char_case, Qdowncase))
|
|
|
235 {
|
|
|
236 Fput_char_table (character, value, XCASE_TABLE_DOWNCASE (case_table));
|
|
826
|
237 /* This one is not at all intuitive. See comment at top of file. */
|
|
446
|
238 Fput_char_table (character, value, XCASE_TABLE_UPCASE (case_table));
|
|
|
239 }
|
|
|
240 else if (EQ (char_case, Qupcase))
|
|
|
241 {
|
|
|
242 Fput_char_table (character, value, XCASE_TABLE_UPCASE (case_table));
|
|
826
|
243 Fput_char_table (character, character,
|
|
|
244 XCASE_TABLE_DOWNCASE (case_table));
|
|
446
|
245 }
|
|
|
246 else
|
|
826
|
247 invalid_constant ("CHAR-CASE must be downcase or upcase", char_case);
|
|
446
|
248
|
|
826
|
249 XCASE_TABLE (case_table)->dirty = 1;
|
|
446
|
250 return Qnil;
|
|
|
251 }
|
|
|
252
|
|
|
253 DEFUN ("put-case-table-pair", Fput_case_table_pair, 3, 3, 0, /*
|
|
|
254 Make UC and LC a pair of inter-case-converting letters in CASE-TABLE.
|
|
|
255 UC is an uppercase character and LC is a downcase character.
|
|
|
256 */
|
|
|
257 (uc, lc, case_table))
|
|
|
258 {
|
|
|
259 CHECK_CHAR (uc);
|
|
|
260 CHECK_CHAR (lc);
|
|
|
261 CHECK_CASE_TABLE (case_table);
|
|
|
262
|
|
|
263 Fput_char_table (lc, lc, XCASE_TABLE_DOWNCASE (case_table));
|
|
|
264 Fput_char_table (uc, lc, XCASE_TABLE_UPCASE (case_table));
|
|
|
265 Fput_char_table (uc, lc, XCASE_TABLE_DOWNCASE (case_table));
|
|
|
266 Fput_char_table (lc, uc, XCASE_TABLE_UPCASE (case_table));
|
|
|
267
|
|
826
|
268 XCASE_TABLE (case_table)->dirty = 1;
|
|
446
|
269 return Qnil;
|
|
|
270 }
|
|
|
271
|
|
|
272 DEFUN ("copy-case-table", Fcopy_case_table, 1, 1, 0, /*
|
|
|
273 Return a new case table which is a copy of CASE-TABLE
|
|
|
274 */
|
|
|
275 (case_table))
|
|
|
276 {
|
|
|
277 Lisp_Object new_obj;
|
|
|
278 CHECK_CASE_TABLE (case_table);
|
|
|
279
|
|
826
|
280 new_obj = allocate_case_table (0);
|
|
446
|
281 XSET_CASE_TABLE_DOWNCASE
|
|
|
282 (new_obj, Fcopy_char_table (XCASE_TABLE_DOWNCASE (case_table)));
|
|
|
283 XSET_CASE_TABLE_UPCASE
|
|
|
284 (new_obj, Fcopy_char_table (XCASE_TABLE_UPCASE (case_table)));
|
|
|
285 XSET_CASE_TABLE_CANON
|
|
|
286 (new_obj, Fcopy_char_table (XCASE_TABLE_CANON (case_table)));
|
|
|
287 XSET_CASE_TABLE_EQV
|
|
|
288 (new_obj, Fcopy_char_table (XCASE_TABLE_EQV (case_table)));
|
|
|
289 return new_obj;
|
|
|
290 }
|
|
|
291
|
|
826
|
292 static int
|
|
|
293 compute_canon_mapper (struct chartab_range *range,
|
|
2286
|
294 Lisp_Object UNUSED (table), Lisp_Object val, void *arg)
|
|
826
|
295 {
|
|
|
296 Lisp_Object casetab = VOID_TO_LISP (arg);
|
|
|
297 if (range->type == CHARTAB_RANGE_CHAR)
|
|
|
298 SET_TRT_TABLE_OF (XCASE_TABLE_CANON (casetab), range->ch,
|
|
|
299 TRT_TABLE_OF (XCASE_TABLE_DOWNCASE (casetab),
|
|
|
300 TRT_TABLE_OF (XCASE_TABLE_UPCASE (casetab),
|
|
|
301 XCHAR (val))));
|
|
|
302
|
|
|
303 return 0;
|
|
|
304 }
|
|
|
305
|
|
|
306 static int
|
|
|
307 initialize_identity_mapper (struct chartab_range *range,
|
|
2286
|
308 Lisp_Object UNUSED (table),
|
|
|
309 Lisp_Object UNUSED (val), void *arg)
|
|
826
|
310 {
|
|
|
311 Lisp_Object trt = VOID_TO_LISP (arg);
|
|
|
312 if (range->type == CHARTAB_RANGE_CHAR)
|
|
|
313 SET_TRT_TABLE_OF (trt, range->ch, range->ch);
|
|
|
314
|
|
|
315 return 0;
|
|
|
316 }
|
|
|
317
|
|
|
318 static int
|
|
|
319 compute_up_or_eqv_mapper (struct chartab_range *range,
|
|
2286
|
320 Lisp_Object UNUSED (table),
|
|
|
321 Lisp_Object val, void *arg)
|
|
826
|
322 {
|
|
|
323 Lisp_Object inverse = VOID_TO_LISP (arg);
|
|
867
|
324 Ichar toch = XCHAR (val);
|
|
826
|
325
|
|
|
326 if (range->type == CHARTAB_RANGE_CHAR && range->ch != toch)
|
|
|
327 {
|
|
867
|
328 Ichar c = TRT_TABLE_OF (inverse, toch);
|
|
826
|
329 SET_TRT_TABLE_OF (inverse, toch, range->ch);
|
|
|
330 SET_TRT_TABLE_OF (inverse, range->ch, c);
|
|
|
331 }
|
|
|
332
|
|
|
333 return 0;
|
|
|
334 }
|
|
|
335
|
|
|
336 /* Recomputing the canonical and equivalency tables from scratch is a
|
|
|
337 lengthy process, and doing them incrementally is extremely difficult or
|
|
|
338 perhaps impossible -- and certainly not worth it. To avoid lots of
|
|
|
339 excessive recomputation when lots of stuff is incrementally added, we
|
|
|
340 just store a dirty flag and then recompute when a value from the canon
|
|
|
341 or eqv tables is actually needed. */
|
|
|
342
|
|
|
343 void
|
|
|
344 recompute_case_table (Lisp_Object casetab)
|
|
|
345 {
|
|
|
346 struct chartab_range range;
|
|
|
347
|
|
|
348 range.type = CHARTAB_RANGE_ALL;
|
|
|
349 /* Turn off dirty flag first so we don't get infinite recursion when
|
|
|
350 retrieving the values below! */
|
|
|
351 XCASE_TABLE (casetab)->dirty = 0;
|
|
|
352 map_char_table (XCASE_TABLE_DOWNCASE (casetab), &range,
|
|
|
353 compute_canon_mapper, LISP_TO_VOID (casetab));
|
|
|
354 map_char_table (XCASE_TABLE_CANON (casetab), &range,
|
|
|
355 initialize_identity_mapper,
|
|
|
356 LISP_TO_VOID (XCASE_TABLE_EQV (casetab)));
|
|
|
357 map_char_table (XCASE_TABLE_CANON (casetab), &range,
|
|
|
358 compute_up_or_eqv_mapper,
|
|
|
359 LISP_TO_VOID (XCASE_TABLE_EQV (casetab)));
|
|
|
360 }
|
|
|
361
|
|
428
|
362 DEFUN ("current-case-table", Fcurrent_case_table, 0, 1, 0, /*
|
|
|
363 Return the case table of BUFFER, which defaults to the current buffer.
|
|
|
364 */
|
|
|
365 (buffer))
|
|
|
366 {
|
|
|
367 struct buffer *buf = decode_buffer (buffer, 0);
|
|
|
368
|
|
446
|
369 return buf->case_table;
|
|
428
|
370 }
|
|
|
371
|
|
|
372 DEFUN ("standard-case-table", Fstandard_case_table, 0, 0, 0, /*
|
|
|
373 Return the standard case table.
|
|
|
374 This is the one used for new buffers.
|
|
|
375 */
|
|
|
376 ())
|
|
|
377 {
|
|
446
|
378 return Vstandard_case_table;
|
|
428
|
379 }
|
|
|
380
|
|
826
|
381 static void
|
|
|
382 convert_old_style_syntax_string (Lisp_Object table, Lisp_Object string)
|
|
|
383 {
|
|
867
|
384 Ichar i;
|
|
826
|
385
|
|
|
386 for (i = 0; i < 256; i++)
|
|
867
|
387 SET_TRT_TABLE_OF (table, i, string_ichar (string, i));
|
|
826
|
388 }
|
|
|
389
|
|
|
390 static Lisp_Object
|
|
|
391 set_case_table (Lisp_Object table, int standard)
|
|
|
392 {
|
|
|
393 /* This function can GC */
|
|
|
394 struct buffer *buf =
|
|
|
395 standard ? XBUFFER (Vbuffer_defaults) : current_buffer;
|
|
|
396
|
|
|
397 check_case_table (table);
|
|
|
398
|
|
|
399 if (CASE_TABLEP (table))
|
|
|
400 {
|
|
|
401 if (standard)
|
|
|
402 Vstandard_case_table = table;
|
|
|
403
|
|
|
404 buf->case_table = table;
|
|
|
405 }
|
|
|
406 else
|
|
|
407 {
|
|
|
408 /* For backward compatibility. */
|
|
|
409 Lisp_Object down, up, canon, eqv, tail = table;
|
|
|
410 Lisp_Object casetab =
|
|
|
411 standard ? Vstandard_case_table : buf->case_table;
|
|
|
412 struct chartab_range range;
|
|
|
413
|
|
|
414 range.type = CHARTAB_RANGE_ALL;
|
|
|
415
|
|
|
416 Freset_char_table (XCASE_TABLE_DOWNCASE (casetab));
|
|
|
417 Freset_char_table (XCASE_TABLE_UPCASE (casetab));
|
|
|
418 Freset_char_table (XCASE_TABLE_CANON (casetab));
|
|
|
419 Freset_char_table (XCASE_TABLE_EQV (casetab));
|
|
|
420
|
|
|
421 down = XCAR (tail); tail = XCDR (tail);
|
|
|
422 up = XCAR (tail); tail = XCDR (tail);
|
|
|
423 canon = XCAR (tail); tail = XCDR (tail);
|
|
|
424 eqv = XCAR (tail);
|
|
|
425
|
|
|
426 convert_old_style_syntax_string (XCASE_TABLE_DOWNCASE (casetab), down);
|
|
|
427
|
|
|
428 if (NILP (up))
|
|
|
429 {
|
|
|
430 map_char_table (XCASE_TABLE_DOWNCASE (casetab), &range,
|
|
|
431 initialize_identity_mapper,
|
|
|
432 LISP_TO_VOID (XCASE_TABLE_UPCASE (casetab)));
|
|
|
433 map_char_table (XCASE_TABLE_DOWNCASE (casetab), &range,
|
|
|
434 compute_up_or_eqv_mapper,
|
|
|
435 LISP_TO_VOID (XCASE_TABLE_UPCASE (casetab)));
|
|
|
436 }
|
|
|
437 else
|
|
|
438 convert_old_style_syntax_string (XCASE_TABLE_UPCASE (casetab), up);
|
|
|
439
|
|
|
440 if (NILP (canon))
|
|
|
441 map_char_table (XCASE_TABLE_DOWNCASE (casetab), &range,
|
|
|
442 compute_canon_mapper, LISP_TO_VOID (casetab));
|
|
|
443 else
|
|
|
444 convert_old_style_syntax_string (XCASE_TABLE_CANON (casetab), canon);
|
|
|
445
|
|
|
446 if (NILP (eqv))
|
|
|
447 {
|
|
|
448 map_char_table (XCASE_TABLE_CANON (casetab), &range,
|
|
|
449 initialize_identity_mapper,
|
|
|
450 LISP_TO_VOID (XCASE_TABLE_EQV (casetab)));
|
|
|
451 map_char_table (XCASE_TABLE_CANON (casetab), &range,
|
|
|
452 compute_up_or_eqv_mapper,
|
|
|
453 LISP_TO_VOID (XCASE_TABLE_EQV (casetab)));
|
|
|
454 }
|
|
|
455 else
|
|
|
456 convert_old_style_syntax_string (XCASE_TABLE_CANON (casetab), eqv);
|
|
|
457 }
|
|
|
458
|
|
|
459 return buf->case_table;
|
|
|
460 }
|
|
428
|
461
|
|
|
462 DEFUN ("set-case-table", Fset_case_table, 1, 1, 0, /*
|
|
444
|
463 Select CASE-TABLE as the new case table for the current buffer.
|
|
446
|
464 A case table is a case-table object or list
|
|
|
465 (DOWNCASE UPCASE CANONICALIZE EQUIVALENCES)
|
|
428
|
466 where each element is either nil or a string of length 256.
|
|
446
|
467 The latter is provided for backward-compatibility.
|
|
428
|
468 DOWNCASE maps each character to its lower-case equivalent.
|
|
|
469 UPCASE maps each character to its upper-case equivalent;
|
|
|
470 if lower and upper case characters are in 1-1 correspondence,
|
|
|
471 you may use nil and the upcase table will be deduced from DOWNCASE.
|
|
|
472 CANONICALIZE maps each character to a canonical equivalent;
|
|
|
473 any two characters that are related by case-conversion have the same
|
|
|
474 canonical equivalent character; it may be nil, in which case it is
|
|
|
475 deduced from DOWNCASE and UPCASE.
|
|
|
476 EQUIVALENCES is a map that cyclicly permutes each equivalence class
|
|
|
477 (of characters with the same canonical equivalent); it may be nil,
|
|
|
478 in which case it is deduced from CANONICALIZE.
|
|
|
479
|
|
446
|
480 See also `get-case-table', `put-case-table' and `put-case-table-pair'.
|
|
428
|
481 */
|
|
444
|
482 (case_table))
|
|
428
|
483 {
|
|
446
|
484 /* This function can GC */
|
|
444
|
485 return set_case_table (case_table, 0);
|
|
428
|
486 }
|
|
|
487
|
|
|
488 DEFUN ("set-standard-case-table", Fset_standard_case_table, 1, 1, 0, /*
|
|
444
|
489 Select CASE-TABLE as the new standard case table for new buffers.
|
|
428
|
490 See `set-case-table' for more info on case tables.
|
|
|
491 */
|
|
444
|
492 (case_table))
|
|
428
|
493 {
|
|
446
|
494 /* This function can GC */
|
|
444
|
495 return set_case_table (case_table, 1);
|
|
428
|
496 }
|
|
|
497
|
|
|
498
|
|
|
499 void
|
|
|
500 syms_of_casetab (void)
|
|
|
501 {
|
|
446
|
502 INIT_LRECORD_IMPLEMENTATION (case_table);
|
|
|
503
|
|
563
|
504 DEFSYMBOL_MULTIWORD_PREDICATE (Qcase_tablep);
|
|
|
505 DEFSYMBOL (Qdowncase);
|
|
|
506 DEFSYMBOL (Qupcase);
|
|
428
|
507
|
|
826
|
508 DEFSUBR (Fmake_case_table);
|
|
428
|
509 DEFSUBR (Fcase_table_p);
|
|
446
|
510 DEFSUBR (Fget_case_table);
|
|
|
511 DEFSUBR (Fput_case_table);
|
|
|
512 DEFSUBR (Fput_case_table_pair);
|
|
428
|
513 DEFSUBR (Fcurrent_case_table);
|
|
|
514 DEFSUBR (Fstandard_case_table);
|
|
446
|
515 DEFSUBR (Fcopy_case_table);
|
|
428
|
516 DEFSUBR (Fset_case_table);
|
|
|
517 DEFSUBR (Fset_standard_case_table);
|
|
|
518 }
|
|
|
519
|
|
|
520 void
|
|
|
521 complex_vars_of_casetab (void)
|
|
|
522 {
|
|
867
|
523 REGISTER Ichar i;
|
|
428
|
524
|
|
446
|
525 staticpro (&Vstandard_case_table);
|
|
428
|
526
|
|
826
|
527 Vstandard_case_table = allocate_case_table (1);
|
|
428
|
528
|
|
|
529 for (i = 0; i < 256; i++)
|
|
|
530 {
|
|
|
531 unsigned char lowered = tolower (i);
|
|
|
532
|
|
826
|
533 SET_TRT_TABLE_OF (XCASE_TABLE_DOWNCASE (Vstandard_case_table), i,
|
|
|
534 lowered);
|
|
428
|
535 }
|
|
|
536
|
|
|
537 for (i = 0; i < 256; i++)
|
|
|
538 {
|
|
|
539 unsigned char flipped = (isupper (i) ? tolower (i)
|
|
|
540 : (islower (i) ? toupper (i) : i));
|
|
|
541
|
|
826
|
542 SET_TRT_TABLE_OF (XCASE_TABLE_UPCASE (Vstandard_case_table), i,
|
|
|
543 flipped);
|
|
428
|
544 }
|
|
826
|
545
|
|
|
546 recompute_case_table (Vstandard_case_table);
|
|
428
|
547 }
|
