/* GNU Emacs routines to deal with category tables.
- Copyright (C) 1998, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
+ Copyright (C) 1998, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
Free Software Foundation, Inc.
Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007, 2008
+ 2005, 2006, 2007, 2008, 2009, 2010
National Institute of Advanced Industrial Science and Technology (AIST)
Registration Number H14PRO021
Copyright (C) 2003
#include <config.h>
#include <ctype.h>
+#include <setjmp.h>
#include "lisp.h"
#include "buffer.h"
#include "character.h"
\f
/* Category set staff. */
+static Lisp_Object hash_get_category_set (Lisp_Object, Lisp_Object);
+
+static Lisp_Object
+hash_get_category_set (Lisp_Object table, Lisp_Object category_set)
+{
+ Lisp_Object val;
+ struct Lisp_Hash_Table *h;
+ int i;
+ unsigned hash;
+
+ if (NILP (XCHAR_TABLE (table)->extras[1]))
+ XCHAR_TABLE (table)->extras[1]
+ = make_hash_table (Qequal, make_number (DEFAULT_HASH_SIZE),
+ make_float (DEFAULT_REHASH_SIZE),
+ make_float (DEFAULT_REHASH_THRESHOLD),
+ Qnil, Qnil, Qnil);
+ h = XHASH_TABLE (XCHAR_TABLE (table)->extras[1]);
+ i = hash_lookup (h, category_set, &hash);
+ if (i >= 0)
+ return HASH_KEY (h, i);
+ hash_put (h, category_set, Qnil, hash);
+ return category_set;
+}
+
+
DEFUN ("make-category-set", Fmake_category_set, Smake_category_set, 1, 1, 0,
doc: /* Return a newly created category-set which contains CATEGORIES.
CATEGORIES is a string of category mnemonics.
The value is a bool-vector which has t at the indices corresponding to
those categories. */)
- (categories)
- Lisp_Object categories;
+ (Lisp_Object categories)
{
Lisp_Object val;
int len;
\f
/* Category staff. */
-Lisp_Object check_category_table ();
+Lisp_Object check_category_table (Lisp_Object table);
DEFUN ("define-category", Fdefine_category, Sdefine_category, 2, 3, 0,
doc: /* Define CATEGORY as a category which is described by DOCSTRING.
CATEGORY should be an ASCII printing character in the range ` ' to `~'.
-DOCSTRING is the documentation string of the category.
+DOCSTRING is the documentation string of the category. The first line
+should be a terse text (preferably less than 16 characters),
+and the rest lines should be the full description.
The category is defined only in category table TABLE, which defaults to
the current buffer's category table. */)
- (category, docstring, table)
- Lisp_Object category, docstring, table;
+ (Lisp_Object category, Lisp_Object docstring, Lisp_Object table)
{
CHECK_CATEGORY (category);
CHECK_STRING (docstring);
if (!NILP (CATEGORY_DOCSTRING (table, XFASTINT (category))))
error ("Category `%c' is already defined", XFASTINT (category));
+ if (!NILP (Vpurify_flag))
+ docstring = Fpurecopy (docstring);
CATEGORY_DOCSTRING (table, XFASTINT (category)) = docstring;
return Qnil;
doc: /* Return the documentation string of CATEGORY, as defined in TABLE.
TABLE should be a category table and defaults to the current buffer's
category table. */)
- (category, table)
- Lisp_Object category, table;
+ (Lisp_Object category, Lisp_Object table)
{
CHECK_CATEGORY (category);
table = check_category_table (table);
If no category remains available, return nil.
The optional argument TABLE specifies which category table to modify;
it defaults to the current buffer's category table. */)
- (table)
- Lisp_Object table;
+ (Lisp_Object table)
{
int i;
DEFUN ("category-table-p", Fcategory_table_p, Scategory_table_p, 1, 1, 0,
doc: /* Return t if ARG is a category table. */)
- (arg)
- Lisp_Object arg;
+ (Lisp_Object arg)
{
if (CHAR_TABLE_P (arg)
&& EQ (XCHAR_TABLE (arg)->purpose, Qcategory_table))
wrong-type-argument. */
Lisp_Object
-check_category_table (table)
- Lisp_Object table;
+check_category_table (Lisp_Object table)
{
if (NILP (table))
return current_buffer->category_table;
DEFUN ("category-table", Fcategory_table, Scategory_table, 0, 0, 0,
doc: /* Return the current category table.
This is the one specified by the current buffer. */)
- ()
+ (void)
{
return current_buffer->category_table;
}
Sstandard_category_table, 0, 0, 0,
doc: /* Return the standard category table.
This is the one used for new buffers. */)
- ()
+ (void)
{
return Vstandard_category_table;
}
static void
-copy_category_entry (table, c, val)
- Lisp_Object table, c, val;
+copy_category_entry (Lisp_Object table, Lisp_Object c, Lisp_Object val)
{
val = Fcopy_sequence (val);
if (CONSP (c))
binding TABLE to a sub char table. */
Lisp_Object
-copy_category_table (table)
- Lisp_Object table;
+copy_category_table (Lisp_Object table)
{
table = copy_char_table (table);
0, 1, 0,
doc: /* Construct a new category table and return it.
It is a copy of the TABLE, which defaults to the standard category table. */)
- (table)
- Lisp_Object table;
+ (Lisp_Object table)
{
if (!NILP (table))
check_category_table (table);
DEFUN ("make-category-table", Fmake_category_table, Smake_category_table,
0, 0, 0,
doc: /* Construct a new and empty category table and return it. */)
- ()
+ (void)
{
Lisp_Object val;
int i;
DEFUN ("set-category-table", Fset_category_table, Sset_category_table, 1, 1, 0,
doc: /* Specify TABLE as the category table for the current buffer.
Return TABLE. */)
- (table)
- Lisp_Object table;
+ (Lisp_Object table)
{
int idx;
table = check_category_table (table);
\f
Lisp_Object
-char_category_set (c)
- int c;
+char_category_set (int c)
{
return CHAR_TABLE_REF (current_buffer->category_table, c);
}
DEFUN ("char-category-set", Fchar_category_set, Schar_category_set, 1, 1, 0,
doc: /* Return the category set of CHAR.
usage: (char-category-set CHAR) */)
- (ch)
- Lisp_Object ch;
+ (Lisp_Object ch)
{
CHECK_NUMBER (ch);
return CATEGORY_SET (XFASTINT (ch));
CATEGORY-SET is a bool-vector, and the categories \"in\" it are those
that are indexes where t occurs in the bool-vector.
The return value is a string containing those same categories. */)
- (category_set)
- Lisp_Object category_set;
+ (Lisp_Object category_set)
{
int i, j;
char str[96];
}
void
-set_category_set (category_set, category, val)
- Lisp_Object category_set, category, val;
+set_category_set (Lisp_Object category_set, Lisp_Object category, Lisp_Object val)
{
do {
int idx = XINT (category) / 8;
lower and upper ends of an inclusive character range to modify.
If optional fourth argument RESET is non-nil,
then delete CATEGORY from the category set instead of adding it. */)
- (character, category, table, reset)
- Lisp_Object character, category, table, reset;
+ (Lisp_Object character, Lisp_Object category, Lisp_Object table, Lisp_Object reset)
{
Lisp_Object set_value; /* Actual value to be set in category sets. */
Lisp_Object category_set;
while (start <= end)
{
+ from = start, to = end;
category_set = char_table_ref_and_range (table, start, &from, &to);
if (CATEGORY_MEMBER (XFASTINT (category), category_set) != NILP (reset))
{
category_set = Fcopy_sequence (category_set);
SET_CATEGORY_SET (category_set, category, set_value);
- if (to > end)
- char_table_set_range (table, start, end, category_set);
- else
- char_table_set_range (table, start, to, category_set);
+ category_set = hash_get_category_set (table, category_set);
+ char_table_set_range (table, start, to, category_set);
}
start = to + 1;
}
directly. */
int
-word_boundary_p (c1, c2)
- int c1, c2;
+word_boundary_p (int c1, int c2)
{
Lisp_Object category_set1, category_set2;
Lisp_Object tail;
int default_result;
- if (CHAR_CHARSET (c1) == CHAR_CHARSET (c2))
+ if (EQ (CHAR_TABLE_REF (Vchar_script_table, c1),
+ CHAR_TABLE_REF (Vchar_script_table, c2)))
{
tail = Vword_separating_categories;
default_result = 0;
Lisp_Object elt = XCAR (tail);
if (CONSP (elt)
- && CATEGORYP (XCAR (elt))
- && CATEGORYP (XCDR (elt))
- && CATEGORY_MEMBER (XFASTINT (XCAR (elt)), category_set1)
- && CATEGORY_MEMBER (XFASTINT (XCDR (elt)), category_set2))
+ && (NILP (XCAR (elt))
+ || (CATEGORYP (XCAR (elt))
+ && CATEGORY_MEMBER (XFASTINT (XCAR (elt)), category_set1)
+ && ! CATEGORY_MEMBER (XFASTINT (XCAR (elt)), category_set2)))
+ && (NILP (XCDR (elt))
+ || (CATEGORYP (XCDR (elt))
+ && ! CATEGORY_MEMBER (XFASTINT (XCDR (elt)), category_set1)
+ && CATEGORY_MEMBER (XFASTINT (XCDR (elt)), category_set2))))
return !default_result;
}
return default_result;
\f
void
-init_category_once ()
+init_category_once (void)
{
/* This has to be done here, before we call Fmake_char_table. */
- Qcategory_table = intern ("category-table");
+ Qcategory_table = intern_c_string ("category-table");
staticpro (&Qcategory_table);
/* Intern this now in case it isn't already done.
Setting this variable twice is harmless.
But don't staticpro it here--that is done in alloc.c. */
- Qchar_table_extra_slots = intern ("char-table-extra-slots");
+ Qchar_table_extra_slots = intern_c_string ("char-table-extra-slots");
/* Now we are ready to set up this property, so we can
create category tables. */
}
void
-syms_of_category ()
+syms_of_category (void)
{
- Qcategoryp = intern ("categoryp");
+ Qcategoryp = intern_c_string ("categoryp");
staticpro (&Qcategoryp);
- Qcategorysetp = intern ("categorysetp");
+ Qcategorysetp = intern_c_string ("categorysetp");
staticpro (&Qcategorysetp);
- Qcategory_table_p = intern ("category-table-p");
+ Qcategory_table_p = intern_c_string ("category-table-p");
staticpro (&Qcategory_table_p);
DEFVAR_LISP ("word-combining-categories", &Vword_combining_categories,
Emacs treats a sequence of word constituent characters as a single
word (i.e. finds no word boundary between them) only if they belong to
-the same charset. But, exceptions are allowed in the following cases.
+the same script. But, exceptions are allowed in the following cases.
-\(1) The case that characters are in different charsets is controlled
+\(1) The case that characters are in different scripts is controlled
by the variable `word-combining-categories'.
-Emacs finds no word boundary between characters of different charsets
+Emacs finds no word boundary between characters of different scripts
if they have categories matching some element of this list.
More precisely, if an element of this list is a cons of category CAT1
and CAT2, and a multibyte character C1 which has CAT1 is followed by
C2 which has CAT2, there's no word boundary between C1 and C2.
-For instance, to tell that ASCII characters and Latin-1 characters can
-form a single word, the element `(?l . ?l)' should be in this list
-because both characters have the category `l' (Latin characters).
+For instance, to tell that Han characters followed by Hiragana
+characters can form a single word, the element `(?C . ?H)' should be
+in this list.
-\(2) The case that character are in the same charset is controlled by
+\(2) The case that character are in the same script is controlled by
the variable `word-separating-categories'.
-Emacs find a word boundary between characters of the same charset
+Emacs finds a word boundary between characters of the same script
if they have categories matching some element of this list.
More precisely, if an element of this list is a cons of category CAT1
-and CAT2, and a multibyte character C1 which has CAT1 is followed by
-C2 which has CAT2, there's a word boundary between C1 and C2.
+and CAT2, and a multibyte character C1 which has CAT1 but not CAT2 is
+followed by C2 which has CAT2 but not CAT1, there's a word boundary
+between C1 and C2.
-For instance, to tell that there's a word boundary between Japanese
-Hiragana and Japanese Kanji (both are in the same charset), the
-element `(?H . ?C) should be in this list. */);
+For instance, to tell that there's a word boundary between Hiragana
+and Katakana (both are in the same script `kana'),
+the element `(?H . ?K) should be in this list. */);
Vword_combining_categories = Qnil;