Mercurial > hg > xemacs-beta

comparison src/casetab.c @ 428:3ecd8885ac67 r21-2-22

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-22
author cvs
date Mon, 13 Aug 2007 11:28:15 +0200
parents
children abe6d1db359e
comparison
equal deleted inserted replaced
427:0a0253eac470 428:3ecd8885ac67
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.
4
5 This file is part of XEmacs.
6
7 XEmacs is free software; you can redistribute it and/or modify it
8 under the terms of the GNU General Public License as published by the
9 Free Software Foundation; either version 2, or (at your option) any
10 later version.
11
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
15 for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with XEmacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
21
22 /* Synched up with: FSF 19.28. Between FSF 19.28 and 19.30, casetab.c
23 was rewritten to use junky FSF char tables. Meanwhile I rewrote it
24 to use more logical char tables. RMS also discards the "list of four
25 tables" format and instead stuffs the other tables as "extra slots"
26 in the downcase table. I've kept the four-lists format for now. */
27
28 /* Written by Howard Gayle. See some mythical and not-in-the-Emacs-
29 distribution file chartab.c for details. */
30
31 /* Modified for Mule by Ben Wing. */
32
33 /* #### We do not currently deal properly with translating non-ASCII
34 (including Latin-1!) characters under Mule. Getting this right is
35 *hard*, way fucking hard. So we at least preserve consistency by
36 sanitizing all the case tables to remove translations that would
37 get us into trouble and possibly result in inconsistent internal
38 text, which would likely lead to crashes. */
39
40 #include <config.h>
41 #include "lisp.h"
42 #include "buffer.h"
43 #include "opaque.h"
44
45 Lisp_Object Qcase_tablep;
46 Lisp_Object Vascii_downcase_table, Vascii_upcase_table;
47 Lisp_Object Vascii_canon_table, Vascii_eqv_table;
48 #ifdef MULE
49 Lisp_Object Vmirror_ascii_downcase_table, Vmirror_ascii_upcase_table;
50 Lisp_Object Vmirror_ascii_canon_table, Vmirror_ascii_eqv_table;
51 #endif
52
53 static void compute_trt_inverse (Lisp_Object trt, Lisp_Object inverse);
54
55 #define STRING256_P(obj) (STRINGP (obj) && XSTRING_CHAR_LENGTH (obj) == 256)
56
57 DEFUN ("case-table-p", Fcase_table_p, 1, 1, 0, /*
58 Return t if ARG is a case table.
59 See `set-case-table' for more information on these data structures.
60 */
61 (table))
62 {
63 Lisp_Object down, up, canon, eqv;
64 if (!CONSP (table)) return Qnil; down = XCAR (table); table = XCDR (table);
65 if (!CONSP (table)) return Qnil; up = XCAR (table); table = XCDR (table);
66 if (!CONSP (table)) return Qnil; canon = XCAR (table); table = XCDR (table);
67 if (!CONSP (table)) return Qnil; eqv = XCAR (table);
68
69 return (STRING256_P (down)
70 && (NILP (up) || STRING256_P (up))
71 && ((NILP (canon) && NILP (eqv))
72 || (STRING256_P (canon)
73 && (NILP (eqv) || STRING256_P (eqv))))
74 ? Qt : Qnil);
75 }
76
77 static Lisp_Object
78 check_case_table (Lisp_Object obj)
79 {
80 REGISTER Lisp_Object tem;
81
82 while (tem = Fcase_table_p (obj), NILP (tem))
83 obj = wrong_type_argument (Qcase_tablep, obj);
84 return (obj);
85 }
86
87 DEFUN ("current-case-table", Fcurrent_case_table, 0, 1, 0, /*
88 Return the case table of BUFFER, which defaults to the current buffer.
89 */
90 (buffer))
91 {
92 struct buffer *buf = decode_buffer (buffer, 0);
93
94 return list4 (buf->downcase_table,
95 buf->upcase_table,
96 buf->case_canon_table,
97 buf->case_eqv_table);
98 }
99
100 DEFUN ("standard-case-table", Fstandard_case_table, 0, 0, 0, /*
101 Return the standard case table.
102 This is the one used for new buffers.
103 */
104 ())
105 {
106 return list4 (Vascii_downcase_table,
107 Vascii_upcase_table,
108 Vascii_canon_table,
109 Vascii_eqv_table);
110 }
111
112 static Lisp_Object set_case_table (Lisp_Object table, int standard);
113
114
115 DEFUN ("set-case-table", Fset_case_table, 1, 1, 0, /*
116 Select a new case table for the current buffer.
117 A case table is a list (DOWNCASE UPCASE CANONICALIZE EQUIVALENCES)
118 where each element is either nil or a string of length 256.
119 DOWNCASE maps each character to its lower-case equivalent.
120 UPCASE maps each character to its upper-case equivalent;
121 if lower and upper case characters are in 1-1 correspondence,
122 you may use nil and the upcase table will be deduced from DOWNCASE.
123 CANONICALIZE maps each character to a canonical equivalent;
124 any two characters that are related by case-conversion have the same
125 canonical equivalent character; it may be nil, in which case it is
126 deduced from DOWNCASE and UPCASE.
127 EQUIVALENCES is a map that cyclicly permutes each equivalence class
128 (of characters with the same canonical equivalent); it may be nil,
129 in which case it is deduced from CANONICALIZE.
130
131 BUG: Under XEmacs/Mule, translations to or from non-ASCII characters
132 (this includes chars in the range 128 - 255) are ignored by
133 the string/buffer-searching routines. Thus, `case-fold-search'
134 will not correctly conflate a-umlaut and A-umlaut even if the
135 case tables call for this.
136 */
137 (table))
138 {
139 return set_case_table (table, 0);
140 }
141
142 DEFUN ("set-standard-case-table", Fset_standard_case_table, 1, 1, 0, /*
143 Select a new standard case table for new buffers.
144 See `set-case-table' for more info on case tables.
145 */
146 (table))
147 {
148 return set_case_table (table, 1);
149 }
150
151 #ifdef MULE
152
153 static Lisp_Object
154 make_mirror_trt_table (Lisp_Object table)
155 {
156 Lisp_Object new_table;
157
158 if (!STRING256_P (table))
159 {
160 #ifdef DEBUG_XEMACS
161 /* This should be caught farther up. */
162 abort ();
163 #else
164 signal_simple_error ("Invalid translate table", table);
165 #endif
166 }
167
168 new_table = MAKE_MIRROR_TRT_TABLE ();
169 {
170 int i;
171
172 for (i = 0; i < 256; i++)
173 {
174 Emchar newval = string_char (XSTRING (table), i);
175 if ((i >= 128 && newval != i)
176 || (i < 128 && newval >= 128))
177 {
178 newval = (Emchar) i;
179 }
180 SET_MIRROR_TRT_TABLE_CHAR_1 (new_table, i, newval);
181 }
182 }
183 return new_table;
184 }
185
186 #endif /* MULE */
187
188 static Lisp_Object
189 set_case_table (Lisp_Object table, int standard)
190 {
191 Lisp_Object down, up, canon, eqv, tail = table;
192 struct buffer *buf = current_buffer;
193
194 check_case_table (table);
195
196 down = XCAR (tail); tail = XCDR (tail);
197 up = XCAR (tail); tail = XCDR (tail);
198 canon = XCAR (tail); tail = XCDR (tail);
199 eqv = XCAR (tail);
200
201 if (NILP (up))
202 {
203 up = MAKE_TRT_TABLE ();
204 compute_trt_inverse (down, up);
205 }
206
207 if (NILP (canon))
208 {
209 REGISTER Charcount i;
210
211 canon = MAKE_TRT_TABLE ();
212
213 /* Set up the CANON vector; for each character,
214 this sequence of upcasing and downcasing ought to
215 get the "preferred" lowercase equivalent. */
216 for (i = 0; i < 256; i++)
217 SET_TRT_TABLE_CHAR_1 (canon, i,
218 TRT_TABLE_CHAR_1
219 (down,
220 TRT_TABLE_CHAR_1
221 (up,
222 TRT_TABLE_CHAR_1 (down, i))));
223 }
224
225 if (NILP (eqv))
226 {
227 eqv = MAKE_TRT_TABLE ();
228
229 compute_trt_inverse (canon, eqv);
230 }
231
232 if (standard)
233 {
234 Vascii_downcase_table = down;
235 Vascii_upcase_table = up;
236 Vascii_canon_table = canon;
237 Vascii_eqv_table = eqv;
238 #ifdef MULE
239 Vmirror_ascii_downcase_table = make_mirror_trt_table (down);
240 Vmirror_ascii_upcase_table = make_mirror_trt_table (up);
241 Vmirror_ascii_canon_table = make_mirror_trt_table (canon);
242 Vmirror_ascii_eqv_table = make_mirror_trt_table (eqv);
243 #endif
244 }
245 else
246 {
247 buf->downcase_table = down;
248 buf->upcase_table = up;
249 buf->case_canon_table = canon;
250 buf->case_eqv_table = eqv;
251 #ifdef MULE
252 buf->mirror_downcase_table = make_mirror_trt_table (down);
253 buf->mirror_upcase_table = make_mirror_trt_table (up);
254 buf->mirror_case_canon_table = make_mirror_trt_table (canon);
255 buf->mirror_case_eqv_table = make_mirror_trt_table (eqv);
256 #endif
257 }
258 return table;
259 }
260
261 /* Given a translate table TRT, store the inverse mapping into INVERSE.
262 Since TRT is not one-to-one, INVERSE is not a simple mapping.
263 Instead, it divides the space of characters into equivalence classes.
264 All characters in a given class form one circular list, chained through
265 the elements of INVERSE. */
266
267 static void
268 compute_trt_inverse (Lisp_Object trt, Lisp_Object inverse)
269 {
270 Charcount i = 0400;
271 Emchar c, q;
272
273 while (--i)
274 SET_TRT_TABLE_CHAR_1 (inverse, i, (Emchar) i);
275 i = 0400;
276 while (--i)
277 {
278 if ((q = TRT_TABLE_CHAR_1 (trt, i)) != (Emchar) i)
279 {
280 c = TRT_TABLE_CHAR_1 (inverse, q);
281 SET_TRT_TABLE_CHAR_1 (inverse, q, (Emchar) i);
282 SET_TRT_TABLE_CHAR_1 (inverse, i, c);
283 }
284 }
285 }
286
287
288 void
289 syms_of_casetab (void)
290 {
291 defsymbol (&Qcase_tablep, "case-table-p");
292
293 DEFSUBR (Fcase_table_p);
294 DEFSUBR (Fcurrent_case_table);
295 DEFSUBR (Fstandard_case_table);
296 DEFSUBR (Fset_case_table);
297 DEFSUBR (Fset_standard_case_table);
298 }
299
300 void
301 complex_vars_of_casetab (void)
302 {
303 REGISTER Emchar i;
304 Lisp_Object tem;
305
306 staticpro (&Vascii_downcase_table);
307 staticpro (&Vascii_upcase_table);
308 staticpro (&Vascii_canon_table);
309 staticpro (&Vascii_eqv_table);
310
311 #ifdef MULE
312 staticpro (&Vmirror_ascii_downcase_table);
313 staticpro (&Vmirror_ascii_upcase_table);
314 staticpro (&Vmirror_ascii_canon_table);
315 staticpro (&Vmirror_ascii_eqv_table);
316 #endif
317
318 tem = MAKE_TRT_TABLE ();
319 Vascii_downcase_table = tem;
320 Vascii_canon_table = tem;
321
322 /* Under Mule, can't do set_string_char() until Vcharset_control_1
323 and Vcharset_ascii are initialized. */
324 for (i = 0; i < 256; i++)
325 {
326 unsigned char lowered = tolower (i);
327
328 SET_TRT_TABLE_CHAR_1 (tem, i, lowered);
329 }
330
331 #ifdef MULE
332 tem = make_mirror_trt_table (tem);
333 Vmirror_ascii_downcase_table = tem;
334 Vmirror_ascii_canon_table = tem;
335 #endif
336
337 tem = MAKE_TRT_TABLE ();
338 Vascii_upcase_table = tem;
339 Vascii_eqv_table = tem;
340
341 for (i = 0; i < 256; i++)
342 {
343 unsigned char flipped = (isupper (i) ? tolower (i)
344 : (islower (i) ? toupper (i) : i));
345
346 SET_TRT_TABLE_CHAR_1 (tem, i, flipped);
347 }
348
349 #ifdef MULE
350 tem = make_mirror_trt_table (tem);
351 Vmirror_ascii_upcase_table = tem;
352 Vmirror_ascii_eqv_table = tem;
353 #endif
354 }