Mercurial > hg > xemacs-beta

comparison src/casetab.c @ 446:1ccc32a20af4 r21-2-38

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-38
author cvs
date Mon, 13 Aug 2007 11:37:21 +0200
parents 576fb035e263
children 183866b06e0b
comparison
equal deleted inserted replaced
445:34f3776fcf0e 446:1ccc32a20af4
28 /* Written by Howard Gayle. See some mythical and not-in-the-Emacs- 28 /* Written by Howard Gayle. See some mythical and not-in-the-Emacs-
29 distribution file chartab.c for details. */ 29 distribution file chartab.c for details. */
30 30
31 /* Modified for Mule by Ben Wing. */ 31 /* Modified for Mule by Ben Wing. */
32 32
33 /* #### We do not currently deal properly with translating non-ASCII 33 /* Case table consists of four char-table. Those are for downcase,
34 (including Latin-1!) characters under Mule. Getting this right is 34 upcase, canonical and equivalent respectively.
35 *hard*, way fucking hard. So we at least preserve consistency by 35
36 sanitizing all the case tables to remove translations that would 36 It's entry is like this:
37 get us into trouble and possibly result in inconsistent internal 37
38 text, which would likely lead to crashes. */ 38 downcase: a -> a, A -> a.
39 upcase: a -> A, A -> a. (The latter is for NOCASEP.)
40 canon: a -> a, A -> a.
41 eqv: a -> A, A -> a.
42 */
39 43
40 #include <config.h> 44 #include <config.h>
41 #include "lisp.h" 45 #include "lisp.h"
42 #include "buffer.h" 46 #include "buffer.h"
43 #include "opaque.h" 47 #include "opaque.h"
44 48 #include "chartab.h"
45 Lisp_Object Qcase_tablep; 49 #include "casetab.h"
46 Lisp_Object Vascii_downcase_table, Vascii_upcase_table; 50
47 Lisp_Object Vascii_canon_table, Vascii_eqv_table; 51 Lisp_Object Qcase_tablep, Qdowncase, Qupcase;
48 #ifdef MULE 52 Lisp_Object Vstandard_case_table;
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
53 static void compute_trt_inverse (Lisp_Object trt, Lisp_Object inverse); 54 static void compute_trt_inverse (Lisp_Object trt, Lisp_Object inverse);
54 55 Lisp_Object case_table_char (Lisp_Object ch, Lisp_Object table);
55 #define STRING256_P(obj) (STRINGP (obj) && XSTRING_CHAR_LENGTH (obj) == 256) 56
57 #define STRING256_P(obj) ((STRINGP (obj) && XSTRING_CHAR_LENGTH (obj) == 256))
58
59 static Lisp_Object
60 mark_case_table (Lisp_Object obj)
61 {
62 Lisp_Case_Table *ct = XCASE_TABLE (obj);
63
64 mark_object (CASE_TABLE_DOWNCASE (ct));
65 mark_object (CASE_TABLE_UPCASE (ct));
66 mark_object (CASE_TABLE_CANON (ct));
67 mark_object (CASE_TABLE_EQV (ct));
68 return Qnil;
69 }
70
71 static void
72 print_case_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
73 {
74 Lisp_Case_Table *ct = XCASE_TABLE (obj);
75 char buf[200];
76 if (print_readably)
77 error ("printing unreadable object #<case-table 0x%x", ct->header.uid);
78 write_c_string ("#<case-table ", printcharfun);
79 sprintf (buf, "0x%x>", ct->header.uid);
80 write_c_string (buf, printcharfun);
81 }
82
83 static const struct lrecord_description case_table_description [] = {
84 { XD_LISP_OBJECT, offsetof (Lisp_Case_Table, downcase_table) },
85 { XD_LISP_OBJECT, offsetof (Lisp_Case_Table, upcase_table) },
86 { XD_LISP_OBJECT, offsetof (Lisp_Case_Table, case_canon_table) },
87 { XD_LISP_OBJECT, offsetof (Lisp_Case_Table, case_eqv_table) },
88 { XD_END }
89 };
90
91 DEFINE_LRECORD_IMPLEMENTATION ("case-table", case_table,
92 mark_case_table, print_case_table, 0,
93 0, 0, case_table_description, Lisp_Case_Table);
94
95 static Lisp_Object
96 allocate_case_table (void)
97 {
98 Lisp_Object val;
99 Lisp_Case_Table *ct =
100 alloc_lcrecord_type (Lisp_Case_Table, &lrecord_case_table);
101
102 SET_CASE_TABLE_DOWNCASE (ct, Qnil);
103 SET_CASE_TABLE_UPCASE (ct, Qnil);
104 SET_CASE_TABLE_CANON (ct, Qnil);
105 SET_CASE_TABLE_EQV (ct, Qnil);
106
107 XSETCASE_TABLE (val, ct);
108 return val;
109 }
56 110
57 DEFUN ("case-table-p", Fcase_table_p, 1, 1, 0, /* 111 DEFUN ("case-table-p", Fcase_table_p, 1, 1, 0, /*
58 Return t if OBJECT is a case table. 112 Return t if OBJECT is a case table.
59 See `set-case-table' for more information on these data structures. 113 See `set-case-table' for more information on these data structures.
60 */ 114 */
61 (object)) 115 (object))
62 { 116 {
63 Lisp_Object down, up, canon, eqv; 117 if (CASE_TABLEP (object))
64 if (!CONSP (object)) return Qnil; down = XCAR (object); object = XCDR (object); 118 return Qt;
65 if (!CONSP (object)) return Qnil; up = XCAR (object); object = XCDR (object); 119 else
66 if (!CONSP (object)) return Qnil; canon = XCAR (object); object = XCDR (object); 120 {
67 if (!CONSP (object)) return Qnil; eqv = XCAR (object); 121 Lisp_Object down, up, canon, eqv;
68 122 if (!CONSP (object))
69 return (STRING256_P (down) 123 return Qnil;
70 && (NILP (up) || STRING256_P (up)) 124 down = XCAR (object); object = XCDR (object);
71 && ((NILP (canon) && NILP (eqv)) 125 if (!CONSP (object))
72 || (STRING256_P (canon) 126 return Qnil;
73 && (NILP (eqv) || STRING256_P (eqv)))) 127 up = XCAR (object); object = XCDR (object);
74 ? Qt : Qnil); 128 if (!CONSP (object))
129 return Qnil;
130 canon = XCAR (object); object = XCDR (object);
131 if (!CONSP (object))
132 return Qnil;
133 eqv = XCAR (object);
134
135 return ((STRING256_P (down)
136 && (NILP (up) || STRING256_P (up))
137 && ((NILP (canon) && NILP (eqv))
138 || STRING256_P (canon))
139 && (NILP (eqv) || STRING256_P (eqv)))
140 ? Qt : Qnil);
141
142 }
75 } 143 }
76 144
77 static Lisp_Object 145 static Lisp_Object
78 check_case_table (Lisp_Object object) 146 check_case_table (Lisp_Object object)
79 { 147 {
148 /* This function can GC */
80 while (NILP (Fcase_table_p (object))) 149 while (NILP (Fcase_table_p (object)))
81 object = wrong_type_argument (Qcase_tablep, object); 150 object = wrong_type_argument (Qcase_tablep, object);
82 return object; 151 return object;
83 } 152 }
84 153
154 Lisp_Object
155 case_table_char (Lisp_Object ch, Lisp_Object table)
156 {
157 Lisp_Object ct_char;
158 ct_char = get_char_table (XCHAR (ch), XCHAR_TABLE (table));
159 if (NILP (ct_char))
160 return ch;
161 else
162 return ct_char;
163 }
164
165 DEFUN ("get-case-table", Fget_case_table, 3, 3, 0, /*
166 Return CHAR-CASE version of CHARACTER in CASE-TABLE.
167
168 CHAR-CASE is either downcase or upcase.
169 */
170 (char_case, character, case_table))
171 {
172 CHECK_CHAR (character);
173 CHECK_CASE_TABLE (case_table);
174 if (EQ (char_case, Qdowncase))
175 return case_table_char (character, XCASE_TABLE_DOWNCASE (case_table));
176 else if (EQ (char_case, Qupcase))
177 return case_table_char (character, XCASE_TABLE_UPCASE (case_table));
178 else
179 signal_simple_error ("Char case must be downcase or upcase", char_case);
180
181 return Qnil; /* Not reached. */
182 }
183
184 DEFUN ("put-case-table", Fput_case_table, 4, 4, 0, /*
185 Set CHAR-CASE version of CHARACTER to be VALUE in CASE-TABLE.
186
187 CHAR-CASE is either downcase or upcase.
188 See also `put-case-table-pair'.
189 */
190 (char_case, character, value, case_table))
191 {
192 CHECK_CHAR (character);
193 CHECK_CHAR (value);
194
195 if (EQ (char_case, Qdowncase))
196 {
197 Fput_char_table (character, value, XCASE_TABLE_DOWNCASE (case_table));
198 /* This one is not at all intuitive. */
199 Fput_char_table (character, value, XCASE_TABLE_UPCASE (case_table));
200 Fput_char_table (character, value, XCASE_TABLE_CANON (case_table));
201 Fput_char_table (value, value, XCASE_TABLE_CANON (case_table));
202 Fput_char_table (value, character, XCASE_TABLE_EQV (case_table));
203 Fput_char_table (character, value, XCASE_TABLE_EQV (case_table));
204 }
205 else if (EQ (char_case, Qupcase))
206 {
207 Fput_char_table (character, value, XCASE_TABLE_UPCASE (case_table));
208 Fput_char_table (character, character, XCASE_TABLE_DOWNCASE (case_table));
209 Fput_char_table (character, character, XCASE_TABLE_CANON (case_table));
210 Fput_char_table (value, character, XCASE_TABLE_CANON (case_table));
211 Fput_char_table (value, character, XCASE_TABLE_EQV (case_table));
212 Fput_char_table (character, value, XCASE_TABLE_EQV (case_table));
213 }
214 else
215 signal_simple_error ("Char case must be downcase or upcase", char_case);
216
217 return Qnil;
218 }
219
220 DEFUN ("put-case-table-pair", Fput_case_table_pair, 3, 3, 0, /*
221 Make UC and LC a pair of inter-case-converting letters in CASE-TABLE.
222 UC is an uppercase character and LC is a downcase character.
223 */
224 (uc, lc, case_table))
225 {
226 CHECK_CHAR (uc);
227 CHECK_CHAR (lc);
228 CHECK_CASE_TABLE (case_table);
229
230 Fput_char_table (lc, lc, XCASE_TABLE_DOWNCASE (case_table));
231 Fput_char_table (uc, lc, XCASE_TABLE_UPCASE (case_table));
232 Fput_char_table (uc, lc, XCASE_TABLE_DOWNCASE (case_table));
233 Fput_char_table (lc, uc, XCASE_TABLE_UPCASE (case_table));
234
235 Fput_char_table (lc, lc, XCASE_TABLE_CANON (case_table));
236 Fput_char_table (uc, lc, XCASE_TABLE_CANON (case_table));
237 Fput_char_table (uc, lc, XCASE_TABLE_EQV (case_table));
238 Fput_char_table (lc, uc, XCASE_TABLE_EQV (case_table));
239 return Qnil;
240 }
241
242 DEFUN ("copy-case-table", Fcopy_case_table, 1, 1, 0, /*
243 Return a new case table which is a copy of CASE-TABLE
244 */
245 (case_table))
246 {
247 Lisp_Object new_obj;
248 CHECK_CASE_TABLE (case_table);
249
250 new_obj = allocate_case_table ();
251 XSET_CASE_TABLE_DOWNCASE
252 (new_obj, Fcopy_char_table (XCASE_TABLE_DOWNCASE (case_table)));
253 XSET_CASE_TABLE_UPCASE
254 (new_obj, Fcopy_char_table (XCASE_TABLE_UPCASE (case_table)));
255 XSET_CASE_TABLE_CANON
256 (new_obj, Fcopy_char_table (XCASE_TABLE_CANON (case_table)));
257 XSET_CASE_TABLE_EQV
258 (new_obj, Fcopy_char_table (XCASE_TABLE_EQV (case_table)));
259 return new_obj;
260 }
261
85 DEFUN ("current-case-table", Fcurrent_case_table, 0, 1, 0, /* 262 DEFUN ("current-case-table", Fcurrent_case_table, 0, 1, 0, /*
86 Return the case table of BUFFER, which defaults to the current buffer. 263 Return the case table of BUFFER, which defaults to the current buffer.
87 */ 264 */
88 (buffer)) 265 (buffer))
89 { 266 {
90 struct buffer *buf = decode_buffer (buffer, 0); 267 struct buffer *buf = decode_buffer (buffer, 0);
91 268
92 return list4 (buf->downcase_table, 269 return buf->case_table;
93 buf->upcase_table,
94 buf->case_canon_table,
95 buf->case_eqv_table);
96 } 270 }
97 271
98 DEFUN ("standard-case-table", Fstandard_case_table, 0, 0, 0, /* 272 DEFUN ("standard-case-table", Fstandard_case_table, 0, 0, 0, /*
99 Return the standard case table. 273 Return the standard case table.
100 This is the one used for new buffers. 274 This is the one used for new buffers.
101 */ 275 */
102 ()) 276 ())
103 { 277 {
104 return list4 (Vascii_downcase_table, 278 return Vstandard_case_table;
105 Vascii_upcase_table,
106 Vascii_canon_table,
107 Vascii_eqv_table);
108 } 279 }
109 280
110 static Lisp_Object set_case_table (Lisp_Object table, int standard); 281 static Lisp_Object set_case_table (Lisp_Object table, int standard);
111
112 282
113 DEFUN ("set-case-table", Fset_case_table, 1, 1, 0, /* 283 DEFUN ("set-case-table", Fset_case_table, 1, 1, 0, /*
114 Select CASE-TABLE as the new case table for the current buffer. 284 Select CASE-TABLE as the new case table for the current buffer.
115 A case table is a list (DOWNCASE UPCASE CANONICALIZE EQUIVALENCES) 285 A case table is a case-table object or list
286 (DOWNCASE UPCASE CANONICALIZE EQUIVALENCES)
116 where each element is either nil or a string of length 256. 287 where each element is either nil or a string of length 256.
288 The latter is provided for backward-compatibility.
117 DOWNCASE maps each character to its lower-case equivalent. 289 DOWNCASE maps each character to its lower-case equivalent.
118 UPCASE maps each character to its upper-case equivalent; 290 UPCASE maps each character to its upper-case equivalent;
119 if lower and upper case characters are in 1-1 correspondence, 291 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. 292 you may use nil and the upcase table will be deduced from DOWNCASE.
121 CANONICALIZE maps each character to a canonical equivalent; 293 CANONICALIZE maps each character to a canonical equivalent;
124 deduced from DOWNCASE and UPCASE. 296 deduced from DOWNCASE and UPCASE.
125 EQUIVALENCES is a map that cyclicly permutes each equivalence class 297 EQUIVALENCES is a map that cyclicly permutes each equivalence class
126 (of characters with the same canonical equivalent); it may be nil, 298 (of characters with the same canonical equivalent); it may be nil,
127 in which case it is deduced from CANONICALIZE. 299 in which case it is deduced from CANONICALIZE.
128 300
129 BUG: Under XEmacs/Mule, translations to or from non-ASCII characters 301 See also `get-case-table', `put-case-table' and `put-case-table-pair'.
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.
134 */ 302 */
135 (case_table)) 303 (case_table))
136 { 304 {
305 /* This function can GC */
137 return set_case_table (case_table, 0); 306 return set_case_table (case_table, 0);
138 } 307 }
139 308
140 DEFUN ("set-standard-case-table", Fset_standard_case_table, 1, 1, 0, /* 309 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. 310 Select CASE-TABLE as the new standard case table for new buffers.
142 See `set-case-table' for more info on case tables. 311 See `set-case-table' for more info on case tables.
143 */ 312 */
144 (case_table)) 313 (case_table))
145 { 314 {
315 /* This function can GC */
146 return set_case_table (case_table, 1); 316 return set_case_table (case_table, 1);
147 } 317 }
148
149 #ifdef MULE
150
151 static Lisp_Object
152 make_mirror_trt_table (Lisp_Object table)
153 {
154 Lisp_Object new_table;
155
156 if (!STRING256_P (table))
157 {
158 #ifdef DEBUG_XEMACS
159 /* This should be caught farther up. */
160 abort ();
161 #else
162 signal_simple_error ("Invalid translate table", table);
163 #endif
164 }
165
166 new_table = MAKE_MIRROR_TRT_TABLE ();
167 {
168 int i;
169
170 for (i = 0; i < 256; i++)
171 {
172 Emchar newval = string_char (XSTRING (table), i);
173 if ((i >= 128 && newval != i)
174 || (i < 128 && newval >= 128))
175 {
176 newval = (Emchar) i;
177 }
178 SET_MIRROR_TRT_TABLE_CHAR_1 (new_table, i, newval);
179 }
180 }
181 return new_table;
182 }
183
184 #endif /* MULE */
185 318
186 static Lisp_Object 319 static Lisp_Object
187 set_case_table (Lisp_Object table, int standard) 320 set_case_table (Lisp_Object table, int standard)
188 { 321 {
189 Lisp_Object down, up, canon, eqv, tail = table; 322 /* This function can GC */
190 struct buffer *buf = 323 struct buffer *buf =
191 standard ? XBUFFER(Vbuffer_defaults) : current_buffer; 324 standard ? XBUFFER(Vbuffer_defaults) : current_buffer;
192 325
193 check_case_table (table); 326 check_case_table (table);
194 327
195 down = XCAR (tail); tail = XCDR (tail); 328 if (CASE_TABLEP (table))
196 up = XCAR (tail); tail = XCDR (tail); 329 {
197 canon = XCAR (tail); tail = XCDR (tail); 330 if (standard)
198 eqv = XCAR (tail); 331 Vstandard_case_table = table;
199 332
200 if (NILP (up)) 333 buf->case_table = table;
201 { 334 }
202 up = MAKE_TRT_TABLE (); 335 else
203 compute_trt_inverse (down, up); 336 {
204 } 337 /* For backward compatibility. */
205 338 Lisp_Object down, up, canon, eqv, tail = table;
206 if (NILP (canon)) 339 Lisp_Object temp;
207 { 340 int i;
208 REGISTER Charcount i; 341
209 342 down = XCAR (tail); tail = XCDR (tail);
210 canon = MAKE_TRT_TABLE (); 343 up = XCAR (tail); tail = XCDR (tail);
211 344 canon = XCAR (tail); tail = XCDR (tail);
212 /* Set up the CANON vector; for each character, 345 eqv = XCAR (tail);
213 this sequence of upcasing and downcasing ought to 346
214 get the "preferred" lowercase equivalent. */ 347 temp = down;
348 down = MAKE_TRT_TABLE ();
215 for (i = 0; i < 256; i++) 349 for (i = 0; i < 256; i++)
216 SET_TRT_TABLE_CHAR_1 (canon, i, 350 SET_TRT_TABLE_CHAR_1 (down, i, string_char (XSTRING (temp), i));
217 TRT_TABLE_CHAR_1 351
218 (down, 352 if (NILP (up))
219 TRT_TABLE_CHAR_1 353 {
220 (up, 354 up = MAKE_TRT_TABLE ();
221 TRT_TABLE_CHAR_1 (down, i)))); 355 compute_trt_inverse (down, up);
222 } 356 }
223 357 else
224 if (NILP (eqv)) 358 {
225 { 359 temp = up;
226 eqv = MAKE_TRT_TABLE (); 360 up = MAKE_TRT_TABLE ();
227 361 for (i = 0; i < 256; i++)
228 compute_trt_inverse (canon, eqv); 362 SET_TRT_TABLE_CHAR_1 (up, i, string_char (XSTRING (temp), i));
229 } 363 }
230 364 if (NILP (canon))
231 if (standard) 365 {
232 { 366 canon = MAKE_TRT_TABLE ();
233 Vascii_downcase_table = down; 367
234 Vascii_upcase_table = up; 368 /* Set up the CANON table; for each character,
235 Vascii_canon_table = canon; 369 this sequence of upcasing and downcasing ought to
236 Vascii_eqv_table = eqv; 370 get the "preferred" lowercase equivalent. */
237 #ifdef MULE 371 for (i = 0; i < 256; i++)
238 Vmirror_ascii_downcase_table = make_mirror_trt_table (down); 372 SET_TRT_TABLE_CHAR_1 (canon, i,
239 Vmirror_ascii_upcase_table = make_mirror_trt_table (up); 373 TRT_TABLE_CHAR_1
240 Vmirror_ascii_canon_table = make_mirror_trt_table (canon); 374 (down,
241 Vmirror_ascii_eqv_table = make_mirror_trt_table (eqv); 375 TRT_TABLE_CHAR_1
242 #endif 376 (up,
243 } 377 TRT_TABLE_CHAR_1 (down, i))));
244 buf->downcase_table = down; 378 }
245 buf->upcase_table = up; 379 else
246 buf->case_canon_table = canon; 380 {
247 buf->case_eqv_table = eqv; 381 temp = canon;
248 #ifdef MULE 382 canon = MAKE_TRT_TABLE ();
249 buf->mirror_downcase_table = make_mirror_trt_table (down); 383 for (i = 0; i < 256; i++)
250 buf->mirror_upcase_table = make_mirror_trt_table (up); 384 SET_TRT_TABLE_CHAR_1 (canon, i, string_char (XSTRING (temp), i));
251 buf->mirror_case_canon_table = make_mirror_trt_table (canon); 385 }
252 buf->mirror_case_eqv_table = make_mirror_trt_table (eqv); 386
253 #endif 387 if (NILP (eqv))
254 388 {
255 return table; 389 eqv = MAKE_TRT_TABLE ();
390 compute_trt_inverse (canon, eqv);
391 }
392 else
393 {
394 temp = eqv;
395 eqv = MAKE_TRT_TABLE ();
396 for (i = 0; i < 256; i++)
397 SET_TRT_TABLE_CHAR_1 (eqv, i, string_char (XSTRING (temp), i));
398 }
399
400 if (standard)
401 {
402 XSET_CASE_TABLE_DOWNCASE (Vstandard_case_table, down);
403 XSET_CASE_TABLE_UPCASE (Vstandard_case_table, up);
404 XSET_CASE_TABLE_CANON (Vstandard_case_table, canon);
405 XSET_CASE_TABLE_EQV (Vstandard_case_table, eqv);
406 }
407
408 buf->case_table = allocate_case_table ();
409 XSET_CASE_TABLE_DOWNCASE (buf->case_table, down);
410 XSET_CASE_TABLE_UPCASE (buf->case_table, up);
411 XSET_CASE_TABLE_CANON (buf->case_table, canon);
412 XSET_CASE_TABLE_EQV (buf->case_table, eqv);
413 }
414
415 return buf->case_table;
256 } 416 }
257 417
258 /* Given a translate table TRT, store the inverse mapping into INVERSE. 418 /* 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. 419 Since TRT is not one-to-one, INVERSE is not a simple mapping.
260 Instead, it divides the space of characters into equivalence classes. 420 Instead, it divides the space of characters into equivalence classes.
283 443
284 444
285 void 445 void
286 syms_of_casetab (void) 446 syms_of_casetab (void)
287 { 447 {
448 INIT_LRECORD_IMPLEMENTATION (case_table);
449
288 defsymbol (&Qcase_tablep, "case-table-p"); 450 defsymbol (&Qcase_tablep, "case-table-p");
451 defsymbol (&Qdowncase, "downcase");
452 defsymbol (&Qupcase, "upcase");
289 453
290 DEFSUBR (Fcase_table_p); 454 DEFSUBR (Fcase_table_p);
455 DEFSUBR (Fget_case_table);
456 DEFSUBR (Fput_case_table);
457 DEFSUBR (Fput_case_table_pair);
291 DEFSUBR (Fcurrent_case_table); 458 DEFSUBR (Fcurrent_case_table);
292 DEFSUBR (Fstandard_case_table); 459 DEFSUBR (Fstandard_case_table);
460 DEFSUBR (Fcopy_case_table);
293 DEFSUBR (Fset_case_table); 461 DEFSUBR (Fset_case_table);
294 DEFSUBR (Fset_standard_case_table); 462 DEFSUBR (Fset_standard_case_table);
295 } 463 }
296 464
297 void 465 void
298 complex_vars_of_casetab (void) 466 complex_vars_of_casetab (void)
299 { 467 {
300 REGISTER Emchar i; 468 REGISTER Emchar i;
301 Lisp_Object tem; 469 Lisp_Object tem;
302 470
303 staticpro (&Vascii_downcase_table); 471 staticpro (&Vstandard_case_table);
304 staticpro (&Vascii_upcase_table); 472
305 staticpro (&Vascii_canon_table); 473 Vstandard_case_table = allocate_case_table ();
306 staticpro (&Vascii_eqv_table);
307
308 #ifdef MULE
309 staticpro (&Vmirror_ascii_downcase_table);
310 staticpro (&Vmirror_ascii_upcase_table);
311 staticpro (&Vmirror_ascii_canon_table);
312 staticpro (&Vmirror_ascii_eqv_table);
313 #endif
314 474
315 tem = MAKE_TRT_TABLE (); 475 tem = MAKE_TRT_TABLE ();
316 Vascii_downcase_table = tem; 476 XSET_CASE_TABLE_DOWNCASE (Vstandard_case_table, tem);
317 Vascii_canon_table = tem; 477 XSET_CASE_TABLE_CANON (Vstandard_case_table, tem);
318 478
319 /* Under Mule, can't do set_string_char() until Vcharset_control_1 479 /* Under Mule, can't do set_string_char() until Vcharset_control_1
320 and Vcharset_ascii are initialized. */ 480 and Vcharset_ascii are initialized. */
321 for (i = 0; i < 256; i++) 481 for (i = 0; i < 256; i++)
322 { 482 {
323 unsigned char lowered = tolower (i); 483 unsigned char lowered = tolower (i);
324 484
325 SET_TRT_TABLE_CHAR_1 (tem, i, lowered); 485 SET_TRT_TABLE_CHAR_1 (tem, i, lowered);
326 } 486 }
327 487
328 #ifdef MULE
329 tem = make_mirror_trt_table (tem);
330 Vmirror_ascii_downcase_table = tem;
331 Vmirror_ascii_canon_table = tem;
332 #endif
333
334 tem = MAKE_TRT_TABLE (); 488 tem = MAKE_TRT_TABLE ();
335 Vascii_upcase_table = tem; 489 XSET_CASE_TABLE_UPCASE (Vstandard_case_table, tem);
336 Vascii_eqv_table = tem; 490 XSET_CASE_TABLE_EQV (Vstandard_case_table, tem);
337 491
338 for (i = 0; i < 256; i++) 492 for (i = 0; i < 256; i++)
339 { 493 {
340 unsigned char flipped = (isupper (i) ? tolower (i) 494 unsigned char flipped = (isupper (i) ? tolower (i)
341 : (islower (i) ? toupper (i) : i)); 495 : (islower (i) ? toupper (i) : i));
342 496
343 SET_TRT_TABLE_CHAR_1 (tem, i, flipped); 497 SET_TRT_TABLE_CHAR_1 (tem, i, flipped);
344 } 498 }
345 499 }
346 #ifdef MULE
347 tem = make_mirror_trt_table (tem);
348 Vmirror_ascii_upcase_table = tem;
349 Vmirror_ascii_eqv_table = tem;
350 #endif
351 }