/* GNU Emacs routines to deal with category tables.
- Copyright (C) 1998, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012
- Free Software Foundation, Inc.
- Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007, 2008, 2009, 2010, 2011
- National Institute of Advanced Industrial Science and Technology (AIST)
- Registration Number H14PRO021
- Copyright (C) 2003
- National Institute of Advanced Industrial Science and Technology (AIST)
- Registration Number H13PRO009
+
+Copyright (C) 1998, 2001-2015 Free Software Foundation, Inc.
+Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+ 2005, 2006, 2007, 2008, 2009, 2010, 2011
+ National Institute of Advanced Industrial Science and Technology (AIST)
+ Registration Number H14PRO021
+Copyright (C) 2003
+ National Institute of Advanced Industrial Science and Technology (AIST)
+ Registration Number H13PRO009
This file is part of GNU Emacs.
table. Read comments in the file category.h to understand them. */
#include <config.h>
-#include <ctype.h>
-#include <setjmp.h>
+
#include "lisp.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "charset.h"
#include "category.h"
#include "keymap.h"
+/* This setter is used only in this file, so it can be private. */
+static void
+bset_category_table (struct buffer *b, Lisp_Object val)
+{
+ b->INTERNAL_FIELD (category_table) = val;
+}
+
/* The version number of the latest category table. Each category
table has a unique version number. It is assigned a new number
also when it is modified. When a regular expression is compiled
For the moment, we are not using this feature. */
static int category_table_version;
-
-Lisp_Object Qcategory_table, Qcategoryp, Qcategorysetp, Qcategory_table_p;
-
-/* Variables to determine word boundary. */
-Lisp_Object Vword_combining_categories, Vword_separating_categories;
-
-/* Temporary internal variable used in macro CHAR_HAS_CATEGORY. */
-Lisp_Object _temp_category_set;
-
\f
/* 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;
+hash_get_category_set (Lisp_Object table, Lisp_Object category_set)
{
- Lisp_Object val;
struct Lisp_Hash_Table *h;
- int i;
- unsigned hash;
+ ptrdiff_t i;
+ EMACS_UINT 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);
+ set_char_table_extras
+ (table, 1,
+ make_hash_table (hashtest_equal, make_number (DEFAULT_HASH_SIZE),
+ make_float (DEFAULT_REHASH_SIZE),
+ make_float (DEFAULT_REHASH_THRESHOLD),
+ Qnil));
h = XHASH_TABLE (XCHAR_TABLE (table)->extras[1]);
i = hash_lookup (h, category_set, &hash);
if (i >= 0)
return category_set;
}
+/* Make CATEGORY_SET include (if VAL) or exclude (if !VAL) CATEGORY. */
+
+static void
+set_category_set (Lisp_Object category_set, EMACS_INT category, bool val)
+{
+ bool_vector_set (category_set, category, val);
+}
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;
+ ptrdiff_t len;
CHECK_STRING (categories);
val = MAKE_CATEGORY_SET;
len = SCHARS (categories);
while (--len >= 0)
{
- Lisp_Object category;
+ unsigned char cat = SREF (categories, len);
+ Lisp_Object category = make_number (cat);
- XSETFASTINT (category, SREF (categories, len));
CHECK_CATEGORY (category);
- SET_CATEGORY_SET (val, category, Qt);
+ set_category_set (val, cat, 1);
}
return val;
}
\f
/* Category staff. */
-Lisp_Object check_category_table ();
+static 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.
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);
table = check_category_table (table);
if (!NILP (CATEGORY_DOCSTRING (table, XFASTINT (category))))
- error ("Category `%c' is already defined", XFASTINT (category));
+ error ("Category `%c' is already defined", (int) XFASTINT (category));
if (!NILP (Vpurify_flag))
docstring = Fpurecopy (docstring);
- CATEGORY_DOCSTRING (table, XFASTINT (category)) = docstring;
+ SET_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))
valid, return TABLE itself, but if not valid, signal an error of
wrong-type-argument. */
-Lisp_Object
-check_category_table (table)
- Lisp_Object table;
+static Lisp_Object
+check_category_table (Lisp_Object table)
{
if (NILP (table))
- return current_buffer->category_table;
+ return BVAR (current_buffer, category_table);
CHECK_TYPE (!NILP (Fcategory_table_p (table)), Qcategory_table_p, table);
return 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;
+ return BVAR (current_buffer, category_table);
}
DEFUN ("standard-category-table", Fstandard_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))
the original and the copy. This function is called recursively by
binding TABLE to a sub char table. */
-Lisp_Object
-copy_category_table (table)
- Lisp_Object table;
+static Lisp_Object
+copy_category_table (Lisp_Object table)
{
table = copy_char_table (table);
if (! NILP (XCHAR_TABLE (table)->defalt))
- XCHAR_TABLE (table)->defalt
- = Fcopy_sequence (XCHAR_TABLE (table)->defalt);
- XCHAR_TABLE (table)->extras[0]
- = Fcopy_sequence (XCHAR_TABLE (table)->extras[0]);
+ set_char_table_defalt (table,
+ Fcopy_sequence (XCHAR_TABLE (table)->defalt));
+ set_char_table_extras
+ (table, 0, Fcopy_sequence (XCHAR_TABLE (table)->extras[0]));
map_char_table (copy_category_entry, Qnil, table, table);
return 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;
val = Fmake_char_table (Qcategory_table, Qnil);
- XCHAR_TABLE (val)->defalt = MAKE_CATEGORY_SET;
+ set_char_table_defalt (val, MAKE_CATEGORY_SET);
for (i = 0; i < (1 << CHARTAB_SIZE_BITS_0); i++)
- XCHAR_TABLE (val)->contents[i] = MAKE_CATEGORY_SET;
+ set_char_table_contents (val, i, MAKE_CATEGORY_SET);
Fset_char_table_extra_slot (val, make_number (0),
Fmake_vector (make_number (95), Qnil));
return val;
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);
- current_buffer->category_table = table;
+ bset_category_table (current_buffer, table);
/* Indicate that this buffer now has a specified category table. */
idx = PER_BUFFER_VAR_IDX (category_table);
SET_PER_BUFFER_VALUE_P (current_buffer, idx, 1);
\f
Lisp_Object
-char_category_set (c)
- int c;
+char_category_set (int c)
{
- return CHAR_TABLE_REF (current_buffer->category_table, c);
+ return CHAR_TABLE_REF (BVAR (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);
+ CHECK_CHARACTER (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];
return build_string (str);
}
-void
-set_category_set (category_set, category, val)
- Lisp_Object category_set, category, val;
-{
- do {
- int idx = XINT (category) / 8;
- unsigned char bits = 1 << (XINT (category) % 8);
-
- if (NILP (val))
- XCATEGORY_SET (category_set)->data[idx] &= ~bits;
- else
- XCATEGORY_SET (category_set)->data[idx] |= bits;
- } while (0);
-}
-
DEFUN ("modify-category-entry", Fmodify_category_entry,
Smodify_category_entry, 2, 4, 0,
doc: /* Modify the category set of CHARACTER by adding CATEGORY to it.
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. */
+ bool set_value; /* Actual value to be set in category sets. */
Lisp_Object category_set;
int start, end;
int from, to;
table = check_category_table (table);
if (NILP (CATEGORY_DOCSTRING (table, XFASTINT (category))))
- error ("Undefined category: %c", XFASTINT (category));
+ error ("Undefined category: %c", (int) XFASTINT (category));
- set_value = NILP (reset) ? Qt : Qnil;
+ set_value = NILP (reset);
while (start <= end)
{
if (CATEGORY_MEMBER (XFASTINT (category), category_set) != NILP (reset))
{
category_set = Fcopy_sequence (category_set);
- SET_CATEGORY_SET (category_set, category, set_value);
+ set_category_set (category_set, XFASTINT (category), set_value);
category_set = hash_get_category_set (table, category_set);
char_table_set_range (table, start, to, category_set);
}
return Qnil;
}
\f
-/* Return 1 if there is a word boundary between two word-constituent
- characters C1 and C2 if they appear in this order, else return 0.
+/* Return true if there is a word boundary between two word-constituent
+ characters C1 and C2 if they appear in this order.
Use the macro WORD_BOUNDARY_P instead of calling this function
directly. */
-int
-word_boundary_p (c1, c2)
- int c1, c2;
+bool
+word_boundary_p (int c1, int c2)
{
Lisp_Object category_set1, category_set2;
Lisp_Object tail;
- int default_result;
+ bool default_result;
if (EQ (CHAR_TABLE_REF (Vchar_script_table, c1),
CHAR_TABLE_REF (Vchar_script_table, c2)))
\f
void
-init_category_once ()
+init_category_once (void)
{
/* This has to be done here, before we call Fmake_char_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_c_string ("char-table-extra-slots");
-
- /* Now we are ready to set up this property, so we can
- create category tables. */
+ DEFSYM (Qcategory_table, "category-table");
Fput (Qcategory_table, Qchar_table_extra_slots, make_number (2));
Vstandard_category_table = Fmake_char_table (Qcategory_table, Qnil);
/* Set a category set which contains nothing to the default. */
- XCHAR_TABLE (Vstandard_category_table)->defalt = MAKE_CATEGORY_SET;
+ set_char_table_defalt (Vstandard_category_table, MAKE_CATEGORY_SET);
Fset_char_table_extra_slot (Vstandard_category_table, make_number (0),
Fmake_vector (make_number (95), Qnil));
}
void
-syms_of_category ()
+syms_of_category (void)
{
- Qcategoryp = intern_c_string ("categoryp");
- staticpro (&Qcategoryp);
- Qcategorysetp = intern_c_string ("categorysetp");
- staticpro (&Qcategorysetp);
- Qcategory_table_p = intern_c_string ("category-table-p");
- staticpro (&Qcategory_table_p);
-
- DEFVAR_LISP ("word-combining-categories", &Vword_combining_categories,
+ DEFSYM (Qcategoryp, "categoryp");
+ DEFSYM (Qcategorysetp, "categorysetp");
+ DEFSYM (Qcategory_table_p, "category-table-p");
+
+ DEFVAR_LISP ("word-combining-categories", Vword_combining_categories,
doc: /* List of pair (cons) of categories to determine word boundary.
Emacs treats a sequence of word constituent characters as a single
Vword_combining_categories = Qnil;
- DEFVAR_LISP ("word-separating-categories", &Vword_separating_categories,
+ DEFVAR_LISP ("word-separating-categories", Vword_separating_categories,
doc: /* List of pair (cons) of categories to determine word boundary.
See the documentation of the variable `word-combining-categories'. */);
category_table_version = 0;
}
-
-/* arch-tag: 74ebf524-121b-4d9c-bd68-07f8d708b211
- (do not change this comment) */