(echo-area-clear-hook): Undo Oct 29 change.
[bpt/emacs.git] / src / category.c
index 8e60972..f99a300 100644 (file)
@@ -29,6 +29,7 @@ Boston, MA 02111-1307, USA.  */
 #include "buffer.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
@@ -52,15 +53,17 @@ Lisp_Object _temp_category_set;
 /* Category set staff.  */
 
 DEFUN ("make-category-set", Fmake_category_set, Smake_category_set, 1, 1, 0,
-  "Return a newly created category-set which contains CATEGORIES.\n\
-CATEGORIES is a string of category mnemonics.")
-  (categories)
+       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, 0);
+  CHECK_STRING (categories);
   val = MAKE_CATEGORY_SET;
 
   if (STRING_MULTIBYTE (categories))
@@ -72,7 +75,7 @@ CATEGORIES is a string of category mnemonics.")
       Lisp_Object category;
 
       XSETFASTINT (category, XSTRING (categories)->data[len]);
-      CHECK_CATEGORY (category, 0);
+      CHECK_CATEGORY (category);
       SET_CATEGORY_SET (val, category, Qt);
     }
   return val;
@@ -84,16 +87,16 @@ CATEGORIES is a string of category mnemonics.")
 Lisp_Object check_category_table ();
 
 DEFUN ("define-category", Fdefine_category, Sdefine_category, 2, 3, 0,
-  "Define CHAR as a category which is described by DOCSTRING.\n\
-CHAR should be a visible letter of ` ' thru `~'.\n\
-DOCSTRING is a documentation string of the category.\n\
-The category is defined only in category table TABLE, which defaults to\n\
- the current buffer's category table.")
-  (category, docstring, table)
+       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, 0);
-  CHECK_STRING (docstring, 1);
+  CHECK_CATEGORY (category);
+  CHECK_STRING (docstring);
   table = check_category_table (table);
 
   if (!NILP (CATEGORY_DOCSTRING (table, XFASTINT (category))))
@@ -104,15 +107,11 @@ The category is defined only in category table TABLE, which defaults to\n\
 }
 
 DEFUN ("category-docstring", Fcategory_docstring, Scategory_docstring, 1, 2, 0,
-  "Return a documentation string of CATEGORY.\n\
-Optional second arg specifies CATEGORY-TABLE,\n\
- which defaults to the current buffer's category table.")
-  (category, table)
+       doc: /* Return the documentation string of CATEGORY, as defined in CATEGORY-TABLE.  */)
+     (category, table)
      Lisp_Object category, table;
 {
-  Lisp_Object doc;
-
-  CHECK_CATEGORY (category, 0);
+  CHECK_CATEGORY (category);
   table = check_category_table (table);
 
   return CATEGORY_DOCSTRING (table, XFASTINT (category));
@@ -120,15 +119,14 @@ Optional second arg specifies CATEGORY-TABLE,\n\
 
 DEFUN ("get-unused-category", Fget_unused_category, Sget_unused_category,
        0, 1, 0,
-  "Return a category which is not yet defined.\n\
-If total number of categories has reached the limit (95), return nil.\n\
-Optional argument specifies CATEGORY-TABLE,\n\
- which defaults to the current buffer's category table.")
-  (table)
+       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;
-  Lisp_Object docstring_vector;
 
   table = check_category_table (table);
 
@@ -143,8 +141,8 @@ Optional argument specifies CATEGORY-TABLE,\n\
 /* Category-table staff.  */
 
 DEFUN ("category-table-p", Fcategory_table_p, Scategory_table_p, 1, 1, 0,
-  "Return t if ARG is a category table.")
-  (arg)
+       doc: /* Return t if ARG is a category table.  */)
+     (arg)
      Lisp_Object arg;
 {
   if (CHAR_TABLE_P (arg)
@@ -171,18 +169,18 @@ check_category_table (table)
 }   
 
 DEFUN ("category-table", Fcategory_table, Scategory_table, 0, 0, 0,
-  "Return the current category table.\n\
-This is the one specified by the current buffer.")
-  ()
+       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,
-  "Return the standard category table.\n\
-This is the one used for new buffers.")
-  ()
+       doc: /* Return the standard category table.
+This is the one used for new buffers.  */)
+     ()
 {
   return Vstandard_category_table;
 }
@@ -240,9 +238,9 @@ copy_category_table (table)
 
 DEFUN ("copy-category-table", Fcopy_category_table, Scopy_category_table,
        0, 1, 0,
-  "Construct a new category table and return it.\n\
-It is a copy of the TABLE, which defaults to the standard category table.")
-  (table)
+       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))
@@ -253,44 +251,57 @@ It is a copy of the TABLE, which defaults to the standard 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;
+
+  val = Fmake_char_table (Qcategory_table, Qnil);
+  XCHAR_TABLE (val)->defalt = 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,
-  "Select a new category table for the current buffer.\n\
-One argument, a category table.")
-  (table)
+       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.  */
-  current_buffer->local_var_flags
-    |= XFASTINT (buffer_local_flags.category_table);
+  idx = PER_BUFFER_VAR_IDX (category_table);
+  SET_PER_BUFFER_VALUE_P (current_buffer, idx, 1);
   return table;
 }
 
 \f
 DEFUN ("char-category-set", Fchar_category_set, Schar_category_set, 1, 1, 0,
-  "Return a category set of CHAR.")
-  (ch)
+       doc: /* Return the category set of CHAR.  */)
+     (ch)
      Lisp_Object ch;
 {
-  Lisp_Object val;
-  int charset;
-  unsigned char c1, c2;
-
-  CHECK_NUMBER (ch, 0);
+  CHECK_NUMBER (ch);
   return CATEGORY_SET (XFASTINT (ch));
 }
 
 DEFUN ("category-set-mnemonics", Fcategory_set_mnemonics,
        Scategory_set_mnemonics, 1, 1, 0,
-  "Return a string of mnemonics of all categories in CATEGORY-SET.")
-  (category_set)
+       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, 0);
+  CHECK_CATEGORY_SET (category_set);
 
   j = 0;
   for (i = 32; i < 127; i++)
@@ -312,12 +323,11 @@ modify_lower_category_set (table, category, set_value)
   Lisp_Object val;
   int i;
 
-  if (NILP (XCHAR_TABLE (table)->defalt))
-    {
-      val = MAKE_CATEGORY_SET;
-      SET_CATEGORY_SET (val, category, set_value);
-      XCHAR_TABLE (table)->defalt = val;
-    }
+  val = XCHAR_TABLE (table)->defalt;
+  if (!CATEGORY_SET_P (val))
+    val = MAKE_CATEGORY_SET;
+  SET_CATEGORY_SET (val, category, set_value);
+  XCHAR_TABLE (table)->defalt = val;
 
   for (i = 32; i < SUB_CHAR_TABLE_ORDINARY_SLOTS; i++)
     {
@@ -347,21 +357,21 @@ set_category_set (category_set, category, val)
 
 DEFUN ("modify-category-entry", Fmodify_category_entry,
        Smodify_category_entry, 2, 4, 0,
-  "Modify the category set of CHAR by adding CATEGORY to it.\n\
-The category is changed only for table TABLE, which defaults to\n\
- the current buffer's category table.\n\
-If optional forth argument RESET is non NIL,\n\
- CATEGORY is deleted from the category set instead of being added.")
-  (ch, category, table, reset)
-     Lisp_Object ch, category, table, reset;
+       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.
+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;
 {
   int c, charset, c1, c2;
   Lisp_Object set_value;       /* Actual value to be set in category sets.  */
   Lisp_Object val, category_set;
 
-  CHECK_NUMBER (ch, 0);
-  c = XINT (ch);
-  CHECK_CATEGORY (category, 1);
+  CHECK_NUMBER (character);
+  c = XINT (character);
+  CHECK_CATEGORY (category);
   table = check_category_table (table);
 
   if (NILP (CATEGORY_DOCSTRING (table, XFASTINT (category))))
@@ -378,7 +388,7 @@ If optional forth argument RESET is non NIL,\n\
       return Qnil;
     }
 
-  SPLIT_NON_ASCII_CHAR (c, charset, c1, c2);
+  SPLIT_CHAR (c, charset, c1, c2);
 
   /* The top level table.  */
   val = XCHAR_TABLE (table)->contents[charset + 128];
@@ -490,7 +500,7 @@ describe_category (value)
 
   mnemonics = Fcategory_set_mnemonics (value);
   insert_from_string (mnemonics, 0, 0, XSTRING (mnemonics)->size,
-                     XSTRING (mnemonics)->size_byte, 0);
+                     STRING_BYTES (XSTRING (mnemonics)), 0);
   insert_string ("\n");
   return;
 }
@@ -524,7 +534,7 @@ describe_category_1 (vector)
        insert_char (i + 32);
        insert (": ", 2);
        insert_from_string (elt, 0, 0, XSTRING (elt)->size,
-                           XSTRING (elt)->size_byte, 0);
+                           STRING_BYTES (XSTRING (elt)), 0);
        insert ("\n", 1);
       }
   }
@@ -542,10 +552,10 @@ describe_category_1 (vector)
   return Qnil;
 }
 
-DEFUN ("describe-category", Fdescribe_category, Sdescribe_category, 0, 0, "",
-  "Describe the category specifications in the category table.\n\
-The descriptions are inserted in a buffer, which is then displayed.")
-  ()
+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);
@@ -584,21 +594,22 @@ word_boundary_p (c1, c2)
   if (NILP (category_set2))
     return default_result;
 
-  for (; CONSP (tail); tail = XCONS (tail)->cdr)
+  for (; CONSP (tail); tail = XCDR (tail))
     {
-      Lisp_Object elt = XCONS(tail)->car;
+      Lisp_Object elt = XCAR (tail);
 
       if (CONSP (elt)
-         && CATEGORYP (XCONS (elt)->car)
-         && CATEGORYP (XCONS (elt)->cdr)
-         && CATEGORY_MEMBER (XFASTINT (XCONS (elt)->car), category_set1)
-         && CATEGORY_MEMBER (XFASTINT (XCONS (elt)->cdr), category_set2))
+         && 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;
 }
 
 \f
+void
 init_category_once ()
 {
   /* This has to be done here, before we call Fmake_char_table.  */
@@ -621,6 +632,7 @@ init_category_once ()
                              Fmake_vector (make_number (95), Qnil));
 }
 
+void
 syms_of_category ()
 {
   Qcategoryp = intern ("categoryp");
@@ -631,45 +643,45 @@ syms_of_category ()
   staticpro (&Qcategory_table_p);
 
   DEFVAR_LISP ("word-combining-categories", &Vword_combining_categories,
-    "List of pair (cons) of categories to determine word boundary.\n\
-\n\
-Emacs treats a sequence of word constituent characters as a single\n\
-word (i.e. finds no word boundary between them) iff they belongs to\n\
-the same charset.  But, exceptions are allowed in the following cases.\n\
-\n\
-(1) The case that characters are in different charsets is controlled\n\
-by the variable `word-combining-categories'.\n\
-\n\
-Emacs finds no word boundary between characters of different charsets\n\
-if they have categories matching some element of this list.\n\
-\n\
-More precisely, if an element of this list is a cons of category CAT1\n\
-and CAT2, and a multibyte character C1 which has CAT1 is followed by\n\
-C2 which has CAT2, there's no word boundary between C1 and C2.\n\
-\n\
-For instance, to tell that ASCII characters and Latin-1 characters can\n\
-form a single word, the element `(?l . ?l)' should be in this list\n\
-because both characters have the category `l' (Latin characters).\n\
-\n\
-(2) The case that character are in the same charset is controlled by\n\
-the variable `word-separating-categories'.\n\
-\n\
-Emacs find a word boundary between characters of the same charset\n\
-if they have categories matching some element of this list.\n\
-\n\
-More precisely, if an element of this list is a cons of category CAT1\n\
-and CAT2, and a multibyte character C1 which has CAT1 is followed by\n\
-C2 which has CAT2, there's a word boundary between C1 and C2.\n\
-\n\
-For instance, to tell that there's a word boundary between Japanese\n\
-Hiragana and Japanese Kanji (both are in the same charset), the\n\
-element `(?H . ?C) should be in this list.");
+              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,
-    "List of pair (cons) of categories to determine word boundary.\n\
-See the documentation of the variable `word-combining-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;
 
@@ -681,11 +693,12 @@ See the documentation of the variable `word-combining-categories'.");
   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);
-  defsubr (&Sdescribe_category);
+  defsubr (&Sdescribe_categories);
 
   category_table_version = 0;
 }