]> git.eshelyaron.com Git - emacs.git/commitdiff
(copy_sub_char_table): New function.
authorKenichi Handa <handa@m17n.org>
Mon, 7 Apr 1997 07:12:13 +0000 (07:12 +0000)
committerKenichi Handa <handa@m17n.org>
Mon, 7 Apr 1997 07:12:13 +0000 (07:12 +0000)
(Fcopy_sequence): Call copy_sub_char_table for copying a sub char table.
(Fchar_table_range, Fset_char_table_range, map_char_table,
Fmap_char_table): Handle multibyte characters correctly.

src/fns.c

index 118f1e121fff4abb52839aab497dc6352e9cafc2..2631210a6429a662310afbc5fdcf673b709040de 100644 (file)
--- a/src/fns.c
+++ b/src/fns.c
@@ -293,6 +293,27 @@ Each argument may be a list, vector or string.")
   return concat (nargs, args, Lisp_Vectorlike, 0);
 }
 
+/* Retrun a copy of a sub char table ARG.  The elements except for a
+   nested sub char table are not copied.  */
+static Lisp_Object
+copy_sub_char_table (arg)
+{
+  Lisp_Object copy = make_sub_char_table (XCHAR_TABLE (arg)->defalt);
+  int i;
+
+  /* Copy all the contents.  */
+  bcopy (XCHAR_TABLE (arg)->contents, XCHAR_TABLE (copy)->contents,
+        SUB_CHAR_TABLE_ORDINARY_SLOTS * sizeof (Lisp_Object));
+  /* Recursively copy any sub char-tables in the ordinary slots.  */
+  for (i = 32; i < SUB_CHAR_TABLE_ORDINARY_SLOTS; i++)
+    if (SUB_CHAR_TABLE_P (XCHAR_TABLE (arg)->contents[i]))
+      XCHAR_TABLE (copy)->contents[i]
+       = copy_sub_char_table (XCHAR_TABLE (copy)->contents[i]);
+
+  return copy;
+}
+
+
 DEFUN ("copy-sequence", Fcopy_sequence, Scopy_sequence, 1, 1, 0,
   "Return a copy of a list, vector or string.\n\
 The elements of a list or vector are not copied; they are shared\n\
@@ -313,11 +334,13 @@ with the original.")
             ((XCHAR_TABLE (arg)->size & PSEUDOVECTOR_SIZE_MASK)
              * sizeof (Lisp_Object)));
 
-      /* Recursively copy any char-tables in the ordinary slots.  */
-      for (i = 0; i < CHAR_TABLE_ORDINARY_SLOTS; i++)
-       if (CHAR_TABLE_P (XCHAR_TABLE (arg)->contents[i]))
+      /* Recursively copy any sub char tables in the ordinary slots
+         for multibyte characters.  */
+      for (i = CHAR_TABLE_SINGLE_BYTE_SLOTS;
+          i < CHAR_TABLE_ORDINARY_SLOTS; i++)
+       if (SUB_CHAR_TABLE_P (XCHAR_TABLE (arg)->contents[i]))
          XCHAR_TABLE (copy)->contents[i]
-           = Fcopy_sequence (XCHAR_TABLE (copy)->contents[i]);
+           = copy_sub_char_table (XCHAR_TABLE (copy)->contents[i]);
 
       return copy;
     }
@@ -1298,13 +1321,12 @@ or a character code.")
     return Faref (char_table, range);
   else if (VECTORP (range))
     {
-      for (i = 0; i < XVECTOR (range)->size - 1; i++)
-       char_table = Faref (char_table, XVECTOR (range)->contents[i]);
-
-      if (EQ (XVECTOR (range)->contents[i], Qnil))
-       return XCHAR_TABLE (char_table)->defalt;
-      else
-       return Faref (char_table, XVECTOR (range)->contents[i]);
+      int size = XVECTOR (range)->size;
+      Lisp_Object *val = XVECTOR (range)->contents;
+      Lisp_Object ch = Fmake_char_internal (size <= 0 ? Qnil : val[0],
+                                           size <= 1 ? Qnil : val[1],
+                                           size <= 2 ? Qnil : val[2]);
+      return Faref (char_table, ch);
     }
   else
     error ("Invalid RANGE argument to `char-table-range'");
@@ -1332,22 +1354,12 @@ or a character code.")
     Faset (char_table, range, value);
   else if (VECTORP (range))
     {
-      for (i = 0; i < XVECTOR (range)->size - 1; i++)
-       {
-         Lisp_Object tmp = Faref (char_table, XVECTOR (range)->contents[i]);
-         if (NILP (tmp))
-           {
-             /* Make this char-table deeper.  */
-             XVECTOR (char_table)->contents[XVECTOR (range)->contents[i]]
-               = tmp = Fmake_char_table (Qnil, Qnil);
-           }
-         char_table = tmp;
-       }
-
-      if (EQ (XVECTOR (range)->contents[i], Qnil))
-       XCHAR_TABLE (char_table)->defalt = value;
-      else
-       Faset (char_table, XVECTOR (range)->contents[i], value);
+      int size = XVECTOR (range)->size;
+      Lisp_Object *val = XVECTOR (range)->contents;
+      Lisp_Object ch = Fmake_char_internal (size <= 0 ? Qnil : val[0],
+                                           size <= 1 ? Qnil : val[1],
+                                           size <= 2 ? Qnil : val[2]);
+      return Faset (char_table, ch, value);
     }
   else
     error ("Invalid RANGE argument to `set-char-table-range'");
@@ -1366,46 +1378,54 @@ map_char_table (c_function, function, chartable, depth, indices)
      Lisp_Object (*c_function) (), function, chartable, *indices;
      int depth;
 {
-  int i;
-  int from, to;
+  int i, to;
 
   if (depth == 0)
-    from = 0, to = CHAR_TABLE_ORDINARY_SLOTS;
+    {
+      /* At first, handle ASCII and 8-bit European characters.  */
+      for (i = 0; i < CHAR_TABLE_SINGLE_BYTE_SLOTS; i++)
+       {
+         Lisp_Object elt = XCHAR_TABLE (chartable)->contents[i];
+         if (c_function)
+           (*c_function) (i, elt);
+         else
+           call2 (function, make_number (i), elt);
+       }
+      to = CHAR_TABLE_ORDINARY_SLOTS;
+    }
   else
-    from = 32, to = 128;
-  /* Make INDICES longer if we are about to fill it up.  */
-  if ((depth % 10) == 9)
     {
-      Lisp_Object *new_indices
-       = (Lisp_Object *) alloca ((depth + 10) * sizeof (Lisp_Object));
-      bcopy (indices, new_indices, depth * sizeof (Lisp_Object));
-      indices = new_indices;
+      i = 32;
+      to = SUB_CHAR_TABLE_ORDINARY_SLOTS;
     }
 
-  for (i = from; i < to; i++)
+  for (i; i < to; i++)
     {
-      Lisp_Object elt;
+      Lisp_Object elt = XCHAR_TABLE (chartable)->contents[i];
+
       indices[depth] = i;
-      elt = XCHAR_TABLE (chartable)->contents[i];
-      if (CHAR_TABLE_P (elt))
-       map_char_table (c_function, function, elt, depth + 1, indices);
-      else if (c_function)
-       (*c_function) (depth + 1, indices, elt);
-      else if (depth == 0 && i < 256)
-       /* This is an ASCII or 8-bit European character.  */
-       call2 (function, make_number (i), elt);
+
+      if (SUB_CHAR_TABLE_P (elt))
+       {
+         if (depth >= 3)
+           error ("Too deep char table");
+         map_char_table (c_function, function, elt, depth + 1, indices);
+       }
       else
        {
-         /* This is an entry for multibyte characters.  */
-         unsigned int charset = XFASTINT (indices[0]) - 128, c1, c2, c;
+         int charset = XFASTINT (indices[0]) - 128, c1, c2, c;
+
          if (CHARSET_DEFINED_P (charset))
            {
-             c1 = depth < 1 ? 0 : XFASTINT (indices[1]);
-             c2 = depth < 2 ? 0 : XFASTINT (indices[2]);
+             c1 = depth >= 1 ? XFASTINT (indices[1]) : 0;
+             c2 = depth >= 2 ? XFASTINT (indices[2]) : 0;
              c = MAKE_NON_ASCII_CHAR (charset, c1, c2);
-             call2 (function, make_number (c), elt);
+             if (c_function)
+               (*c_function) (c, elt);
+             else
+               call2 (function, make_number (c), elt);
            }
-       }         
+       }         
     }
 }
 
@@ -1418,7 +1438,8 @@ The key is always a possible RANGE argument to `set-char-table-range'.")
      Lisp_Object function, char_table;
 {
   Lisp_Object keyvec;
-  Lisp_Object *indices = (Lisp_Object *) alloca (10 * sizeof (Lisp_Object));
+  /* The depth of char table is at most 3. */
+  Lisp_Object *indices = (Lisp_Object *) alloca (3 * sizeof (Lisp_Object));
 
   map_char_table (NULL, function, char_table, 0, indices);
   return Qnil;