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_table_p;
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;
52 Lisp_Object Qtranslate_table;
54 static void compute_trt_inverse (Lisp_Object trt, Lisp_Object inverse);
56 #define STRING256_P(obj) (STRINGP (obj) && XSTRING_CHAR_LENGTH (obj) == 256)
58 DEFUN ("case-table-p", Fcase_table_p, 1, 1, 0, /*
59 Return t if ARG is a case table.
60 See `set-case-table' for more information on these data structures.
64 Lisp_Object down, up, canon, eqv;
65 if (!CONSP (table)) return Qnil; down = XCAR (table); table = XCDR (table);
66 if (!CONSP (table)) return Qnil; up = XCAR (table); table = XCDR (table);
67 if (!CONSP (table)) return Qnil; canon = XCAR (table); table = XCDR (table);
68 if (!CONSP (table)) return Qnil; eqv = XCAR (table);
70 return (STRING256_P (down)
71 && (NILP (up) || STRING256_P (up))
72 && ((NILP (canon) && NILP (eqv))
73 || (STRING256_P (canon)
74 && (NILP (eqv) || STRING256_P (eqv))))
79 check_case_table (Lisp_Object obj)
81 REGISTER Lisp_Object tem;
83 while (tem = Fcase_table_p (obj), NILP (tem))
84 obj = wrong_type_argument (Qcase_table_p, obj);
88 DEFUN ("current-case-table", Fcurrent_case_table, 0, 1, 0, /*
89 Return the case table of BUFFER, which defaults to the current buffer.
93 struct buffer *buf = decode_buffer (buffer, 0);
95 return list4 (buf->downcase_table,
97 buf->case_canon_table,
101 DEFUN ("standard-case-table", Fstandard_case_table, 0, 0, 0, /*
102 Return the standard case table.
103 This is the one used for new buffers.
107 return list4 (Vascii_downcase_table,
113 static Lisp_Object set_case_table (Lisp_Object table, int standard);
116 DEFUN ("set-case-table", Fset_case_table, 1, 1, 0, /*
117 Select a new case table for the current buffer.
118 A case table is a list (DOWNCASE UPCASE CANONICALIZE EQUIVALENCES)
119 where each element is either nil or a string of length 256.
120 DOWNCASE maps each character to its lower-case equivalent.
121 UPCASE maps each character to its upper-case equivalent;
122 if lower and upper case characters are in 1-1 correspondence,
123 you may use nil and the upcase table will be deduced from DOWNCASE.
124 CANONICALIZE maps each character to a canonical equivalent;
125 any two characters that are related by case-conversion have the same
126 canonical equivalent character; it may be nil, in which case it is
127 deduced from DOWNCASE and UPCASE.
128 EQUIVALENCES is a map that cyclicly permutes each equivalence class
129 (of characters with the same canonical equivalent); it may be nil,
130 in which case it is deduced from CANONICALIZE.
132 BUG: Under XEmacs/Mule, translations to or from non-ASCII characters
133 (this includes chars in the range 128 - 255) are ignored by
134 the string/buffer-searching routines. Thus, `case-fold-search'
135 will not correctly conflate a-umlaut and A-umlaut even if the
136 case tables call for this.
140 return set_case_table (table, 0);
143 DEFUN ("set-standard-case-table", Fset_standard_case_table, 1, 1, 0, /*
144 Select a new standard case table for new buffers.
145 See `set-case-table' for more info on case tables.
149 return set_case_table (table, 1);
155 make_mirror_trt_table (Lisp_Object table)
157 Lisp_Object new_table;
159 if (!STRING256_P (table))
162 /* This should be caught farther up. */
165 signal_simple_error ("Invalid translate table", table);
169 new_table = MAKE_MIRROR_TRT_TABLE ();
173 for (i = 0; i < 256; i++)
175 Emchar newval = string_char (XSTRING (table), i);
176 if ((i >= 128 && newval != i)
177 || (i < 128 && newval >= 128))
181 SET_MIRROR_TRT_TABLE_CHAR_1 (new_table, i, newval);
190 set_case_table (Lisp_Object table, int standard)
192 Lisp_Object down, up, canon, eqv, tail = table;
193 struct buffer *buf = 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);
248 buf->downcase_table = down;
249 buf->upcase_table = up;
250 buf->case_canon_table = canon;
251 buf->case_eqv_table = eqv;
253 buf->mirror_downcase_table = make_mirror_trt_table (down);
254 buf->mirror_upcase_table = make_mirror_trt_table (up);
255 buf->mirror_case_canon_table = make_mirror_trt_table (canon);
256 buf->mirror_case_eqv_table = make_mirror_trt_table (eqv);
262 /* Given a translate table TRT, store the inverse mapping into INVERSE.
263 Since TRT is not one-to-one, INVERSE is not a simple mapping.
264 Instead, it divides the space of characters into equivalence classes.
265 All characters in a given class form one circular list, chained through
266 the elements of INVERSE. */
269 compute_trt_inverse (Lisp_Object trt, Lisp_Object inverse)
275 SET_TRT_TABLE_CHAR_1 (inverse, i, (Emchar) i);
279 if ((q = TRT_TABLE_CHAR_1 (trt, i)) != (Emchar) i)
281 c = TRT_TABLE_CHAR_1 (inverse, q);
282 SET_TRT_TABLE_CHAR_1 (inverse, q, (Emchar) i);
283 SET_TRT_TABLE_CHAR_1 (inverse, i, c);
290 syms_of_casetab (void)
292 defsymbol (&Qcase_table_p, "case-table-p");
293 defsymbol (&Qtranslate_table, "translate-table");
295 DEFSUBR (Fcase_table_p);
296 DEFSUBR (Fcurrent_case_table);
297 DEFSUBR (Fstandard_case_table);
298 DEFSUBR (Fset_case_table);
299 DEFSUBR (Fset_standard_case_table);
303 complex_vars_of_casetab (void)
308 staticpro (&Vascii_downcase_table);
309 staticpro (&Vascii_upcase_table);
310 staticpro (&Vascii_canon_table);
311 staticpro (&Vascii_eqv_table);
313 tem = MAKE_TRT_TABLE ();
314 Vascii_downcase_table = tem;
315 Vascii_canon_table = tem;
317 /* Under Mule, can't do set_string_char() until Vcharset_control_1
318 and Vcharset_ascii are initialized. */
319 for (i = 0; i < 256; i++)
321 unsigned char lowered = tolower (i);
323 SET_TRT_TABLE_CHAR_1 (tem, i, lowered);
327 tem = make_mirror_trt_table (tem);
328 Vmirror_ascii_downcase_table = tem;
329 Vmirror_ascii_canon_table = tem;
332 tem = MAKE_TRT_TABLE ();
333 Vascii_upcase_table = tem;
334 Vascii_eqv_table = tem;
336 for (i = 0; i < 256; i++)
338 unsigned char flipped = (isupper (i) ? tolower (i)
339 : (islower (i) ? toupper (i) : i));
341 SET_TRT_TABLE_CHAR_1 (tem, i, flipped);
345 tem = make_mirror_trt_table (tem);
346 Vmirror_ascii_upcase_table = tem;
347 Vmirror_ascii_eqv_table = tem;