*** empty log message ***

[bpt/emacs.git] / src / category.c

diff --git a/src/category.c b/src/category.c
index 1041e18..e77d6f3 100644 (file)
--- a/src/category.c
+++ b/src/category.c
@@ -1,7 +1,6 @@
 /* GNU Emacs routines to deal with category tables.
 /* GNU Emacs routines to deal with category tables.

-   Ver.1.0
-   Copyright (C) 1995 Free Software Foundation, Inc.
-   Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
+   Copyright (C) 1995, 1997 Electrotechnical Laboratory, JAPAN.
+   Licensed to the Free Software Foundation.

 
 This file is part of GNU Emacs.
 
 
 This file is part of GNU Emacs.
 


@@ -54,7 +53,9 @@ Lisp_Object _temp_category_set;
 
 DEFUN ("make-category-set", Fmake_category_set, Smake_category_set, 1, 1, 0,
   "Return a newly created category-set which contains CATEGORIES.\n\
 
 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 is a string of category mnemonics.\n\
+The value is a bool-vector which has t at the indices corresponding to\n\
+those categories.")

   (categories)
      Lisp_Object categories;
 {
   (categories)
      Lisp_Object categories;
 {


@@ -64,6 +65,9 @@ CATEGORIES is a string of category mnemonics.")
   CHECK_STRING (categories, 0);
   val = MAKE_CATEGORY_SET;
 
   CHECK_STRING (categories, 0);
   val = MAKE_CATEGORY_SET;
 

+  if (STRING_MULTIBYTE (categories))
+    error ("Multibyte string in make-category-set");
+

   len = XSTRING (categories)->size;
   while (--len >= 0)
     {
   len = XSTRING (categories)->size;
   while (--len >= 0)
     {


@@ -83,7 +87,7 @@ 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\
 
 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\
+CHAR should be an ASCII printing character in the range ` ' to `~'.\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.")
 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.")


@@ -102,14 +106,10 @@ The category is defined only in category table TABLE, which defaults to\n\
 }
 
 DEFUN ("category-docstring", Fcategory_docstring, Scategory_docstring, 1, 2, 0,
 }
 
 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.")
+  "Return the documentation string of CATEGORY, as defined in CATEGORY-TABLE.")

   (category, table)
      Lisp_Object category, table;
 {
   (category, table)
      Lisp_Object category, table;
 {

-  Lisp_Object doc;
-

   CHECK_CATEGORY (category, 0);
   table = check_category_table (table);
 
   CHECK_CATEGORY (category, 0);
   table = check_category_table (table);
 


@@ -118,15 +118,14 @@ Optional second arg specifies CATEGORY-TABLE,\n\
 
 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,

-  "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.")
+  "Return a category which is not yet defined in CATEGORY-TABLE.\n\
+If no category remains available, return nil.\n\
+The optional argument CATEGORY-TABLE specifies which category table\n\
+to modify; it defaults to the current buffer's category table.")

   (table)
      Lisp_Object table;
 {
   int i;
   (table)
      Lisp_Object table;
 {
   int i;

-  Lisp_Object docstring_vector;

 
   table = check_category_table (table);
 
 
   table = check_category_table (table);
 


@@ -188,7 +187,7 @@ This is the one used for new buffers.")
 /* 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
 /* 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

-   biding TABLE to a sub char table.  */
+   binding TABLE to a sub char table.  */

 
 Lisp_Object
 copy_category_table (table)
 
 Lisp_Object
 copy_category_table (table)


@@ -208,6 +207,12 @@ copy_category_table (table)
        if (!NILP (tmp = XCHAR_TABLE (table)->contents[i]))
          XCHAR_TABLE (table)->contents[i] = Fcopy_sequence (tmp);
       to = CHAR_TABLE_ORDINARY_SLOTS;
        if (!NILP (tmp = XCHAR_TABLE (table)->contents[i]))
          XCHAR_TABLE (table)->contents[i] = Fcopy_sequence (tmp);
       to = CHAR_TABLE_ORDINARY_SLOTS;

+
+      /* Also copy the first (and sole) extra slot.  It is a vector
+         containing docstring of each category.  */
+      Fset_char_table_extra_slot
+       (table, make_number (0),
+        Fcopy_sequence (Fchar_table_extra_slot (table, make_number (0))));

     }
   else
     {
     }
   else
     {


@@ -242,40 +247,53 @@ It is a copy of the TABLE, which defaults to the standard category table.")
   else
     table = Vstandard_category_table;
 
   else
     table = Vstandard_category_table;
 

-  return copy_category_table (table, 1);
+  return copy_category_table (table);
+}
+
+DEFUN ("make-category-table", Fmake_category_table, Smake_category_table,
+       0, 0, 0,
+  "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,
 }
 
 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.")
+  "Specify TABLE as the category table for the current buffer.")

   (table)
      Lisp_Object table;
 {
   (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.  */
   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 table;
 }
 
 \f
 DEFUN ("char-category-set", Fchar_category_set, Schar_category_set, 1, 1, 0,

-  "Return a category set of CHAR.")
+  "Return the category set of CHAR.")

   (ch)
      Lisp_Object ch;
 {
   (ch)
      Lisp_Object ch;
 {

-  Lisp_Object val;
-  int charset;
-  unsigned char c1, c2;
-

   CHECK_NUMBER (ch, 0);
   return CATEGORY_SET (XFASTINT (ch));
 }
 
 DEFUN ("category-set-mnemonics", Fcategory_set_mnemonics,
        Scategory_set_mnemonics, 1, 1, 0,
   CHECK_NUMBER (ch, 0);
   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.")
+  "Return a string containing mnemonics of the categories in CATEGORY-SET.\n\
+CATEGORY-SET is a bool-vector, and the categories \"in\" it are those\n\
+that are indexes where t occurs the bool-vector.\n\
+The return value is a string containing those same categories.")

   (category_set)
      Lisp_Object category_set;
 {
   (category_set)
      Lisp_Object category_set;
 {


@@ -304,12 +322,11 @@ modify_lower_category_set (table, category, set_value)
   Lisp_Object val;
   int i;
 
   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++)
     {
 
   for (i = 32; i < SUB_CHAR_TABLE_ORDINARY_SLOTS; i++)
     {


@@ -339,20 +356,20 @@ set_category_set (category_set, category, val)
 
 DEFUN ("modify-category-entry", Fmodify_category_entry,
        Smodify_category_entry, 2, 4, 0,
 
 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\
+  "Modify the category set of CHARACTER 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\
 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;
+If optional fourth argument RESET is non-nil,\n\
+ 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;
 
 {
   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_NUMBER (character, 0);
+  c = XINT (character);

   CHECK_CATEGORY (category, 1);
   table = check_category_table (table);
 
   CHECK_CATEGORY (category, 1);
   table = check_category_table (table);
 


@@ -370,7 +387,7 @@ If optional forth argument RESET is non NIL,\n\
       return Qnil;
     }
 
       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];
 
   /* The top level table.  */
   val = XCHAR_TABLE (table)->contents[charset + 128];


@@ -468,6 +485,12 @@ describe_category (value)
       return;
     }
 
       return;
     }
 

+  if (CHAR_TABLE_P (value))
+    {
+      insert_string ("deeper char-table ...\n");
+      return;
+    }
+

   if (!CATEGORY_SET_P (value))
     {
       insert_string ("invalid\n");
   if (!CATEGORY_SET_P (value))
     {
       insert_string ("invalid\n");


@@ -475,7 +498,8 @@ describe_category (value)
     }
 
   mnemonics = Fcategory_set_mnemonics (value);
     }
 
   mnemonics = Fcategory_set_mnemonics (value);

-  insert_from_string (mnemonics, 0, XSTRING (mnemonics)->size, 0);
+  insert_from_string (mnemonics, 0, 0, XSTRING (mnemonics)->size,
+                     STRING_BYTES (XSTRING (mnemonics)), 0);

   insert_string ("\n");
   return;
 }
   insert_string ("\n");
   return;
 }


@@ -486,7 +510,8 @@ describe_category_1 (vector)
 {
   struct buffer *old = current_buffer;
   set_buffer_internal (XBUFFER (Vstandard_output));
 {
   struct buffer *old = current_buffer;
   set_buffer_internal (XBUFFER (Vstandard_output));

-  describe_vector (vector, Qnil, describe_category, 0, Qnil, Qnil);
+  describe_vector (vector, Qnil, describe_category, 0, Qnil, Qnil,
+                  (int *)0, 0);

   {
     int i;
     Lisp_Object docs = XCHAR_TABLE (vector)->extras[0];
   {
     int i;
     Lisp_Object docs = XCHAR_TABLE (vector)->extras[0];


@@ -507,7 +532,8 @@ describe_category_1 (vector)
 
        insert_char (i + 32);
        insert (": ", 2);
 
        insert_char (i + 32);
        insert (": ", 2);

-       insert_from_string (elt, 0, XSTRING (elt)->size, 0);
+       insert_from_string (elt, 0, 0, XSTRING (elt)->size,
+                           STRING_BYTES (XSTRING (elt)), 0);

        insert ("\n", 1);
       }
   }
        insert ("\n", 1);
       }
   }


@@ -516,7 +542,8 @@ describe_category_1 (vector)
     {
       vector = XCHAR_TABLE (vector)->parent;
       insert_string ("\nThe parent category table is:");
     {
       vector = XCHAR_TABLE (vector)->parent;
       insert_string ("\nThe parent category table is:");

-      describe_vector (vector, Qnil, describe_category, 0, Qnil, Qnil);
+      describe_vector (vector, Qnil, describe_category, 0, Qnil, Qnil,
+                      (int *) 0, 0);

     }
 
   call0 (intern ("help-mode"));
     }
 
   call0 (intern ("help-mode"));


@@ -524,8 +551,8 @@ describe_category_1 (vector)
   return Qnil;
 }
 
   return Qnil;
 }
 

-DEFUN ("describe-category", Fdescribe_category, Sdescribe_category, 0, 0, "",
-  "Describe the category specifications in the category table.\n\
+DEFUN ("describe-categories", Fdescribe_categories, Sdescribe_categories, 0, 0, "",
+  "Describe the category specifications in the current category table.\n\

 The descriptions are inserted in a buffer, which is then displayed.")
   ()
 {
 The descriptions are inserted in a buffer, which is then displayed.")
   ()
 {


@@ -566,21 +593,22 @@ word_boundary_p (c1, c2)
   if (NILP (category_set2))
     return default_result;
 
   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)
 
       if (CONSP (elt)

-         && CATEGORYP (XCONS (elt)->car)
-         && CATEGORYP (XCONS (elt)->cdr)
-         && CATEGORY_MEMBER (XCONS (elt)->car, category_set1)
-         && CATEGORY_MEMBER (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
        return !default_result;
     }
   return default_result;
 }
 
 \f

+void

 init_category_once ()
 {
   /* This has to be done here, before we call Fmake_char_table.  */
 init_category_once ()
 {
   /* This has to be done here, before we call Fmake_char_table.  */


@@ -599,10 +627,11 @@ init_category_once ()
   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;
   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, 0,
+  Fset_char_table_extra_slot (Vstandard_category_table, make_number (0),

                              Fmake_vector (make_number (95), Qnil));
 }
 
                              Fmake_vector (make_number (95), Qnil));
 }
 

+void

 syms_of_category ()
 {
   Qcategoryp = intern ("categoryp");
 syms_of_category ()
 {
   Qcategoryp = intern ("categoryp");


@@ -619,7 +648,7 @@ 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\
 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\
+\(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\
 by the variable `word-combining-categories'.\n\
 \n\
 Emacs finds no word boundary between characters of different charsets\n\


@@ -633,7 +662,7 @@ 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\
 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\
+\(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\
 the variable `word-separating-categories'.\n\
 \n\
 Emacs find a word boundary between characters of the same charset\n\


@@ -663,11 +692,12 @@ See the documentation of the variable `word-combining-categories'.");
   defsubr (&Scategory_table);
   defsubr (&Sstandard_category_table);
   defsubr (&Scopy_category_table);
   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 (&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;
 }
 
   category_table_version = 0;
 }