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.
5 This file is part of XEmacs.
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
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
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. */
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. */
28 /* Written by Howard Gayle. See some mythical and not-in-the-Emacs-
29 distribution file chartab.c for details. */
31 /* Modified for Mule by Ben Wing. */
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. */
45 Lisp_Object Qcase_tablep;
46 Lisp_Object Vascii_downcase_table, Vascii_upcase_table;
47 Lisp_Object Vascii_canon_table, Vascii_eqv_table;
49 Lisp_Object Vmirror_ascii_downcase_table, Vmirror_ascii_upcase_table;
50 Lisp_Object Vmirror_ascii_canon_table, Vmirror_ascii_eqv_table;
53 static void compute_trt_inverse (Lisp_Object trt, Lisp_Object inverse);
55 #define STRING256_P(obj) (STRINGP (obj) && XSTRING_CHAR_LENGTH (obj) == 256)
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.
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);
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))))
78 check_case_table (Lisp_Object obj)
80 REGISTER Lisp_Object tem;
82 while (tem = Fcase_table_p (obj), NILP (tem))
83 obj = wrong_type_argument (Qcase_tablep, obj);
87 DEFUN ("current-case-table", Fcurrent_case_table, 0, 1, 0, /*
88 Return the case table of BUFFER, which defaults to the current buffer.
92 struct buffer *buf = decode_buffer (buffer, 0);
94 return list4 (buf->downcase_table,
96 buf->case_canon_table,
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.
106 return list4 (Vascii_downcase_table,
112 static Lisp_Object set_case_table (Lisp_Object table, int standard);
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.
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.
139 return set_case_table (table, 0);
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.
148 return set_case_table (table, 1);
154 make_mirror_trt_table (Lisp_Object table)
156 Lisp_Object new_table;
158 if (!STRING256_P (table))
161 /* This should be caught farther up. */
164 signal_simple_error ("Invalid translate table", table);
168 new_table = MAKE_MIRROR_TRT_TABLE ();
172 for (i = 0; i < 256; i++)
174 Emchar newval = string_char (XSTRING (table), i);
175 if ((i >= 128 && newval != i)
176 || (i < 128 && newval >= 128))
180 SET_MIRROR_TRT_TABLE_CHAR_1 (new_table, i, newval);
189 set_case_table (Lisp_Object table, int standard)
191 Lisp_Object down, up, canon, eqv, tail = table;
192 struct buffer *buf = current_buffer;
194 check_case_table (table);
196 down = XCAR (tail); tail = XCDR (tail);
197 up = XCAR (tail); tail = XCDR (tail);
198 canon = XCAR (tail); tail = XCDR (tail);
203 up = MAKE_TRT_TABLE ();
204 compute_trt_inverse (down, up);
209 REGISTER Charcount i;
211 canon = MAKE_TRT_TABLE ();
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,
222 TRT_TABLE_CHAR_1 (down, i))));
227 eqv = MAKE_TRT_TABLE ();
229 compute_trt_inverse (canon, eqv);
234 Vascii_downcase_table = down;
235 Vascii_upcase_table = up;
236 Vascii_canon_table = canon;
237 Vascii_eqv_table = eqv;
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);
247 buf->downcase_table = down;
248 buf->upcase_table = up;
249 buf->case_canon_table = canon;
250 buf->case_eqv_table = eqv;
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);
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. */
268 compute_trt_inverse (Lisp_Object trt, Lisp_Object inverse)
274 SET_TRT_TABLE_CHAR_1 (inverse, i, (Emchar) i);
278 if ((q = TRT_TABLE_CHAR_1 (trt, i)) != (Emchar) i)
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);
289 syms_of_casetab (void)
291 defsymbol (&Qcase_tablep, "case-table-p");
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);
301 complex_vars_of_casetab (void)
306 staticpro (&Vascii_downcase_table);
307 staticpro (&Vascii_upcase_table);
308 staticpro (&Vascii_canon_table);
309 staticpro (&Vascii_eqv_table);
312 staticpro (&Vmirror_ascii_downcase_table);
313 staticpro (&Vmirror_ascii_upcase_table);
314 staticpro (&Vmirror_ascii_canon_table);
315 staticpro (&Vmirror_ascii_eqv_table);
318 tem = MAKE_TRT_TABLE ();
319 Vascii_downcase_table = tem;
320 Vascii_canon_table = tem;
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++)
326 unsigned char lowered = tolower (i);
328 SET_TRT_TABLE_CHAR_1 (tem, i, lowered);
332 tem = make_mirror_trt_table (tem);
333 Vmirror_ascii_downcase_table = tem;
334 Vmirror_ascii_canon_table = tem;
337 tem = MAKE_TRT_TABLE ();
338 Vascii_upcase_table = tem;
339 Vascii_eqv_table = tem;
341 for (i = 0; i < 256; i++)
343 unsigned char flipped = (isupper (i) ? tolower (i)
344 : (islower (i) ? toupper (i) : i));
346 SET_TRT_TABLE_CHAR_1 (tem, i, flipped);
350 tem = make_mirror_trt_table (tem);
351 Vmirror_ascii_upcase_table = tem;
352 Vmirror_ascii_eqv_table = tem;