(put_char_ccs_code_point): Store characters of =ucs whose code_points
[chise/xemacs-chise.git.1] / src / chartab.c
index 69cf73a..e77cbcb 100644 (file)
@@ -1136,10 +1136,16 @@ Lisp_Object Qsystem_char_id;
 
 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_unified;
-Lisp_Object Q_unified_from;
+Lisp_Object Q_subsumptive;
+Lisp_Object Q_subsumptive_from;
+Lisp_Object Q_component;
+Lisp_Object Q_component_of;
+Lisp_Object Q_same;
+Lisp_Object Q_same_of;
 Lisp_Object Qto_ucs;
 Lisp_Object Q_ucs_unified;
 Lisp_Object Qcompat;
@@ -3275,6 +3281,41 @@ Return DEFAULT-VALUE if the value is not exist.
   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.
@@ -3313,7 +3354,8 @@ Return DEFAULT-VALUE if the value is not exist.
        }
     }
 
-  if ( !(EQ (attribute, Q_unified_from)) &&
+  if ( !(EQ (attribute, Q_identical)) &&
+       !(EQ (attribute, Q_subsumptive_from)) &&
        !(EQ (attribute, Q_denotational_from)) &&
        ( (NILP (char_rel_max)
          || (INTP (char_rel_max) &&
@@ -3324,33 +3366,20 @@ Return DEFAULT-VALUE if the value is not exist.
 
       if ( (name_str[0] != '=') || (name_str[1] == '>') )
        {
-         Lisp_Object ancestors
-           = Fget_char_attribute (character, Q_unified_from, Qnil);
-
-         if (NILP (ancestors))
-           ancestors
-             = Fget_char_attribute (character, Q_denotational_from, Qnil);
+         ret = find_char_feature_in_family (character, Q_identical,
+                                            attribute, feature_rel_max);
+         if (!UNBOUNDP (ret))
+           return ret;
 
-         while (!NILP (ancestors))
-           {
-             Lisp_Object ancestor = XCAR (ancestors);
+         ret = find_char_feature_in_family (character, Q_subsumptive_from,
+                                            attribute, feature_rel_max);
+         if (!UNBOUNDP (ret))
+           return ret;
 
-             if (!EQ (ancestor, character))
-               {
-                 ret = Fchar_feature (ancestor, attribute, Qunbound,
-                                      Qnil, make_int (0));
-                 if (!UNBOUNDP (ret))
-                   return ret;
-
-                 ancestors = XCDR (ancestors);
-                 ret = Fget_char_attribute (ancestor, Q_unified_from, Qnil);
-                 if (!NILP (ret))
-                   ancestors = nconc2 (Fcopy_sequence (ancestors), ret);
-               }
-             else
-               return default_value;
-             /* ancestors = XCDR (ancestors); */
-           }
+         ret = find_char_feature_in_family (character, Q_denotational_from,
+                                            attribute, feature_rel_max);
+         if (!UNBOUNDP (ret))
+           return ret;
        }
     }
   return default_value;
@@ -3477,13 +3506,63 @@ Store CHARACTER's ATTRIBUTE with VALUE.
        Fput_char_attribute (make_char (c), Q_ucs_unified,
                             Fcons (character, ret));
     }
-  else if ( EQ (attribute, Q_unified) ||
-           EQ (attribute, Q_unified_from) ||
+  else if ( EQ (attribute, Q_subsumptive) ||
+           EQ (attribute, Q_subsumptive_from) ||
            EQ (attribute, Q_denotational) ||
-           EQ (attribute, Q_denotational_from) )
+           EQ (attribute, Q_denotational_from) ||
+           EQ (attribute, Q_identical) ||
+           EQ (attribute, Q_identical_from) ||
+           EQ (attribute, Q_component) ||
+           EQ (attribute, Q_component_of) ||
+           EQ (attribute, Q_same) ||
+           EQ (attribute, Q_same_of) ||
+           !NILP (Fstring_match (build_string ("^<-simplified[^*]*$"),
+                                 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 if (EQ (attribute, Q_same))
+       rev_feature = Q_same_of;
+      else if (EQ (attribute, Q_same_of))
+       rev_feature = Q_same;
+      else
+       {
+         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);
+             Bufbyte *rev_name_str = alloca (length + 1);
+
+             memcpy (rev_name_str + 2, name_str + 2, length - 2);
+             rev_name_str[0] = '-';
+             rev_name_str[1] = '>';
+             rev_name_str[length] = 0;
+             rev_feature = intern (rev_name_str);
+           }
+       }
 
       while (CONSP (rest))
        {
@@ -3494,18 +3573,8 @@ Store CHARACTER's ATTRIBUTE with VALUE.
          
          if ( !NILP (ret) && !EQ (ret, character) )
            {
-             Lisp_Object rev_feature;
              Lisp_Object ffv;
 
-             if (EQ (attribute, Q_unified))
-               rev_feature = Q_unified_from;
-             else if (EQ (attribute, Q_unified_from))
-               rev_feature = Q_unified;
-             else if (EQ (attribute, Q_denotational))
-               rev_feature = Q_denotational_from;
-             else /* if (EQ (attribute, Q_denotational_from)) */
-               rev_feature = Q_denotational;
-
              ffv = Fget_char_attribute (ret, rev_feature, Qnil);
              if (!CONSP (ffv))
                put_char_attribute (ret, rev_feature, list1 (character));
@@ -3516,8 +3585,9 @@ Store CHARACTER's ATTRIBUTE with VALUE.
            }
          rest = XCDR (rest);
        }
+      UNGCPRO;
     }
-#if 0
+#if 1
   else if (EQ (attribute, Qideographic_structure))
     value = Fcopy_sequence (Fchar_refs_simplify_char_specs (value));
 #endif
@@ -3757,7 +3827,15 @@ Save values of ATTRIBUTE into database file.
     {
       Lisp_Object (*filter)(Lisp_Object value);
 
-      if (EQ (attribute, Qideographic_structure))
+      if ( EQ (attribute, Qideographic_structure)
+          || EQ (attribute, Q_identical)
+          || EQ (attribute, Q_identical_from)
+          || EQ (attribute, Q_same)
+          || EQ (attribute, Q_same_of)
+          || !NILP (Fstring_match
+                    (build_string ("^\\(<-\\|->\\)simplified[^*]*$"),
+                     Fsymbol_name (attribute),
+                     Qnil, Qnil)) )
        filter = &Fchar_refs_simplify_char_specs;
       else
        filter = NULL;
@@ -4054,33 +4132,46 @@ Store character's 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));
+
   if (NILP (code))
     {
+      rest = attributes;
       while (CONSP (rest))
        {
          Lisp_Object cell = Fcar (rest);
          Lisp_Object ccs;
 
-         if (!LISTP (cell))
+         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))) )
+
+         ccs = Ffind_charset (Fcar (cell));
+         if (!NILP (ccs))
            {
              cell = Fcdr (cell);
-             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;
+             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);
        }
@@ -4508,16 +4599,18 @@ syms_of_chartab (void)
   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 (&Q_unified,               "->unified");
-  defsymbol (&Q_unified_from,          "<-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 (&Q_same,                  "->same");
+  defsymbol (&Q_same_of,               "<-same");
   defsymbol (&Qcomposition,            "composition");
   defsymbol (&Q_decomposition,         "->decomposition");
   defsymbol (&Qcompat,                 "compat");