23 |
#include <config.h> |
#include <config.h> |
24 |
#include "lisp.h" |
#include "lisp.h" |
25 |
#include "buffer.h" |
#include "buffer.h" |
26 |
#include "charset.h" |
#include "character.h" |
27 |
|
|
28 |
Lisp_Object Qcase_table_p, Qcase_table; |
Lisp_Object Qcase_table_p, Qcase_table; |
29 |
Lisp_Object Vascii_downcase_table, Vascii_upcase_table; |
Lisp_Object Vascii_downcase_table, Vascii_upcase_table; |
138 |
if (NILP (up)) |
if (NILP (up)) |
139 |
{ |
{ |
140 |
up = Fmake_char_table (Qcase_table, Qnil); |
up = Fmake_char_table (Qcase_table, Qnil); |
141 |
map_char_table (set_identity, Qnil, table, table, up, 0, indices); |
map_char_table (set_identity, Qnil, table, up); |
142 |
map_char_table (shuffle, Qnil, table, table, up, 0, indices); |
map_char_table (shuffle, Qnil, table, up); |
143 |
XCHAR_TABLE (table)->extras[0] = up; |
XCHAR_TABLE (table)->extras[0] = up; |
144 |
} |
} |
145 |
|
|
147 |
{ |
{ |
148 |
canon = Fmake_char_table (Qcase_table, Qnil); |
canon = Fmake_char_table (Qcase_table, Qnil); |
149 |
XCHAR_TABLE (table)->extras[1] = canon; |
XCHAR_TABLE (table)->extras[1] = canon; |
150 |
map_char_table (set_canon, Qnil, table, table, table, 0, indices); |
map_char_table (set_canon, Qnil, table, table); |
151 |
} |
} |
152 |
|
|
153 |
if (NILP (eqv)) |
if (NILP (eqv)) |
154 |
{ |
{ |
155 |
eqv = Fmake_char_table (Qcase_table, Qnil); |
eqv = Fmake_char_table (Qcase_table, Qnil); |
156 |
map_char_table (set_identity, Qnil, canon, canon, eqv, 0, indices); |
map_char_table (set_identity, Qnil, canon, eqv); |
157 |
map_char_table (shuffle, Qnil, canon, canon, eqv, 0, indices); |
map_char_table (shuffle, Qnil, canon, eqv); |
158 |
XCHAR_TABLE (table)->extras[2] = eqv; |
XCHAR_TABLE (table)->extras[2] = eqv; |
159 |
} |
} |
160 |
|
|
176 |
|
|
177 |
/* The following functions are called in map_char_table. */ |
/* The following functions are called in map_char_table. */ |
178 |
|
|
179 |
/* Set CANON char-table element for C to a translated ELT by UP and |
/* Set CANON char-table element for characters in RANGE to a |
180 |
DOWN char-tables. This is done only when ELT is a character. The |
translated ELT by UP and DOWN char-tables. This is done only when |
181 |
char-tables CANON, UP, and DOWN are in CASE_TABLE. */ |
ELT is a character. The char-tables CANON, UP, and DOWN are in |
182 |
|
CASE_TABLE. */ |
183 |
|
|
184 |
static void |
static void |
185 |
set_canon (case_table, c, elt) |
set_canon (case_table, range, elt) |
186 |
Lisp_Object case_table, c, elt; |
Lisp_Object case_table, range, elt; |
187 |
{ |
{ |
188 |
Lisp_Object up = XCHAR_TABLE (case_table)->extras[0]; |
Lisp_Object up = XCHAR_TABLE (case_table)->extras[0]; |
189 |
Lisp_Object canon = XCHAR_TABLE (case_table)->extras[1]; |
Lisp_Object canon = XCHAR_TABLE (case_table)->extras[1]; |
190 |
|
|
191 |
if (NATNUMP (elt)) |
if (NATNUMP (elt)) |
192 |
Faset (canon, c, Faref (case_table, Faref (up, elt))); |
Fset_char_table_range (canon, range, Faref (case_table, Faref (up, elt))); |
193 |
} |
} |
194 |
|
|
195 |
/* Set elements of char-table TABLE for C to C itself. This is done |
/* Set elements of char-table TABLE for C to C itself. C may be a |
196 |
only when ELT is a character. This is called in map_char_table. */ |
cons specifying a character range. In that case, set characters in |
197 |
|
that range to themselves. This is done only when ELT is a |
198 |
|
character. This is called in map_char_table. */ |
199 |
|
|
200 |
static void |
static void |
201 |
set_identity (table, c, elt) |
set_identity (table, c, elt) |
202 |
Lisp_Object table, c, elt; |
Lisp_Object table, c, elt; |
203 |
{ |
{ |
204 |
if (NATNUMP (elt)) |
if (NATNUMP (elt)) |
205 |
Faset (table, c, c); |
{ |
206 |
|
int from, to; |
207 |
|
|
208 |
|
if (CONSP (c)) |
209 |
|
{ |
210 |
|
from = XINT (XCAR (c)); |
211 |
|
to = XINT (XCDR (c)); |
212 |
|
} |
213 |
|
else |
214 |
|
from = to = XINT (c); |
215 |
|
for (; from <= to; from++) |
216 |
|
CHAR_TABLE_SET (table, from, make_number (from)); |
217 |
|
} |
218 |
} |
} |
219 |
|
|
220 |
/* Permute the elements of TABLE (which is initially an identity |
/* Permute the elements of TABLE (which is initially an identity |
226 |
shuffle (table, c, elt) |
shuffle (table, c, elt) |
227 |
Lisp_Object table, c, elt; |
Lisp_Object table, c, elt; |
228 |
{ |
{ |
229 |
if (NATNUMP (elt) && !EQ (c, elt)) |
if (NATNUMP (elt)) |
230 |
{ |
{ |
231 |
Lisp_Object tem = Faref (table, elt); |
Lisp_Object tem = Faref (table, elt); |
232 |
Faset (table, elt, c); |
int from, to; |
233 |
Faset (table, c, tem); |
|
234 |
|
if (CONSP (c)) |
235 |
|
{ |
236 |
|
from = XINT (XCAR (c)); |
237 |
|
to = XINT (XCDR (c)); |
238 |
|
} |
239 |
|
else |
240 |
|
from = to = XINT (c); |
241 |
|
|
242 |
|
for (; from <= to; from++) |
243 |
|
if (from != XINT (elt)) |
244 |
|
{ |
245 |
|
Faset (table, elt, make_number (from)); |
246 |
|
Faset (table, make_number (from), tem); |
247 |
|
} |
248 |
} |
} |
249 |
} |
} |
250 |
|
|
269 |
Vascii_downcase_table = down; |
Vascii_downcase_table = down; |
270 |
XCHAR_TABLE (down)->purpose = Qcase_table; |
XCHAR_TABLE (down)->purpose = Qcase_table; |
271 |
|
|
272 |
for (i = 0; i < CHAR_TABLE_SINGLE_BYTE_SLOTS; i++) |
for (i = 0; i < 128; i++) |
273 |
XSETFASTINT (XCHAR_TABLE (down)->contents[i], |
{ |
274 |
(i >= 'A' && i <= 'Z') ? i + ('a' - 'A') : i); |
int c = (i >= 'A' && i <= 'Z') ? i + ('a' - 'A') : i; |
275 |
|
CHAR_TABLE_SET (down, i, make_number (c)); |
276 |
|
} |
277 |
|
|
278 |
XCHAR_TABLE (down)->extras[1] = Fcopy_sequence (down); |
XCHAR_TABLE (down)->extras[1] = Fcopy_sequence (down); |
279 |
|
|
280 |
up = Fmake_char_table (Qcase_table, Qnil); |
up = Fmake_char_table (Qcase_table, Qnil); |
281 |
XCHAR_TABLE (down)->extras[0] = up; |
XCHAR_TABLE (down)->extras[0] = up; |
282 |
|
|
283 |
for (i = 0; i < CHAR_TABLE_SINGLE_BYTE_SLOTS; i++) |
for (i = 0; i < 128; i++) |
284 |
XSETFASTINT (XCHAR_TABLE (up)->contents[i], |
{ |
285 |
((i >= 'A' && i <= 'Z') |
int c = ((i >= 'A' && i <= 'Z') ? i + ('a' - 'A') |
286 |
? i + ('a' - 'A') |
: ((i >= 'a' && i <= 'z') ? i + ('A' - 'a') |
287 |
: ((i >= 'a' && i <= 'z') |
: i));; |
288 |
? i + ('A' - 'a') |
CHAR_TABLE_SET (up, i, make_number (c)); |
289 |
: i))); |
} |
290 |
|
|
291 |
XCHAR_TABLE (down)->extras[2] = Fcopy_sequence (up); |
XCHAR_TABLE (down)->extras[2] = Fcopy_sequence (up); |
292 |
} |
} |