1 /* GNU Emacs routines to deal with case tables.
2 Copyright (C) 1993, 1994 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 1, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
20 /* Written by Howard Gayle. See chartab.c for details. */
26 Lisp_Object Qcase_table_p
;
27 Lisp_Object Vascii_downcase_table
, Vascii_upcase_table
;
28 Lisp_Object Vascii_canon_table
, Vascii_eqv_table
;
30 void compute_trt_inverse ();
32 DEFUN ("case-table-p", Fcase_table_p
, Scase_table_p
, 1, 1, 0,
33 "Return t iff ARG is a case table.\n\
34 See `set-case-table' for more information on these data structures.")
38 Lisp_Object down
, up
, canon
, eqv
;
39 down
= Fcar_safe (table
);
40 up
= Fcar_safe (Fcdr_safe (table
));
41 canon
= Fcar_safe (Fcdr_safe (Fcdr_safe (table
)));
42 eqv
= Fcar_safe (Fcdr_safe (Fcdr_safe (Fcdr_safe (table
))));
44 #define STRING256_P(obj) (STRINGP (obj) && XSTRING (obj)->size == 256)
46 return (STRING256_P (down
)
47 && (NILP (up
) || STRING256_P (up
))
48 && ((NILP (canon
) && NILP (eqv
))
49 || (STRING256_P (canon
)
50 && (NILP (eqv
) || STRING256_P (eqv
))))
55 check_case_table (obj
)
58 register Lisp_Object tem
;
60 while (tem
= Fcase_table_p (obj
), NILP (tem
))
61 obj
= wrong_type_argument (Qcase_table_p
, obj
);
65 DEFUN ("current-case-table", Fcurrent_case_table
, Scurrent_case_table
, 0, 0, 0,
66 "Return the case table of the current buffer.")
69 Lisp_Object down
, up
, canon
, eqv
;
71 down
= current_buffer
->downcase_table
;
72 up
= current_buffer
->upcase_table
;
73 canon
= current_buffer
->case_canon_table
;
74 eqv
= current_buffer
->case_eqv_table
;
76 return Fcons (down
, Fcons (up
, Fcons (canon
, Fcons (eqv
, Qnil
))));
79 DEFUN ("standard-case-table", Fstandard_case_table
, Sstandard_case_table
, 0, 0, 0,
80 "Return the standard case table.\n\
81 This is the one used for new buffers.")
84 return Fcons (Vascii_downcase_table
,
85 Fcons (Vascii_upcase_table
,
86 Fcons (Vascii_canon_table
,
87 Fcons (Vascii_eqv_table
, Qnil
))));
90 static Lisp_Object
set_case_table ();
92 DEFUN ("set-case-table", Fset_case_table
, Sset_case_table
, 1, 1, 0,
93 "Select a new case table for the current buffer.\n\
94 A case table is a list (DOWNCASE UPCASE CANONICALIZE EQUIVALENCES)\n\
95 where each element is either nil or a string of length 256.\n\
96 DOWNCASE maps each character to its lower-case equivalent.\n\
97 UPCASE maps each character to its upper-case equivalent;\n\
98 if lower and upper case characters are in 1-1 correspondence,\n\
99 you may use nil and the upcase table will be deduced from DOWNCASE.\n\
100 CANONICALIZE maps each character to a canonical equivalent;\n\
101 any two characters that are related by case-conversion have the same\n\
102 canonical equivalent character; it may be nil, in which case it is\n\
103 deduced from DOWNCASE and UPCASE.\n\
104 EQUIVALENCES is a map that cyclicly permutes each equivalence class\n\
105 (of characters with the same canonical equivalent); it may be nil,\n\
106 in which case it is deduced from CANONICALIZE.")
110 return set_case_table (table
, 0);
113 DEFUN ("set-standard-case-table", Fset_standard_case_table
, Sset_standard_case_table
, 1, 1, 0,
114 "Select a new standard case table for new buffers.\n\
115 See `set-case-table' for more info on case tables.")
119 return set_case_table (table
, 1);
123 set_case_table (table
, standard
)
127 Lisp_Object down
, up
, canon
, eqv
;
129 check_case_table (table
);
131 down
= Fcar_safe (table
);
132 up
= Fcar_safe (Fcdr_safe (table
));
133 canon
= Fcar_safe (Fcdr_safe (Fcdr_safe (table
)));
134 eqv
= Fcar_safe (Fcdr_safe (Fcdr_safe (Fcdr_safe (table
))));
138 up
= Fmake_string (make_number (256), make_number (0));
139 compute_trt_inverse (XSTRING (down
)->data
, XSTRING (up
)->data
);
145 unsigned char *upvec
= XSTRING (up
)->data
;
146 unsigned char *downvec
= XSTRING (down
)->data
;
148 canon
= Fmake_string (make_number (256), make_number (0));
150 /* Set up the CANON vector; for each character,
151 this sequence of upcasing and downcasing ought to
152 get the "preferred" lowercase equivalent. */
153 for (i
= 0; i
< 256; i
++)
154 XSTRING (canon
)->data
[i
] = downvec
[upvec
[downvec
[i
]]];
159 eqv
= Fmake_string (make_number (256), make_number (0));
161 compute_trt_inverse (XSTRING (canon
)->data
, XSTRING (eqv
)->data
);
166 Vascii_downcase_table
= down
;
167 Vascii_upcase_table
= up
;
168 Vascii_canon_table
= canon
;
169 Vascii_eqv_table
= eqv
;
173 current_buffer
->downcase_table
= down
;
174 current_buffer
->upcase_table
= up
;
175 current_buffer
->case_canon_table
= canon
;
176 current_buffer
->case_eqv_table
= eqv
;
181 /* Given a translate table TRT, store the inverse mapping into INVERSE.
182 Since TRT is not one-to-one, INVERSE is not a simple mapping.
183 Instead, it divides the space of characters into equivalence classes.
184 All characters in a given class form one circular list, chained through
185 the elements of INVERSE. */
188 compute_trt_inverse (trt
, inverse
)
189 register unsigned char *trt
;
190 register unsigned char *inverse
;
192 register int i
= 0400;
193 register unsigned char c
, q
;
200 if ((q
= trt
[i
]) != (unsigned char) i
)
214 tem
= Fmake_string (make_number (256), make_number (0));
215 Vascii_downcase_table
= tem
;
216 Vascii_canon_table
= tem
;
218 for (i
= 0; i
< 256; i
++)
219 XSTRING (tem
)->data
[i
] = (i
>= 'A' && i
<= 'Z') ? i
+ 040 : i
;
221 tem
= Fmake_string (make_number (256), make_number (0));
222 Vascii_upcase_table
= tem
;
223 Vascii_eqv_table
= tem
;
225 for (i
= 0; i
< 256; i
++)
226 XSTRING (tem
)->data
[i
]
227 = ((i
>= 'A' && i
<= 'Z')
229 : ((i
>= 'a' && i
<= 'z')
236 Qcase_table_p
= intern ("case-table-p");
237 staticpro (&Qcase_table_p
);
238 staticpro (&Vascii_downcase_table
);
239 staticpro (&Vascii_upcase_table
);
240 staticpro (&Vascii_canon_table
);
241 staticpro (&Vascii_eqv_table
);
243 defsubr (&Scase_table_p
);
244 defsubr (&Scurrent_case_table
);
245 defsubr (&Sstandard_case_table
);
246 defsubr (&Sset_case_table
);
247 defsubr (&Sset_standard_case_table
);
250 DEFVAR_LISP ("ascii-downcase-table", &Vascii_downcase_table
,
251 "String mapping ASCII characters to lowercase equivalents.");
252 DEFVAR_LISP ("ascii-upcase-table", &Vascii_upcase_table
,
253 "String mapping ASCII characters to uppercase equivalents.");