(Vutf_2000_version): New variable [moved from chartab.c].

[chise/xemacs-chise.git-] / src / chartab.c

diff --git a/src/chartab.c b/src/chartab.c
index 93ce1de..66ff5bc 100644 (file)
--- a/src/chartab.c
+++ b/src/chartab.c
@@ -4,6 +4,7 @@
    Copyright (C) 1995, 1996 Ben Wing.
    Copyright (C) 1995, 1997, 1999 Electrotechnical Laboratory, JAPAN.
    Licensed to the Free Software Foundation.
    Copyright (C) 1995, 1996 Ben Wing.
    Copyright (C) 1995, 1997, 1999 Electrotechnical Laboratory, JAPAN.
    Licensed to the Free Software Foundation.

+   Copyright (C) 1999,2000,2001,2002 MORIOKA Tomohiko

 
 This file is part of XEmacs.
 
 
 This file is part of XEmacs.
 

@@ -41,11 +42,8 @@ Boston, MA 02111-1307, USA.  */
 #include "buffer.h"
 #include "chartab.h"
 #include "syntax.h"
 #include "buffer.h"
 #include "chartab.h"
 #include "syntax.h"

-

 #ifdef UTF2000
 #include "elhash.h"
 #ifdef UTF2000
 #include "elhash.h"

-
-Lisp_Object Vutf_2000_version;

 #endif /* UTF2000 */
 
 Lisp_Object Qchar_tablep, Qchar_table;
 #endif /* UTF2000 */
 
 Lisp_Object Qchar_tablep, Qchar_table;

@@ -67,10 +65,11 @@ Lisp_Object Vword_combining_categories, Vword_separating_categories;
 #ifdef UTF2000
 
 #define BT_UINT8_MIN           0
 #ifdef UTF2000
 
 #define BT_UINT8_MIN           0

-#define BT_UINT8_MAX   (UCHAR_MAX - 3)
-#define BT_UINT8_t     (UCHAR_MAX - 2)
-#define BT_UINT8_nil   (UCHAR_MAX - 1)
-#define BT_UINT8_unbound UCHAR_MAX
+#define BT_UINT8_MAX           (UCHAR_MAX - 4)
+#define BT_UINT8_t             (UCHAR_MAX - 3)
+#define BT_UINT8_nil           (UCHAR_MAX - 2)
+#define BT_UINT8_unbound       (UCHAR_MAX - 1)
+#define BT_UINT8_unloaded      UCHAR_MAX

 
 INLINE_HEADER int INT_UINT8_P (Lisp_Object obj);
 INLINE_HEADER int UINT8_VALUE_P (Lisp_Object obj);
 
 INLINE_HEADER int INT_UINT8_P (Lisp_Object obj);
 INLINE_HEADER int UINT8_VALUE_P (Lisp_Object obj);

@@ -94,14 +93,16 @@ INT_UINT8_P (Lisp_Object obj)
 INLINE_HEADER int
 UINT8_VALUE_P (Lisp_Object obj)
 {
 INLINE_HEADER int
 UINT8_VALUE_P (Lisp_Object obj)
 {

-  return EQ (obj, Qunbound)
+  return EQ (obj, Qunloaded) || EQ (obj, Qunbound)

     || EQ (obj, Qnil) || EQ (obj, Qt) || INT_UINT8_P (obj);
 }
 
 INLINE_HEADER unsigned char
 UINT8_ENCODE (Lisp_Object obj)
 {
     || EQ (obj, Qnil) || EQ (obj, Qt) || INT_UINT8_P (obj);
 }
 
 INLINE_HEADER unsigned char
 UINT8_ENCODE (Lisp_Object obj)
 {

-  if (EQ (obj, Qunbound))
+  if (EQ (obj, Qunloaded))
+    return BT_UINT8_unloaded;
+  else if (EQ (obj, Qunbound))

     return BT_UINT8_unbound;
   else if (EQ (obj, Qnil))
     return BT_UINT8_nil;
     return BT_UINT8_unbound;
   else if (EQ (obj, Qnil))
     return BT_UINT8_nil;

@@ -114,7 +115,9 @@ UINT8_ENCODE (Lisp_Object obj)
 INLINE_HEADER Lisp_Object
 UINT8_DECODE (unsigned char n)
 {
 INLINE_HEADER Lisp_Object
 UINT8_DECODE (unsigned char n)
 {

-  if (n == BT_UINT8_unbound)
+  if (n == BT_UINT8_unloaded)
+    return Qunloaded;
+  else if (n == BT_UINT8_unbound)

     return Qunbound;
   else if (n == BT_UINT8_nil)
     return Qnil;
     return Qunbound;
   else if (n == BT_UINT8_nil)
     return Qnil;

@@ -189,12 +192,16 @@ uint8_byte_table_hash (Lisp_Object obj, int depth)
   return hash;
 }
 
   return hash;
 }
 

+static const struct lrecord_description uint8_byte_table_description[] = {
+  { XD_END }
+};
+

 DEFINE_LRECORD_IMPLEMENTATION ("uint8-byte-table", uint8_byte_table,
                                mark_uint8_byte_table,
                               print_uint8_byte_table,
                               0, uint8_byte_table_equal,
                               uint8_byte_table_hash,
 DEFINE_LRECORD_IMPLEMENTATION ("uint8-byte-table", uint8_byte_table,
                                mark_uint8_byte_table,
                               print_uint8_byte_table,
                               0, uint8_byte_table_equal,
                               uint8_byte_table_hash,

-                              0 /* uint8_byte_table_description */,
+                              uint8_byte_table_description,

                               Lisp_Uint8_Byte_Table);
 
 static Lisp_Object
                               Lisp_Uint8_Byte_Table);
 
 static Lisp_Object

@@ -214,6 +221,25 @@ make_uint8_byte_table (unsigned char initval)
   return obj;
 }
 
   return obj;
 }
 

+static Lisp_Object
+copy_uint8_byte_table (Lisp_Object entry)
+{
+  Lisp_Uint8_Byte_Table *cte = XUINT8_BYTE_TABLE (entry);
+  Lisp_Object obj;
+  int i;
+  Lisp_Uint8_Byte_Table *ctenew
+    = alloc_lcrecord_type (Lisp_Uint8_Byte_Table,
+                          &lrecord_uint8_byte_table);
+
+  for (i = 0; i < 256; i++)
+    {
+      ctenew->property[i] = cte->property[i];
+    }
+
+  XSETUINT8_BYTE_TABLE (obj, ctenew);
+  return obj;
+}
+

 static int
 uint8_byte_table_same_value_p (Lisp_Object obj)
 {
 static int
 uint8_byte_table_same_value_p (Lisp_Object obj)
 {

@@ -230,22 +256,49 @@ uint8_byte_table_same_value_p (Lisp_Object obj)
 }
 
 static int
 }
 
 static int

-map_over_uint8_byte_table (Lisp_Uint8_Byte_Table *ct,
-                          int (*fn) (Emchar c, Lisp_Object val, void *arg),
-                          void *arg, Emchar ofs, int place)
+map_over_uint8_byte_table (Lisp_Uint8_Byte_Table *ct, Lisp_Char_Table* root,
+                          Emchar ofs, int place,
+                          int (*fn) (struct chartab_range *range,
+                                     Lisp_Object val, void *arg),
+                          void *arg)

 {
 {

+  struct chartab_range rainj;

   int i, retval;
   int unit = 1 << (8 * place);
   Emchar c = ofs;
   Emchar c1;
 
   int i, retval;
   int unit = 1 << (8 * place);
   Emchar c = ofs;
   Emchar c1;
 

+  rainj.type = CHARTAB_RANGE_CHAR;
+

   for (i = 0, retval = 0; i < 256 && retval == 0; i++)
     {
   for (i = 0, retval = 0; i < 256 && retval == 0; i++)
     {

-      if (ct->property[i] != BT_UINT8_unbound)
+      if (ct->property[i] == BT_UINT8_unloaded)
+       {
+#if 0
+         c1 = c + unit;
+         for (; c < c1 && retval == 0; c++)
+           {
+             Lisp_Object ret = get_char_id_table (root, c);
+
+             if (!UNBOUNDP (ret))
+               {
+                 rainj.ch = c;
+                 retval = (fn) (&rainj, ret, arg);
+               }
+           }
+#else
+         ct->property[i] = BT_UINT8_unbound;
+         c += unit;
+#endif
+       }
+      else if (ct->property[i] != BT_UINT8_unbound)

        {
          c1 = c + unit;
          for (; c < c1 && retval == 0; c++)
        {
          c1 = c + unit;
          for (; c < c1 && retval == 0; c++)

-           retval = (fn) (c, UINT8_DECODE (ct->property[i]), arg);
+           {
+             rainj.ch = c;
+             retval = (fn) (&rainj, UINT8_DECODE (ct->property[i]), arg);
+           }

        }
       else
        c += unit;
        }
       else
        c += unit;

@@ -253,11 +306,50 @@ map_over_uint8_byte_table (Lisp_Uint8_Byte_Table *ct,
   return retval;
 }
 
   return retval;
 }
 

+#ifdef HAVE_DATABASE
+static void
+save_uint8_byte_table (Lisp_Uint8_Byte_Table *ct, Lisp_Char_Table* root,
+                      Lisp_Object db,
+                      Emchar ofs, int place)
+{
+  struct chartab_range rainj;
+  int i, retval;
+  int unit = 1 << (8 * place);
+  Emchar c = ofs;
+  Emchar c1;
+
+  rainj.type = CHARTAB_RANGE_CHAR;
+
+  for (i = 0, retval = 0; i < 256 && retval == 0; i++)
+    {
+      if (ct->property[i] == BT_UINT8_unloaded)
+       {
+         c1 = c + unit;
+       }
+      else if (ct->property[i] != BT_UINT8_unbound)
+       {
+         c1 = c + unit;
+         for (; c < c1 && retval == 0; c++)
+           {
+             Fput_database (Fprin1_to_string (make_char (c), Qnil),
+                            Fprin1_to_string (UINT8_DECODE (ct->property[i]),
+                                              Qnil),
+                            db, Qt);
+             put_char_id_table (root, make_char (c), Qunloaded);
+           }
+       }
+      else
+       c += unit;
+    }
+}
+#endif
+

 #define BT_UINT16_MIN          0
 #define BT_UINT16_MIN          0

-#define BT_UINT16_MAX   (USHRT_MAX - 3)
-#define BT_UINT16_t     (USHRT_MAX - 2)
-#define BT_UINT16_nil   (USHRT_MAX - 1)
-#define BT_UINT16_unbound USHRT_MAX
+#define BT_UINT16_MAX          (USHRT_MAX - 4)
+#define BT_UINT16_t            (USHRT_MAX - 3)
+#define BT_UINT16_nil          (USHRT_MAX - 2)
+#define BT_UINT16_unbound      (USHRT_MAX - 1)
+#define BT_UINT16_unloaded     USHRT_MAX

 
 INLINE_HEADER int INT_UINT16_P (Lisp_Object obj);
 INLINE_HEADER int UINT16_VALUE_P (Lisp_Object obj);
 
 INLINE_HEADER int INT_UINT16_P (Lisp_Object obj);
 INLINE_HEADER int UINT16_VALUE_P (Lisp_Object obj);

@@ -280,14 +372,16 @@ INT_UINT16_P (Lisp_Object obj)
 INLINE_HEADER int
 UINT16_VALUE_P (Lisp_Object obj)
 {
 INLINE_HEADER int
 UINT16_VALUE_P (Lisp_Object obj)
 {

-  return EQ (obj, Qunbound)
+  return EQ (obj, Qunloaded) || EQ (obj, Qunbound)

     || EQ (obj, Qnil) || EQ (obj, Qt) || INT_UINT16_P (obj);
 }
 
 INLINE_HEADER unsigned short
 UINT16_ENCODE (Lisp_Object obj)
 {
     || EQ (obj, Qnil) || EQ (obj, Qt) || INT_UINT16_P (obj);
 }
 
 INLINE_HEADER unsigned short
 UINT16_ENCODE (Lisp_Object obj)
 {

-  if (EQ (obj, Qunbound))
+  if (EQ (obj, Qunloaded))
+    return BT_UINT16_unloaded;
+  else if (EQ (obj, Qunbound))

     return BT_UINT16_unbound;
   else if (EQ (obj, Qnil))
     return BT_UINT16_nil;
     return BT_UINT16_unbound;
   else if (EQ (obj, Qnil))
     return BT_UINT16_nil;

@@ -300,7 +394,9 @@ UINT16_ENCODE (Lisp_Object obj)
 INLINE_HEADER Lisp_Object
 UINT16_DECODE (unsigned short n)
 {
 INLINE_HEADER Lisp_Object
 UINT16_DECODE (unsigned short n)
 {

-  if (n == BT_UINT16_unbound)
+  if (n == BT_UINT16_unloaded)
+    return Qunloaded;
+  else if (n == BT_UINT16_unbound)

     return Qunbound;
   else if (n == BT_UINT16_nil)
     return Qnil;
     return Qunbound;
   else if (n == BT_UINT16_nil)
     return Qnil;

@@ -313,7 +409,9 @@ UINT16_DECODE (unsigned short n)
 INLINE_HEADER unsigned short
 UINT8_TO_UINT16 (unsigned char n)
 {
 INLINE_HEADER unsigned short
 UINT8_TO_UINT16 (unsigned char n)
 {

-  if (n == BT_UINT8_unbound)
+  if (n == BT_UINT8_unloaded)
+    return BT_UINT16_unloaded;
+  else if (n == BT_UINT8_unbound)

     return BT_UINT16_unbound;
   else if (n == BT_UINT8_nil)
     return BT_UINT16_nil;
     return BT_UINT16_unbound;
   else if (n == BT_UINT8_nil)
     return BT_UINT16_nil;

@@ -388,12 +486,16 @@ uint16_byte_table_hash (Lisp_Object obj, int depth)
   return hash;
 }
 
   return hash;
 }
 

+static const struct lrecord_description uint16_byte_table_description[] = {
+  { XD_END }
+};
+

 DEFINE_LRECORD_IMPLEMENTATION ("uint16-byte-table", uint16_byte_table,
                                mark_uint16_byte_table,
                               print_uint16_byte_table,
                               0, uint16_byte_table_equal,
                               uint16_byte_table_hash,
 DEFINE_LRECORD_IMPLEMENTATION ("uint16-byte-table", uint16_byte_table,
                                mark_uint16_byte_table,
                               print_uint16_byte_table,
                               0, uint16_byte_table_equal,
                               uint16_byte_table_hash,

-                              0 /* uint16_byte_table_description */,
+                              uint16_byte_table_description,

                               Lisp_Uint16_Byte_Table);
 
 static Lisp_Object
                               Lisp_Uint16_Byte_Table);
 
 static Lisp_Object

@@ -414,6 +516,25 @@ make_uint16_byte_table (unsigned short initval)
 }
 
 static Lisp_Object
 }
 
 static Lisp_Object

+copy_uint16_byte_table (Lisp_Object entry)
+{
+  Lisp_Uint16_Byte_Table *cte = XUINT16_BYTE_TABLE (entry);
+  Lisp_Object obj;
+  int i;
+  Lisp_Uint16_Byte_Table *ctenew
+    = alloc_lcrecord_type (Lisp_Uint16_Byte_Table,
+                          &lrecord_uint16_byte_table);
+
+  for (i = 0; i < 256; i++)
+    {
+      ctenew->property[i] = cte->property[i];
+    }
+
+  XSETUINT16_BYTE_TABLE (obj, ctenew);
+  return obj;
+}
+
+static Lisp_Object

 expand_uint8_byte_table_to_uint16 (Lisp_Object table)
 {
   Lisp_Object obj;
 expand_uint8_byte_table_to_uint16 (Lisp_Object table)
 {
   Lisp_Object obj;

@@ -447,22 +568,49 @@ uint16_byte_table_same_value_p (Lisp_Object obj)
 }
 
 static int
 }
 
 static int

-map_over_uint16_byte_table (Lisp_Uint16_Byte_Table *ct,
-                           int (*fn) (Emchar c, Lisp_Object val, void *arg),
-                           void *arg, Emchar ofs, int place)
+map_over_uint16_byte_table (Lisp_Uint16_Byte_Table *ct, Lisp_Char_Table* root,
+                           Emchar ofs, int place,
+                           int (*fn) (struct chartab_range *range,
+                                      Lisp_Object val, void *arg),
+                           void *arg)

 {
 {

+  struct chartab_range rainj;

   int i, retval;
   int unit = 1 << (8 * place);
   Emchar c = ofs;
   Emchar c1;
 
   int i, retval;
   int unit = 1 << (8 * place);
   Emchar c = ofs;
   Emchar c1;
 

+  rainj.type = CHARTAB_RANGE_CHAR;
+

   for (i = 0, retval = 0; i < 256 && retval == 0; i++)
     {
   for (i = 0, retval = 0; i < 256 && retval == 0; i++)
     {

-      if (ct->property[i] != BT_UINT16_unbound)
+      if (ct->property[i] == BT_UINT16_unloaded)
+       {
+#if 0
+         c1 = c + unit;
+         for (; c < c1 && retval == 0; c++)
+           {
+             Lisp_Object ret = get_char_id_table (root, c);
+
+             if (!UNBOUNDP (ret))
+               {
+                 rainj.ch = c;
+                 retval = (fn) (&rainj, ret, arg);
+               }
+           }
+#else
+         ct->property[i] = BT_UINT16_unbound;
+         c += unit;
+#endif
+       }
+      else if (ct->property[i] != BT_UINT16_unbound)

        {
          c1 = c + unit;
          for (; c < c1 && retval == 0; c++)
        {
          c1 = c + unit;
          for (; c < c1 && retval == 0; c++)

-           retval = (fn) (c, UINT16_DECODE (ct->property[i]), arg);
+           {
+             rainj.ch = c;
+             retval = (fn) (&rainj, UINT16_DECODE (ct->property[i]), arg);
+           }

        }
       else
        c += unit;
        }
       else
        c += unit;

@@ -470,6 +618,44 @@ map_over_uint16_byte_table (Lisp_Uint16_Byte_Table *ct,
   return retval;
 }
 
   return retval;
 }
 

+#ifdef HAVE_DATABASE
+static void
+save_uint16_byte_table (Lisp_Uint16_Byte_Table *ct, Lisp_Char_Table* root,
+                       Lisp_Object db,
+                       Emchar ofs, int place)
+{
+  struct chartab_range rainj;
+  int i, retval;
+  int unit = 1 << (8 * place);
+  Emchar c = ofs;
+  Emchar c1;
+
+  rainj.type = CHARTAB_RANGE_CHAR;
+
+  for (i = 0, retval = 0; i < 256 && retval == 0; i++)
+    {
+      if (ct->property[i] == BT_UINT16_unloaded)
+       {
+         c1 = c + unit;
+       }
+      else if (ct->property[i] != BT_UINT16_unbound)
+       {
+         c1 = c + unit;
+         for (; c < c1 && retval == 0; c++)
+           {
+             Fput_database (Fprin1_to_string (make_char (c), Qnil),
+                            Fprin1_to_string (UINT16_DECODE (ct->property[i]),
+                                              Qnil),
+                            db, Qt);
+             put_char_id_table (root, make_char (c), Qunloaded);
+           }
+       }
+      else
+       c += unit;
+    }
+}
+#endif
+

 
 static Lisp_Object
 mark_byte_table (Lisp_Object obj)
 
 static Lisp_Object
 mark_byte_table (Lisp_Object obj)

@@ -570,6 +756,37 @@ make_byte_table (Lisp_Object initval)
   return obj;
 }
 
   return obj;
 }
 

+static Lisp_Object
+copy_byte_table (Lisp_Object entry)
+{
+  Lisp_Byte_Table *cte = XBYTE_TABLE (entry);
+  Lisp_Object obj;
+  int i;
+  Lisp_Byte_Table *ctnew
+    = alloc_lcrecord_type (Lisp_Byte_Table, &lrecord_byte_table);
+
+  for (i = 0; i < 256; i++)
+    {
+      if (UINT8_BYTE_TABLE_P (cte->property[i]))
+       {
+         ctnew->property[i] = copy_uint8_byte_table (cte->property[i]);
+       }
+      else if (UINT16_BYTE_TABLE_P (cte->property[i]))
+       {
+         ctnew->property[i] = copy_uint16_byte_table (cte->property[i]);
+       }
+      else if (BYTE_TABLE_P (cte->property[i]))
+       {
+         ctnew->property[i] = copy_byte_table (cte->property[i]);
+       }
+      else
+       ctnew->property[i] = cte->property[i];
+    }
+
+  XSETBYTE_TABLE (obj, ctnew);
+  return obj;
+}
+

 static int
 byte_table_same_value_p (Lisp_Object obj)
 {
 static int
 byte_table_same_value_p (Lisp_Object obj)
 {

@@ -586,9 +803,11 @@ byte_table_same_value_p (Lisp_Object obj)
 }
 
 static int
 }
 
 static int

-map_over_byte_table (Lisp_Byte_Table *ct,
-                    int (*fn) (Emchar c, Lisp_Object val, void *arg),
-                    void *arg, Emchar ofs, int place)
+map_over_byte_table (Lisp_Byte_Table *ct, Lisp_Char_Table* root,
+                    Emchar ofs, int place,
+                    int (*fn) (struct chartab_range *range,
+                               Lisp_Object val, void *arg),
+                    void *arg)

 {
   int i, retval;
   Lisp_Object v;
 {
   int i, retval;
   Lisp_Object v;

@@ -601,29 +820,58 @@ map_over_byte_table (Lisp_Byte_Table *ct,
       if (UINT8_BYTE_TABLE_P (v))
        {
          retval
       if (UINT8_BYTE_TABLE_P (v))
        {
          retval

-           = map_over_uint8_byte_table (XUINT8_BYTE_TABLE(v),
-                                        fn, arg, c, place - 1);
+           = map_over_uint8_byte_table (XUINT8_BYTE_TABLE(v), root,
+                                        c, place - 1, fn, arg);

          c += unit;
        }
       else if (UINT16_BYTE_TABLE_P (v))
        {
          retval
          c += unit;
        }
       else if (UINT16_BYTE_TABLE_P (v))
        {
          retval

-           = map_over_uint16_byte_table (XUINT16_BYTE_TABLE(v),
-                                         fn, arg, c, place - 1);
+           = map_over_uint16_byte_table (XUINT16_BYTE_TABLE(v), root,
+                                         c, place - 1, fn, arg);

          c += unit;
        }
       else if (BYTE_TABLE_P (v))
        {
          c += unit;
        }
       else if (BYTE_TABLE_P (v))
        {

-         retval = map_over_byte_table (XBYTE_TABLE(v),
-                                       fn, arg, c, place - 1);
+         retval = map_over_byte_table (XBYTE_TABLE(v), root,
+                                       c, place - 1, fn, arg);

          c += unit;
        }
          c += unit;
        }

+      else if (EQ (v, Qunloaded))
+       {
+#if 0
+         struct chartab_range rainj;
+         Emchar c1 = c + unit;
+
+         rainj.type = CHARTAB_RANGE_CHAR;
+
+         for (; c < c1 && retval == 0; c++)
+           {
+             Lisp_Object ret = get_char_id_table (root, c);
+
+             if (!UNBOUNDP (ret))
+               {
+                 rainj.ch = c;
+                 retval = (fn) (&rainj, ret, arg);
+               }
+           }
+#else
+         ct->property[i] = Qunbound;
+         c += unit;
+#endif
+       }

       else if (!UNBOUNDP (v))
        {
       else if (!UNBOUNDP (v))
        {

+         struct chartab_range rainj;

          Emchar c1 = c + unit;
 
          Emchar c1 = c + unit;
 

+         rainj.type = CHARTAB_RANGE_CHAR;
+

          for (; c < c1 && retval == 0; c++)
          for (; c < c1 && retval == 0; c++)

-           retval = (fn) (c, v, arg);
+           {
+             rainj.ch = c;
+             retval = (fn) (&rainj, v, arg);
+           }

        }
       else
        c += unit;
        }
       else
        c += unit;

@@ -631,10 +879,62 @@ map_over_byte_table (Lisp_Byte_Table *ct,
   return retval;
 }
 
   return retval;
 }
 

+#ifdef HAVE_DATABASE
+static void
+save_byte_table (Lisp_Byte_Table *ct, Lisp_Char_Table* root,
+                Lisp_Object db,
+                Emchar ofs, int place)
+{
+  int i, retval;
+  Lisp_Object v;
+  int unit = 1 << (8 * place);
+  Emchar c = ofs;
+
+  for (i = 0, retval = 0; i < 256 && retval == 0; i++)
+    {
+      v = ct->property[i];
+      if (UINT8_BYTE_TABLE_P (v))
+       {
+         save_uint8_byte_table (XUINT8_BYTE_TABLE(v), root, db,
+                                c, place - 1);
+         c += unit;
+       }
+      else if (UINT16_BYTE_TABLE_P (v))
+       {
+         save_uint16_byte_table (XUINT16_BYTE_TABLE(v), root, db,
+                                 c, place - 1);
+         c += unit;
+       }
+      else if (BYTE_TABLE_P (v))
+       {
+         save_byte_table (XBYTE_TABLE(v), root, db,
+                          c, place - 1);
+         c += unit;
+       }
+      else if (EQ (v, Qunloaded))
+       {
+         c += unit;
+       }
+      else if (!UNBOUNDP (v))
+       {
+         struct chartab_range rainj;
+         Emchar c1 = c + unit;
+
+         rainj.type = CHARTAB_RANGE_CHAR;

 
 

-Lisp_Object get_byte_table (Lisp_Object table, unsigned char idx);
-Lisp_Object put_byte_table (Lisp_Object table, unsigned char idx,
-                           Lisp_Object value);
+         for (; c < c1 && retval == 0; c++)
+           {
+             Fput_database (Fprin1_to_string (make_char (c), Qnil),
+                            Fprin1_to_string (v, Qnil),
+                            db, Qt);
+             put_char_id_table (root, make_char (c), Qunloaded);
+           }
+       }
+      else
+       c += unit;
+    }
+}
+#endif

 
 Lisp_Object
 get_byte_table (Lisp_Object table, unsigned char idx)
 
 Lisp_Object
 get_byte_table (Lisp_Object table, unsigned char idx)

@@ -742,181 +1042,27 @@ put_byte_table (Lisp_Object table, unsigned char idx, Lisp_Object value)
   return table;
 }
 
   return table;
 }
 

-static Lisp_Object
-mark_char_id_table (Lisp_Object obj)
-{
-  Lisp_Char_ID_Table *cte = XCHAR_ID_TABLE (obj);
-
-  return cte->table;
-}
-
-static void
-print_char_id_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
-{
-  Lisp_Object table = XCHAR_ID_TABLE (obj)->table;
-  int i;
-  struct gcpro gcpro1, gcpro2;
-  GCPRO2 (obj, printcharfun);
-
-  write_c_string ("#<char-id-table ", printcharfun);
-  for (i = 0; i < 256; i++)
-    {
-      Lisp_Object elt = get_byte_table (table, i);
-      if (i != 0) write_c_string ("\n  ", printcharfun);
-      if (EQ (elt, Qunbound))
-       write_c_string ("void", printcharfun);
-      else
-       print_internal (elt, printcharfun, escapeflag);
-    }
-  UNGCPRO;
-  write_c_string (">", printcharfun);
-}
-
-static int
-char_id_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
-{
-  Lisp_Object table1 = XCHAR_ID_TABLE (obj1)->table;
-  Lisp_Object table2 = XCHAR_ID_TABLE (obj2)->table;
-  int i;
-
-  for (i = 0; i < 256; i++)
-    {
-      if (!internal_equal (get_byte_table (table1, i),
-                         get_byte_table (table2, i), 0))
-       return 0;
-    }
-  return -1;
-}
-
-static unsigned long
-char_id_table_hash (Lisp_Object obj, int depth)
-{
-  Lisp_Char_ID_Table *cte = XCHAR_ID_TABLE (obj);
-
-  return char_id_table_hash (cte->table, depth + 1);
-}
-
-static const struct lrecord_description char_id_table_description[] = {
-  { XD_LISP_OBJECT, offsetof(Lisp_Char_ID_Table, table) },
-  { XD_END }
-};
-
-DEFINE_LRECORD_IMPLEMENTATION ("char-id-table", char_id_table,
-                               mark_char_id_table,
-                              print_char_id_table,
-                              0, char_id_table_equal,
-                              char_id_table_hash,
-                              char_id_table_description,
-                              Lisp_Char_ID_Table);

 
 Lisp_Object
 make_char_id_table (Lisp_Object initval)
 {
   Lisp_Object obj;
 
 Lisp_Object
 make_char_id_table (Lisp_Object initval)
 {
   Lisp_Object obj;

-  Lisp_Char_ID_Table *cte;
-
-  cte = alloc_lcrecord_type (Lisp_Char_ID_Table, &lrecord_char_id_table);
-
-  cte->table = make_byte_table (initval);
-
-  XSETCHAR_ID_TABLE (obj, cte);
+  obj = Fmake_char_table (Qgeneric);
+  fill_char_table (XCHAR_TABLE (obj), initval);

   return obj;
 }
 
 
   return obj;
 }
 
 

-Lisp_Object
-get_char_id_table (Emchar ch, Lisp_Object table)
-{
-  unsigned int code = ch;
-
-  return
-    get_byte_table
-    (get_byte_table
-     (get_byte_table
-      (get_byte_table
-       (XCHAR_ID_TABLE (table)->table,
-       (unsigned char)(code >> 24)),
-       (unsigned char) (code >> 16)),
-      (unsigned char)  (code >> 8)),
-     (unsigned char)    code);
-}
-
-void
-put_char_id_table (Emchar ch, Lisp_Object value, Lisp_Object table)
-{
-  unsigned int code = ch;
-  Lisp_Object table1, table2, table3, table4;
+Lisp_Object Vcharacter_composition_table;
+Lisp_Object Vcharacter_variant_table;

 
 

-  table1 = XCHAR_ID_TABLE (table)->table;
-  table2 = get_byte_table (table1, (unsigned char)(code >> 24));
-  table3 = get_byte_table (table2, (unsigned char)(code >> 16));
-  table4 = get_byte_table (table3, (unsigned char)(code >> 8));
-
-  table4 = put_byte_table (table4, (unsigned char)code,         value);
-  table3 = put_byte_table (table3, (unsigned char)(code >> 8),  table4);
-  table2 = put_byte_table (table2, (unsigned char)(code >> 16), table3);
-  XCHAR_ID_TABLE (table)->table
-    = put_byte_table (table1, (unsigned char)(code >> 24), table2);
-}
-
-/* Map FN (with client data ARG) in char table CT.
-   Mapping stops the first time FN returns non-zero, and that value
-   becomes the return value of map_char_id_table(). */
-int
-map_char_id_table (Lisp_Char_ID_Table *ct,
-                  int (*fn) (Emchar c, Lisp_Object val, void *arg),
-                  void *arg);
-int
-map_char_id_table (Lisp_Char_ID_Table *ct,
-                  int (*fn) (Emchar c, Lisp_Object val, void *arg),
-                  void *arg)
-{
-  Lisp_Object v = ct->table;
-
-  if (UINT8_BYTE_TABLE_P (v))
-    return map_over_uint8_byte_table (XUINT8_BYTE_TABLE(v), fn, arg, 0, 3);
-  else if (UINT16_BYTE_TABLE_P (v))
-    return map_over_uint16_byte_table (XUINT16_BYTE_TABLE(v), fn, arg, 0, 3);
-  else if (BYTE_TABLE_P (v))
-    return map_over_byte_table (XBYTE_TABLE(v), fn, arg, 0, 3);
-  else if (!UNBOUNDP (v))
-    {
-      int unit = 1 << 24;
-      Emchar c = 0;
-      Emchar c1 = c + unit;
-      int retval;
-
-      for (retval = 0; c < c1 && retval == 0; c++)
-       retval = (fn) (c, v, arg);
-    }
-  return 0;
-}
-
-struct slow_map_char_id_table_arg
-{
-  Lisp_Object function;
-  Lisp_Object retval;
-};
-
-static int
-slow_map_char_id_table_fun (Emchar c, Lisp_Object val, void *arg)
-{
-  struct slow_map_char_id_table_arg *closure =
-    (struct slow_map_char_id_table_arg *) arg;
-
-  closure->retval = call2 (closure->function, make_char (c), val);
-  return !NILP (closure->retval);
-}
-
-
-Lisp_Object Vchar_attribute_hash_table;
-Lisp_Object Vcharacter_composition_table;
-Lisp_Object Vcharacter_variant_table;

 
 

+Lisp_Object Qsystem_char_id;

 
 Lisp_Object Q_decomposition;
 Lisp_Object Qto_ucs;
 Lisp_Object Q_ucs;
 
 Lisp_Object Q_decomposition;
 Lisp_Object Qto_ucs;
 Lisp_Object Q_ucs;

+Lisp_Object Q_ucs_variants;

 Lisp_Object Qcompat;
 Lisp_Object Qisolated;
 Lisp_Object Qinitial;
 Lisp_Object Qcompat;
 Lisp_Object Qisolated;
 Lisp_Object Qinitial;

@@ -993,19 +1139,19 @@ Return character corresponding with list.
       Lisp_Object ret;
       Emchar c = to_char_id (v, "Invalid value for composition", list);
 
       Lisp_Object ret;
       Emchar c = to_char_id (v, "Invalid value for composition", list);
 

-      ret = get_char_id_table (c, table);
+      ret = get_char_id_table (XCHAR_TABLE(table), c);

 
       rest = Fcdr (rest);
       if (NILP (rest))
        {
 
       rest = Fcdr (rest);
       if (NILP (rest))
        {

-         if (!CHAR_ID_TABLE_P (ret))
+         if (!CHAR_TABLEP (ret))

            return ret;
          else
            return Qt;
        }
       else if (!CONSP (rest))
        break;
            return ret;
          else
            return Qt;
        }
       else if (!CONSP (rest))
        break;

-      else if (CHAR_ID_TABLE_P (ret))
+      else if (CHAR_TABLEP (ret))

        table = ret;
       else
        signal_simple_error ("Invalid table is found with", list);
        table = ret;
       else
        signal_simple_error ("Invalid table is found with", list);

@@ -1018,1860 +1164,2390 @@ Return variants of CHARACTER.
 */
        (character))
 {
 */
        (character))
 {

+  Lisp_Object ret;
+

   CHECK_CHAR (character);
   CHECK_CHAR (character);

-  return Fcopy_list (get_char_id_table (XCHAR (character),
-                                       Vcharacter_variant_table));
+  ret = get_char_id_table (XCHAR_TABLE(Vcharacter_variant_table),
+                          XCHAR(character));
+  if (CONSP (ret))
+    return Fcopy_list (ret);
+  else
+    return Qnil;

 }
 
 }
 

+#endif

 
 

-/* We store the char-attributes in hash tables with the names as the
-   key and the actual char-id-table object as the value.  Occasionally
-   we need to use them in a list format.  These routines provide us
-   with that. */
-struct char_attribute_list_closure
-{
-  Lisp_Object *char_attribute_list;
-};
+\f
+/* A char table maps from ranges of characters to values.

 
 

-static int
-add_char_attribute_to_list_mapper (Lisp_Object key, Lisp_Object value,
-                                  void *char_attribute_list_closure)
-{
-  /* This function can GC */
-  struct char_attribute_list_closure *calcl
-    = (struct char_attribute_list_closure*) char_attribute_list_closure;
-  Lisp_Object *char_attribute_list = calcl->char_attribute_list;
+   Implementing a general data structure that maps from arbitrary
+   ranges of numbers to values is tricky to do efficiently.  As it
+   happens, it should suffice (and is usually more convenient, anyway)
+   when dealing with characters to restrict the sorts of ranges that
+   can be assigned values, as follows:

 
 

-  *char_attribute_list = Fcons (key, *char_attribute_list);
-  return 0;
-}
+   1) All characters.
+   2) All characters in a charset.
+   3) All characters in a particular row of a charset, where a "row"
+      means all characters with the same first byte.
+   4) A particular character in a charset.

 
 

-DEFUN ("char-attribute-list", Fchar_attribute_list, 0, 0, 0, /*
-Return the list of all existing character attributes except coded-charsets.
-*/
-       ())
-{
-  Lisp_Object char_attribute_list = Qnil;
-  struct gcpro gcpro1;
-  struct char_attribute_list_closure char_attribute_list_closure;
-  
-  GCPRO1 (char_attribute_list);
-  char_attribute_list_closure.char_attribute_list = &char_attribute_list;
-  elisp_maphash (add_char_attribute_to_list_mapper,
-                Vchar_attribute_hash_table,
-                &char_attribute_list_closure);
-  UNGCPRO;
-  return char_attribute_list;
-}
+   We use char tables to generalize the 256-element vectors now
+   littering the Emacs code.

 
 

-DEFUN ("find-char-attribute-table", Ffind_char_attribute_table, 1, 1, 0, /*
-Return char-id-table corresponding to ATTRIBUTE.
-*/
-       (attribute))
-{
-  return Fgethash (attribute, Vchar_attribute_hash_table, Qnil);
-}
+   Possible uses (all should be converted at some point):

 
 

+   1) category tables
+   2) syntax tables
+   3) display tables
+   4) case tables
+   5) keyboard-translate-table?

 
 

-/* We store the char-id-tables in hash tables with the attributes as
-   the key and the actual char-id-table object as the value.  Each
-   char-id-table stores values of an attribute corresponding with
-   characters.  Occasionally we need to get attributes of a character
-   in a association-list format.  These routines provide us with
-   that. */
-struct char_attribute_alist_closure
-{
-  Emchar char_id;
-  Lisp_Object *char_attribute_alist;
-};
+   We provide an
+   abstract type to generalize the Emacs vectors and Mule
+   vectors-of-vectors goo.
+   */

 
 

-static int
-add_char_attribute_alist_mapper (Lisp_Object key, Lisp_Object value,
-                                void *char_attribute_alist_closure)
+/************************************************************************/
+/*                         Char Table object                            */
+/************************************************************************/
+
+#if defined(MULE)&&!defined(UTF2000)
+
+static Lisp_Object
+mark_char_table_entry (Lisp_Object obj)

 {
 {

-  /* This function can GC */
-  struct char_attribute_alist_closure *caacl =
-    (struct char_attribute_alist_closure*) char_attribute_alist_closure;
-  Lisp_Object ret = get_char_id_table (caacl->char_id, value);
-  if (!UNBOUNDP (ret))
+  Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj);
+  int i;
+
+  for (i = 0; i < 96; i++)

     {
     {

-      Lisp_Object *char_attribute_alist = caacl->char_attribute_alist;
-      *char_attribute_alist
-       = Fcons (Fcons (key, ret), *char_attribute_alist);
+      mark_object (cte->level2[i]);

     }
     }

-  return 0;
+  return Qnil;

 }
 
 }
 

-DEFUN ("char-attribute-alist", Fchar_attribute_alist, 1, 1, 0, /*
-Return the alist of attributes of CHARACTER.
-*/
-       (character))
+static int
+char_table_entry_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)

 {
 {

-  Lisp_Object alist = Qnil;
+  Lisp_Char_Table_Entry *cte1 = XCHAR_TABLE_ENTRY (obj1);
+  Lisp_Char_Table_Entry *cte2 = XCHAR_TABLE_ENTRY (obj2);

   int i;
 
   int i;
 

-  CHECK_CHAR (character);
-  {
-    struct gcpro gcpro1;
-    struct char_attribute_alist_closure char_attribute_alist_closure;
-  
-    GCPRO1 (alist);
-    char_attribute_alist_closure.char_id = XCHAR (character);
-    char_attribute_alist_closure.char_attribute_alist = &alist;
-    elisp_maphash (add_char_attribute_alist_mapper,
-                  Vchar_attribute_hash_table,
-                  &char_attribute_alist_closure);
-    UNGCPRO;
-  }
+  for (i = 0; i < 96; i++)
+    if (!internal_equal (cte1->level2[i], cte2->level2[i], depth + 1))
+      return 0;

 
 

-  for (i = 0; i < countof (chlook->charset_by_leading_byte); i++)
-    {
-      Lisp_Object ccs = chlook->charset_by_leading_byte[i];
+  return 1;
+}

 
 

-      if (!NILP (ccs))
-       {
-         Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (ccs);
-         Lisp_Object cpos;
+static unsigned long
+char_table_entry_hash (Lisp_Object obj, int depth)
+{
+  Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj);

 
 

-         if ( CHAR_ID_TABLE_P (encoding_table)
-              && INTP (cpos = get_char_id_table (XCHAR (character),
-                                                 encoding_table)) )
-           {
-             alist = Fcons (Fcons (ccs, cpos), alist);
-           }
-       }
-    }
-  return alist;
+  return internal_array_hash (cte->level2, 96, depth);

 }
 
 }
 

-DEFUN ("get-char-attribute", Fget_char_attribute, 2, 3, 0, /*
-Return the value of CHARACTER's ATTRIBUTE.
-Return DEFAULT-VALUE if the value is not exist.
-*/
-       (character, attribute, default_value))
+static const struct lrecord_description char_table_entry_description[] = {
+  { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table_Entry, level2), 96 },
+  { XD_END }
+};
+
+DEFINE_LRECORD_IMPLEMENTATION ("char-table-entry", char_table_entry,
+                               mark_char_table_entry, internal_object_printer,
+                              0, char_table_entry_equal,
+                              char_table_entry_hash,
+                              char_table_entry_description,
+                              Lisp_Char_Table_Entry);
+#endif /* MULE */
+
+static Lisp_Object
+mark_char_table (Lisp_Object obj)

 {
 {

-  Lisp_Object ccs;
+  Lisp_Char_Table *ct = XCHAR_TABLE (obj);
+#ifdef UTF2000

 
 

-  CHECK_CHAR (character);
-  if (!NILP (ccs = Ffind_charset (attribute)))
-    {
-      Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (ccs);
+  mark_object (ct->table);
+  mark_object (ct->name);
+#else
+  int i;

 
 

-      if (CHAR_ID_TABLE_P (encoding_table))
-       return get_char_id_table (XCHAR (character), encoding_table);
-    }
-  else
+  for (i = 0; i < NUM_ASCII_CHARS; i++)
+    mark_object (ct->ascii[i]);
+#ifdef MULE
+  for (i = 0; i < NUM_LEADING_BYTES; i++)
+    mark_object (ct->level1[i]);
+#endif
+#endif
+#ifdef UTF2000
+  return ct->default_value;
+#else
+  return ct->mirror_table;
+#endif
+}
+
+/* WARNING: All functions of this nature need to be written extremely
+   carefully to avoid crashes during GC.  Cf. prune_specifiers()
+   and prune_weak_hash_tables(). */
+
+void
+prune_syntax_tables (void)
+{
+  Lisp_Object rest, prev = Qnil;
+
+  for (rest = Vall_syntax_tables;
+       !NILP (rest);
+       rest = XCHAR_TABLE (rest)->next_table)

     {
     {

-      Lisp_Object table = Fgethash (attribute,
-                                   Vchar_attribute_hash_table,
-                                   Qunbound);
-      if (!UNBOUNDP (table))
+      if (! marked_p (rest))

        {
        {

-         Lisp_Object ret = get_char_id_table (XCHAR (character), table);
-         if (!UNBOUNDP (ret))
-           return ret;
+         /* This table is garbage.  Remove it from the list. */
+         if (NILP (prev))
+           Vall_syntax_tables = XCHAR_TABLE (rest)->next_table;
+         else
+           XCHAR_TABLE (prev)->next_table =
+             XCHAR_TABLE (rest)->next_table;

        }
     }
        }
     }

-  return default_value;

 }
 
 }
 

-DEFUN ("put-char-attribute", Fput_char_attribute, 3, 3, 0, /*
-Store CHARACTER's ATTRIBUTE with VALUE.
-*/
-       (character, attribute, value))
+static Lisp_Object
+char_table_type_to_symbol (enum char_table_type type)

 {
 {

-  Lisp_Object ccs;
+  switch (type)
+  {
+  default: abort();
+  case CHAR_TABLE_TYPE_GENERIC:  return Qgeneric;
+  case CHAR_TABLE_TYPE_SYNTAX:   return Qsyntax;
+  case CHAR_TABLE_TYPE_DISPLAY:  return Qdisplay;
+  case CHAR_TABLE_TYPE_CHAR:     return Qchar;
+#ifdef MULE
+  case CHAR_TABLE_TYPE_CATEGORY: return Qcategory;
+#endif
+  }
+}

 
 

-  CHECK_CHAR (character);
-  ccs = Ffind_charset (attribute);
-  if (!NILP (ccs))
-    {
-      return put_char_ccs_code_point (character, ccs, value);
-    }
-  else if (EQ (attribute, Q_decomposition))
-    {
-      Lisp_Object seq;
-
-      if (!CONSP (value))
-       signal_simple_error ("Invalid value for ->decomposition",
-                            value);
+static enum char_table_type
+symbol_to_char_table_type (Lisp_Object symbol)
+{
+  CHECK_SYMBOL (symbol);

 
 

-      if (CONSP (Fcdr (value)))
-       {
-         Lisp_Object rest = value;
-         Lisp_Object table = Vcharacter_composition_table;
-         size_t len;
-         int i = 0;
+  if (EQ (symbol, Qgeneric))  return CHAR_TABLE_TYPE_GENERIC;
+  if (EQ (symbol, Qsyntax))   return CHAR_TABLE_TYPE_SYNTAX;
+  if (EQ (symbol, Qdisplay))  return CHAR_TABLE_TYPE_DISPLAY;
+  if (EQ (symbol, Qchar))     return CHAR_TABLE_TYPE_CHAR;
+#ifdef MULE
+  if (EQ (symbol, Qcategory)) return CHAR_TABLE_TYPE_CATEGORY;
+#endif

 
 

-         GET_EXTERNAL_LIST_LENGTH (rest, len);
-         seq = make_vector (len, Qnil);
+  signal_simple_error ("Unrecognized char table type", symbol);
+  return CHAR_TABLE_TYPE_GENERIC; /* not reached */
+}

 
 

-         while (CONSP (rest))
-           {
-             Lisp_Object v = Fcar (rest);
-             Lisp_Object ntable;
-             Emchar c
-               = to_char_id (v, "Invalid value for ->decomposition", value);
+static void
+print_chartab_range (Emchar first, Emchar last, Lisp_Object val,
+                    Lisp_Object printcharfun)
+{
+  if (first != last)
+    {
+      write_c_string (" (", printcharfun);
+      print_internal (make_char (first), printcharfun, 0);
+      write_c_string (" ", printcharfun);
+      print_internal (make_char (last), printcharfun, 0);
+      write_c_string (") ", printcharfun);
+    }
+  else
+    {
+      write_c_string (" ", printcharfun);
+      print_internal (make_char (first), printcharfun, 0);
+      write_c_string (" ", printcharfun);
+    }
+  print_internal (val, printcharfun, 1);
+}

 
 

-             if (c < 0)
-               XVECTOR_DATA(seq)[i++] = v;
-             else
-               XVECTOR_DATA(seq)[i++] = make_char (c);
-             rest = Fcdr (rest);
-             if (!CONSP (rest))
-               {
-                 put_char_id_table (c, character, table);
-                 break;
-               }
-             else
-               {
-                 ntable = get_char_id_table (c, table);
-                 if (!CHAR_ID_TABLE_P (ntable))
-                   {
-                     ntable = make_char_id_table (Qnil);
-                     put_char_id_table (c, ntable, table);
-                   }
-                 table = ntable;
-               }
-           }
-       }
-      else
-       {
-         Lisp_Object v = Fcar (value);
+#if defined(MULE)&&!defined(UTF2000)

 
 

-         if (INTP (v))
-           {
-             Emchar c = XINT (v);
-             Lisp_Object ret
-               = get_char_id_table (c, Vcharacter_variant_table);
+static void
+print_chartab_charset_row (Lisp_Object charset,
+                          int row,
+                          Lisp_Char_Table_Entry *cte,
+                          Lisp_Object printcharfun)
+{
+  int i;
+  Lisp_Object cat = Qunbound;
+  int first = -1;

 
 

-             if (NILP (Fmemq (v, ret)))
-               {
-                 put_char_id_table (c, Fcons (character, ret),
-                                    Vcharacter_variant_table);
-               }
-           }
-         seq = make_vector (1, v);
-       }
-      value = seq;
-    }
-  else if (EQ (attribute, Qto_ucs) || EQ (attribute, Q_ucs))
+  for (i = 32; i < 128; i++)

     {
     {

-      Lisp_Object ret;
-      Emchar c;
-
-      if (!INTP (value))
-       signal_simple_error ("Invalid value for ->ucs", value);
+      Lisp_Object pam = cte->level2[i - 32];

 
 

-      c = XINT (value);
+      if (first == -1)
+       {
+         first = i;
+         cat = pam;
+         continue;
+       }

 
 

-      ret = get_char_id_table (c, Vcharacter_variant_table);
-      if (NILP (Fmemq (character, ret)))
+      if (!EQ (cat, pam))

        {
        {

-         put_char_id_table (c, Fcons (character, ret),
-                            Vcharacter_variant_table);
+         if (row == -1)
+           print_chartab_range (MAKE_CHAR (charset, first, 0),
+                                MAKE_CHAR (charset, i - 1, 0),
+                                cat, printcharfun);
+         else
+           print_chartab_range (MAKE_CHAR (charset, row, first),
+                                MAKE_CHAR (charset, row, i - 1),
+                                cat, printcharfun);
+         first = -1;
+         i--;

        }
        }

-#if 0
-      if (EQ (attribute, Q_ucs))
-       attribute = Qto_ucs;
-#endif

     }
     }

-  {
-    Lisp_Object table = Fgethash (attribute,
-                                 Vchar_attribute_hash_table,
-                                 Qnil);

 
 

-    if (NILP (table))
-      {
-       table = make_char_id_table (Qunbound);
-       Fputhash (attribute, table, Vchar_attribute_hash_table);
-      }
-    put_char_id_table (XCHAR (character), value, table);
-    return value;
-  }
+  if (first != -1)
+    {
+      if (row == -1)
+       print_chartab_range (MAKE_CHAR (charset, first, 0),
+                            MAKE_CHAR (charset, i - 1, 0),
+                            cat, printcharfun);
+      else
+       print_chartab_range (MAKE_CHAR (charset, row, first),
+                            MAKE_CHAR (charset, row, i - 1),
+                            cat, printcharfun);
+    }

 }
 }

-  
-DEFUN ("remove-char-attribute", Fremove_char_attribute, 2, 2, 0, /*
-Remove CHARACTER's ATTRIBUTE.
-*/
-       (character, attribute))
+
+static void
+print_chartab_two_byte_charset (Lisp_Object charset,
+                               Lisp_Char_Table_Entry *cte,
+                               Lisp_Object printcharfun)

 {
 {

-  Lisp_Object ccs;
+  int i;

 
 

-  CHECK_CHAR (character);
-  ccs = Ffind_charset (attribute);
-  if (!NILP (ccs))
-    {
-      return remove_char_ccs (character, ccs);
-    }
-  else
+  for (i = 32; i < 128; i++)

     {
     {

-      Lisp_Object table = Fgethash (attribute,
-                                   Vchar_attribute_hash_table,
-                                   Qunbound);
-      if (!UNBOUNDP (table))
+      Lisp_Object jen = cte->level2[i - 32];
+
+      if (!CHAR_TABLE_ENTRYP (jen))

        {
        {

-         put_char_id_table (XCHAR (character), Qunbound, table);
-         return Qt;
+         char buf[100];
+
+         write_c_string (" [", printcharfun);
+         print_internal (XCHARSET_NAME (charset), printcharfun, 0);
+         sprintf (buf, " %d] ", i);
+         write_c_string (buf, printcharfun);
+         print_internal (jen, printcharfun, 0);

        }
        }

+      else
+       print_chartab_charset_row (charset, i, XCHAR_TABLE_ENTRY (jen),
+                                  printcharfun);

     }
     }

-  return Qnil;

 }
 
 }
 

-DEFUN ("map-char-attribute", Fmap_char_attribute, 2, 2, 0, /*
-Map FUNCTION over entries in ATTRIBUTE, calling it with two args,
-each key and value in the table.
-*/
-       (function, attribute))
+#endif /* MULE */
+
+static void
+print_char_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)

 {
 {

-  Lisp_Object ccs;
-  Lisp_Char_ID_Table *ct;
-  struct slow_map_char_id_table_arg slarg;
+  Lisp_Char_Table *ct = XCHAR_TABLE (obj);
+#ifdef UTF2000
+  int i;

   struct gcpro gcpro1, gcpro2;
   struct gcpro gcpro1, gcpro2;

+  GCPRO2 (obj, printcharfun);

 
 

-  if (!NILP (ccs = Ffind_charset (attribute)))
-    {
-      Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (ccs);
-
-      if (CHAR_ID_TABLE_P (encoding_table))
-       ct = XCHAR_ID_TABLE (encoding_table);
-      else
-       return Qnil;
-    }
-  else
+  write_c_string ("#s(char-table ", printcharfun);
+  write_c_string (" ", printcharfun);
+  write_c_string (string_data
+                 (symbol_name
+                  (XSYMBOL (char_table_type_to_symbol (ct->type)))),
+                 printcharfun);
+  write_c_string ("\n ", printcharfun);
+  print_internal (ct->default_value, printcharfun, escapeflag);
+  for (i = 0; i < 256; i++)

     {
     {

-      Lisp_Object table = Fgethash (attribute,
-                                   Vchar_attribute_hash_table,
-                                   Qunbound);
-      if (CHAR_ID_TABLE_P (table))
-       ct = XCHAR_ID_TABLE (table);
+      Lisp_Object elt = get_byte_table (ct->table, i);
+      if (i != 0) write_c_string ("\n  ", printcharfun);
+      if (EQ (elt, Qunbound))
+       write_c_string ("void", printcharfun);

       else
       else

-       return Qnil;
+       print_internal (elt, printcharfun, escapeflag);

     }
     }

-  slarg.function = function;
-  slarg.retval = Qnil;
-  GCPRO2 (slarg.function, slarg.retval);
-  map_char_id_table (ct, slow_map_char_id_table_fun, &slarg);

   UNGCPRO;
   UNGCPRO;

+#else /* non UTF2000 */
+  char buf[200];

 
 

-  return slarg.retval;
-}
-
-EXFUN (Fmake_char, 3);
-EXFUN (Fdecode_char, 2);
+  sprintf (buf, "#s(char-table type %s data (",
+          string_data (symbol_name (XSYMBOL
+                                    (char_table_type_to_symbol (ct->type)))));
+  write_c_string (buf, printcharfun);

 
 

-DEFUN ("define-char", Fdefine_char, 1, 1, 0, /*
-Store character's ATTRIBUTES.
-*/
-       (attributes))
-{
-  Lisp_Object rest = attributes;
-  Lisp_Object code = Fcdr (Fassq (Qucs, attributes));
-  Lisp_Object character;
+  /* Now write out the ASCII/Control-1 stuff. */
+  {
+    int i;
+    int first = -1;
+    Lisp_Object val = Qunbound;

 
 

-  if (NILP (code))
-    {
-      while (CONSP (rest))
-       {
-         Lisp_Object cell = Fcar (rest);
-         Lisp_Object ccs;
+    for (i = 0; i < NUM_ASCII_CHARS; i++)
+      {
+       if (first == -1)
+         {
+           first = i;
+           val = ct->ascii[i];
+           continue;
+         }

 
 

-         if (!LISTP (cell))
-           signal_simple_error ("Invalid argument", attributes);
-         if (!NILP (ccs = Ffind_charset (Fcar (cell)))
-             && ((XCHARSET_FINAL (ccs) != 0) ||
-                 (XCHARSET_UCS_MAX (ccs) > 0)) )
-           {
-             cell = Fcdr (cell);
-             if (CONSP (cell))
-               character = Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
-             else
-               character = Fdecode_char (ccs, cell);
-             if (!NILP (character))
-               goto setup_attributes;
-           }
-         rest = Fcdr (rest);
-       }
-      if ( (!NILP (code = Fcdr (Fassq (Qto_ucs, attributes)))) ||
-          (!NILP (code = Fcdr (Fassq (Q_ucs, attributes)))) )
-       
-       {
-         if (!INTP (code))
-           signal_simple_error ("Invalid argument", attributes);
-         else
-           character = make_char (XINT (code) + 0x100000);
-         goto setup_attributes;
-       }
-      return Qnil;
-    }
-  else if (!INTP (code))
-    signal_simple_error ("Invalid argument", attributes);
-  else
-    character = make_char (XINT (code));
-
- setup_attributes:
-  rest = attributes;
-  while (CONSP (rest))
-    {
-      Lisp_Object cell = Fcar (rest);
+       if (!EQ (ct->ascii[i], val))
+         {
+           print_chartab_range (first, i - 1, val, printcharfun);
+           first = -1;
+           i--;
+         }
+      }

 
 

-      if (!LISTP (cell))
-       signal_simple_error ("Invalid argument", attributes);
+    if (first != -1)
+      print_chartab_range (first, i - 1, val, printcharfun);
+  }

 
 

-      Fput_char_attribute (character, Fcar (cell), Fcdr (cell));
-      rest = Fcdr (rest);
-    }
-  return character;
-}
+#ifdef MULE
+  {
+    Charset_ID i;

 
 

-DEFUN ("find-char", Ffind_char, 1, 1, 0, /*
-Retrieve the character of the given ATTRIBUTES.
-*/
-       (attributes))
-{
-  Lisp_Object rest = attributes;
-  Lisp_Object code;
+    for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES;
+        i++)
+      {
+       Lisp_Object ann = ct->level1[i - MIN_LEADING_BYTE];
+       Lisp_Object charset = CHARSET_BY_LEADING_BYTE (i);

 
 

-  while (CONSP (rest))
-    {
-      Lisp_Object cell = Fcar (rest);
-      Lisp_Object ccs;
+       if (!CHARSETP (charset) || i == LEADING_BYTE_ASCII
+            || i == LEADING_BYTE_CONTROL_1)
+         continue;
+       if (!CHAR_TABLE_ENTRYP (ann))
+         {
+           write_c_string (" ", printcharfun);
+           print_internal (XCHARSET_NAME (charset),
+                           printcharfun, 0);
+           write_c_string (" ", printcharfun);
+           print_internal (ann, printcharfun, 0);
+         }
+       else
+         {
+           Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (ann);
+           if (XCHARSET_DIMENSION (charset) == 1)
+             print_chartab_charset_row (charset, -1, cte, printcharfun);
+           else
+             print_chartab_two_byte_charset (charset, cte, printcharfun);
+         }
+      }
+  }
+#endif /* MULE */
+#endif /* non UTF2000 */

 
 

-      if (!LISTP (cell))
-       signal_simple_error ("Invalid argument", attributes);
-      if (!NILP (ccs = Ffind_charset (Fcar (cell))))
-       {
-         cell = Fcdr (cell);
-         if (CONSP (cell))
-           return Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
-         else
-           return Fdecode_char (ccs, cell);
-       }
-      rest = Fcdr (rest);
-    }
-  if ( (!NILP (code = Fcdr (Fassq (Qto_ucs, attributes)))) ||
-       (!NILP (code = Fcdr (Fassq (Q_ucs, attributes)))) )
-    {
-      if (!INTP (code))
-       signal_simple_error ("Invalid argument", attributes);
-      else
-       return make_char (XINT (code) + 0x100000);
-    }
-  return Qnil;
+  write_c_string ("))", printcharfun);

 }
 
 }
 

-#endif
-
-\f
-/* A char table maps from ranges of characters to values.
-
-   Implementing a general data structure that maps from arbitrary
-   ranges of numbers to values is tricky to do efficiently.  As it
-   happens, it should suffice (and is usually more convenient, anyway)
-   when dealing with characters to restrict the sorts of ranges that
-   can be assigned values, as follows:
-
-   1) All characters.
-   2) All characters in a charset.
-   3) All characters in a particular row of a charset, where a "row"
-      means all characters with the same first byte.
-   4) A particular character in a charset.
-
-   We use char tables to generalize the 256-element vectors now
-   littering the Emacs code.
-
-   Possible uses (all should be converted at some point):
-
-   1) category tables
-   2) syntax tables
-   3) display tables
-   4) case tables
-   5) keyboard-translate-table?
-
-   We provide an
-   abstract type to generalize the Emacs vectors and Mule
-   vectors-of-vectors goo.
-   */
-
-/************************************************************************/
-/*                         Char Table object                            */
-/************************************************************************/
-
-#ifdef MULE
-
-static Lisp_Object
-mark_char_table_entry (Lisp_Object obj)
+static int
+char_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)

 {
 {

-  Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj);
+  Lisp_Char_Table *ct1 = XCHAR_TABLE (obj1);
+  Lisp_Char_Table *ct2 = XCHAR_TABLE (obj2);

   int i;
 
   int i;
 

-  for (i = 0; i < 96; i++)
+  if (CHAR_TABLE_TYPE (ct1) != CHAR_TABLE_TYPE (ct2))
+    return 0;
+
+#ifdef UTF2000
+  for (i = 0; i < 256; i++)

     {
     {

-      mark_object (cte->level2[i]);
+      if (!internal_equal (get_byte_table (ct1->table, i),
+                          get_byte_table (ct2->table, i), 0))
+       return 0;

     }
     }

-  return Qnil;
-}
-
-static int
-char_table_entry_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
-{
-  Lisp_Char_Table_Entry *cte1 = XCHAR_TABLE_ENTRY (obj1);
-  Lisp_Char_Table_Entry *cte2 = XCHAR_TABLE_ENTRY (obj2);
-  int i;
+#else
+  for (i = 0; i < NUM_ASCII_CHARS; i++)
+    if (!internal_equal (ct1->ascii[i], ct2->ascii[i], depth + 1))
+      return 0;

 
 

-  for (i = 0; i < 96; i++)
-    if (!internal_equal (cte1->level2[i], cte2->level2[i], depth + 1))
+#ifdef MULE
+  for (i = 0; i < NUM_LEADING_BYTES; i++)
+    if (!internal_equal (ct1->level1[i], ct2->level1[i], depth + 1))

       return 0;
       return 0;

+#endif /* MULE */
+#endif /* non UTF2000 */

 
   return 1;
 }
 
 static unsigned long
 
   return 1;
 }
 
 static unsigned long

-char_table_entry_hash (Lisp_Object obj, int depth)
+char_table_hash (Lisp_Object obj, int depth)

 {
 {

-  Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj);
-
-  return internal_array_hash (cte->level2, 96, depth);
+  Lisp_Char_Table *ct = XCHAR_TABLE (obj);
+#ifdef UTF2000
+    return byte_table_hash (ct->table, depth + 1);
+#else
+  unsigned long hashval = internal_array_hash (ct->ascii, NUM_ASCII_CHARS,
+                                              depth);
+#ifdef MULE
+  hashval = HASH2 (hashval,
+                  internal_array_hash (ct->level1, NUM_LEADING_BYTES, depth));
+#endif /* MULE */
+  return hashval;
+#endif

 }
 
 }
 

-static const struct lrecord_description char_table_entry_description[] = {
-  { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table_Entry, level2), 96 },
+static const struct lrecord_description char_table_description[] = {
+#ifdef UTF2000
+  { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, table) },
+  { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, default_value) },
+  { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, name) },
+#else
+  { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, ascii), NUM_ASCII_CHARS },
+#ifdef MULE
+  { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, level1), NUM_LEADING_BYTES },
+#endif
+#endif
+#ifndef UTF2000
+  { XD_LISP_OBJECT, offsetof (Lisp_Char_Table, mirror_table) },
+#endif
+  { XD_LO_LINK,     offsetof (Lisp_Char_Table, next_table) },

   { XD_END }
 };
 
   { XD_END }
 };
 

-DEFINE_LRECORD_IMPLEMENTATION ("char-table-entry", char_table_entry,
-                               mark_char_table_entry, internal_object_printer,
-                              0, char_table_entry_equal,
-                              char_table_entry_hash,
-                              char_table_entry_description,
-                              Lisp_Char_Table_Entry);
-#endif /* MULE */
+DEFINE_LRECORD_IMPLEMENTATION ("char-table", char_table,
+                               mark_char_table, print_char_table, 0,
+                              char_table_equal, char_table_hash,
+                              char_table_description,
+                              Lisp_Char_Table);

 
 

-static Lisp_Object
-mark_char_table (Lisp_Object obj)
-{
-  Lisp_Char_Table *ct = XCHAR_TABLE (obj);
-  int i;
+DEFUN ("char-table-p", Fchar_table_p, 1, 1, 0, /*
+Return non-nil if OBJECT is a char table.

 
 

-  for (i = 0; i < NUM_ASCII_CHARS; i++)
-    mark_object (ct->ascii[i]);
-#ifdef MULE
-  for (i = 0; i < NUM_LEADING_BYTES; i++)
-    mark_object (ct->level1[i]);
-#endif
-  return ct->mirror_table;
-}
+A char table is a table that maps characters (or ranges of characters)
+to values.  Char tables are specialized for characters, only allowing
+particular sorts of ranges to be assigned values.  Although this
+loses in generality, it makes for extremely fast (constant-time)
+lookups, and thus is feasible for applications that do an extremely
+large number of lookups (e.g. scanning a buffer for a character in
+a particular syntax, where a lookup in the syntax table must occur
+once per character).

 
 

-/* WARNING: All functions of this nature need to be written extremely
-   carefully to avoid crashes during GC.  Cf. prune_specifiers()
-   and prune_weak_hash_tables(). */
+When Mule support exists, the types of ranges that can be assigned
+values are

 
 

-void
-prune_syntax_tables (void)
-{
-  Lisp_Object rest, prev = Qnil;
+-- all characters
+-- an entire charset
+-- a single row in a two-octet charset
+-- a single character

 
 

-  for (rest = Vall_syntax_tables;
-       !NILP (rest);
-       rest = XCHAR_TABLE (rest)->next_table)
-    {
-      if (! marked_p (rest))
-       {
-         /* This table is garbage.  Remove it from the list. */
-         if (NILP (prev))
-           Vall_syntax_tables = XCHAR_TABLE (rest)->next_table;
-         else
-           XCHAR_TABLE (prev)->next_table =
-             XCHAR_TABLE (rest)->next_table;
-       }
-    }
+When Mule support is not present, the types of ranges that can be
+assigned values are
+
+-- all characters
+-- a single character
+
+To create a char table, use `make-char-table'.
+To modify a char table, use `put-char-table' or `remove-char-table'.
+To retrieve the value for a particular character, use `get-char-table'.
+See also `map-char-table', `clear-char-table', `copy-char-table',
+`valid-char-table-type-p', `char-table-type-list',
+`valid-char-table-value-p', and `check-char-table-value'.
+*/
+       (object))
+{
+  return CHAR_TABLEP (object) ? Qt : Qnil;

 }
 
 }
 

-static Lisp_Object
-char_table_type_to_symbol (enum char_table_type type)
+DEFUN ("char-table-type-list", Fchar_table_type_list, 0, 0, 0, /*
+Return a list of the recognized char table types.
+See `valid-char-table-type-p'.
+*/
+       ())

 {
 {

-  switch (type)
-  {
-  default: abort();
-  case CHAR_TABLE_TYPE_GENERIC:  return Qgeneric;
-  case CHAR_TABLE_TYPE_SYNTAX:   return Qsyntax;
-  case CHAR_TABLE_TYPE_DISPLAY:  return Qdisplay;
-  case CHAR_TABLE_TYPE_CHAR:     return Qchar;

 #ifdef MULE
 #ifdef MULE

-  case CHAR_TABLE_TYPE_CATEGORY: return Qcategory;
+  return list5 (Qchar, Qcategory, Qdisplay, Qgeneric, Qsyntax);
+#else
+  return list4 (Qchar, Qdisplay, Qgeneric, Qsyntax);

 #endif
 #endif

-  }

 }
 
 }
 

-static enum char_table_type
-symbol_to_char_table_type (Lisp_Object symbol)
-{
-  CHECK_SYMBOL (symbol);
+DEFUN ("valid-char-table-type-p", Fvalid_char_table_type_p, 1, 1, 0, /*
+Return t if TYPE if a recognized char table type.

 
 

-  if (EQ (symbol, Qgeneric))  return CHAR_TABLE_TYPE_GENERIC;
-  if (EQ (symbol, Qsyntax))   return CHAR_TABLE_TYPE_SYNTAX;
-  if (EQ (symbol, Qdisplay))  return CHAR_TABLE_TYPE_DISPLAY;
-  if (EQ (symbol, Qchar))     return CHAR_TABLE_TYPE_CHAR;
+Each char table type is used for a different purpose and allows different
+sorts of values.  The different char table types are
+
+`category'
+       Used for category tables, which specify the regexp categories
+       that a character is in.  The valid values are nil or a
+       bit vector of 95 elements.  Higher-level Lisp functions are
+       provided for working with category tables.  Currently categories
+       and category tables only exist when Mule support is present.
+`char'
+       A generalized char table, for mapping from one character to
+       another.  Used for case tables, syntax matching tables,
+       `keyboard-translate-table', etc.  The valid values are characters.
+`generic'
+        An even more generalized char table, for mapping from a
+       character to anything.
+`display'
+       Used for display tables, which specify how a particular character
+       is to appear when displayed.  #### Not yet implemented.
+`syntax'
+       Used for syntax tables, which specify the syntax of a particular
+       character.  Higher-level Lisp functions are provided for
+       working with syntax tables.  The valid values are integers.
+
+*/
+       (type))
+{
+  return (EQ (type, Qchar)     ||

 #ifdef MULE
 #ifdef MULE

-  if (EQ (symbol, Qcategory)) return CHAR_TABLE_TYPE_CATEGORY;
+         EQ (type, Qcategory) ||

 #endif
 #endif

-
-  signal_simple_error ("Unrecognized char table type", symbol);
-  return CHAR_TABLE_TYPE_GENERIC; /* not reached */
+         EQ (type, Qdisplay)  ||
+         EQ (type, Qgeneric)  ||
+         EQ (type, Qsyntax)) ? Qt : Qnil;

 }
 
 }
 

-static void
-print_chartab_range (Emchar first, Emchar last, Lisp_Object val,
-                    Lisp_Object printcharfun)
+DEFUN ("char-table-type", Fchar_table_type, 1, 1, 0, /*
+Return the type of CHAR-TABLE.
+See `valid-char-table-type-p'.
+*/
+       (char_table))

 {
 {

-  if (first != last)
-    {
-      write_c_string (" (", printcharfun);
-      print_internal (make_char (first), printcharfun, 0);
-      write_c_string (" ", printcharfun);
-      print_internal (make_char (last), printcharfun, 0);
-      write_c_string (") ", printcharfun);
-    }
-  else
-    {
-      write_c_string (" ", printcharfun);
-      print_internal (make_char (first), printcharfun, 0);
-      write_c_string (" ", printcharfun);
-    }
-  print_internal (val, printcharfun, 1);
+  CHECK_CHAR_TABLE (char_table);
+  return char_table_type_to_symbol (XCHAR_TABLE (char_table)->type);

 }
 
 }
 

-#ifdef MULE
-
-static void
-print_chartab_charset_row (Lisp_Object charset,
-                          int row,
-                          Lisp_Char_Table_Entry *cte,
-                          Lisp_Object printcharfun)
+void
+fill_char_table (Lisp_Char_Table *ct, Lisp_Object value)

 {
 {

+#ifdef UTF2000
+  ct->table = Qunbound;
+  ct->default_value = value;
+  ct->unloaded = 0;
+#else

   int i;
   int i;

-  Lisp_Object cat = Qunbound;
-  int first = -1;
-
-  for (i = 32; i < 128; i++)
-    {
-      Lisp_Object pam = cte->level2[i - 32];
-
-      if (first == -1)
-       {
-         first = i;
-         cat = pam;
-         continue;
-       }

 
 

-      if (!EQ (cat, pam))
-       {
-         if (row == -1)
-           print_chartab_range (MAKE_CHAR (charset, first, 0),
-                                MAKE_CHAR (charset, i - 1, 0),
-                                cat, printcharfun);
-         else
-           print_chartab_range (MAKE_CHAR (charset, row, first),
-                                MAKE_CHAR (charset, row, i - 1),
-                                cat, printcharfun);
-         first = -1;
-         i--;
-       }
-    }
+  for (i = 0; i < NUM_ASCII_CHARS; i++)
+    ct->ascii[i] = value;
+#ifdef MULE
+  for (i = 0; i < NUM_LEADING_BYTES; i++)
+    ct->level1[i] = value;
+#endif /* MULE */
+#endif

 
 

-  if (first != -1)
-    {
-      if (row == -1)
-       print_chartab_range (MAKE_CHAR (charset, first, 0),
-                            MAKE_CHAR (charset, i - 1, 0),
-                            cat, printcharfun);
-      else
-       print_chartab_range (MAKE_CHAR (charset, row, first),
-                            MAKE_CHAR (charset, row, i - 1),
-                            cat, printcharfun);
-    }
+#ifndef UTF2000
+  if (ct->type == CHAR_TABLE_TYPE_SYNTAX)
+    update_syntax_table (ct);
+#endif

 }
 
 }
 

-static void
-print_chartab_two_byte_charset (Lisp_Object charset,
-                               Lisp_Char_Table_Entry *cte,
-                               Lisp_Object printcharfun)
+DEFUN ("reset-char-table", Freset_char_table, 1, 1, 0, /*
+Reset CHAR-TABLE to its default state.
+*/
+       (char_table))

 {
 {

-  int i;
+  Lisp_Char_Table *ct;

 
 

-  for (i = 32; i < 128; i++)
+  CHECK_CHAR_TABLE (char_table);
+  ct = XCHAR_TABLE (char_table);
+
+  switch (ct->type)

     {
     {

-      Lisp_Object jen = cte->level2[i - 32];
+    case CHAR_TABLE_TYPE_CHAR:
+      fill_char_table (ct, make_char (0));
+      break;
+    case CHAR_TABLE_TYPE_DISPLAY:
+    case CHAR_TABLE_TYPE_GENERIC:
+#ifdef MULE
+    case CHAR_TABLE_TYPE_CATEGORY:
+#endif /* MULE */
+      fill_char_table (ct, Qnil);
+      break;

 
 

-      if (!CHAR_TABLE_ENTRYP (jen))
-       {
-         char buf[100];
+    case CHAR_TABLE_TYPE_SYNTAX:
+      fill_char_table (ct, make_int (Sinherit));
+      break;

 
 

-         write_c_string (" [", printcharfun);
-         print_internal (XCHARSET_NAME (charset), printcharfun, 0);
-         sprintf (buf, " %d] ", i);
-         write_c_string (buf, printcharfun);
-         print_internal (jen, printcharfun, 0);
-       }
-      else
-       print_chartab_charset_row (charset, i, XCHAR_TABLE_ENTRY (jen),
-                                  printcharfun);
+    default:
+      abort ();

     }
     }

-}

 
 

-#endif /* MULE */
+  return Qnil;
+}

 
 

-static void
-print_char_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
+DEFUN ("make-char-table", Fmake_char_table, 1, 1, 0, /*
+Return a new, empty char table of type TYPE.
+Currently recognized types are 'char, 'category, 'display, 'generic,
+and 'syntax.  See `valid-char-table-type-p'.
+*/
+       (type))

 {
 {

-  Lisp_Char_Table *ct = XCHAR_TABLE (obj);
-  char buf[200];
-
-  sprintf (buf, "#s(char-table type %s data (",
-          string_data (symbol_name (XSYMBOL
-                                    (char_table_type_to_symbol (ct->type)))));
-  write_c_string (buf, printcharfun);
-
-  /* Now write out the ASCII/Control-1 stuff. */
-  {
-    int i;
-    int first = -1;
-    Lisp_Object val = Qunbound;
+  Lisp_Char_Table *ct;
+  Lisp_Object obj;
+  enum char_table_type ty = symbol_to_char_table_type (type);

 
 

-    for (i = 0; i < NUM_ASCII_CHARS; i++)
-      {
-       if (first == -1)
-         {
-           first = i;
-           val = ct->ascii[i];
-           continue;
-         }
+  ct = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table);
+  ct->type = ty;
+#ifndef UTF2000
+  if (ty == CHAR_TABLE_TYPE_SYNTAX)
+    {
+      ct->mirror_table = Fmake_char_table (Qgeneric);
+      fill_char_table (XCHAR_TABLE (ct->mirror_table),
+                       make_int (Spunct));
+    }
+  else
+    ct->mirror_table = Qnil;
+#else
+  ct->name = Qnil;
+#endif
+  ct->next_table = Qnil;
+  XSETCHAR_TABLE (obj, ct);
+  if (ty == CHAR_TABLE_TYPE_SYNTAX)
+    {
+      ct->next_table = Vall_syntax_tables;
+      Vall_syntax_tables = obj;
+    }
+  Freset_char_table (obj);
+  return obj;
+}

 
 

-       if (!EQ (ct->ascii[i], val))
-         {
-           print_chartab_range (first, i - 1, val, printcharfun);
-           first = -1;
-           i--;
-         }
-      }
+#if defined(MULE)&&!defined(UTF2000)

 
 

-    if (first != -1)
-      print_chartab_range (first, i - 1, val, printcharfun);
-  }
+static Lisp_Object
+make_char_table_entry (Lisp_Object initval)
+{
+  Lisp_Object obj;
+  int i;
+  Lisp_Char_Table_Entry *cte =
+    alloc_lcrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry);

 
 

-#ifdef MULE
-  {
-    Charset_ID i;
+  for (i = 0; i < 96; i++)
+    cte->level2[i] = initval;

 
 

-    for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES;
-        i++)
-      {
-       Lisp_Object ann = ct->level1[i - MIN_LEADING_BYTE];
-       Lisp_Object charset = CHARSET_BY_LEADING_BYTE (i);
+  XSETCHAR_TABLE_ENTRY (obj, cte);
+  return obj;
+}

 
 

-       if (!CHARSETP (charset) || i == LEADING_BYTE_ASCII
-            || i == LEADING_BYTE_CONTROL_1)
-         continue;
-       if (!CHAR_TABLE_ENTRYP (ann))
-         {
-           write_c_string (" ", printcharfun);
-           print_internal (XCHARSET_NAME (charset),
-                           printcharfun, 0);
-           write_c_string (" ", printcharfun);
-           print_internal (ann, printcharfun, 0);
-         }
-       else
-         {
-           Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (ann);
-           if (XCHARSET_DIMENSION (charset) == 1)
-             print_chartab_charset_row (charset, -1, cte, printcharfun);
-           else
-             print_chartab_two_byte_charset (charset, cte, printcharfun);
-         }
-      }
-  }
-#endif /* MULE */
+static Lisp_Object
+copy_char_table_entry (Lisp_Object entry)
+{
+  Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (entry);
+  Lisp_Object obj;
+  int i;
+  Lisp_Char_Table_Entry *ctenew =
+    alloc_lcrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry);

 
 

-  write_c_string ("))", printcharfun);
+  for (i = 0; i < 96; i++)
+    {
+      Lisp_Object new = cte->level2[i];
+      if (CHAR_TABLE_ENTRYP (new))
+       ctenew->level2[i] = copy_char_table_entry (new);
+      else
+       ctenew->level2[i] = new;
+    }
+
+  XSETCHAR_TABLE_ENTRY (obj, ctenew);
+  return obj;

 }
 
 }
 

-static int
-char_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
+#endif /* MULE */
+
+DEFUN ("copy-char-table", Fcopy_char_table, 1, 1, 0, /*
+Return a new char table which is a copy of CHAR-TABLE.
+It will contain the same values for the same characters and ranges
+as CHAR-TABLE.  The values will not themselves be copied.
+*/
+       (char_table))

 {
 {

-  Lisp_Char_Table *ct1 = XCHAR_TABLE (obj1);
-  Lisp_Char_Table *ct2 = XCHAR_TABLE (obj2);
+  Lisp_Char_Table *ct, *ctnew;
+  Lisp_Object obj;
+#ifndef UTF2000

   int i;
   int i;

+#endif

 
 

-  if (CHAR_TABLE_TYPE (ct1) != CHAR_TABLE_TYPE (ct2))
-    return 0;
+  CHECK_CHAR_TABLE (char_table);
+  ct = XCHAR_TABLE (char_table);
+  ctnew = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table);
+  ctnew->type = ct->type;
+#ifdef UTF2000
+  ctnew->default_value = ct->default_value;
+  /* [tomo:2002-01-21] Perhaps this code seems wrong */
+  ctnew->name = ct->name;
+
+  if (UINT8_BYTE_TABLE_P (ct->table))
+    {
+      ctnew->table = copy_uint8_byte_table (ct->table);
+    }
+  else if (UINT16_BYTE_TABLE_P (ct->table))
+    {
+      ctnew->table = copy_uint16_byte_table (ct->table);
+    }
+  else if (BYTE_TABLE_P (ct->table))
+    {
+      ctnew->table = copy_byte_table (ct->table);
+    }
+  else if (!UNBOUNDP (ct->table))
+    ctnew->table = ct->table;
+#else /* non UTF2000 */

 
   for (i = 0; i < NUM_ASCII_CHARS; i++)
 
   for (i = 0; i < NUM_ASCII_CHARS; i++)

-    if (!internal_equal (ct1->ascii[i], ct2->ascii[i], depth + 1))
-      return 0;
+    {
+      Lisp_Object new = ct->ascii[i];
+#ifdef MULE
+      assert (! (CHAR_TABLE_ENTRYP (new)));
+#endif /* MULE */
+      ctnew->ascii[i] = new;
+    }

 
 #ifdef MULE
 
 #ifdef MULE

+

   for (i = 0; i < NUM_LEADING_BYTES; i++)
   for (i = 0; i < NUM_LEADING_BYTES; i++)

-    if (!internal_equal (ct1->level1[i], ct2->level1[i], depth + 1))
-      return 0;
+    {
+      Lisp_Object new = ct->level1[i];
+      if (CHAR_TABLE_ENTRYP (new))
+       ctnew->level1[i] = copy_char_table_entry (new);
+      else
+       ctnew->level1[i] = new;
+    }
+

 #endif /* MULE */
 #endif /* MULE */

+#endif /* non UTF2000 */

 
 

-  return 1;
+#ifndef UTF2000
+  if (CHAR_TABLEP (ct->mirror_table))
+    ctnew->mirror_table = Fcopy_char_table (ct->mirror_table);
+  else
+    ctnew->mirror_table = ct->mirror_table;
+#endif
+  ctnew->next_table = Qnil;
+  XSETCHAR_TABLE (obj, ctnew);
+  if (ctnew->type == CHAR_TABLE_TYPE_SYNTAX)
+    {
+      ctnew->next_table = Vall_syntax_tables;
+      Vall_syntax_tables = obj;
+    }
+  return obj;

 }
 
 }
 

-static unsigned long
-char_table_hash (Lisp_Object obj, int depth)
+INLINE_HEADER int XCHARSET_CELL_RANGE (Lisp_Object ccs);
+INLINE_HEADER int
+XCHARSET_CELL_RANGE (Lisp_Object ccs)

 {
 {

-  Lisp_Char_Table *ct = XCHAR_TABLE (obj);
-  unsigned long hashval = internal_array_hash (ct->ascii, NUM_ASCII_CHARS,
-                                              depth);
-#ifdef MULE
-  hashval = HASH2 (hashval,
-                  internal_array_hash (ct->level1, NUM_LEADING_BYTES, depth));
-#endif /* MULE */
-  return hashval;
+  switch (XCHARSET_CHARS (ccs))
+    {
+    case 94:
+      return (33 << 8) | 126;
+    case 96:
+      return (32 << 8) | 127;
+#ifdef UTF2000
+    case 128:
+      return (0 << 8) | 127;
+    case 256:
+      return (0 << 8) | 255;
+#endif
+    default:
+      abort ();
+      return 0;
+    }

 }
 
 }
 

-static const struct lrecord_description char_table_description[] = {
-  { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, ascii), NUM_ASCII_CHARS },
-#ifdef MULE
-  { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, level1), NUM_LEADING_BYTES },
+#ifndef UTF2000
+static

 #endif
 #endif

-  { XD_LISP_OBJECT, offsetof (Lisp_Char_Table, mirror_table) },
-  { XD_LO_LINK,     offsetof (Lisp_Char_Table, next_table) },
-  { XD_END }
-};
+void
+decode_char_table_range (Lisp_Object range, struct chartab_range *outrange)
+{
+  if (EQ (range, Qt))
+    outrange->type = CHARTAB_RANGE_ALL;
+  else if (EQ (range, Qnil))
+    outrange->type = CHARTAB_RANGE_DEFAULT;
+  else if (CHAR_OR_CHAR_INTP (range))
+    {
+      outrange->type = CHARTAB_RANGE_CHAR;
+      outrange->ch = XCHAR_OR_CHAR_INT (range);
+    }
+#ifndef MULE
+  else
+    signal_simple_error ("Range must be t or a character", range);
+#else /* MULE */
+  else if (VECTORP (range))
+    {
+      Lisp_Vector *vec = XVECTOR (range);
+      Lisp_Object *elts = vector_data (vec);
+      int cell_min, cell_max;

 
 

-DEFINE_LRECORD_IMPLEMENTATION ("char-table", char_table,
-                               mark_char_table, print_char_table, 0,
-                              char_table_equal, char_table_hash,
-                              char_table_description,
-                              Lisp_Char_Table);
+      outrange->type = CHARTAB_RANGE_ROW;
+      outrange->charset = Fget_charset (elts[0]);
+      CHECK_INT (elts[1]);
+      outrange->row = XINT (elts[1]);
+      if (XCHARSET_DIMENSION (outrange->charset) < 2)
+       signal_simple_error ("Charset in row vector must be multi-byte",
+                            outrange->charset);
+      else
+       {
+         int ret = XCHARSET_CELL_RANGE (outrange->charset);

 
 

-DEFUN ("char-table-p", Fchar_table_p, 1, 1, 0, /*
-Return non-nil if OBJECT is a char table.
+         cell_min = ret >> 8;
+         cell_max = ret & 0xFF;
+       }
+      if (XCHARSET_DIMENSION (outrange->charset) == 2)
+       check_int_range (outrange->row, cell_min, cell_max);
+#ifdef UTF2000
+      else if (XCHARSET_DIMENSION (outrange->charset) == 3)
+       {
+         check_int_range (outrange->row >> 8  , cell_min, cell_max);
+         check_int_range (outrange->row & 0xFF, cell_min, cell_max);
+       }
+      else if (XCHARSET_DIMENSION (outrange->charset) == 4)
+       {
+         check_int_range ( outrange->row >> 16       , cell_min, cell_max);
+         check_int_range ((outrange->row >> 8) & 0xFF, cell_min, cell_max);
+         check_int_range ( outrange->row       & 0xFF, cell_min, cell_max);
+       }
+#endif
+      else
+       abort ();
+    }
+  else
+    {
+      if (!CHARSETP (range) && !SYMBOLP (range))
+       signal_simple_error
+         ("Char table range must be t, charset, char, or vector", range);
+      outrange->type = CHARTAB_RANGE_CHARSET;
+      outrange->charset = Fget_charset (range);
+    }
+#endif /* MULE */
+}

 
 

-A char table is a table that maps characters (or ranges of characters)
-to values.  Char tables are specialized for characters, only allowing
-particular sorts of ranges to be assigned values.  Although this
-loses in generality, it makes for extremely fast (constant-time)
-lookups, and thus is feasible for applications that do an extremely
-large number of lookups (e.g. scanning a buffer for a character in
-a particular syntax, where a lookup in the syntax table must occur
-once per character).
+#if defined(MULE)&&!defined(UTF2000)

 
 

-When Mule support exists, the types of ranges that can be assigned
-values are
+/* called from CHAR_TABLE_VALUE(). */
+Lisp_Object
+get_non_ascii_char_table_value (Lisp_Char_Table *ct, Charset_ID leading_byte,
+                              Emchar c)
+{
+  Lisp_Object val;
+#ifdef UTF2000
+  Lisp_Object charset;
+#else
+  Lisp_Object charset = CHARSET_BY_LEADING_BYTE (leading_byte);
+#endif
+  int byte1, byte2;

 
 

--- all characters
--- an entire charset
--- a single row in a two-octet charset
--- a single character
+#ifdef UTF2000
+  BREAKUP_CHAR (c, charset, byte1, byte2);
+#else
+  BREAKUP_CHAR_1_UNSAFE (c, charset, byte1, byte2);
+#endif
+  val = ct->level1[leading_byte - MIN_LEADING_BYTE];
+  if (CHAR_TABLE_ENTRYP (val))
+    {
+      Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
+      val = cte->level2[byte1 - 32];
+      if (CHAR_TABLE_ENTRYP (val))
+       {
+         cte = XCHAR_TABLE_ENTRY (val);
+         assert (byte2 >= 32);
+         val = cte->level2[byte2 - 32];
+         assert (!CHAR_TABLE_ENTRYP (val));
+       }
+    }

 
 

-When Mule support is not present, the types of ranges that can be
-assigned values are
+  return val;
+}

 
 

--- all characters
--- a single character
+#endif /* MULE */

 
 

-To create a char table, use `make-char-table'.
-To modify a char table, use `put-char-table' or `remove-char-table'.
-To retrieve the value for a particular character, use `get-char-table'.
-See also `map-char-table', `clear-char-table', `copy-char-table',
-`valid-char-table-type-p', `char-table-type-list',
-`valid-char-table-value-p', and `check-char-table-value'.
-*/
-       (object))
+Lisp_Object
+get_char_table (Emchar ch, Lisp_Char_Table *ct)

 {
 {

-  return CHAR_TABLEP (object) ? Qt : Qnil;
-}
+#ifdef UTF2000
+  return get_char_id_table (ct, ch);
+#elif defined(MULE)
+  {
+    Lisp_Object charset;
+    int byte1, byte2;
+    Lisp_Object val;

 
 

-DEFUN ("char-table-type-list", Fchar_table_type_list, 0, 0, 0, /*
-Return a list of the recognized char table types.
-See `valid-char-table-type-p'.
-*/
-       ())
-{
-#ifdef MULE
-  return list5 (Qchar, Qcategory, Qdisplay, Qgeneric, Qsyntax);
-#else
-  return list4 (Qchar, Qdisplay, Qgeneric, Qsyntax);
-#endif
-}
+    BREAKUP_CHAR (ch, charset, byte1, byte2);

 
 

-DEFUN ("valid-char-table-type-p", Fvalid_char_table_type_p, 1, 1, 0, /*
-Return t if TYPE if a recognized char table type.
+    if (EQ (charset, Vcharset_ascii))
+      val = ct->ascii[byte1];
+    else if (EQ (charset, Vcharset_control_1))
+      val = ct->ascii[byte1 + 128];
+    else
+      {
+       int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE;
+       val = ct->level1[lb];
+       if (CHAR_TABLE_ENTRYP (val))
+         {
+           Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
+           val = cte->level2[byte1 - 32];
+           if (CHAR_TABLE_ENTRYP (val))
+             {
+               cte = XCHAR_TABLE_ENTRY (val);
+               assert (byte2 >= 32);
+               val = cte->level2[byte2 - 32];
+               assert (!CHAR_TABLE_ENTRYP (val));
+             }
+         }
+      }

 
 

-Each char table type is used for a different purpose and allows different
-sorts of values.  The different char table types are
+    return val;
+  }
+#else /* not MULE */
+  return ct->ascii[(unsigned char)ch];
+#endif /* not MULE */
+}

 
 

-`category'
-       Used for category tables, which specify the regexp categories
-       that a character is in.  The valid values are nil or a
-       bit vector of 95 elements.  Higher-level Lisp functions are
-       provided for working with category tables.  Currently categories
-       and category tables only exist when Mule support is present.
-`char'
-       A generalized char table, for mapping from one character to
-       another.  Used for case tables, syntax matching tables,
-       `keyboard-translate-table', etc.  The valid values are characters.
-`generic'
-        An even more generalized char table, for mapping from a
-       character to anything.
-`display'
-       Used for display tables, which specify how a particular character
-       is to appear when displayed.  #### Not yet implemented.
-`syntax'
-       Used for syntax tables, which specify the syntax of a particular
-       character.  Higher-level Lisp functions are provided for
-       working with syntax tables.  The valid values are integers.

 
 

+DEFUN ("get-char-table", Fget_char_table, 2, 2, 0, /*
+Find value for CHARACTER in CHAR-TABLE.

 */
 */

-       (type))
+       (character, char_table))

 {
 {

-  return (EQ (type, Qchar)     ||
-#ifdef MULE
-         EQ (type, Qcategory) ||
-#endif
-         EQ (type, Qdisplay)  ||
-         EQ (type, Qgeneric)  ||
-         EQ (type, Qsyntax)) ? Qt : Qnil;
+  CHECK_CHAR_TABLE (char_table);
+  CHECK_CHAR_COERCE_INT (character);
+
+  return get_char_table (XCHAR (character), XCHAR_TABLE (char_table));

 }
 
 }
 

-DEFUN ("char-table-type", Fchar_table_type, 1, 1, 0, /*
-Return the type of CHAR-TABLE.
-See `valid-char-table-type-p'.
+DEFUN ("get-range-char-table", Fget_range_char_table, 2, 3, 0, /*
+Find value for a range in CHAR-TABLE.
+If there is more than one value, return MULTI (defaults to nil).

 */
 */

-       (char_table))
+       (range, char_table, multi))

 {
 {

+  Lisp_Char_Table *ct;
+  struct chartab_range rainj;
+
+  if (CHAR_OR_CHAR_INTP (range))
+    return Fget_char_table (range, char_table);

   CHECK_CHAR_TABLE (char_table);
   CHECK_CHAR_TABLE (char_table);

-  return char_table_type_to_symbol (XCHAR_TABLE (char_table)->type);
-}
+  ct = XCHAR_TABLE (char_table);

 
 

-void
-fill_char_table (Lisp_Char_Table *ct, Lisp_Object value)
-{
-  int i;
+  decode_char_table_range (range, &rainj);
+  switch (rainj.type)
+    {
+    case CHARTAB_RANGE_ALL:
+      {
+#ifdef UTF2000
+       if (UINT8_BYTE_TABLE_P (ct->table))
+         return multi;
+       else if (UINT16_BYTE_TABLE_P (ct->table))
+         return multi;
+       else if (BYTE_TABLE_P (ct->table))
+         return multi;
+       else
+         return ct->table;
+#else /* non UTF2000 */
+       int i;
+       Lisp_Object first = ct->ascii[0];
+
+       for (i = 1; i < NUM_ASCII_CHARS; i++)
+         if (!EQ (first, ct->ascii[i]))
+           return multi;

 
 

-  for (i = 0; i < NUM_ASCII_CHARS; i++)
-    ct->ascii[i] = value;

 #ifdef MULE
 #ifdef MULE

-  for (i = 0; i < NUM_LEADING_BYTES; i++)
-    ct->level1[i] = value;
+       for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES;
+            i++)
+         {
+           if (!CHARSETP (CHARSET_BY_LEADING_BYTE (i))
+               || i == LEADING_BYTE_ASCII
+               || i == LEADING_BYTE_CONTROL_1)
+             continue;
+           if (!EQ (first, ct->level1[i - MIN_LEADING_BYTE]))
+             return multi;
+         }

 #endif /* MULE */
 
 #endif /* MULE */
 

-  if (ct->type == CHAR_TABLE_TYPE_SYNTAX)
-    update_syntax_table (ct);
-}
+       return first;
+#endif /* non UTF2000 */
+      }

 
 

-DEFUN ("reset-char-table", Freset_char_table, 1, 1, 0, /*
-Reset CHAR-TABLE to its default state.
-*/
-       (char_table))
-{
-  Lisp_Char_Table *ct;
+#ifdef MULE
+    case CHARTAB_RANGE_CHARSET:
+#ifdef UTF2000
+      return multi;
+#else
+      if (EQ (rainj.charset, Vcharset_ascii))
+       {
+         int i;
+         Lisp_Object first = ct->ascii[0];

 
 

-  CHECK_CHAR_TABLE (char_table);
-  ct = XCHAR_TABLE (char_table);
+         for (i = 1; i < 128; i++)
+           if (!EQ (first, ct->ascii[i]))
+             return multi;
+         return first;
+       }

 
 

-  switch (ct->type)
+      if (EQ (rainj.charset, Vcharset_control_1))
+       {
+         int i;
+         Lisp_Object first = ct->ascii[128];
+
+         for (i = 129; i < 160; i++)
+           if (!EQ (first, ct->ascii[i]))
+             return multi;
+         return first;
+       }
+
+      {
+       Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (rainj.charset) -
+                                    MIN_LEADING_BYTE];
+       if (CHAR_TABLE_ENTRYP (val))
+         return multi;
+       return val;
+      }
+#endif
+
+    case CHARTAB_RANGE_ROW:
+#ifdef UTF2000
+      return multi;
+#else
+      {
+       Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (rainj.charset) -
+                                    MIN_LEADING_BYTE];
+       if (!CHAR_TABLE_ENTRYP (val))
+         return val;
+       val = XCHAR_TABLE_ENTRY (val)->level2[rainj.row - 32];
+       if (CHAR_TABLE_ENTRYP (val))
+         return multi;
+       return val;
+      }
+#endif /* not UTF2000 */
+#endif /* not MULE */
+
+    default:
+      abort ();
+    }
+
+  return Qnil; /* not reached */
+}
+
+static int
+check_valid_char_table_value (Lisp_Object value, enum char_table_type type,
+                             Error_behavior errb)
+{
+  switch (type)

     {
     {

-    case CHAR_TABLE_TYPE_CHAR:
-      fill_char_table (ct, make_char (0));
+    case CHAR_TABLE_TYPE_SYNTAX:
+      if (!ERRB_EQ (errb, ERROR_ME))
+       return INTP (value) || (CONSP (value) && INTP (XCAR (value))
+                               && CHAR_OR_CHAR_INTP (XCDR (value)));
+      if (CONSP (value))
+        {
+         Lisp_Object cdr = XCDR (value);
+          CHECK_INT (XCAR (value));
+         CHECK_CHAR_COERCE_INT (cdr);
+         }
+      else
+        CHECK_INT (value);

       break;
       break;

-    case CHAR_TABLE_TYPE_DISPLAY:
-    case CHAR_TABLE_TYPE_GENERIC:
+

 #ifdef MULE
     case CHAR_TABLE_TYPE_CATEGORY:
 #ifdef MULE
     case CHAR_TABLE_TYPE_CATEGORY:

-#endif /* MULE */
-      fill_char_table (ct, Qnil);
+      if (!ERRB_EQ (errb, ERROR_ME))
+       return CATEGORY_TABLE_VALUEP (value);
+      CHECK_CATEGORY_TABLE_VALUE (value);

       break;
       break;

+#endif /* MULE */

 
 

-    case CHAR_TABLE_TYPE_SYNTAX:
-      fill_char_table (ct, make_int (Sinherit));
+    case CHAR_TABLE_TYPE_GENERIC:
+      return 1;
+
+    case CHAR_TABLE_TYPE_DISPLAY:
+      /* #### fix this */
+      maybe_signal_simple_error ("Display char tables not yet implemented",
+                                value, Qchar_table, errb);
+      return 0;
+
+    case CHAR_TABLE_TYPE_CHAR:
+      if (!ERRB_EQ (errb, ERROR_ME))
+       return CHAR_OR_CHAR_INTP (value);
+      CHECK_CHAR_COERCE_INT (value);

       break;
 
     default:
       abort ();
     }
 
       break;
 
     default:
       abort ();
     }
 

-  return Qnil;
+  return 0; /* not reached */

 }
 
 }
 

-DEFUN ("make-char-table", Fmake_char_table, 1, 1, 0, /*
-Return a new, empty char table of type TYPE.
-Currently recognized types are 'char, 'category, 'display, 'generic,
-and 'syntax.  See `valid-char-table-type-p'.
-*/
-       (type))
+static Lisp_Object
+canonicalize_char_table_value (Lisp_Object value, enum char_table_type type)

 {
 {

-  Lisp_Char_Table *ct;
-  Lisp_Object obj;
-  enum char_table_type ty = symbol_to_char_table_type (type);
-
-  ct = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table);
-  ct->type = ty;
-  if (ty == CHAR_TABLE_TYPE_SYNTAX)
-    {
-      ct->mirror_table = Fmake_char_table (Qgeneric);
-      fill_char_table (XCHAR_TABLE (ct->mirror_table),
-                       make_int (Spunct));
-    }
-  else
-    ct->mirror_table = Qnil;
-  ct->next_table = Qnil;
-  XSETCHAR_TABLE (obj, ct);
-  if (ty == CHAR_TABLE_TYPE_SYNTAX)
+  switch (type)

     {
     {

-      ct->next_table = Vall_syntax_tables;
-      Vall_syntax_tables = obj;
+    case CHAR_TABLE_TYPE_SYNTAX:
+      if (CONSP (value))
+       {
+         Lisp_Object car = XCAR (value);
+         Lisp_Object cdr = XCDR (value);
+         CHECK_CHAR_COERCE_INT (cdr);
+         return Fcons (car, cdr);
+       }
+      break;
+    case CHAR_TABLE_TYPE_CHAR:
+      CHECK_CHAR_COERCE_INT (value);
+      break;
+    default:
+      break;

     }
     }

-  Freset_char_table (obj);
-  return obj;
+  return value;

 }
 
 }
 

-#ifdef MULE
-
-static Lisp_Object
-make_char_table_entry (Lisp_Object initval)
+DEFUN ("valid-char-table-value-p", Fvalid_char_table_value_p, 2, 2, 0, /*
+Return non-nil if VALUE is a valid value for CHAR-TABLE-TYPE.
+*/
+       (value, char_table_type))

 {
 {

-  Lisp_Object obj;
-  int i;
-  Lisp_Char_Table_Entry *cte =
-    alloc_lcrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry);
-
-  for (i = 0; i < 96; i++)
-    cte->level2[i] = initval;
+  enum char_table_type type = symbol_to_char_table_type (char_table_type);

 
 

-  XSETCHAR_TABLE_ENTRY (obj, cte);
-  return obj;
+  return check_valid_char_table_value (value, type, ERROR_ME_NOT) ? Qt : Qnil;

 }
 
 }
 

-static Lisp_Object
-copy_char_table_entry (Lisp_Object entry)
+DEFUN ("check-valid-char-table-value", Fcheck_valid_char_table_value, 2, 2, 0, /*
+Signal an error if VALUE is not a valid value for CHAR-TABLE-TYPE.
+*/
+       (value, char_table_type))

 {
 {

-  Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (entry);
-  Lisp_Object obj;
-  int i;
-  Lisp_Char_Table_Entry *ctenew =
-    alloc_lcrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry);
-
-  for (i = 0; i < 96; i++)
-    {
-      Lisp_Object new = cte->level2[i];
-      if (CHAR_TABLE_ENTRYP (new))
-       ctenew->level2[i] = copy_char_table_entry (new);
-      else
-       ctenew->level2[i] = new;
-    }
+  enum char_table_type type = symbol_to_char_table_type (char_table_type);

 
 

-  XSETCHAR_TABLE_ENTRY (obj, ctenew);
-  return obj;
+  check_valid_char_table_value (value, type, ERROR_ME);
+  return Qnil;

 }
 
 }
 

-#endif /* MULE */
+#ifdef UTF2000
+Lisp_Char_Table* char_attribute_table_to_put;
+Lisp_Object Qput_char_table_map_function;
+Lisp_Object value_to_put;

 
 

-DEFUN ("copy-char-table", Fcopy_char_table, 1, 1, 0, /*
-Return a new char table which is a copy of CHAR-TABLE.
-It will contain the same values for the same characters and ranges
-as CHAR-TABLE.  The values will not themselves be copied.
+DEFUN ("put-char-table-map-function",
+       Fput_char_table_map_function, 2, 2, 0, /*
+For internal use.  Don't use it.

 */
 */

-       (char_table))
+       (c, value))

 {
 {

-  Lisp_Char_Table *ct, *ctnew;
-  Lisp_Object obj;
-  int i;
-
-  CHECK_CHAR_TABLE (char_table);
-  ct = XCHAR_TABLE (char_table);
-  ctnew = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table);
-  ctnew->type = ct->type;
-
-  for (i = 0; i < NUM_ASCII_CHARS; i++)
-    {
-      Lisp_Object new = ct->ascii[i];
-#ifdef MULE
-      assert (! (CHAR_TABLE_ENTRYP (new)));
-#endif /* MULE */
-      ctnew->ascii[i] = new;
-    }
-
-#ifdef MULE
-
-  for (i = 0; i < NUM_LEADING_BYTES; i++)
-    {
-      Lisp_Object new = ct->level1[i];
-      if (CHAR_TABLE_ENTRYP (new))
-       ctnew->level1[i] = copy_char_table_entry (new);
-      else
-       ctnew->level1[i] = new;
-    }
-
-#endif /* MULE */
-
-  if (CHAR_TABLEP (ct->mirror_table))
-    ctnew->mirror_table = Fcopy_char_table (ct->mirror_table);
-  else
-    ctnew->mirror_table = ct->mirror_table;
-  ctnew->next_table = Qnil;
-  XSETCHAR_TABLE (obj, ctnew);
-  if (ctnew->type == CHAR_TABLE_TYPE_SYNTAX)
-    {
-      ctnew->next_table = Vall_syntax_tables;
-      Vall_syntax_tables = obj;
-    }
-  return obj;
+  put_char_id_table_0 (char_attribute_table_to_put, c, value_to_put);
+  return Qnil;

 }
 }

+#endif

 
 

-static void
-decode_char_table_range (Lisp_Object range, struct chartab_range *outrange)
+/* Assign VAL to all characters in RANGE in char table CT. */
+
+void
+put_char_table (Lisp_Char_Table *ct, struct chartab_range *range,
+               Lisp_Object val)

 {
 {

-  if (EQ (range, Qt))
-    outrange->type = CHARTAB_RANGE_ALL;
-  else if (CHAR_OR_CHAR_INTP (range))
-    {
-      outrange->type = CHARTAB_RANGE_CHAR;
-      outrange->ch = XCHAR_OR_CHAR_INT (range);
-    }
-#ifndef MULE
-  else
-    signal_simple_error ("Range must be t or a character", range);
-#else /* MULE */
-  else if (VECTORP (range))
-    {
-      Lisp_Vector *vec = XVECTOR (range);
-      Lisp_Object *elts = vector_data (vec);
-      if (vector_length (vec) != 2)
-       signal_simple_error ("Length of charset row vector must be 2",
-                            range);
-      outrange->type = CHARTAB_RANGE_ROW;
-      outrange->charset = Fget_charset (elts[0]);
-      CHECK_INT (elts[1]);
-      outrange->row = XINT (elts[1]);
-      if (XCHARSET_DIMENSION (outrange->charset) >= 2)
-       {
-         switch (XCHARSET_CHARS (outrange->charset))
-           {
-           case 94:
-             check_int_range (outrange->row, 33, 126);
-             break;
-           case 96:
-             check_int_range (outrange->row, 32, 127);
-             break;
-           default:
-             abort ();
-           }
-       }
-      else
-       signal_simple_error ("Charset in row vector must be multi-byte",
-                            outrange->charset);  
-    }
-  else
+  switch (range->type)

     {
     {

-      if (!CHARSETP (range) && !SYMBOLP (range))
-       signal_simple_error
-         ("Char table range must be t, charset, char, or vector", range);
-      outrange->type = CHARTAB_RANGE_CHARSET;
-      outrange->charset = Fget_charset (range);
-    }
-#endif /* MULE */
-}
-
-#ifdef MULE
+    case CHARTAB_RANGE_ALL:
+      /* printf ("put-char-table: range = all\n"); */
+      fill_char_table (ct, val);
+      return; /* avoid the duplicate call to update_syntax_table() below,
+                since fill_char_table() also did that. */

 
 

-/* called from CHAR_TABLE_VALUE(). */
-Lisp_Object
-get_non_ascii_char_table_value (Lisp_Char_Table *ct, Charset_ID leading_byte,
-                              Emchar c)
-{
-  Lisp_Object val;

 #ifdef UTF2000
 #ifdef UTF2000

-  Lisp_Object charset;
-#else
-  Lisp_Object charset = CHARSET_BY_LEADING_BYTE (leading_byte);
+    case CHARTAB_RANGE_DEFAULT:
+      ct->default_value = val;
+      return;

 #endif
 #endif

-  int byte1, byte2;

 
 

+#ifdef MULE
+    case CHARTAB_RANGE_CHARSET:

 #ifdef UTF2000
 #ifdef UTF2000

-  BREAKUP_CHAR (c, charset, byte1, byte2);
+      {
+       Emchar c;
+       Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (range->charset);
+
+       /* printf ("put-char-table: range = charset: %d\n",
+          XCHARSET_LEADING_BYTE (range->charset));
+       */
+       if ( CHAR_TABLEP (encoding_table) )
+         {
+#if 1
+           char_attribute_table_to_put = ct;
+           value_to_put = val;
+           Fmap_char_attribute (Qput_char_table_map_function,
+                                XCHAR_TABLE_NAME (encoding_table),
+                                Qnil);

 #else
 #else

-  BREAKUP_CHAR_1_UNSAFE (c, charset, byte1, byte2);
+           for (c = 0; c < 1 << 24; c++)
+             {
+               if ( INTP (get_char_id_table (XCHAR_TABLE(encoding_table),
+                                             c)) )
+                 put_char_id_table_0 (ct, c, val);
+             }

 #endif
 #endif

-  val = ct->level1[leading_byte - MIN_LEADING_BYTE];
-  if (CHAR_TABLE_ENTRYP (val))
-    {
-      Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
-      val = cte->level2[byte1 - 32];
-      if (CHAR_TABLE_ENTRYP (val))
+         }
+       else
+         {
+           for (c = 0; c < 1 << 24; c++)
+             {
+               if ( charset_code_point (range->charset, c) >= 0 )
+                 put_char_id_table_0 (ct, c, val);
+             }
+         }
+      }
+#else
+      if (EQ (range->charset, Vcharset_ascii))

        {
        {

-         cte = XCHAR_TABLE_ENTRY (val);
-         assert (byte2 >= 32);
-         val = cte->level2[byte2 - 32];
-         assert (!CHAR_TABLE_ENTRYP (val));
+         int i;
+         for (i = 0; i < 128; i++)
+           ct->ascii[i] = val;
+       }
+      else if (EQ (range->charset, Vcharset_control_1))
+       {
+         int i;
+         for (i = 128; i < 160; i++)
+           ct->ascii[i] = val;
+       }
+      else
+       {
+         int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE;
+         ct->level1[lb] = val;

        }
        }

-    }
-
-  return val;
-}
+#endif
+      break;

 
 

-#endif /* MULE */
+    case CHARTAB_RANGE_ROW:
+#ifdef UTF2000
+      {
+       int cell_min, cell_max, i;

 
 

-Lisp_Object
-get_char_table (Emchar ch, Lisp_Char_Table *ct)
-{
-#ifdef MULE
-  {
-    Lisp_Object charset;
-    int byte1, byte2;
-    Lisp_Object val;
+       i = XCHARSET_CELL_RANGE (range->charset);
+       cell_min = i >> 8;
+       cell_max = i & 0xFF;
+       for (i = cell_min; i <= cell_max; i++)
+         {
+           Emchar ch = DECODE_CHAR (range->charset, (range->row << 8) | i);

 
 

-    BREAKUP_CHAR (ch, charset, byte1, byte2);
+           if ( charset_code_point (range->charset, ch) >= 0 )
+             put_char_id_table_0 (ct, ch, val);
+         }
+      }
+#else
+      {
+       Lisp_Char_Table_Entry *cte;
+       int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE;
+       /* make sure that there is a separate entry for the row. */
+       if (!CHAR_TABLE_ENTRYP (ct->level1[lb]))
+         ct->level1[lb] = make_char_table_entry (ct->level1[lb]);
+       cte = XCHAR_TABLE_ENTRY (ct->level1[lb]);
+       cte->level2[range->row - 32] = val;
+      }
+#endif /* not UTF2000 */
+      break;
+#endif /* MULE */

 
 

-    if (EQ (charset, Vcharset_ascii))
-      val = ct->ascii[byte1];
-    else if (EQ (charset, Vcharset_control_1))
-      val = ct->ascii[byte1 + 128];
-    else
+    case CHARTAB_RANGE_CHAR:
+#ifdef UTF2000
+      /* printf ("put-char-table: range = char: 0x%x\n", range->ch); */
+      put_char_id_table_0 (ct, range->ch, val);
+      break;
+#elif defined(MULE)

       {
       {

-       int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE;
-       val = ct->level1[lb];
-       if (CHAR_TABLE_ENTRYP (val))
+       Lisp_Object charset;
+       int byte1, byte2;
+
+       BREAKUP_CHAR (range->ch, charset, byte1, byte2);
+       if (EQ (charset, Vcharset_ascii))
+         ct->ascii[byte1] = val;
+       else if (EQ (charset, Vcharset_control_1))
+         ct->ascii[byte1 + 128] = val;
+       else

          {
          {

-           Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
-           val = cte->level2[byte1 - 32];
-           if (CHAR_TABLE_ENTRYP (val))
+           Lisp_Char_Table_Entry *cte;
+           int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE;
+           /* make sure that there is a separate entry for the row. */
+           if (!CHAR_TABLE_ENTRYP (ct->level1[lb]))
+             ct->level1[lb] = make_char_table_entry (ct->level1[lb]);
+           cte = XCHAR_TABLE_ENTRY (ct->level1[lb]);
+           /* now CTE is a char table entry for the charset;
+              each entry is for a single row (or character of
+              a one-octet charset). */
+           if (XCHARSET_DIMENSION (charset) == 1)
+             cte->level2[byte1 - 32] = val;
+           else

              {
              {

-               cte = XCHAR_TABLE_ENTRY (val);
-               assert (byte2 >= 32);
-               val = cte->level2[byte2 - 32];
-               assert (!CHAR_TABLE_ENTRYP (val));
+               /* assigning to one character in a two-octet charset. */
+               /* make sure that the charset row contains a separate
+                  entry for each character. */
+               if (!CHAR_TABLE_ENTRYP (cte->level2[byte1 - 32]))
+                 cte->level2[byte1 - 32] =
+                   make_char_table_entry (cte->level2[byte1 - 32]);
+               cte = XCHAR_TABLE_ENTRY (cte->level2[byte1 - 32]);
+               cte->level2[byte2 - 32] = val;

              }
          }
       }
              }
          }
       }

-
-    return val;
-  }

 #else /* not MULE */
 #else /* not MULE */

-  return ct->ascii[(unsigned char)ch];
+      ct->ascii[(unsigned char) (range->ch)] = val;
+      break;

 #endif /* not MULE */
 #endif /* not MULE */

+    }
+
+#ifndef UTF2000
+  if (ct->type == CHAR_TABLE_TYPE_SYNTAX)
+    update_syntax_table (ct);
+#endif

 }
 
 }
 

+DEFUN ("put-char-table", Fput_char_table, 3, 3, 0, /*
+Set the value for chars in RANGE to be VALUE in CHAR-TABLE.

 
 

-DEFUN ("get-char-table", Fget_char_table, 2, 2, 0, /*
-Find value for CHARACTER in CHAR-TABLE.
-*/
-       (character, char_table))
-{
-  CHECK_CHAR_TABLE (char_table);
-  CHECK_CHAR_COERCE_INT (character);
+RANGE specifies one or more characters to be affected and should be
+one of the following:

 
 

-  return get_char_table (XCHAR (character), XCHAR_TABLE (char_table));
-}
+-- t (all characters are affected)
+-- A charset (only allowed when Mule support is present)
+-- A vector of two elements: a two-octet charset and a row number
+   (only allowed when Mule support is present)
+-- A single character

 
 

-DEFUN ("get-range-char-table", Fget_range_char_table, 2, 3, 0, /*
-Find value for a range in CHAR-TABLE.
-If there is more than one value, return MULTI (defaults to nil).
+VALUE must be a value appropriate for the type of CHAR-TABLE.
+See `valid-char-table-type-p'.

 */
 */

-       (range, char_table, multi))
+       (range, value, char_table))

 {
   Lisp_Char_Table *ct;
   struct chartab_range rainj;
 
 {
   Lisp_Char_Table *ct;
   struct chartab_range rainj;
 

-  if (CHAR_OR_CHAR_INTP (range))
-    return Fget_char_table (range, char_table);

   CHECK_CHAR_TABLE (char_table);
   ct = XCHAR_TABLE (char_table);
   CHECK_CHAR_TABLE (char_table);
   ct = XCHAR_TABLE (char_table);

-
+  check_valid_char_table_value (value, ct->type, ERROR_ME);

   decode_char_table_range (range, &rainj);
   decode_char_table_range (range, &rainj);

-  switch (rainj.type)
-    {
-    case CHARTAB_RANGE_ALL:
-      {
-       int i;
-       Lisp_Object first = ct->ascii[0];
+  value = canonicalize_char_table_value (value, ct->type);
+  put_char_table (ct, &rainj, value);
+  return Qnil;
+}

 
 

-       for (i = 1; i < NUM_ASCII_CHARS; i++)
-         if (!EQ (first, ct->ascii[i]))
-           return multi;
+#ifndef UTF2000
+/* Map FN over the ASCII chars in CT. */

 
 

+static int
+map_over_charset_ascii (Lisp_Char_Table *ct,
+                       int (*fn) (struct chartab_range *range,
+                                  Lisp_Object val, void *arg),
+                       void *arg)
+{
+  struct chartab_range rainj;
+  int i, retval;
+  int start = 0;

 #ifdef MULE
 #ifdef MULE

-       for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES;
-            i++)
-         {
-           if (!CHARSETP (CHARSET_BY_LEADING_BYTE (i))
-               || i == LEADING_BYTE_ASCII
-               || i == LEADING_BYTE_CONTROL_1)
-             continue;
-           if (!EQ (first, ct->level1[i - MIN_LEADING_BYTE]))
-             return multi;
-         }
-#endif /* MULE */
+  int stop = 128;
+#else
+  int stop = 256;
+#endif

 
 

-       return first;
-      }
+  rainj.type = CHARTAB_RANGE_CHAR;
+
+  for (i = start, retval = 0; i < stop && retval == 0; i++)
+    {
+      rainj.ch = (Emchar) i;
+      retval = (fn) (&rainj, ct->ascii[i], arg);
+    }
+
+  return retval;
+}

 
 #ifdef MULE
 
 #ifdef MULE

-    case CHARTAB_RANGE_CHARSET:
-      if (EQ (rainj.charset, Vcharset_ascii))
+
+/* Map FN over the Control-1 chars in CT. */
+
+static int
+map_over_charset_control_1 (Lisp_Char_Table *ct,
+                           int (*fn) (struct chartab_range *range,
+                                      Lisp_Object val, void *arg),
+                           void *arg)
+{
+  struct chartab_range rainj;
+  int i, retval;
+  int start = 128;
+  int stop  = start + 32;
+
+  rainj.type = CHARTAB_RANGE_CHAR;
+
+  for (i = start, retval = 0; i < stop && retval == 0; i++)
+    {
+      rainj.ch = (Emchar) (i);
+      retval = (fn) (&rainj, ct->ascii[i], arg);
+    }
+
+  return retval;
+}
+
+/* Map FN over the row ROW of two-byte charset CHARSET.
+   There must be a separate value for that row in the char table.
+   CTE specifies the char table entry for CHARSET. */
+
+static int
+map_over_charset_row (Lisp_Char_Table_Entry *cte,
+                     Lisp_Object charset, int row,
+                     int (*fn) (struct chartab_range *range,
+                                Lisp_Object val, void *arg),
+                     void *arg)
+{
+  Lisp_Object val = cte->level2[row - 32];
+
+  if (!CHAR_TABLE_ENTRYP (val))
+    {
+      struct chartab_range rainj;
+
+      rainj.type = CHARTAB_RANGE_ROW;
+      rainj.charset = charset;
+      rainj.row = row;
+      return (fn) (&rainj, val, arg);
+    }
+  else
+    {
+      struct chartab_range rainj;
+      int i, retval;
+      int charset94_p = (XCHARSET_CHARS (charset) == 94);
+      int start = charset94_p ?  33 :  32;
+      int stop  = charset94_p ? 127 : 128;
+
+      cte = XCHAR_TABLE_ENTRY (val);
+
+      rainj.type = CHARTAB_RANGE_CHAR;
+
+      for (i = start, retval = 0; i < stop && retval == 0; i++)

        {
        {

-         int i;
-         Lisp_Object first = ct->ascii[0];
+         rainj.ch = MAKE_CHAR (charset, row, i);
+         retval = (fn) (&rainj, cte->level2[i - 32], arg);
+       }
+      return retval;
+    }
+}
+
+
+static int
+map_over_other_charset (Lisp_Char_Table *ct, Charset_ID lb,
+                       int (*fn) (struct chartab_range *range,
+                                  Lisp_Object val, void *arg),
+                       void *arg)
+{
+  Lisp_Object val = ct->level1[lb - MIN_LEADING_BYTE];
+  Lisp_Object charset = CHARSET_BY_LEADING_BYTE (lb);
+
+  if (!CHARSETP (charset)
+      || lb == LEADING_BYTE_ASCII
+      || lb == LEADING_BYTE_CONTROL_1)
+    return 0;

 
 

-         for (i = 1; i < 128; i++)
-           if (!EQ (first, ct->ascii[i]))
-             return multi;
-         return first;
-       }
+  if (!CHAR_TABLE_ENTRYP (val))
+    {
+      struct chartab_range rainj;

 
 

-      if (EQ (rainj.charset, Vcharset_control_1))
-       {
-         int i;
-         Lisp_Object first = ct->ascii[128];
+      rainj.type = CHARTAB_RANGE_CHARSET;
+      rainj.charset = charset;
+      return (fn) (&rainj, val, arg);
+    }

 
 

-         for (i = 129; i < 160; i++)
-           if (!EQ (first, ct->ascii[i]))
-             return multi;
-         return first;
-       }
+  {
+    Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
+    int charset94_p = (XCHARSET_CHARS (charset) == 94);
+    int start = charset94_p ?  33 :  32;
+    int stop  = charset94_p ? 127 : 128;
+    int i, retval;

 
 

+    if (XCHARSET_DIMENSION (charset) == 1)

       {
       {

-       Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (rainj.charset) -
-                                    MIN_LEADING_BYTE];
-       if (CHAR_TABLE_ENTRYP (val))
-         return multi;
-       return val;
-      }
+       struct chartab_range rainj;
+       rainj.type = CHARTAB_RANGE_CHAR;

 
 

-    case CHARTAB_RANGE_ROW:
+       for (i = start, retval = 0; i < stop && retval == 0; i++)
+         {
+           rainj.ch = MAKE_CHAR (charset, i, 0);
+           retval = (fn) (&rainj, cte->level2[i - 32], arg);
+         }
+      }
+    else

       {
       {

-       Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (rainj.charset) -
-                                    MIN_LEADING_BYTE];
-       if (!CHAR_TABLE_ENTRYP (val))
-         return val;
-       val = XCHAR_TABLE_ENTRY (val)->level2[rainj.row - 32];
-       if (CHAR_TABLE_ENTRYP (val))
-         return multi;
-       return val;
+       for (i = start, retval = 0; i < stop && retval == 0; i++)
+         retval = map_over_charset_row (cte, charset, i, fn, arg);

       }
       }

-#endif /* not MULE */
-
-    default:
-      abort ();
-    }

 
 

-  return Qnil; /* not reached */
+    return retval;
+  }

 }
 
 }
 

+#endif /* MULE */
+#endif /* not UTF2000 */
+
+#ifdef UTF2000
+struct map_char_table_for_charset_arg
+{
+  int (*fn) (struct chartab_range *range, Lisp_Object val, void *arg);
+  Lisp_Char_Table *ct;
+  void *arg;
+};
+

 static int
 static int

-check_valid_char_table_value (Lisp_Object value, enum char_table_type type,
-                             Error_behavior errb)
+map_char_table_for_charset_fun (struct chartab_range *range,
+                               Lisp_Object val, void *arg)

 {
 {

-  switch (type)
+  struct map_char_table_for_charset_arg *closure =
+    (struct map_char_table_for_charset_arg *) arg;
+  Lisp_Object ret;
+
+  switch (range->type)

     {
     {

-    case CHAR_TABLE_TYPE_SYNTAX:
-      if (!ERRB_EQ (errb, ERROR_ME))
-       return INTP (value) || (CONSP (value) && INTP (XCAR (value))
-                               && CHAR_OR_CHAR_INTP (XCDR (value)));
-      if (CONSP (value))
-        {
-         Lisp_Object cdr = XCDR (value);
-          CHECK_INT (XCAR (value));
-         CHECK_CHAR_COERCE_INT (cdr);
-         }
-      else
-        CHECK_INT (value);
+    case CHARTAB_RANGE_ALL:

       break;
 
       break;
 

-#ifdef MULE
-    case CHAR_TABLE_TYPE_CATEGORY:
-      if (!ERRB_EQ (errb, ERROR_ME))
-       return CATEGORY_TABLE_VALUEP (value);
-      CHECK_CATEGORY_TABLE_VALUE (value);
+    case CHARTAB_RANGE_DEFAULT:

       break;
       break;

-#endif /* MULE */

 
 

-    case CHAR_TABLE_TYPE_GENERIC:
-      return 1;
+    case CHARTAB_RANGE_CHARSET:
+      break;

 
 

-    case CHAR_TABLE_TYPE_DISPLAY:
-      /* #### fix this */
-      maybe_signal_simple_error ("Display char tables not yet implemented",
-                                value, Qchar_table, errb);
-      return 0;
+    case CHARTAB_RANGE_ROW:
+      break;

 
 

-    case CHAR_TABLE_TYPE_CHAR:
-      if (!ERRB_EQ (errb, ERROR_ME))
-       return CHAR_OR_CHAR_INTP (value);
-      CHECK_CHAR_COERCE_INT (value);
+    case CHARTAB_RANGE_CHAR:
+      ret = get_char_table (range->ch, closure->ct);
+      if (!UNBOUNDP (ret))
+       return (closure->fn) (range, ret, closure->arg);

       break;
 
     default:
       abort ();
     }
 
       break;
 
     default:
       abort ();
     }
 

-  return 0; /* not reached */
+  return 0;

 }
 
 }
 

-static Lisp_Object
-canonicalize_char_table_value (Lisp_Object value, enum char_table_type type)
+#if defined(HAVE_DATABASE)
+EXFUN (Fload_char_attribute_table, 1);
+#endif
+
+#endif
+
+/* Map FN (with client data ARG) over range RANGE in char table CT.
+   Mapping stops the first time FN returns non-zero, and that value
+   becomes the return value of map_char_table(). */
+
+int
+map_char_table (Lisp_Char_Table *ct,
+               struct chartab_range *range,
+               int (*fn) (struct chartab_range *range,
+                          Lisp_Object val, void *arg),
+               void *arg)

 {
 {

-  switch (type)
+  switch (range->type)

     {
     {

-    case CHAR_TABLE_TYPE_SYNTAX:
-      if (CONSP (value))
+    case CHARTAB_RANGE_ALL:
+#ifdef UTF2000
+      if (!UNBOUNDP (ct->default_value))

        {
        {

-         Lisp_Object car = XCAR (value);
-         Lisp_Object cdr = XCDR (value);
-         CHECK_CHAR_COERCE_INT (cdr);
-         return Fcons (car, cdr);
+         struct chartab_range rainj;
+         int retval;
+
+         rainj.type = CHARTAB_RANGE_DEFAULT;
+         retval = (fn) (&rainj, ct->default_value, arg);
+         if (retval != 0)
+           return retval;

        }
        }

-      break;
-    case CHAR_TABLE_TYPE_CHAR:
-      CHECK_CHAR_COERCE_INT (value);
-      break;
-    default:
-      break;
-    }
-  return value;
-}
+      if (UINT8_BYTE_TABLE_P (ct->table))
+       return map_over_uint8_byte_table (XUINT8_BYTE_TABLE(ct->table), ct,
+                                         0, 3, fn, arg);
+      else if (UINT16_BYTE_TABLE_P (ct->table))
+       return map_over_uint16_byte_table (XUINT16_BYTE_TABLE(ct->table), ct,
+                                          0, 3, fn, arg);
+      else if (BYTE_TABLE_P (ct->table))
+       return map_over_byte_table (XBYTE_TABLE(ct->table), ct,
+                                   0, 3, fn, arg);
+      else if (EQ (ct->table, Qunloaded))
+       {
+#if 0
+         struct chartab_range rainj;
+         int unit = 1 << 30;
+         Emchar c = 0;
+         Emchar c1 = c + unit;
+         int retval;

 
 

-DEFUN ("valid-char-table-value-p", Fvalid_char_table_value_p, 2, 2, 0, /*
-Return non-nil if VALUE is a valid value for CHAR-TABLE-TYPE.
-*/
-       (value, char_table_type))
-{
-  enum char_table_type type = symbol_to_char_table_type (char_table_type);
+         rainj.type = CHARTAB_RANGE_CHAR;
+
+         for (retval = 0; c < c1 && retval == 0; c++)
+           {
+             Lisp_Object ret = get_char_id_table (ct, c);
+
+             if (!UNBOUNDP (ret))
+               {
+                 rainj.ch = c;
+                 retval = (fn) (&rainj, ct->table, arg);
+               }
+           }
+         return retval;
+#else
+         ct->table = Qunbound;
+#endif
+       }
+      else if (!UNBOUNDP (ct->table))
+        return (fn) (range, ct->table, arg);
+      return 0;
+#else
+      {
+       int retval;
+
+       retval = map_over_charset_ascii (ct, fn, arg);
+       if (retval)
+         return retval;
+#ifdef MULE
+       retval = map_over_charset_control_1 (ct, fn, arg);
+       if (retval)
+         return retval;
+       {
+         Charset_ID i;
+         Charset_ID start = MIN_LEADING_BYTE;
+         Charset_ID stop  = start + NUM_LEADING_BYTES;
+
+         for (i = start, retval = 0; i < stop && retval == 0; i++)
+           {
+             retval = map_over_other_charset (ct, i, fn, arg);
+           }
+       }
+#endif /* MULE */
+       return retval;
+      }
+#endif
+
+#ifdef UTF2000
+    case CHARTAB_RANGE_DEFAULT:
+      if (!UNBOUNDP (ct->default_value))
+       return (fn) (range, ct->default_value, arg);
+      return 0;
+#endif
+
+#ifdef MULE
+    case CHARTAB_RANGE_CHARSET:
+#ifdef UTF2000
+      {
+       Lisp_Object encoding_table
+         = XCHARSET_ENCODING_TABLE (range->charset);
+
+       if (!NILP (encoding_table))
+         {
+           struct chartab_range rainj;
+           struct map_char_table_for_charset_arg mcarg;
+
+#ifdef HAVE_DATABASE
+           if (XCHAR_TABLE_UNLOADED(encoding_table))
+             Fload_char_attribute_table (XCHAR_TABLE_NAME (encoding_table));
+#endif
+           mcarg.fn = fn;
+           mcarg.ct = ct;
+           mcarg.arg = arg;
+           rainj.type = CHARTAB_RANGE_ALL;
+           return map_char_table (XCHAR_TABLE(encoding_table),
+                                  &rainj,
+                                  &map_char_table_for_charset_fun,
+                                  &mcarg);
+         }
+      }
+      return 0;
+#else
+      return map_over_other_charset (ct,
+                                    XCHARSET_LEADING_BYTE (range->charset),
+                                    fn, arg);
+#endif
+
+    case CHARTAB_RANGE_ROW:
+#ifdef UTF2000
+      {
+       int cell_min, cell_max, i;
+       int retval;
+       struct chartab_range rainj;
+
+       i = XCHARSET_CELL_RANGE (range->charset);
+       cell_min = i >> 8;
+       cell_max = i & 0xFF;
+       rainj.type = CHARTAB_RANGE_CHAR;
+       for (retval =0, i = cell_min; i <= cell_max && retval == 0; i++)
+         {
+           Emchar ch = DECODE_CHAR (range->charset, (range->row << 8) | i);
+
+           if ( charset_code_point (range->charset, ch) >= 0 )
+             {
+               Lisp_Object val
+                 = get_byte_table (get_byte_table
+                                   (get_byte_table
+                                    (get_byte_table
+                                     (ct->table,
+                                      (unsigned char)(ch >> 24)),
+                                     (unsigned char) (ch >> 16)),
+                                    (unsigned char)  (ch >> 8)),
+                                   (unsigned char)    ch);
+
+               if (UNBOUNDP (val))
+                 val = ct->default_value;
+               rainj.ch = ch;
+               retval = (fn) (&rainj, val, arg);
+             }
+         }
+       return retval;
+      }
+#else
+      {
+       Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (range->charset)
+                                   - MIN_LEADING_BYTE];
+       if (!CHAR_TABLE_ENTRYP (val))
+         {
+           struct chartab_range rainj;
+
+           rainj.type = CHARTAB_RANGE_ROW;
+           rainj.charset = range->charset;
+           rainj.row = range->row;
+           return (fn) (&rainj, val, arg);
+         }
+       else
+         return map_over_charset_row (XCHAR_TABLE_ENTRY (val),
+                                      range->charset, range->row,
+                                      fn, arg);
+      }
+#endif /* not UTF2000 */
+#endif /* MULE */
+
+    case CHARTAB_RANGE_CHAR:
+      {
+       Emchar ch = range->ch;
+       Lisp_Object val = CHAR_TABLE_VALUE_UNSAFE (ct, ch);

 
 

-  return check_valid_char_table_value (value, type, ERROR_ME_NOT) ? Qt : Qnil;
-}
+       if (!UNBOUNDP (val))
+         {
+           struct chartab_range rainj;

 
 

-DEFUN ("check-valid-char-table-value", Fcheck_valid_char_table_value, 2, 2, 0, /*
-Signal an error if VALUE is not a valid value for CHAR-TABLE-TYPE.
-*/
-       (value, char_table_type))
-{
-  enum char_table_type type = symbol_to_char_table_type (char_table_type);
+           rainj.type = CHARTAB_RANGE_CHAR;
+           rainj.ch = ch;
+           return (fn) (&rainj, val, arg);
+         }
+       return 0;
+      }

 
 

-  check_valid_char_table_value (value, type, ERROR_ME);
-  return Qnil;
+    default:
+      abort ();
+    }
+
+  return 0;

 }
 
 }
 

-/* Assign VAL to all characters in RANGE in char table CT. */
+struct slow_map_char_table_arg
+{
+  Lisp_Object function;
+  Lisp_Object retval;
+};

 
 

-void
-put_char_table (Lisp_Char_Table *ct, struct chartab_range *range,
-               Lisp_Object val)
+static int
+slow_map_char_table_fun (struct chartab_range *range,
+                        Lisp_Object val, void *arg)

 {
 {

+  Lisp_Object ranjarg = Qnil;
+  struct slow_map_char_table_arg *closure =
+    (struct slow_map_char_table_arg *) arg;
+

   switch (range->type)
     {
     case CHARTAB_RANGE_ALL:
   switch (range->type)
     {
     case CHARTAB_RANGE_ALL:

-      fill_char_table (ct, val);
-      return; /* avoid the duplicate call to update_syntax_table() below,
-                since fill_char_table() also did that. */
+      ranjarg = Qt;
+      break;
+
+#ifdef UTF2000
+    case CHARTAB_RANGE_DEFAULT:
+      ranjarg = Qnil;
+      break;
+#endif

 
 #ifdef MULE
     case CHARTAB_RANGE_CHARSET:
 
 #ifdef MULE
     case CHARTAB_RANGE_CHARSET:

-      if (EQ (range->charset, Vcharset_ascii))
-       {
-         int i;
-         for (i = 0; i < 128; i++)
-           ct->ascii[i] = val;
-       }
-      else if (EQ (range->charset, Vcharset_control_1))
-       {
-         int i;
-         for (i = 128; i < 160; i++)
-           ct->ascii[i] = val;
-       }
-      else
-       {
-         int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE;
-         ct->level1[lb] = val;
-       }
+      ranjarg = XCHARSET_NAME (range->charset);

       break;
 
     case CHARTAB_RANGE_ROW:
       break;
 
     case CHARTAB_RANGE_ROW:

-      {
-       Lisp_Char_Table_Entry *cte;
-       int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE;
-       /* make sure that there is a separate entry for the row. */
-       if (!CHAR_TABLE_ENTRYP (ct->level1[lb]))
-         ct->level1[lb] = make_char_table_entry (ct->level1[lb]);
-       cte = XCHAR_TABLE_ENTRY (ct->level1[lb]);
-       cte->level2[range->row - 32] = val;
-      }
+      ranjarg = vector2 (XCHARSET_NAME (range->charset),
+                        make_int (range->row));

       break;
 #endif /* MULE */
       break;
 #endif /* MULE */

-

     case CHARTAB_RANGE_CHAR:
     case CHARTAB_RANGE_CHAR:

-#ifdef MULE
-      {
-       Lisp_Object charset;
-       int byte1, byte2;
-
-       BREAKUP_CHAR (range->ch, charset, byte1, byte2);
-       if (EQ (charset, Vcharset_ascii))
-         ct->ascii[byte1] = val;
-       else if (EQ (charset, Vcharset_control_1))
-         ct->ascii[byte1 + 128] = val;
-       else
-         {
-           Lisp_Char_Table_Entry *cte;
-           int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE;
-           /* make sure that there is a separate entry for the row. */
-           if (!CHAR_TABLE_ENTRYP (ct->level1[lb]))
-             ct->level1[lb] = make_char_table_entry (ct->level1[lb]);
-           cte = XCHAR_TABLE_ENTRY (ct->level1[lb]);
-           /* now CTE is a char table entry for the charset;
-              each entry is for a single row (or character of
-              a one-octet charset). */
-           if (XCHARSET_DIMENSION (charset) == 1)
-             cte->level2[byte1 - 32] = val;
-           else
-             {
-               /* assigning to one character in a two-octet charset. */
-               /* make sure that the charset row contains a separate
-                  entry for each character. */
-               if (!CHAR_TABLE_ENTRYP (cte->level2[byte1 - 32]))
-                 cte->level2[byte1 - 32] =
-                   make_char_table_entry (cte->level2[byte1 - 32]);
-               cte = XCHAR_TABLE_ENTRY (cte->level2[byte1 - 32]);
-               cte->level2[byte2 - 32] = val;
-             }
-         }
-      }
-#else /* not MULE */
-      ct->ascii[(unsigned char) (range->ch)] = val;
+      ranjarg = make_char (range->ch);

       break;
       break;

-#endif /* not MULE */
+    default:
+      abort ();

     }
 
     }
 

-  if (ct->type == CHAR_TABLE_TYPE_SYNTAX)
-    update_syntax_table (ct);
+  closure->retval = call2 (closure->function, ranjarg, val);
+  return !NILP (closure->retval);

 }
 
 }
 

-DEFUN ("put-char-table", Fput_char_table, 3, 3, 0, /*
-Set the value for chars in RANGE to be VALUE in CHAR-TABLE.
-
-RANGE specifies one or more characters to be affected and should be
-one of the following:
-
--- t (all characters are affected)
--- A charset (only allowed when Mule support is present)
--- A vector of two elements: a two-octet charset and a row number
-   (only allowed when Mule support is present)
--- A single character
+DEFUN ("map-char-table", Fmap_char_table, 2, 3, 0, /*
+Map FUNCTION over entries in CHAR-TABLE, calling it with two args,
+each key and value in the table.

 
 

-VALUE must be a value appropriate for the type of CHAR-TABLE.
-See `valid-char-table-type-p'.
+RANGE specifies a subrange to map over and is in the same format as
+the RANGE argument to `put-range-table'.  If omitted or t, it defaults to
+the entire table.

 */
 */

-       (range, value, char_table))
+       (function, char_table, range))

 {
   Lisp_Char_Table *ct;
 {
   Lisp_Char_Table *ct;

+  struct slow_map_char_table_arg slarg;
+  struct gcpro gcpro1, gcpro2;

   struct chartab_range rainj;
 
   CHECK_CHAR_TABLE (char_table);
   ct = XCHAR_TABLE (char_table);
   struct chartab_range rainj;
 
   CHECK_CHAR_TABLE (char_table);
   ct = XCHAR_TABLE (char_table);

-  check_valid_char_table_value (value, ct->type, ERROR_ME);
+  if (NILP (range))
+    range = Qt;

   decode_char_table_range (range, &rainj);
   decode_char_table_range (range, &rainj);

-  value = canonicalize_char_table_value (value, ct->type);
-  put_char_table (ct, &rainj, value);
-  return Qnil;
+  slarg.function = function;
+  slarg.retval = Qnil;
+  GCPRO2 (slarg.function, slarg.retval);
+  map_char_table (ct, &rainj, slow_map_char_table_fun, &slarg);
+  UNGCPRO;
+
+  return slarg.retval;

 }
 
 }
 

-/* Map FN over the ASCII chars in CT. */
+\f
+/************************************************************************/
+/*                         Character Attributes                         */
+/************************************************************************/
+
+#ifdef UTF2000
+
+Lisp_Object Vchar_attribute_hash_table;
+
+/* We store the char-attributes in hash tables with the names as the
+   key and the actual char-id-table object as the value.  Occasionally
+   we need to use them in a list format.  These routines provide us
+   with that. */
+struct char_attribute_list_closure
+{
+  Lisp_Object *char_attribute_list;
+};

 
 static int
 
 static int

-map_over_charset_ascii (Lisp_Char_Table *ct,
-                       int (*fn) (struct chartab_range *range,
-                                  Lisp_Object val, void *arg),
-                       void *arg)
+add_char_attribute_to_list_mapper (Lisp_Object key, Lisp_Object value,
+                                  void *char_attribute_list_closure)

 {
 {

-  struct chartab_range rainj;
-  int i, retval;
-  int start = 0;
-#ifdef MULE
-  int stop = 128;
-#else
-  int stop = 256;
-#endif
+  /* This function can GC */
+  struct char_attribute_list_closure *calcl
+    = (struct char_attribute_list_closure*) char_attribute_list_closure;
+  Lisp_Object *char_attribute_list = calcl->char_attribute_list;

 
 

-  rainj.type = CHARTAB_RANGE_CHAR;
+  *char_attribute_list = Fcons (key, *char_attribute_list);
+  return 0;
+}

 
 

-  for (i = start, retval = 0; i < stop && retval == 0; i++)
+DEFUN ("char-attribute-list", Fchar_attribute_list, 0, 0, 0, /*
+Return the list of all existing character attributes except coded-charsets.
+*/
+       ())
+{
+  Lisp_Object char_attribute_list = Qnil;
+  struct gcpro gcpro1;
+  struct char_attribute_list_closure char_attribute_list_closure;
+  
+  GCPRO1 (char_attribute_list);
+  char_attribute_list_closure.char_attribute_list = &char_attribute_list;
+  elisp_maphash (add_char_attribute_to_list_mapper,
+                Vchar_attribute_hash_table,
+                &char_attribute_list_closure);
+  UNGCPRO;
+  return char_attribute_list;
+}
+
+DEFUN ("find-char-attribute-table", Ffind_char_attribute_table, 1, 1, 0, /*
+Return char-id-table corresponding to ATTRIBUTE.
+*/
+       (attribute))
+{
+  return Fgethash (attribute, Vchar_attribute_hash_table, Qnil);
+}
+
+
+/* We store the char-id-tables in hash tables with the attributes as
+   the key and the actual char-id-table object as the value.  Each
+   char-id-table stores values of an attribute corresponding with
+   characters.  Occasionally we need to get attributes of a character
+   in a association-list format.  These routines provide us with
+   that. */
+struct char_attribute_alist_closure
+{
+  Emchar char_id;
+  Lisp_Object *char_attribute_alist;
+};
+
+static int
+add_char_attribute_alist_mapper (Lisp_Object key, Lisp_Object value,
+                                void *char_attribute_alist_closure)
+{
+  /* This function can GC */
+  struct char_attribute_alist_closure *caacl =
+    (struct char_attribute_alist_closure*) char_attribute_alist_closure;
+  Lisp_Object ret
+    = get_char_id_table (XCHAR_TABLE(value), caacl->char_id);
+  if (!UNBOUNDP (ret))

     {
     {

-      rainj.ch = (Emchar) i;
-      retval = (fn) (&rainj, ct->ascii[i], arg);
+      Lisp_Object *char_attribute_alist = caacl->char_attribute_alist;
+      *char_attribute_alist
+       = Fcons (Fcons (key, ret), *char_attribute_alist);

     }
     }

+  return 0;
+}
+
+DEFUN ("char-attribute-alist", Fchar_attribute_alist, 1, 1, 0, /*
+Return the alist of attributes of CHARACTER.
+*/
+       (character))
+{
+  struct gcpro gcpro1;
+  struct char_attribute_alist_closure char_attribute_alist_closure;
+  Lisp_Object alist = Qnil;

 
 

-  return retval;
-}
+  CHECK_CHAR (character);

 
 

-#ifdef MULE
+  GCPRO1 (alist);
+  char_attribute_alist_closure.char_id = XCHAR (character);
+  char_attribute_alist_closure.char_attribute_alist = &alist;
+  elisp_maphash (add_char_attribute_alist_mapper,
+                Vchar_attribute_hash_table,
+                &char_attribute_alist_closure);
+  UNGCPRO;

 
 

-/* Map FN over the Control-1 chars in CT. */
+  return alist;
+}

 
 

-static int
-map_over_charset_control_1 (Lisp_Char_Table *ct,
-                           int (*fn) (struct chartab_range *range,
-                                      Lisp_Object val, void *arg),
-                           void *arg)
+DEFUN ("get-char-attribute", Fget_char_attribute, 2, 3, 0, /*
+Return the value of CHARACTER's ATTRIBUTE.
+Return DEFAULT-VALUE if the value is not exist.
+*/
+       (character, attribute, default_value))

 {
 {

-  struct chartab_range rainj;
-  int i, retval;
-  int start = 128;
-  int stop  = start + 32;
+  Lisp_Object table;

 
 

-  rainj.type = CHARTAB_RANGE_CHAR;
+  CHECK_CHAR (character);

 
 

-  for (i = start, retval = 0; i < stop && retval == 0; i++)
+  if (CHARSETP (attribute))
+    attribute = XCHARSET_NAME (attribute);
+
+  table = Fgethash (attribute, Vchar_attribute_hash_table,
+                   Qunbound);
+  if (!UNBOUNDP (table))

     {
     {

-      rainj.ch = (Emchar) (i);
-      retval = (fn) (&rainj, ct->ascii[i], arg);
+      Lisp_Object ret = get_char_id_table (XCHAR_TABLE(table),
+                                          XCHAR (character));
+      if (!UNBOUNDP (ret))
+       return ret;

     }
     }

-
-  return retval;
+  return default_value;

 }
 
 }
 

-/* Map FN over the row ROW of two-byte charset CHARSET.
-   There must be a separate value for that row in the char table.
-   CTE specifies the char table entry for CHARSET. */
-
-static int
-map_over_charset_row (Lisp_Char_Table_Entry *cte,
-                     Lisp_Object charset, int row,
-                     int (*fn) (struct chartab_range *range,
-                                Lisp_Object val, void *arg),
-                     void *arg)
+DEFUN ("put-char-attribute", Fput_char_attribute, 3, 3, 0, /*
+Store CHARACTER's ATTRIBUTE with VALUE.
+*/
+       (character, attribute, value))

 {
 {

-  Lisp_Object val = cte->level2[row - 32];
+  Lisp_Object ccs = Ffind_charset (attribute);

 
 

-  if (!CHAR_TABLE_ENTRYP (val))
+  if (!NILP (ccs))

     {
     {

-      struct chartab_range rainj;
-
-      rainj.type = CHARTAB_RANGE_ROW;
-      rainj.charset = charset;
-      rainj.row = row;
-      return (fn) (&rainj, val, arg);
+      CHECK_CHAR (character);
+      value = put_char_ccs_code_point (character, ccs, value);

     }
     }

-  else
+  else if (EQ (attribute, Q_decomposition))

     {
     {

-      struct chartab_range rainj;
-      int i, retval;
-      int charset94_p = (XCHARSET_CHARS (charset) == 94);
-      int start = charset94_p ?  33 :  32;
-      int stop  = charset94_p ? 127 : 128;
-
-      cte = XCHAR_TABLE_ENTRY (val);
+      Lisp_Object seq;

 
 

-      rainj.type = CHARTAB_RANGE_CHAR;
+      CHECK_CHAR (character);
+      if (!CONSP (value))
+       signal_simple_error ("Invalid value for ->decomposition",
+                            value);

 
 

-      for (i = start, retval = 0; i < stop && retval == 0; i++)
+      if (CONSP (Fcdr (value)))

        {
        {

-         rainj.ch = MAKE_CHAR (charset, row, i);
-         retval = (fn) (&rainj, cte->level2[i - 32], arg);
-       }
-      return retval;
-    }
-}
+         Lisp_Object rest = value;
+         Lisp_Object table = Vcharacter_composition_table;
+         size_t len;
+         int i = 0;

 
 

+         GET_EXTERNAL_LIST_LENGTH (rest, len);
+         seq = make_vector (len, Qnil);

 
 

-static int
-map_over_other_charset (Lisp_Char_Table *ct, Charset_ID lb,
-                       int (*fn) (struct chartab_range *range,
-                                  Lisp_Object val, void *arg),
-                       void *arg)
-{
-  Lisp_Object val = ct->level1[lb - MIN_LEADING_BYTE];
-  Lisp_Object charset = CHARSET_BY_LEADING_BYTE (lb);
+         while (CONSP (rest))
+           {
+             Lisp_Object v = Fcar (rest);
+             Lisp_Object ntable;
+             Emchar c
+               = to_char_id (v, "Invalid value for ->decomposition", value);

 
 

-  if (!CHARSETP (charset)
-      || lb == LEADING_BYTE_ASCII
-      || lb == LEADING_BYTE_CONTROL_1)
-    return 0;
+             if (c < 0)
+               XVECTOR_DATA(seq)[i++] = v;
+             else
+               XVECTOR_DATA(seq)[i++] = make_char (c);
+             rest = Fcdr (rest);
+             if (!CONSP (rest))
+               {
+                 put_char_id_table (XCHAR_TABLE(table),
+                                    make_char (c), character);
+                 break;
+               }
+             else
+               {
+                 ntable = get_char_id_table (XCHAR_TABLE(table), c);
+                 if (!CHAR_TABLEP (ntable))
+                   {
+                     ntable = make_char_id_table (Qnil);
+                     put_char_id_table (XCHAR_TABLE(table),
+                                        make_char (c), ntable);
+                   }
+                 table = ntable;
+               }
+           }
+       }
+      else
+       {
+         Lisp_Object v = Fcar (value);

 
 

-  if (!CHAR_TABLE_ENTRYP (val))
-    {
-      struct chartab_range rainj;
+         if (INTP (v))
+           {
+             Emchar c = XINT (v);
+             Lisp_Object ret
+               = get_char_id_table (XCHAR_TABLE(Vcharacter_variant_table),
+                                    c);

 
 

-      rainj.type = CHARTAB_RANGE_CHARSET;
-      rainj.charset = charset;
-      return (fn) (&rainj, val, arg);
+             if (!CONSP (ret))
+               {
+                 put_char_id_table (XCHAR_TABLE(Vcharacter_variant_table),
+                                    make_char (c), Fcons (character, Qnil));
+               }
+             else if (NILP (Fmemq (v, ret)))
+               {
+                 put_char_id_table (XCHAR_TABLE(Vcharacter_variant_table),
+                                    make_char (c), Fcons (character, ret));
+               }
+           }
+         seq = make_vector (1, v);
+       }
+      value = seq;

     }
     }

+  else if (EQ (attribute, Qto_ucs) || EQ (attribute, Q_ucs))
+    {
+      Lisp_Object ret;
+      Emchar c;

 
 

-  {
-    Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
-    int charset94_p = (XCHARSET_CHARS (charset) == 94);
-    int start = charset94_p ?  33 :  32;
-    int stop  = charset94_p ? 127 : 128;
-    int i, retval;
+      CHECK_CHAR (character);
+      if (!INTP (value))
+       signal_simple_error ("Invalid value for ->ucs", value);

 
 

-    if (XCHARSET_DIMENSION (charset) == 1)
-      {
-       struct chartab_range rainj;
-       rainj.type = CHARTAB_RANGE_CHAR;
+      c = XINT (value);

 
 

-       for (i = start, retval = 0; i < stop && retval == 0; i++)
-         {
-           rainj.ch = MAKE_CHAR (charset, i, 0);
-           retval = (fn) (&rainj, cte->level2[i - 32], arg);
-         }
-      }
-    else
+      ret = get_char_id_table (XCHAR_TABLE(Vcharacter_variant_table), c);
+      if (!CONSP (ret))
+       {
+         put_char_id_table (XCHAR_TABLE(Vcharacter_variant_table),
+                            make_char (c), Fcons (character, Qnil));
+       }
+      else if (NILP (Fmemq (character, ret)))
+       {
+         put_char_id_table (XCHAR_TABLE(Vcharacter_variant_table),
+                            make_char (c), Fcons (character, ret));
+       }
+#if 0
+      if (EQ (attribute, Q_ucs))
+       attribute = Qto_ucs;
+#endif
+    }
+  {
+    Lisp_Object table = Fgethash (attribute,
+                                 Vchar_attribute_hash_table,
+                                 Qnil);
+
+    if (NILP (table))

       {
       {

-       for (i = start, retval = 0; i < stop && retval == 0; i++)
-         retval = map_over_charset_row (cte, charset, i, fn, arg);
+       table = make_char_id_table (Qunbound);
+       Fputhash (attribute, table, Vchar_attribute_hash_table);
+#ifdef HAVE_DATABASE
+       XCHAR_TABLE_NAME (table) = attribute;
+#endif

       }
       }

-
-    return retval;
+    put_char_id_table (XCHAR_TABLE(table), character, value);
+    return value;

   }
 }
   }
 }

-
-#endif /* MULE */
-
-/* Map FN (with client data ARG) over range RANGE in char table CT.
-   Mapping stops the first time FN returns non-zero, and that value
-   becomes the return value of map_char_table(). */
-
-int
-map_char_table (Lisp_Char_Table *ct,
-               struct chartab_range *range,
-               int (*fn) (struct chartab_range *range,
-                          Lisp_Object val, void *arg),
-               void *arg)
+  
+DEFUN ("remove-char-attribute", Fremove_char_attribute, 2, 2, 0, /*
+Remove CHARACTER's ATTRIBUTE.
+*/
+       (character, attribute))

 {
 {

-  switch (range->type)
-    {
-    case CHARTAB_RANGE_ALL:
-      {
-       int retval;
+  Lisp_Object ccs;

 
 

-       retval = map_over_charset_ascii (ct, fn, arg);
-       if (retval)
-         return retval;
-#ifdef MULE
-       retval = map_over_charset_control_1 (ct, fn, arg);
-       if (retval)
-         return retval;
+  CHECK_CHAR (character);
+  ccs = Ffind_charset (attribute);
+  if (!NILP (ccs))
+    {
+      return remove_char_ccs (character, ccs);
+    }
+  else
+    {
+      Lisp_Object table = Fgethash (attribute,
+                                   Vchar_attribute_hash_table,
+                                   Qunbound);
+      if (!UNBOUNDP (table))

        {
        {

-         Charset_ID i;
-         Charset_ID start = MIN_LEADING_BYTE;
-         Charset_ID stop  = start + NUM_LEADING_BYTES;
-
-         for (i = start, retval = 0; i < stop && retval == 0; i++)
-           {
-             retval = map_over_other_charset (ct, i, fn, arg);
-           }
+         put_char_id_table (XCHAR_TABLE(table), character, Qunbound);
+         return Qt;

        }
        }

-#endif /* MULE */
-       return retval;
-      }
+    }
+  return Qnil;
+}

 
 

-#ifdef MULE
-    case CHARTAB_RANGE_CHARSET:
-      return map_over_other_charset (ct,
-                                    XCHARSET_LEADING_BYTE (range->charset),
-                                    fn, arg);
+Lisp_Object
+char_attribute_system_db_file (Lisp_Object key_type, Lisp_Object attribute,
+                              int writing_mode)
+{
+  Lisp_Object db_dir = Vexec_directory;

 
 

-    case CHARTAB_RANGE_ROW:
+  if (NILP (db_dir))
+    db_dir = build_string ("../lib-src");
+
+  db_dir = Fexpand_file_name (build_string ("char-db"), db_dir);
+  if (writing_mode && NILP (Ffile_exists_p (db_dir)))
+    Fmake_directory_internal (db_dir);
+
+  db_dir = Fexpand_file_name (Fsymbol_name (key_type), db_dir);
+  if (writing_mode && NILP (Ffile_exists_p (db_dir)))
+    Fmake_directory_internal (db_dir);
+
+  {
+    Lisp_Object attribute_name = Fsymbol_name (attribute);
+    Lisp_Object dest = Qnil, ret;
+    int base = 0;
+    struct gcpro gcpro1, gcpro2;
+    int len = XSTRING_CHAR_LENGTH (attribute_name);
+    int i;
+
+    GCPRO2 (dest, ret);
+    for (i = 0; i < len; i++)

       {
       {

-       Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (range->charset)
-                                   - MIN_LEADING_BYTE];
-       if (!CHAR_TABLE_ENTRYP (val))
-         {
-           struct chartab_range rainj;
+       Emchar c = string_char (XSTRING (attribute_name), i);

 
 

-           rainj.type = CHARTAB_RANGE_ROW;
-           rainj.charset = range->charset;
-           rainj.row = range->row;
-           return (fn) (&rainj, val, arg);
+       if ( (c == '/') || (c == '%') )
+         {
+           char str[4];
+
+           sprintf (str, "%%%02X", c);
+           dest = concat3 (dest,
+                           Fsubstring (attribute_name,
+                                       make_int (base), make_int (i)),
+                           build_string (str));
+           base = i + 1;

          }
          }

-       else
-         return map_over_charset_row (XCHAR_TABLE_ENTRY (val),
-                                      range->charset, range->row,
-                                      fn, arg);

       }
       }

-#endif /* MULE */
+    ret = Fsubstring (attribute_name, make_int (base), make_int (len));
+    dest = concat2 (dest, ret);
+    UNGCPRO;
+    return Fexpand_file_name (dest, db_dir);
+  }
+#if 0
+  return Fexpand_file_name (Fsymbol_name (attribute), db_dir);
+#endif
+}
+  
+DEFUN ("save-char-attribute-table", Fsave_char_attribute_table, 1, 1, 0, /*
+Save values of ATTRIBUTE into database file.
+*/
+       (attribute))
+{
+#ifdef HAVE_DATABASE
+  Lisp_Object table = Fgethash (attribute,
+                               Vchar_attribute_hash_table, Qunbound);
+  Lisp_Char_Table *ct;
+  Lisp_Object db;
+  Lisp_Object db_file;

 
 

-    case CHARTAB_RANGE_CHAR:
-      {
-       Emchar ch = range->ch;
-       Lisp_Object val = CHAR_TABLE_VALUE_UNSAFE (ct, ch);
-       struct chartab_range rainj;
+  if (CHAR_TABLEP (table))
+    ct = XCHAR_TABLE (table);
+  else
+    return Qnil;
+  
+  db_file = char_attribute_system_db_file (Qsystem_char_id, attribute, 1);
+  db = Fopen_database (db_file, Qnil, Qnil, Qnil, Qnil);
+  if (!NILP (db))
+    {
+      if (UINT8_BYTE_TABLE_P (ct->table))
+       save_uint8_byte_table (XUINT8_BYTE_TABLE(ct->table), ct, db, 0, 3);
+      else if (UINT16_BYTE_TABLE_P (ct->table))
+       save_uint16_byte_table (XUINT16_BYTE_TABLE(ct->table), ct, db, 0, 3);
+      else if (BYTE_TABLE_P (ct->table))
+       save_byte_table (XBYTE_TABLE(ct->table), ct, db, 0, 3);
+      Fclose_database (db);
+      return Qt;
+    }
+  else
+    return Qnil;
+#else
+  return Qnil;
+#endif
+}

 
 

-       rainj.type = CHARTAB_RANGE_CHAR;
-       rainj.ch = ch;
-       return (fn) (&rainj, val, arg);
-      }
+DEFUN ("reset-char-attribute-table", Freset_char_attribute_table, 1, 1, 0, /*
+Reset values of ATTRIBUTE with database file.
+*/
+       (attribute))
+{
+#ifdef HAVE_DATABASE
+  Lisp_Object table = Fgethash (attribute,
+                               Vchar_attribute_hash_table, Qunbound);
+  Lisp_Char_Table *ct;
+  Lisp_Object db_file
+    = char_attribute_system_db_file (Qsystem_char_id, attribute, 0);

 
 

-    default:
-      abort ();
+  if (!NILP (Ffile_exists_p (db_file)))
+    {
+      if (UNBOUNDP (table))
+       {
+         table = make_char_id_table (Qunbound);
+         Fputhash (attribute, table, Vchar_attribute_hash_table);
+         XCHAR_TABLE_NAME(table) = attribute;
+       }
+      ct = XCHAR_TABLE (table);
+      ct->table = Qunloaded;
+      XCHAR_TABLE_UNLOADED(table) = 1;
+      return Qt;

     }
     }

+#endif
+  return Qnil;
+}

 
 

-  return 0;
+#ifdef HAVE_DATABASE
+Lisp_Object
+load_char_attribute_maybe (Emchar ch, Lisp_Object attribute)
+{
+  Lisp_Object db;
+  Lisp_Object db_file
+    = char_attribute_system_db_file (Qsystem_char_id, attribute, 0);
+
+  db = Fopen_database (db_file, Qnil, Qnil, Qnil, Qnil);
+  if (!NILP (db))
+    {
+      Lisp_Object val
+       = Fget_database (Fprin1_to_string (make_char (ch), Qnil),
+                        db, Qunbound);
+      if (!UNBOUNDP (val))
+       val = Fread (val);
+      else
+       val = Qunbound;
+      Fclose_database (db);
+      return val;
+    }
+  else
+    return Qunbound;

 }
 
 }
 

-struct slow_map_char_table_arg
+Lisp_Char_Table* char_attribute_table_to_load;
+
+Lisp_Object Qload_char_attribute_table_map_function;
+
+DEFUN ("load-char-attribute-table-map-function",
+       Fload_char_attribute_table_map_function, 2, 2, 0, /*
+For internal use.  Don't use it.
+*/
+       (key, value))

 {
 {

-  Lisp_Object function;
-  Lisp_Object retval;
-};
+  Lisp_Object c = Fread (key);
+  Emchar code = XCHAR (c);
+  Lisp_Object ret = get_char_id_table (char_attribute_table_to_load, code);

 
 

-static int
-slow_map_char_table_fun (struct chartab_range *range,
-                        Lisp_Object val, void *arg)
+  if (EQ (ret, Qunloaded))
+    put_char_id_table_0 (char_attribute_table_to_load, code, Fread (value));
+  return Qnil;
+}
+#endif
+
+DEFUN ("load-char-attribute-table", Fload_char_attribute_table, 1, 1, 0, /*
+Load values of ATTRIBUTE into database file.
+*/
+       (attribute))

 {
 {

-  Lisp_Object ranjarg = Qnil;
-  struct slow_map_char_table_arg *closure =
-    (struct slow_map_char_table_arg *) arg;
+#ifdef HAVE_DATABASE
+  Lisp_Object db;
+  Lisp_Object db_file
+    = char_attribute_system_db_file (Qsystem_char_id, attribute, 0);

 
 

-  switch (range->type)
+  db = Fopen_database (db_file, Qnil, Qnil, Qnil, Qnil);
+  if (!NILP (db))

     {
     {

-    case CHARTAB_RANGE_ALL:
-      ranjarg = Qt;
-      break;
-
-#ifdef MULE
-    case CHARTAB_RANGE_CHARSET:
-      ranjarg = XCHARSET_NAME (range->charset);
-      break;
+      Lisp_Object table = Fgethash (attribute,
+                                   Vchar_attribute_hash_table,
+                                   Qunbound);
+      struct gcpro gcpro1, gcpro2;

 
 

-    case CHARTAB_RANGE_ROW:
-      ranjarg = vector2 (XCHARSET_NAME (range->charset),
-                        make_int (range->row));
-      break;
-#endif /* MULE */
-    case CHARTAB_RANGE_CHAR:
-      ranjarg = make_char (range->ch);
-      break;
-    default:
-      abort ();
+      if (CHAR_TABLEP (table))
+       char_attribute_table_to_load = XCHAR_TABLE (table);
+      else
+       {
+         Fclose_database (db);
+         return Qnil;
+       }
+      GCPRO2 (db, table);
+      Fmap_database (Qload_char_attribute_table_map_function, db);
+      UNGCPRO;
+      Fclose_database (db);
+      XCHAR_TABLE_UNLOADED(table) = 0;
+      return Qt;

     }
     }

-
-  closure->retval = call2 (closure->function, ranjarg, val);
-  return !NILP (closure->retval);
+  else
+    return Qnil;
+#endif

 }
 
 }
 

-DEFUN ("map-char-table", Fmap_char_table, 2, 3, 0, /*
-Map FUNCTION over entries in CHAR-TABLE, calling it with two args,
+DEFUN ("map-char-attribute", Fmap_char_attribute, 2, 3, 0, /*
+Map FUNCTION over entries in ATTRIBUTE, calling it with two args,

 each key and value in the table.
 
 RANGE specifies a subrange to map over and is in the same format as
 the RANGE argument to `put-range-table'.  If omitted or t, it defaults to
 the entire table.
 */
 each key and value in the table.
 
 RANGE specifies a subrange to map over and is in the same format as
 the RANGE argument to `put-range-table'.  If omitted or t, it defaults to
 the entire table.
 */

-       (function, char_table, range))
+       (function, attribute, range))

 {
 {

+  Lisp_Object ccs;

   Lisp_Char_Table *ct;
   struct slow_map_char_table_arg slarg;
   struct gcpro gcpro1, gcpro2;
   struct chartab_range rainj;
 
   Lisp_Char_Table *ct;
   struct slow_map_char_table_arg slarg;
   struct gcpro gcpro1, gcpro2;
   struct chartab_range rainj;
 

-  CHECK_CHAR_TABLE (char_table);
-  ct = XCHAR_TABLE (char_table);
+  if (!NILP (ccs = Ffind_charset (attribute)))
+    {
+      Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (ccs);
+
+      if (CHAR_TABLEP (encoding_table))
+       ct = XCHAR_TABLE (encoding_table);
+      else
+       return Qnil;
+    }
+  else
+    {
+      Lisp_Object table = Fgethash (attribute,
+                                   Vchar_attribute_hash_table,
+                                   Qunbound);
+      if (CHAR_TABLEP (table))
+       ct = XCHAR_TABLE (table);
+      else
+       return Qnil;
+    }

   if (NILP (range))
     range = Qt;
   decode_char_table_range (range, &rainj);
   if (NILP (range))
     range = Qt;
   decode_char_table_range (range, &rainj);

+#ifdef HAVE_DATABASE
+  if (CHAR_TABLE_UNLOADED(ct))
+    Fload_char_attribute_table (attribute);
+#endif

   slarg.function = function;
   slarg.retval = Qnil;
   GCPRO2 (slarg.function, slarg.retval);
   slarg.function = function;
   slarg.retval = Qnil;
   GCPRO2 (slarg.function, slarg.retval);

@@ -2881,6 +3557,108 @@ the entire table.
   return slarg.retval;
 }
 
   return slarg.retval;
 }
 

+DEFUN ("define-char", Fdefine_char, 1, 1, 0, /*
+Store character's ATTRIBUTES.
+*/
+       (attributes))
+{
+  Lisp_Object rest = attributes;
+  Lisp_Object code = Fcdr (Fassq (Qucs, attributes));
+  Lisp_Object character;
+
+  if (NILP (code))
+    {
+      while (CONSP (rest))
+       {
+         Lisp_Object cell = Fcar (rest);
+         Lisp_Object ccs;
+
+         if (!LISTP (cell))
+           signal_simple_error ("Invalid argument", attributes);
+         if (!NILP (ccs = Ffind_charset (Fcar (cell)))
+             && ((XCHARSET_FINAL (ccs) != 0) ||
+                 (XCHARSET_MAX_CODE (ccs) > 0) ||
+                 (EQ (ccs, Vcharset_chinese_big5))) )
+           {
+             cell = Fcdr (cell);
+             if (CONSP (cell))
+               character = Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
+             else
+               character = Fdecode_char (ccs, cell, Qnil);
+             if (!NILP (character))
+               goto setup_attributes;
+           }
+         rest = Fcdr (rest);
+       }
+      if ( (!NILP (code = Fcdr (Fassq (Qto_ucs, attributes)))) ||
+          (!NILP (code = Fcdr (Fassq (Q_ucs, attributes)))) )
+       
+       {
+         if (!INTP (code))
+           signal_simple_error ("Invalid argument", attributes);
+         else
+           character = make_char (XINT (code) + 0x100000);
+         goto setup_attributes;
+       }
+      return Qnil;
+    }
+  else if (!INTP (code))
+    signal_simple_error ("Invalid argument", attributes);
+  else
+    character = make_char (XINT (code));
+
+ setup_attributes:
+  rest = attributes;
+  while (CONSP (rest))
+    {
+      Lisp_Object cell = Fcar (rest);
+
+      if (!LISTP (cell))
+       signal_simple_error ("Invalid argument", attributes);
+
+      Fput_char_attribute (character, Fcar (cell), Fcdr (cell));
+      rest = Fcdr (rest);
+    }
+  return character;
+}
+
+DEFUN ("find-char", Ffind_char, 1, 1, 0, /*
+Retrieve the character of the given ATTRIBUTES.
+*/
+       (attributes))
+{
+  Lisp_Object rest = attributes;
+  Lisp_Object code;
+
+  while (CONSP (rest))
+    {
+      Lisp_Object cell = Fcar (rest);
+      Lisp_Object ccs;
+
+      if (!LISTP (cell))
+       signal_simple_error ("Invalid argument", attributes);
+      if (!NILP (ccs = Ffind_charset (Fcar (cell))))
+       {
+         cell = Fcdr (cell);
+         if (CONSP (cell))
+           return Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
+         else
+           return Fdecode_char (ccs, cell, Qnil);
+       }
+      rest = Fcdr (rest);
+    }
+  if ( (!NILP (code = Fcdr (Fassq (Qto_ucs, attributes)))) ||
+       (!NILP (code = Fcdr (Fassq (Q_ucs, attributes)))) )
+    {
+      if (!INTP (code))
+       signal_simple_error ("Invalid argument", attributes);
+      else
+       return make_char (XINT (code) + 0x100000);
+    }
+  return Qnil;
+}
+
+#endif

 
 \f
 /************************************************************************/
 
 \f
 /************************************************************************/

@@ -3027,7 +3805,7 @@ check_category_table (Lisp_Object object, Lisp_Object default_)
 
 int
 check_category_char (Emchar ch, Lisp_Object table,
 
 int
 check_category_char (Emchar ch, Lisp_Object table,

-                    unsigned int designator, unsigned int not)
+                    unsigned int designator, unsigned int not_p)

 {
   REGISTER Lisp_Object temp;
   Lisp_Char_Table *ctbl;
 {
   REGISTER Lisp_Object temp;
   Lisp_Char_Table *ctbl;

@@ -3038,10 +3816,10 @@ check_category_char (Emchar ch, Lisp_Object table,
   ctbl = XCHAR_TABLE (table);
   temp = get_char_table (ch, ctbl);
   if (NILP (temp))
   ctbl = XCHAR_TABLE (table);
   temp = get_char_table (ch, ctbl);
   if (NILP (temp))

-    return not;
+    return not_p;

 
   designator -= ' ';
 
   designator -= ' ';

-  return bit_vector_bit (XBIT_VECTOR (temp), designator) ? !not : not;
+  return bit_vector_bit (XBIT_VECTOR (temp), designator) ? !not_p : not_p;

 }
 
 DEFUN ("check-category-at", Fcheck_category_at, 2, 4, 0, /*
 }
 
 DEFUN ("check-category-at", Fcheck_category_at, 2, 4, 0, /*

@@ -3221,10 +3999,12 @@ syms_of_chartab (void)
   INIT_LRECORD_IMPLEMENTATION (uint8_byte_table);
   INIT_LRECORD_IMPLEMENTATION (uint16_byte_table);
   INIT_LRECORD_IMPLEMENTATION (byte_table);
   INIT_LRECORD_IMPLEMENTATION (uint8_byte_table);
   INIT_LRECORD_IMPLEMENTATION (uint16_byte_table);
   INIT_LRECORD_IMPLEMENTATION (byte_table);

-  INIT_LRECORD_IMPLEMENTATION (char_id_table);
+
+  defsymbol (&Qsystem_char_id,         "system-char-id");

 
   defsymbol (&Qto_ucs,                 "=>ucs");
   defsymbol (&Q_ucs,                   "->ucs");
 
   defsymbol (&Qto_ucs,                 "=>ucs");
   defsymbol (&Q_ucs,                   "->ucs");

+  defsymbol (&Q_ucs_variants,          "->ucs-variants");

   defsymbol (&Q_decomposition,         "->decomposition");
   defsymbol (&Qcompat,                 "compat");
   defsymbol (&Qisolated,               "isolated");
   defsymbol (&Q_decomposition,         "->decomposition");
   defsymbol (&Qcompat,                 "compat");
   defsymbol (&Qisolated,               "isolated");

@@ -3245,6 +4025,16 @@ syms_of_chartab (void)
 
   DEFSUBR (Fchar_attribute_list);
   DEFSUBR (Ffind_char_attribute_table);
 
   DEFSUBR (Fchar_attribute_list);
   DEFSUBR (Ffind_char_attribute_table);

+  defsymbol (&Qput_char_table_map_function, "put-char-table-map-function");
+  DEFSUBR (Fput_char_table_map_function);
+  DEFSUBR (Fsave_char_attribute_table);
+  DEFSUBR (Freset_char_attribute_table);
+#ifdef HAVE_DATABASE
+  defsymbol (&Qload_char_attribute_table_map_function,
+            "load-char-attribute-table-map-function");
+  DEFSUBR (Fload_char_attribute_table_map_function);
+#endif
+  DEFSUBR (Fload_char_attribute_table);

   DEFSUBR (Fchar_attribute_alist);
   DEFSUBR (Fget_char_attribute);
   DEFSUBR (Fput_char_attribute);
   DEFSUBR (Fchar_attribute_alist);
   DEFSUBR (Fget_char_attribute);
   DEFSUBR (Fput_char_attribute);

@@ -3260,7 +4050,9 @@ syms_of_chartab (void)
   INIT_LRECORD_IMPLEMENTATION (char_table);
 
 #ifdef MULE
   INIT_LRECORD_IMPLEMENTATION (char_table);
 
 #ifdef MULE

+#ifndef UTF2000

   INIT_LRECORD_IMPLEMENTATION (char_table_entry);
   INIT_LRECORD_IMPLEMENTATION (char_table_entry);

+#endif

 
   defsymbol (&Qcategory_table_p, "category-table-p");
   defsymbol (&Qcategory_designator_p, "category-designator-p");
 
   defsymbol (&Qcategory_table_p, "category-table-p");
   defsymbol (&Qcategory_designator_p, "category-designator-p");

@@ -3302,20 +4094,11 @@ void
 vars_of_chartab (void)
 {
 #ifdef UTF2000
 vars_of_chartab (void)
 {
 #ifdef UTF2000

-  Vutf_2000_version = build_string("0.17 (Hōryūji)");
-  DEFVAR_LISP ("utf-2000-version", &Vutf_2000_version /*
-Version number of XEmacs UTF-2000.
-*/ );
-

   staticpro (&Vcharacter_composition_table);
   Vcharacter_composition_table = make_char_id_table (Qnil);
 
   staticpro (&Vcharacter_variant_table);
   staticpro (&Vcharacter_composition_table);
   Vcharacter_composition_table = make_char_id_table (Qnil);
 
   staticpro (&Vcharacter_variant_table);

-  Vcharacter_variant_table = make_char_id_table (Qnil);
-
-  staticpro (&Vchar_attribute_hash_table);
-  Vchar_attribute_hash_table
-    = make_lisp_hash_table (16, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
+  Vcharacter_variant_table = make_char_id_table (Qunbound);

 #endif
   /* DO NOT staticpro this.  It works just like Vweak_hash_tables. */
   Vall_syntax_tables = Qnil;
 #endif
   /* DO NOT staticpro this.  It works just like Vweak_hash_tables. */
   Vall_syntax_tables = Qnil;

@@ -3336,6 +4119,16 @@ structure_type_create_chartab (void)
 void
 complex_vars_of_chartab (void)
 {
 void
 complex_vars_of_chartab (void)
 {

+#ifdef UTF2000
+  staticpro (&Vchar_attribute_hash_table);
+  Vchar_attribute_hash_table
+    = make_lisp_hash_table (16, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
+#ifdef HAVE_DATABASE
+  Fputhash (Q_ucs_variants, Vcharacter_variant_table,
+           Vchar_attribute_hash_table);
+  XCHAR_TABLE_NAME (Vcharacter_variant_table) = Q_ucs_variants;
+#endif /* HAVE_DATABASE */
+#endif /* UTF2000 */

 #ifdef MULE
   /* Set this now, so first buffer creation can refer to it. */
   /* Make it nil before calling copy-category-table
 #ifdef MULE
   /* Set this now, so first buffer creation can refer to it. */
   /* Make it nil before calling copy-category-table