X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/0b6694a52d053bb9458da1eb5937aafcbdaece9a..e6feb692fb27773fd062a63e2b30aef4db5d4bac:/src/category.c diff --git a/src/category.c b/src/category.c index d308b5a77c..929cd7ea1c 100644 --- a/src/category.c +++ b/src/category.c @@ -1,6 +1,8 @@ /* 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. @@ -16,8 +18,8 @@ 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. */ +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 @@ -67,14 +69,14 @@ those categories. */) 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); } @@ -87,11 +89,11 @@ those categories. */) 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; { @@ -107,7 +109,9 @@ The category is defined only in category table TABLE, which defaults to } 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; { @@ -119,10 +123,9 @@ DEFUN ("category-docstring", Fcategory_docstring, Scategory_docstring, 1, 2, 0, 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; @@ -167,7 +170,7 @@ check_category_table (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. @@ -267,7 +270,8 @@ DEFUN ("make-category-table", Fmake_category_table, Smake_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; { @@ -294,7 +298,7 @@ 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. +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; @@ -377,7 +381,7 @@ then delete CATEGORY from the category set instead of adding it. */) 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) @@ -471,99 +475,6 @@ then delete CATEGORY from the category set instead of adding it. */) return Qnil; } -/* 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; -} - /* 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 @@ -627,7 +538,7 @@ init_category_once () 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)); @@ -699,7 +610,9 @@ See the documentation of the variable `word-combining-categories'. */); 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) */