]> code.delx.au - gnu-emacs/blobdiff - src/category.c
(Fset_keymap_parent): Minor doc fix.
[gnu-emacs] / src / category.c
index 40804367528010c7a9039d86419af408f3f2e8b1..b7eadd0e77168def77827460d7411c83daa976dc 100644 (file)
@@ -63,19 +63,19 @@ those categories.  */)
   Lisp_Object val;
   int len;
 
   Lisp_Object val;
   int len;
 
-  CHECK_STRING (categories, 0);
+  CHECK_STRING (categories);
   val = MAKE_CATEGORY_SET;
 
   if (STRING_MULTIBYTE (categories))
     error ("Multibyte string in make-category-set");
 
   val = MAKE_CATEGORY_SET;
 
   if (STRING_MULTIBYTE (categories))
     error ("Multibyte string in make-category-set");
 
-  len = XSTRING (categories)->size;
+  len = SCHARS (categories);
   while (--len >= 0)
     {
       Lisp_Object category;
 
   while (--len >= 0)
     {
       Lisp_Object category;
 
-      XSETFASTINT (category, XSTRING (categories)->data[len]);
-      CHECK_CATEGORY (category, 0);
+      XSETFASTINT (category, SREF (categories, len));
+      CHECK_CATEGORY (category);
       SET_CATEGORY_SET (val, category, Qt);
     }
   return val;
       SET_CATEGORY_SET (val, category, Qt);
     }
   return val;
@@ -87,16 +87,16 @@ those categories.  */)
 Lisp_Object check_category_table ();
 
 DEFUN ("define-category", Fdefine_category, Sdefine_category, 2, 3, 0,
 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 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;
 {
      (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))))
   table = check_category_table (table);
 
   if (!NILP (CATEGORY_DOCSTRING (table, XFASTINT (category))))
@@ -107,11 +107,13 @@ The category is defined only in category table TABLE, which defaults to
 }
 
 DEFUN ("category-docstring", Fcategory_docstring, Scategory_docstring, 1, 2, 0,
 }
 
 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;
 {
      (category, table)
      Lisp_Object category, table;
 {
-  CHECK_CATEGORY (category, 0);
+  CHECK_CATEGORY (category);
   table = check_category_table (table);
 
   return CATEGORY_DOCSTRING (table, XFASTINT (category));
   table = check_category_table (table);
 
   return CATEGORY_DOCSTRING (table, XFASTINT (category));
@@ -119,10 +121,10 @@ DEFUN ("category-docstring", Fcategory_docstring, Scategory_docstring, 1, 2, 0,
 
 DEFUN ("get-unused-category", Fget_unused_category, Sget_unused_category,
        0, 1, 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.  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.  */)
+       doc: /* Return a category which is not yet defined in 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;
 {
      (table)
      Lisp_Object table;
 {
@@ -166,7 +168,7 @@ check_category_table (table)
   while (tem = Fcategory_table_p (table), NILP (tem))
     table = wrong_type_argument (Qcategory_table_p, table);
   return 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 ("category-table", Fcategory_table, Scategory_table, 0, 0, 0,
        doc: /* Return the current category table.
@@ -266,7 +268,8 @@ DEFUN ("make-category-table", Fmake_category_table, Smake_category_table,
 }
 
 DEFUN ("set-category-table", Fset_category_table, Sset_category_table, 1, 1, 0,
 }
 
 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;
 {
      (table)
      Lisp_Object table;
 {
@@ -285,7 +288,7 @@ DEFUN ("char-category-set", Fchar_category_set, Schar_category_set, 1, 1, 0,
      (ch)
      Lisp_Object ch;
 {
      (ch)
      Lisp_Object ch;
 {
-  CHECK_NUMBER (ch, 0);
+  CHECK_NUMBER (ch);
   return CATEGORY_SET (XFASTINT (ch));
 }
 
   return CATEGORY_SET (XFASTINT (ch));
 }
 
@@ -293,7 +296,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
        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;
 The return value is a string containing those same categories.  */)
      (category_set)
      Lisp_Object category_set;
@@ -301,7 +304,7 @@ The return value is a string containing those same categories.  */)
   int i, j;
   char str[96];
 
   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++)
 
   j = 0;
   for (i = 32; i < 127; i++)
@@ -369,14 +372,14 @@ then delete CATEGORY from the category set instead of adding it.  */)
   Lisp_Object set_value;       /* Actual value to be set in category sets.  */
   Lisp_Object val, category_set;
 
   Lisp_Object set_value;       /* Actual value to be set in category sets.  */
   Lisp_Object val, category_set;
 
-  CHECK_NUMBER (character, 0);
+  CHECK_NUMBER (character);
   c = XINT (character);
   c = XINT (character);
-  CHECK_CATEGORY (category, 1);
+  CHECK_CATEGORY (category);
   table = check_category_table (table);
 
   if (NILP (CATEGORY_DOCSTRING (table, XFASTINT (category))))
     error ("Undefined category: %c", XFASTINT (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;
 
   if (c < CHAR_TABLE_SINGLE_BYTE_SLOTS)
   set_value = NILP (reset) ? Qt : Qnil;
 
   if (c < CHAR_TABLE_SINGLE_BYTE_SLOTS)
@@ -470,99 +473,6 @@ then delete CATEGORY from the category set instead of adding it.  */)
   return Qnil;
 }
 \f
   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
 /* 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
@@ -626,7 +536,7 @@ init_category_once ()
   Fput (Qcategory_table, Qchar_table_extra_slots, make_number (2));
 
   Vstandard_category_table = Fmake_char_table (Qcategory_table, Qnil);
   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));
   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));
@@ -698,7 +608,9 @@ See the documentation of the variable `word-combining-categories'.  */);
   defsubr (&Schar_category_set);
   defsubr (&Scategory_set_mnemonics);
   defsubr (&Smodify_category_entry);
   defsubr (&Schar_category_set);
   defsubr (&Scategory_set_mnemonics);
   defsubr (&Smodify_category_entry);
-  defsubr (&Sdescribe_categories);
 
   category_table_version = 0;
 }
 
   category_table_version = 0;
 }
+
+/* arch-tag: 74ebf524-121b-4d9c-bd68-07f8d708b211
+   (do not change this comment) */