(Fencode_sjis_char, Fencode_big5_char): Improve argument/docstring consistency.

[gnu-emacs] / src / casetab.c

diff --git a/src/casetab.c b/src/casetab.c
index de13a91dcc8e58c5bada1fa6abfd89e542350e34..8c46ab11c601c90674361dcac25384c6af7096fb 100644 (file)
--- a/src/casetab.c
+++ b/src/casetab.c
@@ -1,11 +1,12 @@
 /* GNU Emacs routines to deal with case tables.
 /* GNU Emacs routines to deal with case tables.

-   Copyright (C) 1993 Free Software Foundation, Inc.
+   Copyright (C) 1993, 1994, 2002, 2003, 2004,
+                 2005, 2006 Free Software Foundation, Inc.

 
 This file is part of GNU Emacs.
 
 GNU Emacs is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
 
 This file is part of GNU Emacs.
 
 GNU Emacs is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by

-the Free Software Foundation; either version 1, or (at your option)
+the Free Software Foundation; either version 2, or (at your option)

 any later version.
 
 GNU Emacs is distributed in the hope that it will be useful,
 any later version.
 
 GNU Emacs is distributed in the hope that it will be useful,


@@ -15,39 +16,50 @@ 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
 
 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, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */

 
 

-/* Written by Howard Gayle.  See chartab.c for details. */
+/* Written by Howard Gayle.  */

 
 

-#include "config.h"
+#include <config.h>

 #include "lisp.h"
 #include "buffer.h"
 #include "lisp.h"
 #include "buffer.h"

+#include "charset.h"

 
 

-Lisp_Object Qcase_table_p;
+Lisp_Object Qcase_table_p, Qcase_table;

 Lisp_Object Vascii_downcase_table, Vascii_upcase_table;
 Lisp_Object Vascii_canon_table, Vascii_eqv_table;
 
 Lisp_Object Vascii_downcase_table, Vascii_upcase_table;
 Lisp_Object Vascii_canon_table, Vascii_eqv_table;
 

-void compute_trt_inverse ();
+/* Used as a temporary in DOWNCASE and other macros in lisp.h.  No
+   need to mark it, since it is used only very temporarily.  */
+int case_temp1;
+Lisp_Object case_temp2;
+
+static void set_canon ();
+static void set_identity ();
+static void shuffle ();

 
 DEFUN ("case-table-p", Fcase_table_p, Scase_table_p, 1, 1, 0,
 
 DEFUN ("case-table-p", Fcase_table_p, Scase_table_p, 1, 1, 0,

-  "Return t iff ARG is a case table.\n\
-See `set-case-table' for more information on these data structures.")
-  (table)
-     Lisp_Object table;
+       doc: /* Return t iff OBJECT is a case table.
+See `set-case-table' for more information on these data structures.  */)
+     (object)
+     Lisp_Object object;

 {
 {

-  Lisp_Object down, up, canon, eqv;
-  down = Fcar_safe (table);
-  up = Fcar_safe (Fcdr_safe (table));
-  canon = Fcar_safe (Fcdr_safe (Fcdr_safe (table)));
-  eqv = Fcar_safe (Fcdr_safe (Fcdr_safe (Fcdr_safe (table))));
+  Lisp_Object up, canon, eqv;
+
+  if (! CHAR_TABLE_P (object))
+    return Qnil;
+  if (! EQ (XCHAR_TABLE (object)->purpose, Qcase_table))
+    return Qnil;

 
 

-#define STRING256_P(obj) \
-  (XTYPE (obj) == Lisp_String && XSTRING (obj)->size == 256)
+  up = XCHAR_TABLE (object)->extras[0];
+  canon = XCHAR_TABLE (object)->extras[1];
+  eqv = XCHAR_TABLE (object)->extras[2];

 
 

-  return (STRING256_P (down)
-         && (NILP (up) || STRING256_P (up))
+  return ((NILP (up) || CHAR_TABLE_P (up))

          && ((NILP (canon) && NILP (eqv))
          && ((NILP (canon) && NILP (eqv))

-             || (STRING256_P (canon) && STRING256_P (eqv)))
+             || (CHAR_TABLE_P (canon)
+                 && (NILP (eqv) || CHAR_TABLE_P (eqv))))

          ? Qt : Qnil);
 }
 
          ? Qt : Qnil);
 }
 


@@ -55,67 +67,54 @@ static Lisp_Object
 check_case_table (obj)
      Lisp_Object obj;
 {
 check_case_table (obj)
      Lisp_Object obj;
 {

-  register Lisp_Object tem;
-
-  while (tem = Fcase_table_p (obj), NILP (tem))
-    obj = wrong_type_argument (Qcase_table_p, obj);
+  CHECK_TYPE (!NILP (Fcase_table_p (obj)), Qcase_table_p, obj);

   return (obj);
   return (obj);

-}   
+}

 
 DEFUN ("current-case-table", Fcurrent_case_table, Scurrent_case_table, 0, 0, 0,
 
 DEFUN ("current-case-table", Fcurrent_case_table, Scurrent_case_table, 0, 0, 0,

-  "Return the case table of the current buffer.")
-  ()
+       doc: /* Return the case table of the current buffer.  */)
+     ()

 {
 {

-  Lisp_Object down, up, canon, eqv;
-  
-  down = current_buffer->downcase_table;
-  up = current_buffer->upcase_table;
-  canon = current_buffer->case_canon_table;
-  eqv = current_buffer->case_eqv_table;
-
-  return Fcons (down, Fcons (up, Fcons (canon, Fcons (eqv, Qnil))));
+  return current_buffer->downcase_table;

 }
 
 }
 

-DEFUN ("standard-case-table", Fstandard_case_table,
-  Sstandard_case_table, 0, 0, 0,
-  "Return the standard case table.\n\
-This is the one used for new buffers.")
-  ()
+DEFUN ("standard-case-table", Fstandard_case_table, Sstandard_case_table, 0, 0, 0,
+       doc: /* Return the standard case table.
+This is the one used for new buffers.  */)
+     ()

 {
 {

-  return Fcons (Vascii_downcase_table,
-               Fcons (Vascii_upcase_table,
-                      Fcons (Vascii_canon_table,
-                             Fcons (Vascii_eqv_table, Qnil))));
+  return Vascii_downcase_table;

 }
 
 static Lisp_Object set_case_table ();
 
 DEFUN ("set-case-table", Fset_case_table, Sset_case_table, 1, 1, 0,
 }
 
 static Lisp_Object set_case_table ();
 
 DEFUN ("set-case-table", Fset_case_table, Sset_case_table, 1, 1, 0,

-  "Select a new case table for the current buffer.\n\
-A case table is a list (DOWNCASE UPCASE CANONICALIZE EQUIVALENCES)\n\
- where each element is either nil or a string of length 256.\n\
-DOWNCASE maps each character to its lower-case equivalent.\n\
-UPCASE maps each character to its upper-case equivalent;\n\
- if lower and upper case characters are in 1-1 correspondence,\n\
- you may use nil and the upcase table will be deduced from DOWNCASE.\n\
-CANONICALIZE maps each character to a canonical equivalent;\n\
- any two characters that are related by case-conversion have the same\n\
- canonical equivalent character.\n\
-EQUIVALENCES is a map that cyclicly permutes each equivalence class\n\
- (of characters with the same canonical equivalent).\n\
-Both CANONICALIZE and EQUIVALENCES may be nil, in which case\n\
- both are deduced from DOWNCASE and UPCASE.")
-  (table)
+       doc: /* Select a new case table for the current buffer.
+A case table is a char-table which maps characters
+to their lower-case equivalents.  It also has three \"extra\" slots
+which may be additional char-tables or nil.
+These slots are called UPCASE, CANONICALIZE and EQUIVALENCES.
+UPCASE maps each non-upper-case character to its upper-case equivalent.
+ (The value in UPCASE for an upper-case character is never used.)
+ If lower and upper case characters are in 1-1 correspondence,
+ you may use nil and the upcase table will be deduced from DOWNCASE.
+CANONICALIZE maps each character to a canonical equivalent;
+ any two characters that are related by case-conversion have the same
+ canonical equivalent character; it may be nil, in which case it is
+ deduced from DOWNCASE and UPCASE.
+EQUIVALENCES is a map that cyclicly permutes each equivalence class
+ (of characters with the same canonical equivalent); it may be nil,
+ in which case it is deduced from CANONICALIZE.  */)
+     (table)

      Lisp_Object table;
 {
   return set_case_table (table, 0);
 }
 
      Lisp_Object table;
 {
   return set_case_table (table, 0);
 }
 

-DEFUN ("set-standard-case-table",
-       Fset_standard_case_table, Sset_standard_case_table, 1, 1, 0,
-  "Select a new standard case table for new buffers.\n\
-See `set-case-table' for more info on case tables.")
-  (table)
+DEFUN ("set-standard-case-table", Fset_standard_case_table, Sset_standard_case_table, 1, 1, 0,
+       doc: /* Select a new standard case table for new buffers.
+See `set-case-table' for more info on case tables.  */)
+     (table)

      Lisp_Object table;
 {
   return set_case_table (table, 1);
      Lisp_Object table;
 {
   return set_case_table (table, 1);


@@ -126,128 +125,165 @@ set_case_table (table, standard)
      Lisp_Object table;
      int standard;
 {
      Lisp_Object table;
      int standard;
 {

-  Lisp_Object down, up, canon, eqv;
+  Lisp_Object up, canon, eqv;
+  Lisp_Object indices[3];

 
   check_case_table (table);
 
 
   check_case_table (table);
 

-  down = Fcar_safe (table);
-  up = Fcar_safe (Fcdr_safe (table));
-  canon = Fcar_safe (Fcdr_safe (Fcdr_safe (table)));
-  eqv = Fcar_safe (Fcdr_safe (Fcdr_safe (Fcdr_safe (table))));
+  up = XCHAR_TABLE (table)->extras[0];
+  canon = XCHAR_TABLE (table)->extras[1];
+  eqv = XCHAR_TABLE (table)->extras[2];

 
   if (NILP (up))
     {
 
   if (NILP (up))
     {

-      up = Fmake_string (make_number (256), make_number (0));
-      compute_trt_inverse (XSTRING (down)->data, XSTRING (up)->data);
+      up = Fmake_char_table (Qcase_table, Qnil);
+      map_char_table (set_identity, Qnil, table, table, up, 0, indices);
+      map_char_table (shuffle, Qnil, table, table, up, 0, indices);
+      XCHAR_TABLE (table)->extras[0] = up;

     }
 
   if (NILP (canon))
     {
     }
 
   if (NILP (canon))
     {

-      register int i;
-      unsigned char *upvec = XSTRING (up)->data;
-      unsigned char *downvec = XSTRING (down)->data;
-
-      canon = Fmake_string (make_number (256), make_number (0));
-      eqv = Fmake_string (make_number (256), make_number (0));
-
-      /* Set up the CANON vector; for each character,
-        this sequence of upcasing and downcasing ought to
-        get the "preferred" lowercase equivalent.  */
-      for (i = 0; i < 256; i++)
-       XSTRING (canon)->data[i] = downvec[upvec[downvec[i]]];
+      canon = Fmake_char_table (Qcase_table, Qnil);
+      XCHAR_TABLE (table)->extras[1] = canon;
+      map_char_table (set_canon, Qnil, table, table, table, 0, indices);
+    }

 
 

-      compute_trt_inverse (XSTRING (canon)->data, XSTRING (eqv)->data);
+  if (NILP (eqv))
+    {
+      eqv = Fmake_char_table (Qcase_table, Qnil);
+      map_char_table (set_identity, Qnil, canon, canon, eqv, 0, indices);
+      map_char_table (shuffle, Qnil, canon, canon, eqv, 0, indices);
+      XCHAR_TABLE (table)->extras[2] = eqv;

     }
 
     }
 

+  /* This is so set_image_of_range_1 in regex.c can find the EQV table.  */
+  XCHAR_TABLE (canon)->extras[2] = eqv;
+

   if (standard)
     {
   if (standard)
     {

-      Vascii_downcase_table = down;
+      Vascii_downcase_table = table;

       Vascii_upcase_table = up;
       Vascii_canon_table = canon;
       Vascii_eqv_table = eqv;
     }
   else
     {
       Vascii_upcase_table = up;
       Vascii_canon_table = canon;
       Vascii_eqv_table = eqv;
     }
   else
     {

-      current_buffer->downcase_table = down;
+      current_buffer->downcase_table = table;

       current_buffer->upcase_table = up;
       current_buffer->case_canon_table = canon;
       current_buffer->case_eqv_table = eqv;
     }
       current_buffer->upcase_table = up;
       current_buffer->case_canon_table = canon;
       current_buffer->case_eqv_table = eqv;
     }

+

   return table;
 }
 \f
   return table;
 }
 \f

-/* Given a translate table TRT, store the inverse mapping into INVERSE.
-   Since TRT is not one-to-one, INVERSE is not a simple mapping.
-   Instead, it divides the space of characters into equivalence classes.
-   All characters in a given class form one circular list, chained through
-   the elements of INVERSE.  */
+/* The following functions are called in map_char_table.  */

 
 

-void
-compute_trt_inverse (trt, inverse)
-     register unsigned char *trt;
-     register unsigned char *inverse;
+/*  Set CANON char-table element for C to a translated ELT by UP and
+   DOWN char-tables.  This is done only when ELT is a character.  The
+   char-tables CANON, UP, and DOWN are in CASE_TABLE.  */
+
+static void
+set_canon (case_table, c, elt)
+     Lisp_Object case_table, c, elt;
+{
+  Lisp_Object up = XCHAR_TABLE (case_table)->extras[0];
+  Lisp_Object canon = XCHAR_TABLE (case_table)->extras[1];
+
+  if (NATNUMP (elt))
+    Faset (canon, c, Faref (case_table, Faref (up, elt)));
+}
+
+/* Set elements of char-table TABLE for C to C itself.  This is done
+   only when ELT is a character.  This is called in map_char_table.  */
+
+static void
+set_identity (table, c, elt)
+     Lisp_Object table, c, elt;

 {
 {

-  register int i = 0400;
-  register unsigned char c, q;
+  if (NATNUMP (elt))
+    Faset (table, c, c);
+}
+
+/* Permute the elements of TABLE (which is initially an identity
+   mapping) so that it has one cycle for each equivalence class
+   induced by the translation table on which map_char_table is
+   operated.  */

 
 

-  while (i--)
-    inverse[i] = i;
-  i = 0400;
-  while (i--)
+static void
+shuffle (table, c, elt)
+     Lisp_Object table, c, elt;
+{
+  if (NATNUMP (elt) && !EQ (c, elt))

     {
     {

-      if ((q = trt[i]) != (unsigned char) i)
-       {
-         c = inverse[q];
-         inverse[q] = i;
-         inverse[i] = c;
-       }
+      Lisp_Object tem = Faref (table, elt);
+      Faset (table, elt, c);
+      Faset (table, c, tem);

     }
 }
 \f
     }
 }
 \f

+void

 init_casetab_once ()
 {
   register int i;
 init_casetab_once ()
 {
   register int i;

-  Lisp_Object tem;
-
-  tem = Fmake_string (make_number (256), make_number (0));
-  Vascii_downcase_table = tem;
-  Vascii_canon_table = tem;
-
-  for (i = 0; i < 256; i++)
-    XSTRING (tem)->data[i] = (i >= 'A' && i <= 'Z') ? i + 040 : i;
-
-  tem = Fmake_string (make_number (256), make_number (0));
-  Vascii_upcase_table = tem;
-  Vascii_eqv_table = tem;
-
-  for (i = 0; i < 256; i++)
-    XSTRING (tem)->data[i]
-      = ((i >= 'A' && i <= 'Z')
-        ? i + ('a' - 'A')
-        : ((i >= 'a' && i <= 'z')
-           ? i + ('A' - 'a')
-           : i));
+  Lisp_Object down, up;
+  Qcase_table = intern ("case-table");
+  staticpro (&Qcase_table);
+
+  /* Intern this now in case it isn't already done.
+     Setting this variable twice is harmless.
+     But don't staticpro it here--that is done in alloc.c.  */
+  Qchar_table_extra_slots = intern ("char-table-extra-slots");
+
+  /* Now we are ready to set up this property, so we can
+     create char tables.  */
+  Fput (Qcase_table, Qchar_table_extra_slots, make_number (3));
+
+  down = Fmake_char_table (Qcase_table, Qnil);
+  Vascii_downcase_table = down;
+  XCHAR_TABLE (down)->purpose = Qcase_table;
+
+  for (i = 0; i < CHAR_TABLE_SINGLE_BYTE_SLOTS; i++)
+    XSETFASTINT (XCHAR_TABLE (down)->contents[i],
+                (i >= 'A' && i <= 'Z') ? i + ('a' - 'A') : i);
+
+  XCHAR_TABLE (down)->extras[1] = Fcopy_sequence (down);
+
+  up = Fmake_char_table (Qcase_table, Qnil);
+  XCHAR_TABLE (down)->extras[0] = up;
+
+  for (i = 0; i < CHAR_TABLE_SINGLE_BYTE_SLOTS; i++)
+    XSETFASTINT (XCHAR_TABLE (up)->contents[i],
+                ((i >= 'A' && i <= 'Z')
+                 ? i + ('a' - 'A')
+                 : ((i >= 'a' && i <= 'z')
+                    ? i + ('A' - 'a')
+                    : i)));
+
+  XCHAR_TABLE (down)->extras[2] = Fcopy_sequence (up);
+
+  /* Fill in what isn't filled in.  */
+  set_case_table (down, 1);

 }
 
 }
 

+void

 syms_of_casetab ()
 {
   Qcase_table_p = intern ("case-table-p");
   staticpro (&Qcase_table_p);
 syms_of_casetab ()
 {
   Qcase_table_p = intern ("case-table-p");
   staticpro (&Qcase_table_p);

-  staticpro (&Vascii_downcase_table);
-  staticpro (&Vascii_upcase_table);
+

   staticpro (&Vascii_canon_table);
   staticpro (&Vascii_canon_table);

+  staticpro (&Vascii_downcase_table);

   staticpro (&Vascii_eqv_table);
   staticpro (&Vascii_eqv_table);

+  staticpro (&Vascii_upcase_table);

 
   defsubr (&Scase_table_p);
   defsubr (&Scurrent_case_table);
   defsubr (&Sstandard_case_table);
   defsubr (&Sset_case_table);
   defsubr (&Sset_standard_case_table);
 
   defsubr (&Scase_table_p);
   defsubr (&Scurrent_case_table);
   defsubr (&Sstandard_case_table);
   defsubr (&Sset_case_table);
   defsubr (&Sset_standard_case_table);

-
-#if 0
-  DEFVAR_LISP ("ascii-downcase-table", &Vascii_downcase_table,
-              "String mapping ASCII characters to lowercase equivalents.");
-  DEFVAR_LISP ("ascii-upcase-table", &Vascii_upcase_table,
-              "String mapping ASCII characters to uppercase equivalents.");
-#endif

 }
 }

+
+/* arch-tag: e06388ad-99fe-40ec-ba67-9d010fcc4916
+   (do not change this comment) */