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;
193 standard ? XBUFFER(Vbuffer_defaults) : current_buffer;
195 check_case_table (table);
197 down = XCAR (tail); tail = XCDR (tail);
198 up = XCAR (tail); tail = XCDR (tail);
199 canon = XCAR (tail); tail = XCDR (tail);
204 up = MAKE_TRT_TABLE ();
205 compute_trt_inverse (down, up);
210 REGISTER Charcount i;
212 canon = MAKE_TRT_TABLE ();
214 /* Set up the CANON vector; for each character,
215 this sequence of upcasing and downcasing ought to
216 get the "preferred" lowercase equivalent. */
217 for (i = 0; i < 256; i++)
218 SET_TRT_TABLE_CHAR_1 (canon, i,
223 TRT_TABLE_CHAR_1 (down, i))));
228 eqv = MAKE_TRT_TABLE ();
230 compute_trt_inverse (canon, eqv);
235 Vascii_downcase_table = down;
236 Vascii_upcase_table = up;
237 Vascii_canon_table = canon;
238 Vascii_eqv_table = eqv;
240 Vmirror_ascii_downcase_table = make_mirror_trt_table (down);
241 Vmirror_ascii_upcase_table = make_mirror_trt_table (up);
242 Vmirror_ascii_canon_table = make_mirror_trt_table (canon);
243 Vmirror_ascii_eqv_table = make_mirror_trt_table (eqv);
246 buf->downcase_table = down;
247 buf->upcase_table = up;
248 buf->case_canon_table = canon;
249 buf->case_eqv_table = eqv;
251 buf->mirror_downcase_table = make_mirror_trt_table (down);
252 buf->mirror_upcase_table = make_mirror_trt_table (up);
253 buf->mirror_case_canon_table = make_mirror_trt_table (canon);
254 buf->mirror_case_eqv_table = make_mirror_trt_table (eqv);
260 /* Given a translate table TRT, store the inverse mapping into INVERSE.
261 Since TRT is not one-to-one, INVERSE is not a simple mapping.
262 Instead, it divides the space of characters into equivalence classes.
263 All characters in a given class form one circular list, chained through
264 the elements of INVERSE. */
267 compute_trt_inverse (Lisp_Object trt, Lisp_Object inverse)
273 SET_TRT_TABLE_CHAR_1 (inverse, i, (Emchar) i);
277 if ((q = TRT_TABLE_CHAR_1 (trt, i)) != (Emchar) i)
279 c = TRT_TABLE_CHAR_1 (inverse, q);
280 SET_TRT_TABLE_CHAR_1 (inverse, q, (Emchar) i);
281 SET_TRT_TABLE_CHAR_1 (inverse, i, c);
288 syms_of_casetab (void)
290 defsymbol (&Qcase_tablep, "case-table-p");
292 DEFSUBR (Fcase_table_p);
293 DEFSUBR (Fcurrent_case_table);
294 DEFSUBR (Fstandard_case_table);
295 DEFSUBR (Fset_case_table);
296 DEFSUBR (Fset_standard_case_table);
300 complex_vars_of_casetab (void)
305 staticpro (&Vascii_downcase_table);
306 staticpro (&Vascii_upcase_table);
307 staticpro (&Vascii_canon_table);
308 staticpro (&Vascii_eqv_table);
311 staticpro (&Vmirror_ascii_downcase_table);
312 staticpro (&Vmirror_ascii_upcase_table);
313 staticpro (&Vmirror_ascii_canon_table);
314 staticpro (&Vmirror_ascii_eqv_table);
317 tem = MAKE_TRT_TABLE ();
318 Vascii_downcase_table = tem;
319 Vascii_canon_table = tem;
321 /* Under Mule, can't do set_string_char() until Vcharset_control_1
322 and Vcharset_ascii are initialized. */
323 for (i = 0; i < 256; i++)
325 unsigned char lowered = tolower (i);
327 SET_TRT_TABLE_CHAR_1 (tem, i, lowered);
331 tem = make_mirror_trt_table (tem);
332 Vmirror_ascii_downcase_table = tem;
333 Vmirror_ascii_canon_table = tem;
336 tem = MAKE_TRT_TABLE ();
337 Vascii_upcase_table = tem;
338 Vascii_eqv_table = tem;
340 for (i = 0; i < 256; i++)
342 unsigned char flipped = (isupper (i) ? tolower (i)
343 : (islower (i) ? toupper (i) : i));
345 SET_TRT_TABLE_CHAR_1 (tem, i, flipped);
349 tem = make_mirror_trt_table (tem);
350 Vmirror_ascii_upcase_table = tem;
351 Vmirror_ascii_eqv_table = tem;