1 |
/* GNU Emacs routines to deal with category tables. |
/* GNU Emacs routines to deal with category tables. |
2 |
Copyright (C) 1995, 1997 Electrotechnical Laboratory, JAPAN. |
Copyright (C) 1995, 1997 Electrotechnical Laboratory, JAPAN. |
3 |
Licensed to the Free Software Foundation. |
Licensed to the Free Software Foundation. |
4 |
|
Copyright (C) 2003 |
5 |
|
National Institute of Advanced Industrial Science and Technology (AIST) |
6 |
|
Registration Number H13PRO009 |
7 |
|
|
8 |
This file is part of GNU Emacs. |
This file is part of GNU Emacs. |
9 |
|
|
30 |
#include <ctype.h> |
#include <ctype.h> |
31 |
#include "lisp.h" |
#include "lisp.h" |
32 |
#include "buffer.h" |
#include "buffer.h" |
33 |
|
#include "character.h" |
34 |
#include "charset.h" |
#include "charset.h" |
35 |
#include "category.h" |
#include "category.h" |
36 |
#include "keymap.h" |
#include "keymap.h" |
190 |
return Vstandard_category_table; |
return Vstandard_category_table; |
191 |
} |
} |
192 |
|
|
193 |
|
|
194 |
|
static void |
195 |
|
copy_category_entry (table, c, val) |
196 |
|
Lisp_Object table, c, val; |
197 |
|
{ |
198 |
|
val = Fcopy_sequence (val); |
199 |
|
if (CONSP (c)) |
200 |
|
char_table_set_range (table, XINT (XCAR (c)), XINT (XCDR (c)), val); |
201 |
|
else |
202 |
|
char_table_set (table, XINT (c), val); |
203 |
|
} |
204 |
|
|
205 |
/* Return a copy of category table TABLE. We can't simply use the |
/* Return a copy of category table TABLE. We can't simply use the |
206 |
function copy-sequence because no contents should be shared between |
function copy-sequence because no contents should be shared between |
207 |
the original and the copy. This function is called recursively by |
the original and the copy. This function is called recursively by |
211 |
copy_category_table (table) |
copy_category_table (table) |
212 |
Lisp_Object table; |
Lisp_Object table; |
213 |
{ |
{ |
214 |
Lisp_Object tmp; |
table = copy_char_table (table); |
|
int i, to; |
|
215 |
|
|
216 |
if (!NILP (XCHAR_TABLE (table)->top)) |
if (! NILP (XCHAR_TABLE (table)->defalt)) |
217 |
{ |
XCHAR_TABLE (table)->defalt |
218 |
/* TABLE is a top level char table. |
= Fcopy_sequence (XCHAR_TABLE (table)->defalt); |
219 |
At first, make a copy of tree structure of the table. */ |
XCHAR_TABLE (table)->extras[0] |
220 |
table = Fcopy_sequence (table); |
= Fcopy_sequence (XCHAR_TABLE (table)->extras[0]); |
221 |
|
map_char_table (copy_category_entry, Qnil, table, table); |
|
/* Then, copy elements for single byte characters one by one. */ |
|
|
for (i = 0; i < CHAR_TABLE_SINGLE_BYTE_SLOTS; i++) |
|
|
if (!NILP (tmp = XCHAR_TABLE (table)->contents[i])) |
|
|
XCHAR_TABLE (table)->contents[i] = Fcopy_sequence (tmp); |
|
|
to = CHAR_TABLE_ORDINARY_SLOTS; |
|
|
|
|
|
/* Also copy the first (and sole) extra slot. It is a vector |
|
|
containing docstring of each category. */ |
|
|
Fset_char_table_extra_slot |
|
|
(table, make_number (0), |
|
|
Fcopy_sequence (Fchar_table_extra_slot (table, make_number (0)))); |
|
|
} |
|
|
else |
|
|
{ |
|
|
i = 32; |
|
|
to = SUB_CHAR_TABLE_ORDINARY_SLOTS; |
|
|
} |
|
|
|
|
|
/* If the table has non-nil default value, copy it. */ |
|
|
if (!NILP (tmp = XCHAR_TABLE (table)->defalt)) |
|
|
XCHAR_TABLE (table)->defalt = Fcopy_sequence (tmp); |
|
|
|
|
|
/* At last, copy the remaining elements while paying attention to a |
|
|
sub char table. */ |
|
|
for (; i < to; i++) |
|
|
if (!NILP (tmp = XCHAR_TABLE (table)->contents[i])) |
|
|
XCHAR_TABLE (table)->contents[i] |
|
|
= (SUB_CHAR_TABLE_P (tmp) |
|
|
? copy_category_table (tmp) : Fcopy_sequence (tmp)); |
|
222 |
|
|
223 |
return table; |
return table; |
224 |
} |
} |
244 |
() |
() |
245 |
{ |
{ |
246 |
Lisp_Object val; |
Lisp_Object val; |
247 |
|
int i; |
248 |
|
|
249 |
val = Fmake_char_table (Qcategory_table, Qnil); |
val = Fmake_char_table (Qcategory_table, Qnil); |
250 |
XCHAR_TABLE (val)->defalt = MAKE_CATEGORY_SET; |
XCHAR_TABLE (val)->defalt = MAKE_CATEGORY_SET; |
251 |
|
for (i = 0; i < (1 << CHARTAB_SIZE_BITS_0); i++) |
252 |
|
XCHAR_TABLE (val)->contents[i] = MAKE_CATEGORY_SET; |
253 |
Fset_char_table_extra_slot (val, make_number (0), |
Fset_char_table_extra_slot (val, make_number (0), |
254 |
Fmake_vector (make_number (95), Qnil)); |
Fmake_vector (make_number (95), Qnil)); |
255 |
return val; |
return val; |
270 |
} |
} |
271 |
|
|
272 |
|
|
273 |
|
Lisp_Object |
274 |
|
char_category_set (c) |
275 |
|
int c; |
276 |
|
{ |
277 |
|
return CHAR_TABLE_REF (current_buffer->category_table, c); |
278 |
|
} |
279 |
|
|
280 |
DEFUN ("char-category-set", Fchar_category_set, Schar_category_set, 1, 1, 0, |
DEFUN ("char-category-set", Fchar_category_set, Schar_category_set, 1, 1, 0, |
281 |
doc: /* Return the category set of CHAR. */) |
doc: /* Return the category set of CHAR. */) |
282 |
(ch) |
(ch) |
309 |
return build_string (str); |
return build_string (str); |
310 |
} |
} |
311 |
|
|
|
/* Modify all category sets stored under sub char-table TABLE so that |
|
|
they contain (SET_VALUE is t) or don't contain (SET_VALUE is nil) |
|
|
CATEGORY. */ |
|
|
|
|
|
void |
|
|
modify_lower_category_set (table, category, set_value) |
|
|
Lisp_Object table, category, set_value; |
|
|
{ |
|
|
Lisp_Object val; |
|
|
int i; |
|
|
|
|
|
val = XCHAR_TABLE (table)->defalt; |
|
|
if (!CATEGORY_SET_P (val)) |
|
|
val = MAKE_CATEGORY_SET; |
|
|
SET_CATEGORY_SET (val, category, set_value); |
|
|
XCHAR_TABLE (table)->defalt = val; |
|
|
|
|
|
for (i = 32; i < SUB_CHAR_TABLE_ORDINARY_SLOTS; i++) |
|
|
{ |
|
|
val = XCHAR_TABLE (table)->contents[i]; |
|
|
|
|
|
if (CATEGORY_SET_P (val)) |
|
|
SET_CATEGORY_SET (val, category, set_value); |
|
|
else if (SUB_CHAR_TABLE_P (val)) |
|
|
modify_lower_category_set (val, category, set_value); |
|
|
} |
|
|
} |
|
|
|
|
312 |
void |
void |
313 |
set_category_set (category_set, category, val) |
set_category_set (category_set, category, val) |
314 |
Lisp_Object category_set, category, val; |
Lisp_Object category_set, category, val; |
328 |
Smodify_category_entry, 2, 4, 0, |
Smodify_category_entry, 2, 4, 0, |
329 |
doc: /* Modify the category set of CHARACTER by adding CATEGORY to it. |
doc: /* Modify the category set of CHARACTER by adding CATEGORY to it. |
330 |
The category is changed only for table TABLE, which defaults to |
The category is changed only for table TABLE, which defaults to |
331 |
the current buffer's category table. |
the current buffer's category table. |
332 |
|
CHARACTER can be either a single character or a cons representing the |
333 |
|
lower and upper ends of an inclusive character range to modify. |
334 |
If optional fourth argument RESET is non-nil, |
If optional fourth argument RESET is non-nil, |
335 |
then delete CATEGORY from the category set instead of adding it. */) |
then delete CATEGORY from the category set instead of adding it. */) |
336 |
(character, category, table, reset) |
(character, category, table, reset) |
337 |
Lisp_Object character, category, table, reset; |
Lisp_Object character, category, table, reset; |
338 |
{ |
{ |
|
int c, charset, c1, c2; |
|
339 |
Lisp_Object set_value; /* Actual value to be set in category sets. */ |
Lisp_Object set_value; /* Actual value to be set in category sets. */ |
340 |
Lisp_Object val, category_set; |
Lisp_Object category_set; |
341 |
|
int start, end; |
342 |
|
int from, to; |
343 |
|
|
344 |
CHECK_NUMBER (character); |
if (INTEGERP (character)) |
|
c = XINT (character); |
|
|
CHECK_CATEGORY (category); |
|
|
table = check_category_table (table); |
|
|
|
|
|
if (NILP (CATEGORY_DOCSTRING (table, XFASTINT (category)))) |
|
|
error ("Undefined category: %c", XFASTINT (category)); |
|
|
|
|
|
set_value = NILP (reset) ? Qt : Qnil; |
|
|
|
|
|
if (c < CHAR_TABLE_SINGLE_BYTE_SLOTS) |
|
|
{ |
|
|
val = XCHAR_TABLE (table)->contents[c]; |
|
|
if (!CATEGORY_SET_P (val)) |
|
|
XCHAR_TABLE (table)->contents[c] = (val = MAKE_CATEGORY_SET); |
|
|
SET_CATEGORY_SET (val, category, set_value); |
|
|
return Qnil; |
|
|
} |
|
|
|
|
|
SPLIT_CHAR (c, charset, c1, c2); |
|
|
|
|
|
/* The top level table. */ |
|
|
val = XCHAR_TABLE (table)->contents[charset + 128]; |
|
|
if (CATEGORY_SET_P (val)) |
|
|
category_set = val; |
|
|
else if (!SUB_CHAR_TABLE_P (val)) |
|
345 |
{ |
{ |
346 |
category_set = val = MAKE_CATEGORY_SET; |
CHECK_CHARACTER (character); |
347 |
XCHAR_TABLE (table)->contents[charset + 128] = category_set; |
start = end = XFASTINT (character); |
348 |
} |
} |
349 |
|
else |
|
if (c1 <= 0) |
|
|
{ |
|
|
/* Only a charset is specified. */ |
|
|
if (SUB_CHAR_TABLE_P (val)) |
|
|
/* All characters in CHARSET should be the same as for having |
|
|
CATEGORY or not. */ |
|
|
modify_lower_category_set (val, category, set_value); |
|
|
else |
|
|
SET_CATEGORY_SET (category_set, category, set_value); |
|
|
return Qnil; |
|
|
} |
|
|
|
|
|
/* The second level table. */ |
|
|
if (!SUB_CHAR_TABLE_P (val)) |
|
350 |
{ |
{ |
351 |
val = make_sub_char_table (Qnil); |
CHECK_CONS (character); |
352 |
XCHAR_TABLE (table)->contents[charset + 128] = val; |
CHECK_CHARACTER_CAR (character); |
353 |
/* We must set default category set of CHARSET in `defalt' slot. */ |
CHECK_CHARACTER_CDR (character); |
354 |
XCHAR_TABLE (val)->defalt = category_set; |
start = XFASTINT (XCAR (character)); |
355 |
|
end = XFASTINT (XCDR (character)); |
356 |
} |
} |
|
table = val; |
|
357 |
|
|
358 |
val = XCHAR_TABLE (table)->contents[c1]; |
CHECK_CATEGORY (category); |
359 |
if (CATEGORY_SET_P (val)) |
table = check_category_table (table); |
|
category_set = val; |
|
|
else if (!SUB_CHAR_TABLE_P (val)) |
|
|
{ |
|
|
category_set = val = Fcopy_sequence (XCHAR_TABLE (table)->defalt); |
|
|
XCHAR_TABLE (table)->contents[c1] = category_set; |
|
|
} |
|
360 |
|
|
361 |
if (c2 <= 0) |
if (NILP (CATEGORY_DOCSTRING (table, XFASTINT (category)))) |
362 |
{ |
error ("Undefined category: %c", XFASTINT (category)); |
|
if (SUB_CHAR_TABLE_P (val)) |
|
|
/* All characters in C1 group of CHARSET should be the same as |
|
|
for CATEGORY. */ |
|
|
modify_lower_category_set (val, category, set_value); |
|
|
else |
|
|
SET_CATEGORY_SET (category_set, category, set_value); |
|
|
return Qnil; |
|
|
} |
|
363 |
|
|
364 |
/* The third (bottom) level table. */ |
set_value = NILP (reset) ? Qt : Qnil; |
|
if (!SUB_CHAR_TABLE_P (val)) |
|
|
{ |
|
|
val = make_sub_char_table (Qnil); |
|
|
XCHAR_TABLE (table)->contents[c1] = val; |
|
|
/* We must set default category set of CHARSET and C1 in |
|
|
`defalt' slot. */ |
|
|
XCHAR_TABLE (val)->defalt = category_set; |
|
|
} |
|
|
table = val; |
|
365 |
|
|
366 |
val = XCHAR_TABLE (table)->contents[c2]; |
while (start <= end) |
|
if (CATEGORY_SET_P (val)) |
|
|
category_set = val; |
|
|
else if (!SUB_CHAR_TABLE_P (val)) |
|
367 |
{ |
{ |
368 |
category_set = Fcopy_sequence (XCHAR_TABLE (table)->defalt); |
category_set = char_table_ref_and_range (table, start, &from, &to); |
369 |
XCHAR_TABLE (table)->contents[c2] = category_set; |
if (CATEGORY_MEMBER (XFASTINT (category), category_set) != NILP (reset)) |
370 |
|
{ |
371 |
|
category_set = Fcopy_sequence (category_set); |
372 |
|
SET_CATEGORY_SET (category_set, category, set_value); |
373 |
|
if (to > end) |
374 |
|
char_table_set_range (table, start, end, category_set); |
375 |
|
else |
376 |
|
char_table_set_range (table, start, to, category_set); |
377 |
|
} |
378 |
|
start = to + 1; |
379 |
} |
} |
|
else |
|
|
/* This should never happen. */ |
|
|
error ("Invalid category table"); |
|
|
|
|
|
SET_CATEGORY_SET (category_set, category, set_value); |
|
380 |
|
|
381 |
return Qnil; |
return Qnil; |
382 |
} |
} |