(char_table_get_db): Use `read_from_c_string'.
[chise/xemacs-chise.git.1] / src / chartab.c
index 772c7b9..4b5b82c 100644 (file)
@@ -4,7 +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,2003 MORIOKA Tomohiko
+   Copyright (C) 1999,2000,2001,2002,2003,2004 MORIOKA Tomohiko
 
 This file is part of XEmacs.
 
 
 This file is part of XEmacs.
 
@@ -34,7 +34,7 @@ Boston, MA 02111-1307, USA.  */
              loosely based on the original Mule.
    Jareth Hein: fixed a couple of bugs in the implementation, and
             added regex support for categories with check_category_at
              loosely based on the original Mule.
    Jareth Hein: fixed a couple of bugs in the implementation, and
             added regex support for categories with check_category_at
-   MORIOKA Tomohiko: Rewritten for XEmacs UTF-2000
+   MORIOKA Tomohiko: Rewritten for XEmacs CHISE
  */
 
 #include <config.h>
  */
 
 #include <config.h>
@@ -75,6 +75,8 @@ CHISE_DS *default_chise_data_source = NULL;
 EXFUN (Fchar_refs_simplify_char_specs, 1);
 extern Lisp_Object Qideographic_structure;
 
 EXFUN (Fchar_refs_simplify_char_specs, 1);
 extern Lisp_Object Qideographic_structure;
 
+Lisp_Object Vnext_defined_char_id;
+
 EXFUN (Fmap_char_attribute, 3);
 
 #ifdef HAVE_LIBCHISE
 EXFUN (Fmap_char_attribute, 3);
 
 #ifdef HAVE_LIBCHISE
@@ -1127,12 +1129,16 @@ make_char_id_table (Lisp_Object initval)
 }
 
 
 }
 
 
-#if defined(HAVE_CHISE) && !defined(HAVE_LIBCHISE_LIBCHISE)
-Lisp_Object Qsystem_char_id;
-#endif
-
 Lisp_Object Qcomposition;
 Lisp_Object Q_decomposition;
 Lisp_Object Qcomposition;
 Lisp_Object Q_decomposition;
+Lisp_Object Q_identical;
+Lisp_Object Q_identical_from;
+Lisp_Object Q_denotational;
+Lisp_Object Q_denotational_from;
+Lisp_Object Q_subsumptive;
+Lisp_Object Q_subsumptive_from;
+Lisp_Object Q_component;
+Lisp_Object Q_component_of;
 Lisp_Object Qto_ucs;
 Lisp_Object Q_ucs_unified;
 Lisp_Object Qcompat;
 Lisp_Object Qto_ucs;
 Lisp_Object Q_ucs_unified;
 Lisp_Object Qcompat;
@@ -1218,7 +1224,8 @@ Return character corresponding with list.
       modifier = Fcar (rest);
       rest = Fcdr (rest);
       base = Fcdr (Fassq (modifier,
       modifier = Fcar (rest);
       rest = Fcdr (rest);
       base = Fcdr (Fassq (modifier,
-                         Fget_char_attribute (base, Qcomposition, Qnil)));
+                         Fchar_feature (base, Qcomposition, Qnil,
+                                        Qnil, Qnil)));
     }
   return base;
 }
     }
   return base;
 }
@@ -1228,14 +1235,16 @@ Return variants of CHARACTER.
 */
        (character))
 {
 */
        (character))
 {
-  Lisp_Object ret;
-
   CHECK_CHAR (character);
   CHECK_CHAR (character);
-  ret = Fget_char_attribute (character, Q_ucs_unified, Qnil);
-  if (CONSP (ret))
-    return Fcopy_list (ret);
-  else
-    return Qnil;
+  return
+    nconc2
+    (Fcopy_list (Fget_char_attribute (character, Q_subsumptive, Qnil)),
+     (nconc2
+      (Fcopy_list (Fget_char_attribute (character, Q_denotational, Qnil)),
+       (nconc2
+       (Fcopy_list (Fget_char_attribute (character, Q_identical, Qnil)),
+        Fcopy_list (Fchar_feature (character, Q_ucs_unified, Qnil,
+                                   Qnil, Qnil)))))));
 }
 
 #endif
 }
 
 #endif
@@ -2149,9 +2158,11 @@ get_char_table (Emchar ch, Lisp_Char_Table *ct)
     if (NILP (ret))
       {
        if (EQ (CHAR_TABLE_NAME (ct), Qdowncase))
     if (NILP (ret))
       {
        if (EQ (CHAR_TABLE_NAME (ct), Qdowncase))
-         ret = Fget_char_attribute (make_char (ch), Q_lowercase, Qnil);
+         ret = Fchar_feature (make_char (ch), Q_lowercase, Qnil,
+                              Qnil, Qnil);
        else if (EQ (CHAR_TABLE_NAME (ct), Qflippedcase))
        else if (EQ (CHAR_TABLE_NAME (ct), Qflippedcase))
-         ret = Fget_char_attribute (make_char (ch), Q_uppercase, Qnil);
+         ret = Fchar_feature (make_char (ch), Q_uppercase, Qnil,
+                              Qnil, Qnil);
        if (CONSP (ret))
          {
            ret = XCAR (ret);
        if (CONSP (ret))
          {
            ret = XCAR (ret);
@@ -2444,7 +2455,6 @@ put_char_table (Lisp_Char_Table *ct, struct chartab_range *range,
   switch (range->type)
     {
     case CHARTAB_RANGE_ALL:
   switch (range->type)
     {
     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. */
       fill_char_table (ct, val);
       return; /* avoid the duplicate call to update_syntax_table() below,
                 since fill_char_table() also did that. */
@@ -2461,9 +2471,6 @@ put_char_table (Lisp_Char_Table *ct, struct chartab_range *range,
       {
        Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (range->charset);
 
       {
        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) )
          {
            Lisp_Object mother = XCHARSET_MOTHER (range->charset);
        if ( CHAR_TABLEP (encoding_table) )
          {
            Lisp_Object mother = XCHARSET_MOTHER (range->charset);
@@ -2526,7 +2533,8 @@ put_char_table (Lisp_Char_Table *ct, struct chartab_range *range,
        cell_max = i & 0xFF;
        for (i = cell_min; i <= cell_max; i++)
          {
        cell_max = i & 0xFF;
        for (i = cell_min; i <= cell_max; i++)
          {
-           Emchar ch = DECODE_CHAR (range->charset, (range->row << 8) | i);
+           Emchar ch
+             = DECODE_CHAR (range->charset, (range->row << 8) | i, 0);
 
            if ( charset_code_point (range->charset, ch, 0) >= 0 )
              put_char_id_table_0 (ct, ch, val);
 
            if ( charset_code_point (range->charset, ch, 0) >= 0 )
              put_char_id_table_0 (ct, ch, val);
@@ -2548,7 +2556,6 @@ put_char_table (Lisp_Char_Table *ct, struct chartab_range *range,
 
     case CHARTAB_RANGE_CHAR:
 #ifdef UTF2000
 
     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)
       put_char_id_table_0 (ct, range->ch, val);
       break;
 #elif defined(MULE)
@@ -2968,7 +2975,8 @@ map_char_table (Lisp_Char_Table *ct,
        rainj.type = CHARTAB_RANGE_CHAR;
        for (retval =0, i = cell_min; i <= cell_max && retval == 0; i++)
          {
        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);
+           Emchar ch
+             = DECODE_CHAR (range->charset, (range->row << 8) | i, 0);
 
            if ( charset_code_point (range->charset, ch, 0) >= 0 )
              {
 
            if ( charset_code_point (range->charset, ch, 0) >= 0 )
              {
@@ -3267,6 +3275,110 @@ Return DEFAULT-VALUE if the value is not exist.
   return default_value;
 }
 
   return default_value;
 }
 
+static Lisp_Object
+find_char_feature_in_family (Lisp_Object character,
+                            Lisp_Object con_feature,
+                            Lisp_Object feature,
+                            Lisp_Object feature_rel_max)
+{
+  Lisp_Object ancestors
+    = Fget_char_attribute (character, con_feature, Qnil);
+
+  while (!NILP (ancestors))
+    {
+      Lisp_Object ancestor = XCAR (ancestors);
+      Lisp_Object ret;
+
+      if (EQ (ancestor, character))
+       return Qunbound;
+
+      ret = Fchar_feature (ancestor, feature, Qunbound,
+                          Qnil, make_int (0));
+      if (!UNBOUNDP (ret))
+       return ret;
+
+      ancestors = XCDR (ancestors);
+
+      ret = Fget_char_attribute (ancestor, Q_subsumptive_from, Qnil);
+      if (!NILP (ret))
+       ancestors = nconc2 (Fcopy_sequence (ancestors), ret);
+
+      ret = Fget_char_attribute (ancestor, Q_denotational_from, Qnil);
+      if (!NILP (ret))
+       ancestors = nconc2 (Fcopy_sequence (ancestors), ret);
+    }
+  return Qunbound;
+}
+
+DEFUN ("char-feature", Fchar_feature, 2, 5, 0, /*
+Return the value of CHARACTER's FEATURE.
+Return DEFAULT-VALUE if the value is not exist.
+*/
+       (character, attribute, default_value,
+       feature_rel_max, char_rel_max))
+{
+  Lisp_Object ret
+    = Fget_char_attribute (character, attribute, Qunbound);
+
+  if (!UNBOUNDP (ret))
+    return ret;
+
+  if (NILP (feature_rel_max)
+      || (INTP (feature_rel_max) &&
+         XINT (feature_rel_max) > 0))
+    {
+      Lisp_String* name = symbol_name (XSYMBOL (attribute));
+      Bufbyte *name_str = string_data (name);
+
+      if (name_str[0] == '=' && name_str[1] == '>')
+       {
+         Bytecount length = string_length (name) - 1;
+         Lisp_Object map_to = make_uninit_string (length);
+
+         memcpy (XSTRING_DATA (map_to) + 1, name_str + 2, length - 1);
+         XSTRING_DATA(map_to)[0] = '=';
+         ret = Fchar_feature (character, Fintern (map_to, Qnil),
+                              Qunbound,
+                              NILP (feature_rel_max)
+                              ? feature_rel_max
+                              : make_int (XINT (feature_rel_max) - 1),
+                              char_rel_max);
+         if (!UNBOUNDP (ret))
+           return ret;
+       }
+    }
+
+  if ( !(EQ (attribute, Q_identical)) &&
+       !(EQ (attribute, Q_subsumptive_from)) &&
+       !(EQ (attribute, Q_denotational_from)) &&
+       ( (NILP (char_rel_max)
+         || (INTP (char_rel_max) &&
+             XINT (char_rel_max) > 0)) ) )
+    {
+      Lisp_String* name = symbol_name (XSYMBOL (attribute));
+      Bufbyte *name_str = string_data (name);
+
+      if ( (name_str[0] != '=') || (name_str[1] == '>') )
+       {
+         ret = find_char_feature_in_family (character, Q_identical,
+                                            attribute, feature_rel_max);
+         if (!UNBOUNDP (ret))
+           return ret;
+
+         ret = find_char_feature_in_family (character, Q_subsumptive_from,
+                                            attribute, feature_rel_max);
+         if (!UNBOUNDP (ret))
+           return ret;
+
+         ret = find_char_feature_in_family (character, Q_denotational_from,
+                                            attribute, feature_rel_max);
+         if (!UNBOUNDP (ret))
+           return ret;
+       }
+    }
+  return default_value;
+}
+
 void put_char_composition (Lisp_Object character, Lisp_Object value);
 void
 put_char_composition (Lisp_Object character, Lisp_Object value)
 void put_char_composition (Lisp_Object character, Lisp_Object value);
 void
 put_char_composition (Lisp_Object character, Lisp_Object value)
@@ -3295,7 +3407,8 @@ put_char_composition (Lisp_Object character, Lisp_Object value)
          if (CHARP (base))
            {
              Lisp_Object alist
          if (CHARP (base))
            {
              Lisp_Object alist
-               = Fget_char_attribute (base, Qcomposition, Qnil);
+               = Fchar_feature (base, Qcomposition, Qnil,
+                                Qnil, Qnil);
              Lisp_Object ret = Fassq (modifier, alist);
 
              if (NILP (ret))
              Lisp_Object ret = Fassq (modifier, alist);
 
              if (NILP (ret))
@@ -3313,9 +3426,10 @@ put_char_composition (Lisp_Object character, Lisp_Object value)
 
       if (INTP (v))
        {
 
       if (INTP (v))
        {
-         Emchar c = XINT (v);
+         Emchar c = DECODE_CHAR (Vcharset_ucs, XINT (v), 0);
          Lisp_Object ret
          Lisp_Object ret
-           = Fget_char_attribute (make_char (c), Q_ucs_unified, Qnil);
+           = Fchar_feature (make_char (c), Q_ucs_unified, Qnil,
+                            Qnil, Qnil);
 
          if (!CONSP (ret))
            {
 
          if (!CONSP (ret))
            {
@@ -3331,6 +3445,26 @@ put_char_composition (Lisp_Object character, Lisp_Object value)
     }
 }
 
     }
 }
 
+static Lisp_Object
+put_char_attribute (Lisp_Object character, Lisp_Object attribute,
+                   Lisp_Object value)
+{
+  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);
+#ifdef HAVE_CHISE
+      XCHAR_TABLE_NAME (table) = attribute;
+#endif
+    }
+  put_char_id_table (XCHAR_TABLE(table), character, value);
+  return value;
+}
+
 DEFUN ("put-char-attribute", Fput_char_attribute, 3, 3, 0, /*
 Store CHARACTER's ATTRIBUTE with VALUE.
 */
 DEFUN ("put-char-attribute", Fput_char_attribute, 3, 3, 0, /*
 Store CHARACTER's ATTRIBUTE with VALUE.
 */
@@ -3355,40 +3489,112 @@ Store CHARACTER's ATTRIBUTE with VALUE.
       if (!INTP (value))
        signal_simple_error ("Invalid value for =>ucs", value);
 
       if (!INTP (value))
        signal_simple_error ("Invalid value for =>ucs", value);
 
-      c = XINT (value);
+      c = DECODE_CHAR (Vcharset_ucs, XINT (value), 0);
 
 
-      ret = Fget_char_attribute (make_char (c), Q_ucs_unified, Qnil);
+      ret = Fchar_feature (make_char (c), Q_ucs_unified, Qnil,
+                          Qnil, Qnil);
       if (!CONSP (ret))
       if (!CONSP (ret))
+       put_char_attribute (make_char (c), Q_ucs_unified,
+                           list1 (character));
+      else if (NILP (Fmemq (character, ret)))
+       Fput_char_attribute (make_char (c), Q_ucs_unified,
+                            Fcons (character, ret));
+    }
+  else if ( EQ (attribute, Q_subsumptive) ||
+           EQ (attribute, Q_subsumptive_from) ||
+           EQ (attribute, Q_denotational) ||
+           EQ (attribute, Q_denotational_from) ||
+           EQ (attribute, Q_identical) ||
+           EQ (attribute, Q_identical_from) ||
+           EQ (attribute, Q_component) ||
+           EQ (attribute, Q_component_of) ||
+           !NILP (Fstring_match
+                  (build_string ("^\\(<-\\|->\\)\\("
+                                 "fullwidth\\|halfwidth"
+                                 "\\|simplified\\|vulgar\\|wrong"
+                                 "\\|same\\|original\\|ancient"
+                                 "\\|Oracle-Bones\\)[^*]*$"),
+                   Fsymbol_name (attribute),
+                   Qnil, Qnil)) )
+    {
+      Lisp_Object rest = value;
+      Lisp_Object ret;
+      Lisp_Object rev_feature = Qnil;
+      struct gcpro gcpro1;
+      GCPRO1 (rev_feature);
+
+      if (EQ (attribute, Q_identical))
+       rev_feature = Q_identical_from;
+      else if (EQ (attribute, Q_identical_from))
+       rev_feature = Q_identical;
+      else if (EQ (attribute, Q_subsumptive))
+       rev_feature = Q_subsumptive_from;
+      else if (EQ (attribute, Q_subsumptive_from))
+       rev_feature = Q_subsumptive;
+      else if (EQ (attribute, Q_denotational))
+       rev_feature = Q_denotational_from;
+      else if (EQ (attribute, Q_denotational_from))
+       rev_feature = Q_denotational;
+      else if (EQ (attribute, Q_component))
+       rev_feature = Q_component_of;
+      else if (EQ (attribute, Q_component_of))
+       rev_feature = Q_component;
+      else
        {
        {
-         Fput_char_attribute (make_char (c), Q_ucs_unified,
-                              Fcons (character, Qnil));
+         Lisp_String* name = symbol_name (XSYMBOL (attribute));
+         Bufbyte *name_str = string_data (name);
+
+         if ( (name_str[0] == '<' && name_str[1] == '-') || 
+              (name_str[0] == '-' && name_str[1] == '>') )
+           {
+             Bytecount length = string_length (name);
+             Bufbyte *rev_name_str = alloca (length + 1);
+
+             memcpy (rev_name_str + 2, name_str + 2, length - 2);
+             if (name_str[0] == '<')
+               {
+                 rev_name_str[0] = '-';
+                 rev_name_str[1] = '>';
+               }
+             else
+               {
+                 rev_name_str[0] = '<';
+                 rev_name_str[1] = '-';
+               }
+             rev_name_str[length] = 0;
+             rev_feature = intern (rev_name_str);
+           }
        }
        }
-      else if (NILP (Fmemq (character, ret)))
+
+      while (CONSP (rest))
        {
        {
-         Fput_char_attribute (make_char (c), Q_ucs_unified,
-                              Fcons (character, ret));
+         ret = XCAR (rest);
+
+         if (CONSP (ret))
+           ret = Fdefine_char (ret);
+         
+         if ( !NILP (ret) && !EQ (ret, character) )
+           {
+             Lisp_Object ffv;
+
+             ffv = Fget_char_attribute (ret, rev_feature, Qnil);
+             if (!CONSP (ffv))
+               put_char_attribute (ret, rev_feature, list1 (character));
+             else if (NILP (Fmemq (character, ffv)))
+               put_char_attribute
+                 (ret, rev_feature,
+                  nconc2 (Fcopy_sequence (ffv), list1 (character)));
+             Fsetcar (rest, ret);
+           }
+         rest = XCDR (rest);
        }
        }
+      UNGCPRO;
     }
     }
-#if 0
+#if 1
   else if (EQ (attribute, Qideographic_structure))
     value = Fcopy_sequence (Fchar_refs_simplify_char_specs (value));
 #endif
   else if (EQ (attribute, Qideographic_structure))
     value = Fcopy_sequence (Fchar_refs_simplify_char_specs (value));
 #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);
-#ifdef HAVE_CHISE
-       XCHAR_TABLE_NAME (table) = attribute;
-#endif
-      }
-    put_char_id_table (XCHAR_TABLE(table), character, value);
-    return value;
-  }
+  return put_char_attribute (character, attribute, value);
 }
   
 DEFUN ("remove-char-attribute", Fremove_char_attribute, 2, 2, 0, /*
 }
   
 DEFUN ("remove-char-attribute", Fremove_char_attribute, 2, 2, 0, /*
@@ -3430,11 +3636,11 @@ open_chise_data_source_maybe ()
 {
   if (default_chise_data_source == NULL)
     {
 {
   if (default_chise_data_source == NULL)
     {
-      Lisp_Object db_dir = Vexec_directory;
+      Lisp_Object db_dir = Vdata_directory;
       int modemask = 0755;             /* rwxr-xr-x */
 
       if (NILP (db_dir))
       int modemask = 0755;             /* rwxr-xr-x */
 
       if (NILP (db_dir))
-       db_dir = build_string ("../lib-src");
+       db_dir = build_string ("../etc");
       db_dir = Fexpand_file_name (build_string ("chise-db"), db_dir);
 
       default_chise_data_source
       db_dir = Fexpand_file_name (build_string ("chise-db"), db_dir);
 
       default_chise_data_source
@@ -3442,6 +3648,10 @@ open_chise_data_source_maybe ()
                         0 /* DB_HASH */, modemask);
       if (default_chise_data_source == NULL)
        return -1;
                         0 /* DB_HASH */, modemask);
       if (default_chise_data_source == NULL)
        return -1;
+#if 0
+      chise_ds_set_make_string_function (default_chise_data_source,
+                                        &make_string);
+#endif
     }
   return 0;
 }
     }
   return 0;
 }
@@ -3517,8 +3727,13 @@ char_table_get_db (Lisp_Char_Table* cit, Emchar ch)
 
   if (!status)
     {
 
   if (!status)
     {
+#if 0
       val = Fread (make_string (chise_value_data (&value),
                                chise_value_size (&value) ));
       val = Fread (make_string (chise_value_data (&value),
                                chise_value_size (&value) ));
+#else
+      val = read_from_c_string (chise_value_data (&value),
+                               chise_value_size (&value) );
+#endif
     }
   else
     val = Qunbound;
     }
   else
     val = Qunbound;
@@ -3538,10 +3753,10 @@ Lisp_Object
 char_attribute_system_db_file (Lisp_Object key_type, Lisp_Object attribute,
                               int writing_mode)
 {
 char_attribute_system_db_file (Lisp_Object key_type, Lisp_Object attribute,
                               int writing_mode)
 {
-  Lisp_Object db_dir = Vexec_directory;
+  Lisp_Object db_dir = Vdata_directory;
 
   if (NILP (db_dir))
 
   if (NILP (db_dir))
-    db_dir = build_string ("../lib-src");
+    db_dir = build_string ("../etc");
 
   db_dir = Fexpand_file_name (build_string ("chise-db"), db_dir);
   if (writing_mode && NILP (Ffile_exists_p (db_dir)))
 
   db_dir = Fexpand_file_name (build_string ("chise-db"), db_dir);
   if (writing_mode && NILP (Ffile_exists_p (db_dir)))
@@ -3624,7 +3839,18 @@ Save values of ATTRIBUTE into database file.
     {
       Lisp_Object (*filter)(Lisp_Object value);
 
     {
       Lisp_Object (*filter)(Lisp_Object value);
 
-      if (EQ (attribute, Qideographic_structure))
+      if ( !NILP (Ffind_charset (attribute)) )
+       filter = NULL;
+      else if ( EQ (attribute, Qideographic_structure)
+          || EQ (attribute, Q_identical)
+          || EQ (attribute, Q_identical_from)
+          || !NILP (Fstring_match
+                    (build_string ("^\\(<-\\|->\\)\\(simplified"
+                                   "\\|same\\|vulgar\\|wrong"
+                                   "\\|original\\|ancient"
+                                   "\\|Oracle-Bones\\)[^*]*$"),
+                     Fsymbol_name (attribute),
+                     Qnil, Qnil)) )
        filter = &Fchar_refs_simplify_char_specs;
       else
        filter = NULL;
        filter = &Fchar_refs_simplify_char_specs;
       else
        filter = NULL;
@@ -3921,36 +4147,61 @@ Store character's ATTRIBUTES.
 */
        (attributes))
 {
 */
        (attributes))
 {
-  Lisp_Object rest = attributes;
+  Lisp_Object rest;
   Lisp_Object code = Fcdr (Fassq (Qmap_ucs, attributes));
   Lisp_Object character;
 
   if (NILP (code))
     code = Fcdr (Fassq (Qucs, attributes));
   Lisp_Object code = Fcdr (Fassq (Qmap_ucs, attributes));
   Lisp_Object character;
 
   if (NILP (code))
     code = Fcdr (Fassq (Qucs, attributes));
+
   if (NILP (code))
     {
   if (NILP (code))
     {
+      rest = attributes;
       while (CONSP (rest))
        {
          Lisp_Object cell = Fcar (rest);
          Lisp_Object ccs;
 
       while (CONSP (rest))
        {
          Lisp_Object cell = Fcar (rest);
          Lisp_Object ccs;
 
-         if (!LISTP (cell))
+         if ( !LISTP (cell) )
            signal_simple_error ("Invalid argument", attributes);
            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))) )
+
+         ccs = Ffind_charset (Fcar (cell));
+         if (!NILP (ccs))
            {
              cell = Fcdr (cell);
            {
              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;
+             if (INTP (cell))
+               {
+                 character = Fdecode_char (ccs, cell, Qt, Qt);
+                 if (!NILP (character))
+                   goto setup_attributes;
+               }
+             if ( (XCHARSET_FINAL (ccs) != 0) ||
+                  (XCHARSET_MAX_CODE (ccs) > 0) ||
+                  (EQ (ccs, Vcharset_chinese_big5)) )
+               {
+                 if (CONSP (cell))
+                   character
+                     = Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
+                 else
+                   character = Fdecode_char (ccs, cell, Qnil, Qt);
+                 if (!NILP (character))
+                   goto setup_attributes;
+               }
            }
          rest = Fcdr (rest);
        }
            }
          rest = Fcdr (rest);
        }
+#if 1
+      {
+       int cid = XINT (Vnext_defined_char_id);
+
+       if (cid <= 0xE00000)
+         {
+           character = make_char (cid);
+           Vnext_defined_char_id = make_int (cid + 1);
+           goto setup_attributes;
+         }
+      }
+#else
       if ( (!NILP (code = Fcdr (Fassq (Qto_ucs, attributes)))) )
        {
          if (!INTP (code))
       if ( (!NILP (code = Fcdr (Fassq (Qto_ucs, attributes)))) )
        {
          if (!INTP (code))
@@ -3959,6 +4210,7 @@ Store character's ATTRIBUTES.
            character = make_char (XINT (code) + 0x100000);
          goto setup_attributes;
        }
            character = make_char (XINT (code) + 0x100000);
          goto setup_attributes;
        }
+#endif
       return Qnil;
     }
   else if (!INTP (code))
       return Qnil;
     }
   else if (!INTP (code))
@@ -4002,7 +4254,7 @@ Retrieve the character of the given ATTRIBUTES.
          if (CONSP (cell))
            return Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
          else
          if (CONSP (cell))
            return Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
          else
-           return Fdecode_char (ccs, cell, Qnil);
+           return Fdecode_char (ccs, cell, Qnil, Qnil);
        }
       rest = Fcdr (rest);
     }
        }
       rest = Fcdr (rest);
     }
@@ -4362,12 +4614,16 @@ syms_of_chartab (void)
   INIT_LRECORD_IMPLEMENTATION (uint16_byte_table);
   INIT_LRECORD_IMPLEMENTATION (byte_table);
 
   INIT_LRECORD_IMPLEMENTATION (uint16_byte_table);
   INIT_LRECORD_IMPLEMENTATION (byte_table);
 
-#if defined(HAVE_CHISE) && !defined(HAVE_LIBCHISE_LIBCHISE)
-  defsymbol (&Qsystem_char_id,         "system-char-id");
-#endif
-
   defsymbol (&Qto_ucs,                 "=>ucs");
   defsymbol (&Q_ucs_unified,           "->ucs-unified");
   defsymbol (&Qto_ucs,                 "=>ucs");
   defsymbol (&Q_ucs_unified,           "->ucs-unified");
+  defsymbol (&Q_subsumptive,           "->subsumptive");
+  defsymbol (&Q_subsumptive_from,      "<-subsumptive");
+  defsymbol (&Q_denotational,          "->denotational");
+  defsymbol (&Q_denotational_from,     "<-denotational");
+  defsymbol (&Q_identical,             "->identical");
+  defsymbol (&Q_identical_from,                "<-identical");
+  defsymbol (&Q_component,             "->ideographic-component-forms");
+  defsymbol (&Q_component_of,          "<-ideographic-component-forms");
   defsymbol (&Qcomposition,            "composition");
   defsymbol (&Q_decomposition,         "->decomposition");
   defsymbol (&Qcompat,                 "compat");
   defsymbol (&Qcomposition,            "composition");
   defsymbol (&Q_decomposition,         "->decomposition");
   defsymbol (&Qcompat,                 "compat");
@@ -4404,6 +4660,7 @@ syms_of_chartab (void)
 #endif
   DEFSUBR (Fload_char_attribute_table);
 #endif
 #endif
   DEFSUBR (Fload_char_attribute_table);
 #endif
+  DEFSUBR (Fchar_feature);
   DEFSUBR (Fchar_attribute_alist);
   DEFSUBR (Fget_char_attribute);
   DEFSUBR (Fput_char_attribute);
   DEFSUBR (Fchar_attribute_alist);
   DEFSUBR (Fget_char_attribute);
   DEFSUBR (Fput_char_attribute);
@@ -4462,6 +4719,12 @@ syms_of_chartab (void)
 void
 vars_of_chartab (void)
 {
 void
 vars_of_chartab (void)
 {
+#ifdef UTF2000
+  DEFVAR_LISP ("next-defined-char-id", &Vnext_defined_char_id /*
+*/ );
+  Vnext_defined_char_id = make_int (0x0F0000);
+#endif
+
 #ifdef HAVE_CHISE
   DEFVAR_LISP ("char-db-stingy-mode", &Vchar_db_stingy_mode /*
 */ );
 #ifdef HAVE_CHISE
   DEFVAR_LISP ("char-db-stingy-mode", &Vchar_db_stingy_mode /*
 */ );