X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/a971635315e259c076de020b3676c04d1dcc415e..ff5dec5cd103f6a9b030d295b014f0ff81025def:/src/category.c
diff --git a/src/category.c b/src/category.c
index fca39ecb4e..b56d62b6b8 100644
--- a/src/category.c
+++ b/src/category.c
@@ -1,8 +1,8 @@
/* 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
@@ -30,6 +30,7 @@ along with GNU Emacs. If not, see . */
#include
#include
+#include
#include "lisp.h"
#include "buffer.h"
#include "character.h"
@@ -58,6 +59,32 @@ Lisp_Object _temp_category_set;
/* Category set staff. */
+static Lisp_Object hash_get_category_set P_ ((Lisp_Object, Lisp_Object));
+
+static Lisp_Object
+hash_get_category_set (table, category_set)
+ Lisp_Object table, 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.
@@ -95,7 +122,9 @@ Lisp_Object check_category_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)
@@ -107,6 +136,8 @@ the current buffer's category table. */)
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;
@@ -368,15 +399,14 @@ then delete CATEGORY from the category set instead of adding it. */)
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;
}
@@ -397,7 +427,8 @@ word_boundary_p (c1, c2)
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;
@@ -420,10 +451,14 @@ word_boundary_p (c1, c2)
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;
@@ -434,13 +469,13 @@ void
init_category_once ()
{
/* 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. */
@@ -456,11 +491,11 @@ init_category_once ()
void
syms_of_category ()
{
- 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,
@@ -468,35 +503,36 @@ syms_of_category ()
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;