[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/src/category.c [emacs-unicode-2]
From: |
Kenichi Handa |
Subject: |
[Emacs-diffs] Changes to emacs/src/category.c [emacs-unicode-2] |
Date: |
Mon, 08 Sep 2003 08:48:31 -0400 |
Index: emacs/src/category.c
diff -c /dev/null emacs/src/category.c:1.32.6.1
*** /dev/null Mon Sep 8 08:48:31 2003
--- emacs/src/category.c Mon Sep 8 08:48:09 2003
***************
*** 0 ****
--- 1,521 ----
+ /* GNU Emacs routines to deal with category tables.
+ Copyright (C) 1995, 1997 Electrotechnical Laboratory, JAPAN.
+ Licensed to the Free Software Foundation.
+ Copyright (C) 2003
+ National Institute of Advanced Industrial Science and Technology (AIST)
+ Registration Number H13PRO009
+
+ This file is part of GNU Emacs.
+
+ GNU Emacs is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ GNU Emacs is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with GNU Emacs; see the file COPYING. If not, write to
+ the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+ Boston, MA 02111-1307, USA. */
+
+
+ /* Here we handle three objects: category, category set, and category
+ table. Read comments in the file category.h to understand them. */
+
+ #include <config.h>
+ #include <ctype.h>
+ #include "lisp.h"
+ #include "buffer.h"
+ #include "character.h"
+ #include "charset.h"
+ #include "category.h"
+ #include "keymap.h"
+
+ /* 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
+ into the struct re_pattern_buffer, the version number of the
+ category table (of the current buffer) at that moment is also
+ embedded in the structure.
+
+ 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;
+
+
+ /* Category set staff. */
+
+ 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 val;
+ int len;
+
+ CHECK_STRING (categories);
+ val = MAKE_CATEGORY_SET;
+
+ if (STRING_MULTIBYTE (categories))
+ error ("Multibyte string in make-category-set");
+
+ len = SCHARS (categories);
+ while (--len >= 0)
+ {
+ Lisp_Object category;
+
+ XSETFASTINT (category, SREF (categories, len));
+ CHECK_CATEGORY (category);
+ SET_CATEGORY_SET (val, category, Qt);
+ }
+ return val;
+ }
+
+
+ /* Category staff. */
+
+ Lisp_Object check_category_table ();
+
+ DEFUN ("define-category", Fdefine_category, Sdefine_category, 2, 3, 0,
+ doc: /* Define CHAR as a category which is described by DOCSTRING.
+ CHAR should be an ASCII printing character in the range ` ' to `~'.
+ DOCSTRING is a documentation string of the category.
+ 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;
+ {
+ 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));
+ CATEGORY_DOCSTRING (table, XFASTINT (category)) = docstring;
+
+ return Qnil;
+ }
+
+ DEFUN ("category-docstring", Fcategory_docstring, Scategory_docstring, 1, 2,
0,
+ doc: /* Return the documentation string of CATEGORY, as defined in
CATEGORY-TABLE. */)
+ (category, table)
+ Lisp_Object category, table;
+ {
+ CHECK_CATEGORY (category);
+ table = check_category_table (table);
+
+ return CATEGORY_DOCSTRING (table, XFASTINT (category));
+ }
+
+ DEFUN ("get-unused-category", Fget_unused_category, Sget_unused_category,
+ 0, 1, 0,
+ doc: /* Return a category which is not yet defined in CATEGORY-TABLE.
+ If no category remains available, return nil.
+ The optional argument CATEGORY-TABLE
+ specifies which category table to modify;
+ it defaults to the current buffer's category table. */)
+ (table)
+ Lisp_Object table;
+ {
+ int i;
+
+ table = check_category_table (table);
+
+ for (i = ' '; i <= '~'; i++)
+ if (NILP (CATEGORY_DOCSTRING (table, i)))
+ return make_number (i);
+
+ return Qnil;
+ }
+
+
+ /* Category-table staff. */
+
+ 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;
+ {
+ if (CHAR_TABLE_P (arg)
+ && EQ (XCHAR_TABLE (arg)->purpose, Qcategory_table))
+ return Qt;
+ return Qnil;
+ }
+
+ /* If TABLE is nil, return the current category table. If TABLE is
+ not nil, check the validity of TABLE as a category table. If
+ valid, return TABLE itself, but if not valid, signal an error of
+ wrong-type-argument. */
+
+ Lisp_Object
+ check_category_table (table)
+ Lisp_Object table;
+ {
+ register Lisp_Object tem;
+ if (NILP (table))
+ return current_buffer->category_table;
+ while (tem = Fcategory_table_p (table), NILP (tem))
+ table = wrong_type_argument (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. */)
+ ()
+ {
+ return 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. */)
+ ()
+ {
+ return Vstandard_category_table;
+ }
+
+
+ static void
+ copy_category_entry (table, c, val)
+ Lisp_Object table, c, val;
+ {
+ val = Fcopy_sequence (val);
+ if (CONSP (c))
+ char_table_set_range (table, XINT (XCAR (c)), XINT (XCDR (c)), val);
+ else
+ char_table_set (table, XINT (c), val);
+ }
+
+ /* Return a copy of category table TABLE. We can't simply use the
+ function copy-sequence because no contents should be shared between
+ 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;
+ {
+ 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]);
+ map_char_table (copy_category_entry, Qnil, table, table);
+
+ return table;
+ }
+
+ DEFUN ("copy-category-table", Fcopy_category_table, Scopy_category_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;
+ {
+ if (!NILP (table))
+ check_category_table (table);
+ else
+ table = Vstandard_category_table;
+
+ return copy_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. */)
+ ()
+ {
+ Lisp_Object val;
+ int i;
+
+ val = Fmake_char_table (Qcategory_table, Qnil);
+ XCHAR_TABLE (val)->defalt = MAKE_CATEGORY_SET;
+ for (i = 0; i < (1 << CHARTAB_SIZE_BITS_0); i++)
+ XCHAR_TABLE (val)->contents[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.
*/)
+ (table)
+ Lisp_Object table;
+ {
+ int idx;
+ table = check_category_table (table);
+ current_buffer->category_table = 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);
+ return table;
+ }
+
+
+ Lisp_Object
+ char_category_set (c)
+ 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. */)
+ (ch)
+ Lisp_Object ch;
+ {
+ CHECK_NUMBER (ch);
+ return CATEGORY_SET (XFASTINT (ch));
+ }
+
+ DEFUN ("category-set-mnemonics", Fcategory_set_mnemonics,
+ Scategory_set_mnemonics, 1, 1, 0,
+ doc: /* Return a string containing mnemonics of the categories in
CATEGORY-SET.
+ CATEGORY-SET is a bool-vector, and the categories \"in\" it are those
+ that are indexes where t occurs the bool-vector.
+ The return value is a string containing those same categories. */)
+ (category_set)
+ Lisp_Object category_set;
+ {
+ int i, j;
+ char str[96];
+
+ CHECK_CATEGORY_SET (category_set);
+
+ j = 0;
+ for (i = 32; i < 127; i++)
+ if (CATEGORY_MEMBER (i, category_set))
+ str[j++] = i;
+ str[j] = '\0';
+
+ 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.
+ The category is changed only for table TABLE, which defaults to
+ the current buffer's category table.
+ CHARACTER can be either a single character or a cons representing the
+ 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 set_value; /* Actual value to be set in category sets. */
+ Lisp_Object category_set;
+ int start, end;
+ int from, to;
+
+ if (INTEGERP (character))
+ {
+ CHECK_CHARACTER (character);
+ start = end = XFASTINT (character);
+ }
+ else
+ {
+ CHECK_CONS (character);
+ CHECK_CHARACTER_CAR (character);
+ CHECK_CHARACTER_CDR (character);
+ start = XFASTINT (XCAR (character));
+ end = XFASTINT (XCDR (character));
+ }
+
+ CHECK_CATEGORY (category);
+ table = check_category_table (table);
+
+ if (NILP (CATEGORY_DOCSTRING (table, XFASTINT (category))))
+ error ("Undefined category: %c", XFASTINT (category));
+
+ set_value = NILP (reset) ? Qt : Qnil;
+
+ while (start <= 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);
+ }
+ start = to + 1;
+ }
+
+ return Qnil;
+ }
+
+ /* 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.
+ Use the macro WORD_BOUNDARY_P instead of calling this function
+ directly. */
+
+ int
+ word_boundary_p (c1, c2)
+ int c1, c2;
+ {
+ Lisp_Object category_set1, category_set2;
+ Lisp_Object tail;
+ int default_result;
+
+ if (CHAR_CHARSET (c1) == CHAR_CHARSET (c2))
+ {
+ tail = Vword_separating_categories;
+ default_result = 0;
+ }
+ else
+ {
+ tail = Vword_combining_categories;
+ default_result = 1;
+ }
+
+ category_set1 = CATEGORY_SET (c1);
+ if (NILP (category_set1))
+ return default_result;
+ category_set2 = CATEGORY_SET (c2);
+ if (NILP (category_set2))
+ return default_result;
+
+ for (; CONSP (tail); tail = XCDR (tail))
+ {
+ 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))
+ return !default_result;
+ }
+ return default_result;
+ }
+
+
+ void
+ init_category_once ()
+ {
+ /* This has to be done here, before we call Fmake_char_table. */
+ Qcategory_table = intern ("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");
+
+ /* Now we are ready to set up this property, so we can
+ create category tables. */
+ 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;
+ Fset_char_table_extra_slot (Vstandard_category_table, make_number (0),
+ Fmake_vector (make_number (95), Qnil));
+ }
+
+ void
+ syms_of_category ()
+ {
+ Qcategoryp = intern ("categoryp");
+ staticpro (&Qcategoryp);
+ Qcategorysetp = intern ("categorysetp");
+ staticpro (&Qcategorysetp);
+ Qcategory_table_p = intern ("category-table-p");
+ staticpro (&Qcategory_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
+ word (i.e. finds no word boundary between them) iff they belongs to
+ the same charset. But, exceptions are allowed in the following cases.
+
+ \(1) The case that characters are in different charsets is controlled
+ by the variable `word-combining-categories'.
+
+ Emacs finds no word boundary between characters of different charsets
+ 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).
+
+ \(2) The case that character are in the same charset is controlled by
+ the variable `word-separating-categories'.
+
+ Emacs find a word boundary between characters of the same charset
+ 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.
+
+ 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. */);
+
+ Vword_combining_categories = Qnil;
+
+ 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'. */);
+
+ Vword_separating_categories = Qnil;
+
+ defsubr (&Smake_category_set);
+ defsubr (&Sdefine_category);
+ defsubr (&Scategory_docstring);
+ defsubr (&Sget_unused_category);
+ defsubr (&Scategory_table_p);
+ defsubr (&Scategory_table);
+ defsubr (&Sstandard_category_table);
+ defsubr (&Scopy_category_table);
+ defsubr (&Smake_category_table);
+ defsubr (&Sset_category_table);
+ defsubr (&Schar_category_set);
+ defsubr (&Scategory_set_mnemonics);
+ defsubr (&Smodify_category_entry);
+
+ category_table_version = 0;
+ }
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] Changes to emacs/src/category.c [emacs-unicode-2],
Kenichi Handa <=