/* 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.
\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.
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;
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;
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);
\f
Lisp_Object
-char_category_set (c)
- int c;
+char_category_set (int c)
{
return CHAR_TABLE_REF (current_buffer->category_table, c);
}
}
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;
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;
if (CONSP (elt)
&& (NILP (XCAR (elt))
|| (CATEGORYP (XCAR (elt))
- && CATEGORY_MEMBER (XFASTINT (XCAR (elt)), category_set1)))
+ && 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;
}
\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,
\(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 script
+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 Hiragana
and Katakana (both are in the same script `kana'),
HCoop / bpt / emacs.git / blobdiff