1 /* GNU Emacs routines to deal with category tables.
2 Copyright (C) 1998, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
3 Free Software Foundation, Inc.
4 Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
6 National Institute of Advanced Industrial Science and Technology (AIST)
7 Registration Number H14PRO021
9 National Institute of Advanced Industrial Science and Technology (AIST)
10 Registration Number H13PRO009
12 This file is part of GNU Emacs.
14 GNU Emacs is free software: you can redistribute it and/or modify
15 it under the terms of the GNU General Public License as published by
16 the Free Software Foundation, either version 3 of the License, or
17 (at your option) any later version.
19 GNU Emacs is distributed in the hope that it will be useful,
20 but WITHOUT ANY WARRANTY; without even the implied warranty of
21 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 GNU General Public License for more details.
24 You should have received a copy of the GNU General Public License
25 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
28 /* Here we handle three objects: category, category set, and category
29 table. Read comments in the file category.h to understand them. */
35 #include "character.h"
40 /* The version number of the latest category table. Each category
41 table has a unique version number. It is assigned a new number
42 also when it is modified. When a regular expression is compiled
43 into the struct re_pattern_buffer, the version number of the
44 category table (of the current buffer) at that moment is also
45 embedded in the structure.
47 For the moment, we are not using this feature. */
48 static int category_table_version
;
50 Lisp_Object Qcategory_table
, Qcategoryp
, Qcategorysetp
, Qcategory_table_p
;
52 /* Variables to determine word boundary. */
53 Lisp_Object Vword_combining_categories
, Vword_separating_categories
;
55 /* Temporary internal variable used in macro CHAR_HAS_CATEGORY. */
56 Lisp_Object _temp_category_set
;
59 /* Category set staff. */
61 DEFUN ("make-category-set", Fmake_category_set
, Smake_category_set
, 1, 1, 0,
62 doc
: /* Return a newly created category-set which contains CATEGORIES.
63 CATEGORIES is a string of category mnemonics.
64 The value is a bool-vector which has t at the indices corresponding to
67 Lisp_Object categories
;
72 CHECK_STRING (categories
);
73 val
= MAKE_CATEGORY_SET
;
75 if (STRING_MULTIBYTE (categories
))
76 error ("Multibyte string in `make-category-set'");
78 len
= SCHARS (categories
);
83 XSETFASTINT (category
, SREF (categories
, len
));
84 CHECK_CATEGORY (category
);
85 SET_CATEGORY_SET (val
, category
, Qt
);
93 Lisp_Object
check_category_table ();
95 DEFUN ("define-category", Fdefine_category
, Sdefine_category
, 2, 3, 0,
96 doc
: /* Define CATEGORY as a category which is described by DOCSTRING.
97 CATEGORY should be an ASCII printing character in the range ` ' to `~'.
98 DOCSTRING is the documentation string of the category. The first line
99 should be a terse text (preferably less than 16 characters),
100 and the rest lines should be the full description.
101 The category is defined only in category table TABLE, which defaults to
102 the current buffer's category table. */)
103 (category
, docstring
, table
)
104 Lisp_Object category
, docstring
, table
;
106 CHECK_CATEGORY (category
);
107 CHECK_STRING (docstring
);
108 table
= check_category_table (table
);
110 if (!NILP (CATEGORY_DOCSTRING (table
, XFASTINT (category
))))
111 error ("Category `%c' is already defined", XFASTINT (category
));
112 CATEGORY_DOCSTRING (table
, XFASTINT (category
)) = docstring
;
117 DEFUN ("category-docstring", Fcategory_docstring
, Scategory_docstring
, 1, 2, 0,
118 doc
: /* Return the documentation string of CATEGORY, as defined in TABLE.
119 TABLE should be a category table and defaults to the current buffer's
122 Lisp_Object category
, table
;
124 CHECK_CATEGORY (category
);
125 table
= check_category_table (table
);
127 return CATEGORY_DOCSTRING (table
, XFASTINT (category
));
130 DEFUN ("get-unused-category", Fget_unused_category
, Sget_unused_category
,
132 doc
: /* Return a category which is not yet defined in TABLE.
133 If no category remains available, return nil.
134 The optional argument TABLE specifies which category table to modify;
135 it defaults to the current buffer's category table. */)
141 table
= check_category_table (table
);
143 for (i
= ' '; i
<= '~'; i
++)
144 if (NILP (CATEGORY_DOCSTRING (table
, i
)))
145 return make_number (i
);
151 /* Category-table staff. */
153 DEFUN ("category-table-p", Fcategory_table_p
, Scategory_table_p
, 1, 1, 0,
154 doc
: /* Return t if ARG is a category table. */)
158 if (CHAR_TABLE_P (arg
)
159 && EQ (XCHAR_TABLE (arg
)->purpose
, Qcategory_table
))
164 /* If TABLE is nil, return the current category table. If TABLE is
165 not nil, check the validity of TABLE as a category table. If
166 valid, return TABLE itself, but if not valid, signal an error of
167 wrong-type-argument. */
170 check_category_table (table
)
174 return current_buffer
->category_table
;
175 CHECK_TYPE (!NILP (Fcategory_table_p (table
)), Qcategory_table_p
, table
);
179 DEFUN ("category-table", Fcategory_table
, Scategory_table
, 0, 0, 0,
180 doc
: /* Return the current category table.
181 This is the one specified by the current buffer. */)
184 return current_buffer
->category_table
;
187 DEFUN ("standard-category-table", Fstandard_category_table
,
188 Sstandard_category_table
, 0, 0, 0,
189 doc
: /* Return the standard category table.
190 This is the one used for new buffers. */)
193 return Vstandard_category_table
;
198 copy_category_entry (table
, c
, val
)
199 Lisp_Object table
, c
, val
;
201 val
= Fcopy_sequence (val
);
203 char_table_set_range (table
, XINT (XCAR (c
)), XINT (XCDR (c
)), val
);
205 char_table_set (table
, XINT (c
), val
);
208 /* Return a copy of category table TABLE. We can't simply use the
209 function copy-sequence because no contents should be shared between
210 the original and the copy. This function is called recursively by
211 binding TABLE to a sub char table. */
214 copy_category_table (table
)
217 table
= copy_char_table (table
);
219 if (! NILP (XCHAR_TABLE (table
)->defalt
))
220 XCHAR_TABLE (table
)->defalt
221 = Fcopy_sequence (XCHAR_TABLE (table
)->defalt
);
222 XCHAR_TABLE (table
)->extras
[0]
223 = Fcopy_sequence (XCHAR_TABLE (table
)->extras
[0]);
224 map_char_table (copy_category_entry
, Qnil
, table
, table
);
229 DEFUN ("copy-category-table", Fcopy_category_table
, Scopy_category_table
,
231 doc
: /* Construct a new category table and return it.
232 It is a copy of the TABLE, which defaults to the standard category table. */)
237 check_category_table (table
);
239 table
= Vstandard_category_table
;
241 return copy_category_table (table
);
244 DEFUN ("make-category-table", Fmake_category_table
, Smake_category_table
,
246 doc
: /* Construct a new and empty category table and return it. */)
252 val
= Fmake_char_table (Qcategory_table
, Qnil
);
253 XCHAR_TABLE (val
)->defalt
= MAKE_CATEGORY_SET
;
254 for (i
= 0; i
< (1 << CHARTAB_SIZE_BITS_0
); i
++)
255 XCHAR_TABLE (val
)->contents
[i
] = MAKE_CATEGORY_SET
;
256 Fset_char_table_extra_slot (val
, make_number (0),
257 Fmake_vector (make_number (95), Qnil
));
261 DEFUN ("set-category-table", Fset_category_table
, Sset_category_table
, 1, 1, 0,
262 doc
: /* Specify TABLE as the category table for the current buffer.
268 table
= check_category_table (table
);
269 current_buffer
->category_table
= table
;
270 /* Indicate that this buffer now has a specified category table. */
271 idx
= PER_BUFFER_VAR_IDX (category_table
);
272 SET_PER_BUFFER_VALUE_P (current_buffer
, idx
, 1);
278 char_category_set (c
)
281 return CHAR_TABLE_REF (current_buffer
->category_table
, c
);
284 DEFUN ("char-category-set", Fchar_category_set
, Schar_category_set
, 1, 1, 0,
285 doc
: /* Return the category set of CHAR.
286 usage: (char-category-set CHAR) */)
291 return CATEGORY_SET (XFASTINT (ch
));
294 DEFUN ("category-set-mnemonics", Fcategory_set_mnemonics
,
295 Scategory_set_mnemonics
, 1, 1, 0,
296 doc
: /* Return a string containing mnemonics of the categories in CATEGORY-SET.
297 CATEGORY-SET is a bool-vector, and the categories \"in\" it are those
298 that are indexes where t occurs in the bool-vector.
299 The return value is a string containing those same categories. */)
301 Lisp_Object category_set
;
306 CHECK_CATEGORY_SET (category_set
);
309 for (i
= 32; i
< 127; i
++)
310 if (CATEGORY_MEMBER (i
, category_set
))
314 return build_string (str
);
318 set_category_set (category_set
, category
, val
)
319 Lisp_Object category_set
, category
, val
;
322 int idx
= XINT (category
) / 8;
323 unsigned char bits
= 1 << (XINT (category
) % 8);
326 XCATEGORY_SET (category_set
)->data
[idx
] &= ~bits
;
328 XCATEGORY_SET (category_set
)->data
[idx
] |= bits
;
332 DEFUN ("modify-category-entry", Fmodify_category_entry
,
333 Smodify_category_entry
, 2, 4, 0,
334 doc
: /* Modify the category set of CHARACTER by adding CATEGORY to it.
335 The category is changed only for table TABLE, which defaults to
336 the current buffer's category table.
337 CHARACTER can be either a single character or a cons representing the
338 lower and upper ends of an inclusive character range to modify.
339 If optional fourth argument RESET is non-nil,
340 then delete CATEGORY from the category set instead of adding it. */)
341 (character
, category
, table
, reset
)
342 Lisp_Object character
, category
, table
, reset
;
344 Lisp_Object set_value
; /* Actual value to be set in category sets. */
345 Lisp_Object category_set
;
349 if (INTEGERP (character
))
351 CHECK_CHARACTER (character
);
352 start
= end
= XFASTINT (character
);
356 CHECK_CONS (character
);
357 CHECK_CHARACTER_CAR (character
);
358 CHECK_CHARACTER_CDR (character
);
359 start
= XFASTINT (XCAR (character
));
360 end
= XFASTINT (XCDR (character
));
363 CHECK_CATEGORY (category
);
364 table
= check_category_table (table
);
366 if (NILP (CATEGORY_DOCSTRING (table
, XFASTINT (category
))))
367 error ("Undefined category: %c", XFASTINT (category
));
369 set_value
= NILP (reset
) ? Qt
: Qnil
;
373 category_set
= char_table_ref_and_range (table
, start
, &from
, &to
);
374 if (CATEGORY_MEMBER (XFASTINT (category
), category_set
) != NILP (reset
))
376 category_set
= Fcopy_sequence (category_set
);
377 SET_CATEGORY_SET (category_set
, category
, set_value
);
379 char_table_set_range (table
, start
, end
, category_set
);
381 char_table_set_range (table
, start
, to
, category_set
);
389 /* Return 1 if there is a word boundary between two word-constituent
390 characters C1 and C2 if they appear in this order, else return 0.
391 Use the macro WORD_BOUNDARY_P instead of calling this function
395 word_boundary_p (c1
, c2
)
398 Lisp_Object category_set1
, category_set2
;
402 if (EQ (CHAR_TABLE_REF (Vchar_script_table
, c1
),
403 CHAR_TABLE_REF (Vchar_script_table
, c2
)))
405 tail
= Vword_separating_categories
;
410 tail
= Vword_combining_categories
;
414 category_set1
= CATEGORY_SET (c1
);
415 if (NILP (category_set1
))
416 return default_result
;
417 category_set2
= CATEGORY_SET (c2
);
418 if (NILP (category_set2
))
419 return default_result
;
421 for (; CONSP (tail
); tail
= XCDR (tail
))
423 Lisp_Object elt
= XCAR (tail
);
426 && (NILP (XCAR (elt
))
427 || (CATEGORYP (XCAR (elt
))
428 && CATEGORY_MEMBER (XFASTINT (XCAR (elt
)), category_set1
)))
429 && (NILP (XCDR (elt
))
430 || (CATEGORYP (XCDR (elt
))
431 && CATEGORY_MEMBER (XFASTINT (XCDR (elt
)), category_set2
))))
432 return !default_result
;
434 return default_result
;
439 init_category_once ()
441 /* This has to be done here, before we call Fmake_char_table. */
442 Qcategory_table
= intern ("category-table");
443 staticpro (&Qcategory_table
);
445 /* Intern this now in case it isn't already done.
446 Setting this variable twice is harmless.
447 But don't staticpro it here--that is done in alloc.c. */
448 Qchar_table_extra_slots
= intern ("char-table-extra-slots");
450 /* Now we are ready to set up this property, so we can
451 create category tables. */
452 Fput (Qcategory_table
, Qchar_table_extra_slots
, make_number (2));
454 Vstandard_category_table
= Fmake_char_table (Qcategory_table
, Qnil
);
455 /* Set a category set which contains nothing to the default. */
456 XCHAR_TABLE (Vstandard_category_table
)->defalt
= MAKE_CATEGORY_SET
;
457 Fset_char_table_extra_slot (Vstandard_category_table
, make_number (0),
458 Fmake_vector (make_number (95), Qnil
));
464 Qcategoryp
= intern ("categoryp");
465 staticpro (&Qcategoryp
);
466 Qcategorysetp
= intern ("categorysetp");
467 staticpro (&Qcategorysetp
);
468 Qcategory_table_p
= intern ("category-table-p");
469 staticpro (&Qcategory_table_p
);
471 DEFVAR_LISP ("word-combining-categories", &Vword_combining_categories
,
472 doc
: /* List of pair (cons) of categories to determine word boundary.
474 Emacs treats a sequence of word constituent characters as a single
475 word (i.e. finds no word boundary between them) only if they belong to
476 the same script. But, exceptions are allowed in the following cases.
478 \(1) The case that characters are in different scripts is controlled
479 by the variable `word-combining-categories'.
481 Emacs finds no word boundary between characters of different scripts
482 if they have categories matching some element of this list.
484 More precisely, if an element of this list is a cons of category CAT1
485 and CAT2, and a multibyte character C1 which has CAT1 is followed by
486 C2 which has CAT2, there's no word boundary between C1 and C2.
488 For instance, to tell that Han characters followed by Hiragana
489 characters can form a single word, the element `(?C . ?H)' should be
492 \(2) The case that character are in the same script is controlled by
493 the variable `word-separating-categories'.
495 Emacs find a word boundary between characters of the same script
496 if they have categories matching some element of this list.
498 More precisely, if an element of this list is a cons of category CAT1
499 and CAT2, and a multibyte character C1 which has CAT1 is followed by
500 C2 which has CAT2, there's a word boundary between C1 and C2.
502 For instance, to tell that there's a word boundary between Hiragana
503 and Katakana (both are in the same script `kana'),
504 the element `(?H . ?K) should be in this list. */);
506 Vword_combining_categories
= Qnil
;
508 DEFVAR_LISP ("word-separating-categories", &Vword_separating_categories
,
509 doc
: /* List of pair (cons) of categories to determine word boundary.
510 See the documentation of the variable `word-combining-categories'. */);
512 Vword_separating_categories
= Qnil
;
514 defsubr (&Smake_category_set
);
515 defsubr (&Sdefine_category
);
516 defsubr (&Scategory_docstring
);
517 defsubr (&Sget_unused_category
);
518 defsubr (&Scategory_table_p
);
519 defsubr (&Scategory_table
);
520 defsubr (&Sstandard_category_table
);
521 defsubr (&Scopy_category_table
);
522 defsubr (&Smake_category_table
);
523 defsubr (&Sset_category_table
);
524 defsubr (&Schar_category_set
);
525 defsubr (&Scategory_set_mnemonics
);
526 defsubr (&Smodify_category_entry
);
528 category_table_version
= 0;
531 /* arch-tag: 74ebf524-121b-4d9c-bd68-07f8d708b211
532 (do not change this comment) */