/* GNU Emacs routines to deal with category tables.
- Copyright (C) 1995, 1997 Electrotechnical Laboratory, JAPAN.
- Licensed to the Free Software Foundation.
+ Copyright (C) 1998, 2001, 2004, 2005, 2006 Free Software Foundation, Inc.
+ Copyright (C) 1995, 1997, 1998, 1999
+ National Institute of Advanced Industrial Science and Technology (AIST)
+ Registration Number H14PRO021
This file is part of GNU Emacs.
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. */
+the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
/* Here we handle three objects: category, category set, and category
val = MAKE_CATEGORY_SET;
if (STRING_MULTIBYTE (categories))
- error ("Multibyte string in make-category-set");
+ error ("Multibyte string in `make-category-set'");
- len = XSTRING (categories)->size;
+ len = SCHARS (categories);
while (--len >= 0)
{
Lisp_Object category;
- XSETFASTINT (category, XSTRING (categories)->data[len]);
+ XSETFASTINT (category, SREF (categories, len));
CHECK_CATEGORY (category);
SET_CATEGORY_SET (val, category, Qt);
}
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.
+ 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.
The category is defined only in category table TABLE, which defaults to
- the current buffer's category table. */)
+the current buffer's category table. */)
(category, docstring, table)
Lisp_Object category, docstring, table;
{
}
DEFUN ("category-docstring", Fcategory_docstring, Scategory_docstring, 1, 2, 0,
- doc: /* Return the documentation string of CATEGORY, as defined in CATEGORY-TABLE. */)
+ 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;
{
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.
+ doc: /* Return a category which is not yet defined in TABLE.
If no category remains available, return nil.
-The optional argument CATEGORY-TABLE
-specifies which category table to modify;
+The optional argument TABLE specifies which category table to modify;
it defaults to the current buffer's category table. */)
(table)
Lisp_Object 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.
}
DEFUN ("set-category-table", Fset_category_table, Sset_category_table, 1, 1, 0,
- doc: /* Specify TABLE as the category table for the current buffer. */)
+ doc: /* Specify TABLE as the category table for the current buffer.
+Return TABLE. */)
(table)
Lisp_Object table;
{
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.
+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;
if (NILP (CATEGORY_DOCSTRING (table, XFASTINT (category))))
error ("Undefined category: %c", XFASTINT (category));
-
+
set_value = NILP (reset) ? Qt : Qnil;
if (c < CHAR_TABLE_SINGLE_BYTE_SLOTS)
return Qnil;
}
\f
-/* Dump category table to buffer in human-readable format */
-
-static void
-describe_category (value)
- Lisp_Object value;
-{
- Lisp_Object mnemonics;
-
- Findent_to (make_number (16), make_number (1));
-
- if (NILP (value))
- {
- insert_string ("default\n");
- return;
- }
-
- if (CHAR_TABLE_P (value))
- {
- insert_string ("deeper char-table ...\n");
- return;
- }
-
- if (!CATEGORY_SET_P (value))
- {
- insert_string ("invalid\n");
- return;
- }
-
- mnemonics = Fcategory_set_mnemonics (value);
- insert_from_string (mnemonics, 0, 0, XSTRING (mnemonics)->size,
- STRING_BYTES (XSTRING (mnemonics)), 0);
- insert_string ("\n");
- return;
-}
-
-static Lisp_Object
-describe_category_1 (vector)
- Lisp_Object vector;
-{
- struct buffer *old = current_buffer;
- set_buffer_internal (XBUFFER (Vstandard_output));
- describe_vector (vector, Qnil, describe_category, 0, Qnil, Qnil,
- (int *)0, 0);
- {
- int i;
- Lisp_Object docs = XCHAR_TABLE (vector)->extras[0];
- Lisp_Object elt;
-
- if (!VECTORP (docs) || XVECTOR (docs)->size != 95)
- {
- insert_string ("Invalid first extra slot in this char table\n");
- return Qnil;
- }
-
- insert_string ("Meanings of mnemonice characters are:\n");
- for (i = 0; i < 95; i++)
- {
- elt = XVECTOR (docs)->contents[i];
- if (NILP (elt))
- continue;
-
- insert_char (i + 32);
- insert (": ", 2);
- insert_from_string (elt, 0, 0, XSTRING (elt)->size,
- STRING_BYTES (XSTRING (elt)), 0);
- insert ("\n", 1);
- }
- }
-
- while (! NILP (XCHAR_TABLE (vector)->parent))
- {
- vector = XCHAR_TABLE (vector)->parent;
- insert_string ("\nThe parent category table is:");
- describe_vector (vector, Qnil, describe_category, 0, Qnil, Qnil,
- (int *) 0, 0);
- }
-
- call0 (intern ("help-mode"));
- set_buffer_internal (old);
- return Qnil;
-}
-
-DEFUN ("describe-categories", Fdescribe_categories, Sdescribe_categories, 0, 0, "",
- doc: /* Describe the category specifications in the current category table.
-The descriptions are inserted in a buffer, which is then displayed. */)
- ()
-{
- internal_with_output_to_temp_buffer
- ("*Help*", describe_category_1, current_buffer->category_table);
-
- 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.
Use the macro WORD_BOUNDARY_P instead of calling this function
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. */
+ /* 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));
defsubr (&Schar_category_set);
defsubr (&Scategory_set_mnemonics);
defsubr (&Smodify_category_entry);
- defsubr (&Sdescribe_categories);
category_table_version = 0;
}
+
+/* arch-tag: 74ebf524-121b-4d9c-bd68-07f8d708b211
+ (do not change this comment) */