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 OBJECT 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 (object)) return Qnil; down = XCAR (object); object = XCDR (object);
65 if (!CONSP (object)) return Qnil; up = XCAR (object); object = XCDR (object);
66 if (!CONSP (object)) return Qnil; canon = XCAR (object); object = XCDR (object);
67 if (!CONSP (object)) return Qnil; eqv = XCAR (object);
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 object)
80 while (NILP (Fcase_table_p (object)))
81 object = wrong_type_argument (Qcase_tablep, object);
85 DEFUN ("current-case-table", Fcurrent_case_table, 0, 1, 0, /*
86 Return the case table of BUFFER, which defaults to the current buffer.
90 struct buffer *buf = decode_buffer (buffer, 0);
92 return list4 (buf->downcase_table,
94 buf->case_canon_table,
98 DEFUN ("standard-case-table", Fstandard_case_table, 0, 0, 0, /*
99 Return the standard case table.
100 This is the one used for new buffers.
104 return list4 (Vascii_downcase_table,
110 static Lisp_Object set_case_table (Lisp_Object table, int standard);
113 DEFUN ("set-case-table", Fset_case_table, 1, 1, 0, /*
114 Select CASE-TABLE as the new case table for the current buffer.
115 A case table is a list (DOWNCASE UPCASE CANONICALIZE EQUIVALENCES)
116 where each element is either nil or a string of length 256.
117 DOWNCASE maps each character to its lower-case equivalent.
118 UPCASE maps each character to its upper-case equivalent;
119 if lower and upper case characters are in 1-1 correspondence,
120 you may use nil and the upcase table will be deduced from DOWNCASE.
121 CANONICALIZE maps each character to a canonical equivalent;
122 any two characters that are related by case-conversion have the same
123 canonical equivalent character; it may be nil, in which case it is
124 deduced from DOWNCASE and UPCASE.
125 EQUIVALENCES is a map that cyclicly permutes each equivalence class
126 (of characters with the same canonical equivalent); it may be nil,
127 in which case it is deduced from CANONICALIZE.
129 BUG: Under XEmacs/Mule, translations to or from non-ASCII characters
130 (this includes chars in the range 128 - 255) are ignored by
131 the string/buffer-searching routines. Thus, `case-fold-search'
132 will not correctly conflate a-umlaut and A-umlaut even if the
133 case tables call for this.
137 return set_case_table (case_table, 0);
140 DEFUN ("set-standard-case-table", Fset_standard_case_table, 1, 1, 0, /*
141 Select CASE-TABLE as the new standard case table for new buffers.
142 See `set-case-table' for more info on case tables.
146 return set_case_table (case_table, 1);
152 make_mirror_trt_table (Lisp_Object table)
154 Lisp_Object new_table;
156 if (!STRING256_P (table))
159 /* This should be caught farther up. */
162 signal_simple_error ("Invalid translate table", table);
166 new_table = MAKE_MIRROR_TRT_TABLE ();
170 for (i = 0; i < 256; i++)
172 Emchar newval = string_char (XSTRING (table), i);
173 if ((i >= 128 && newval != i)
174 || (i < 128 && newval >= 128))
178 SET_MIRROR_TRT_TABLE_CHAR_1 (new_table, i, newval);
187 set_case_table (Lisp_Object table, int standard)
189 Lisp_Object down, up, canon, eqv, tail = table;
191 standard ? XBUFFER(Vbuffer_defaults) : current_buffer;
193 check_case_table (table);
195 down = XCAR (tail); tail = XCDR (tail);
196 up = XCAR (tail); tail = XCDR (tail);
197 canon = XCAR (tail); tail = XCDR (tail);
202 up = MAKE_TRT_TABLE ();
203 compute_trt_inverse (down, up);
208 REGISTER Charcount i;
210 canon = MAKE_TRT_TABLE ();
212 /* Set up the CANON vector; for each character,
213 this sequence of upcasing and downcasing ought to
214 get the "preferred" lowercase equivalent. */
215 for (i = 0; i < 256; i++)
216 SET_TRT_TABLE_CHAR_1 (canon, i,
221 TRT_TABLE_CHAR_1 (down, i))));
226 eqv = MAKE_TRT_TABLE ();
228 compute_trt_inverse (canon, eqv);
233 Vascii_downcase_table = down;
234 Vascii_upcase_table = up;
235 Vascii_canon_table = canon;
236 Vascii_eqv_table = eqv;
238 Vmirror_ascii_downcase_table = make_mirror_trt_table (down);
239 Vmirror_ascii_upcase_table = make_mirror_trt_table (up);
240 Vmirror_ascii_canon_table = make_mirror_trt_table (canon);
241 Vmirror_ascii_eqv_table = make_mirror_trt_table (eqv);
244 buf->downcase_table = down;
245 buf->upcase_table = up;
246 buf->case_canon_table = canon;
247 buf->case_eqv_table = eqv;
249 buf->mirror_downcase_table = make_mirror_trt_table (down);
250 buf->mirror_upcase_table = make_mirror_trt_table (up);
251 buf->mirror_case_canon_table = make_mirror_trt_table (canon);
252 buf->mirror_case_eqv_table = make_mirror_trt_table (eqv);
258 /* Given a translate table TRT, store the inverse mapping into INVERSE.
259 Since TRT is not one-to-one, INVERSE is not a simple mapping.
260 Instead, it divides the space of characters into equivalence classes.
261 All characters in a given class form one circular list, chained through
262 the elements of INVERSE. */
265 compute_trt_inverse (Lisp_Object trt, Lisp_Object inverse)
271 SET_TRT_TABLE_CHAR_1 (inverse, i, (Emchar) i);
275 if ((q = TRT_TABLE_CHAR_1 (trt, i)) != (Emchar) i)
277 c = TRT_TABLE_CHAR_1 (inverse, q);
278 SET_TRT_TABLE_CHAR_1 (inverse, q, (Emchar) i);
279 SET_TRT_TABLE_CHAR_1 (inverse, i, c);
286 syms_of_casetab (void)
288 defsymbol (&Qcase_tablep, "case-table-p");
290 DEFSUBR (Fcase_table_p);
291 DEFSUBR (Fcurrent_case_table);
292 DEFSUBR (Fstandard_case_table);
293 DEFSUBR (Fset_case_table);
294 DEFSUBR (Fset_standard_case_table);
298 complex_vars_of_casetab (void)
303 staticpro (&Vascii_downcase_table);
304 staticpro (&Vascii_upcase_table);
305 staticpro (&Vascii_canon_table);
306 staticpro (&Vascii_eqv_table);
309 staticpro (&Vmirror_ascii_downcase_table);
310 staticpro (&Vmirror_ascii_upcase_table);
311 staticpro (&Vmirror_ascii_canon_table);
312 staticpro (&Vmirror_ascii_eqv_table);
315 tem = MAKE_TRT_TABLE ();
316 Vascii_downcase_table = tem;
317 Vascii_canon_table = tem;
319 /* Under Mule, can't do set_string_char() until Vcharset_control_1
320 and Vcharset_ascii are initialized. */
321 for (i = 0; i < 256; i++)
323 unsigned char lowered = tolower (i);
325 SET_TRT_TABLE_CHAR_1 (tem, i, lowered);
329 tem = make_mirror_trt_table (tem);
330 Vmirror_ascii_downcase_table = tem;
331 Vmirror_ascii_canon_table = tem;
334 tem = MAKE_TRT_TABLE ();
335 Vascii_upcase_table = tem;
336 Vascii_eqv_table = tem;
338 for (i = 0; i < 256; i++)
340 unsigned char flipped = (isupper (i) ? tolower (i)
341 : (islower (i) ? toupper (i) : i));
343 SET_TRT_TABLE_CHAR_1 (tem, i, flipped);
347 tem = make_mirror_trt_table (tem);
348 Vmirror_ascii_upcase_table = tem;
349 Vmirror_ascii_eqv_table = tem;