update.

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

diff --git a/src/chartab.c b/src/chartab.c
index 564d77e..7c1408a 100644 (file)
--- a/src/chartab.c
+++ b/src/chartab.c
@@ -4,7 +4,8 @@
    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,2004 MORIOKA Tomohiko
+   Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2008,
+     2010, 2011, 2012, 2013, 2015, 2016 MORIOKA Tomohiko

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

@@ -76,7 +77,6 @@ EXFUN (Fchar_refs_simplify_char_specs, 1);
 extern Lisp_Object Qideographic_structure;
 
 Lisp_Object Vnext_defined_char_id;
 extern Lisp_Object Qideographic_structure;
 
 Lisp_Object Vnext_defined_char_id;

-EXFUN (Fdefine_char, 1);

 
 EXFUN (Fmap_char_attribute, 3);
 
 
 EXFUN (Fmap_char_attribute, 3);
 

@@ -100,7 +100,7 @@ Lisp_Object Vchar_db_stingy_mode;
 INLINE_HEADER int INT_UINT8_P (Lisp_Object obj);
 INLINE_HEADER int UINT8_VALUE_P (Lisp_Object obj);
 INLINE_HEADER unsigned char UINT8_ENCODE (Lisp_Object obj);
 INLINE_HEADER int INT_UINT8_P (Lisp_Object obj);
 INLINE_HEADER int UINT8_VALUE_P (Lisp_Object obj);
 INLINE_HEADER unsigned char UINT8_ENCODE (Lisp_Object obj);

-INLINE_HEADER Lisp_Object UINT8_DECODE (unsigned char n);
+/* INLINE_HEADER */ Lisp_Object UINT8_DECODE (unsigned char n);

 INLINE_HEADER unsigned short UINT8_TO_UINT16 (unsigned char n);
 
 INLINE_HEADER int
 INLINE_HEADER unsigned short UINT8_TO_UINT16 (unsigned char n);
 
 INLINE_HEADER int

@@ -138,7 +138,7 @@ UINT8_ENCODE (Lisp_Object obj)
     return XINT (obj);
 }
 
     return XINT (obj);
 }
 

-INLINE_HEADER Lisp_Object
+/* INLINE_HEADER */ Lisp_Object

 UINT8_DECODE (unsigned char n)
 {
   if (n == BT_UINT8_unloaded)
 UINT8_DECODE (unsigned char n)
 {
   if (n == BT_UINT8_unloaded)

@@ -355,7 +355,7 @@ save_uint8_byte_table (Lisp_Uint8_Byte_Table *ct, Lisp_Char_Table* root,
     {
       if (ct->property[i] == BT_UINT8_unloaded)
        {
     {
       if (ct->property[i] == BT_UINT8_unloaded)
        {

-         c1 = c + unit;
+         c += unit;

        }
       else if (ct->property[i] != BT_UINT8_unbound)
        {
        }
       else if (ct->property[i] != BT_UINT8_unbound)
        {

@@ -392,7 +392,7 @@ save_uint8_byte_table (Lisp_Uint8_Byte_Table *ct, Lisp_Char_Table* root,
 INLINE_HEADER int INT_UINT16_P (Lisp_Object obj);
 INLINE_HEADER int UINT16_VALUE_P (Lisp_Object obj);
 INLINE_HEADER unsigned short UINT16_ENCODE (Lisp_Object obj);
 INLINE_HEADER int INT_UINT16_P (Lisp_Object obj);
 INLINE_HEADER int UINT16_VALUE_P (Lisp_Object obj);
 INLINE_HEADER unsigned short UINT16_ENCODE (Lisp_Object obj);

-INLINE_HEADER Lisp_Object UINT16_DECODE (unsigned short us);
+/* INLINE_HEADER */ Lisp_Object UINT16_DECODE (unsigned short us);

 
 INLINE_HEADER int
 INT_UINT16_P (Lisp_Object obj)
 
 INLINE_HEADER int
 INT_UINT16_P (Lisp_Object obj)

@@ -429,7 +429,7 @@ UINT16_ENCODE (Lisp_Object obj)
     return XINT (obj);
 }
 
     return XINT (obj);
 }
 

-INLINE_HEADER Lisp_Object
+/* INLINE_HEADER */ Lisp_Object

 UINT16_DECODE (unsigned short n)
 {
   if (n == BT_UINT16_unloaded)
 UINT16_DECODE (unsigned short n)
 {
   if (n == BT_UINT16_unloaded)

@@ -679,7 +679,7 @@ save_uint16_byte_table (Lisp_Uint16_Byte_Table *ct, Lisp_Char_Table* root,
     {
       if (ct->property[i] == BT_UINT16_unloaded)
        {
     {
       if (ct->property[i] == BT_UINT16_unloaded)
        {

-         c1 = c + unit;
+         c += unit;

        }
       else if (ct->property[i] != BT_UINT16_unbound)
        {
        }
       else if (ct->property[i] != BT_UINT16_unbound)
        {

@@ -1130,11 +1130,15 @@ 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 Qcomposition;

+Lisp_Object Qrep_decomposition;
+Lisp_Object Qto_decomposition_at_superscript;
+Lisp_Object Qto_decomposition_at_circled;
+Lisp_Object Q_canonical;
+Lisp_Object Q_halfwidth_of;
+Lisp_Object Q_superscript_of;
+Lisp_Object Q_subscript_of;
+Lisp_Object Q_circled_of;

 Lisp_Object Q_decomposition;
 Lisp_Object Q_identical;
 Lisp_Object Q_identical_from;
 Lisp_Object Q_decomposition;
 Lisp_Object Q_identical;
 Lisp_Object Q_identical_from;

@@ -1240,15 +1244,16 @@ Return variants of CHARACTER.
 */
        (character))
 {
 */
        (character))
 {

-  Lisp_Object ret;
-

   CHECK_CHAR (character);
   CHECK_CHAR (character);

-  ret = Fchar_feature (character, Q_ucs_unified, Qnil,
-                      Qnil, 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

@@ -1396,7 +1401,7 @@ char_table_type_to_symbol (enum char_table_type type)
 {
   switch (type)
   {
 {
   switch (type)
   {

-  default: abort();
+  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_GENERIC:  return Qgeneric;
   case CHAR_TABLE_TYPE_SYNTAX:   return Qsyntax;
   case CHAR_TABLE_TYPE_DISPLAY:  return Qdisplay;

@@ -1717,15 +1722,17 @@ once per character).
 When Mule support exists, the types of ranges that can be assigned
 values are
 
 When Mule support exists, the types of ranges that can be assigned
 values are
 

--- all characters
+-- all characters (represented by t)

 -- an entire charset
 -- an entire charset

--- a single row in a two-octet charset
+-- a single row in a two-octet charset (represented by a vector of two
+   elements: a two-octet charset and a row number; the row must be an
+   integer, not a character)

 -- a single character
 
 When Mule support is not present, the types of ranges that can be
 assigned values are
 
 -- a single character
 
 When Mule support is not present, the types of ranges that can be
 assigned values are
 

--- all characters
+-- all characters (represented by t)

 -- a single character
 
 To create a char table, use `make-char-table'.
 -- a single character
 
 To create a char table, use `make-char-table'.

@@ -1854,7 +1861,7 @@ Reset CHAR-TABLE to its default state.
       break;
 
     default:
       break;
 
     default:

-      abort ();
+      ABORT ();

     }
 
   return Qnil;
     }
 
   return Qnil;

@@ -2037,7 +2044,7 @@ XCHARSET_CELL_RANGE (Lisp_Object ccs)
       return (0 << 8) | 255;
 #endif
     default:
       return (0 << 8) | 255;
 #endif
     default:

-      abort ();
+      ABORT ();

       return 0;
     }
 }
       return 0;
     }
 }

@@ -2099,7 +2106,7 @@ decode_char_table_range (Lisp_Object range, struct chartab_range *outrange)
        }
 #endif
       else
        }
 #endif
       else

-       abort ();
+       ABORT ();

     }
   else
     {
     }
   else
     {

@@ -2227,8 +2234,11 @@ Find value for CHARACTER in CHAR-TABLE.
 }
 
 DEFUN ("get-range-char-table", Fget_range_char_table, 2, 3, 0, /*
 }
 
 DEFUN ("get-range-char-table", Fget_range_char_table, 2, 3, 0, /*

-Find value for a range in CHAR-TABLE.
+Find value for RANGE in CHAR-TABLE.

 If there is more than one value, return MULTI (defaults to nil).
 If there is more than one value, return MULTI (defaults to nil).

+
+Valid values for RANGE are single characters, charsets, a row in a
+two-octet charset, and all characters.  See `put-char-table'.

 */
        (range, char_table, multi))
 {
 */
        (range, char_table, multi))
 {

@@ -2332,8 +2342,13 @@ If there is more than one value, return MULTI (defaults to nil).
 #endif /* not UTF2000 */
 #endif /* not MULE */
 
 #endif /* not UTF2000 */
 #endif /* not MULE */
 

+#ifdef UTF2000
+    case CHARTAB_RANGE_DEFAULT:
+      return ct->default_value;
+#endif /* not UTF2000 */
+

     default:
     default:

-      abort ();
+      ABORT ();

     }
 
   return Qnil; /* not reached */
     }
 
   return Qnil; /* not reached */

@@ -2383,7 +2398,7 @@ check_valid_char_table_value (Lisp_Object value, enum char_table_type type,
       break;
 
     default:
       break;
 
     default:

-      abort ();
+      ABORT ();

     }
 
   return 0; /* not reached */
     }
 
   return 0; /* not reached */

@@ -2618,8 +2633,9 @@ one of the following:
 
 -- t (all characters are affected)
 -- A charset (only allowed when Mule support is present)
 
 -- 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 vector of two elements: a two-octet charset and a row number; the row
+   must be an integer, not a character (only allowed when Mule support is
+   present)

 -- A single character
 
 VALUE must be a value appropriate for the type of CHAR-TABLE.
 -- A single character
 
 VALUE must be a value appropriate for the type of CHAR-TABLE.

@@ -2829,7 +2845,7 @@ map_char_table_for_charset_fun (struct chartab_range *range,
       break;
 
     default:
       break;
 
     default:

-      abort ();
+      ABORT ();

     }
 
   return 0;
     }
 
   return 0;

@@ -3040,7 +3056,7 @@ map_char_table (Lisp_Char_Table *ct,
       }
 
     default:
       }
 
     default:

-      abort ();
+      ABORT ();

     }
 
   return 0;
     }
 
   return 0;

@@ -3086,7 +3102,7 @@ slow_map_char_table_fun (struct chartab_range *range,
       ranjarg = make_char (range->ch);
       break;
     default:
       ranjarg = make_char (range->ch);
       break;
     default:

-      abort ();
+      ABORT ();

     }
 
   closure->retval = call2 (closure->function, ranjarg, val);
     }
 
   closure->retval = call2 (closure->function, ranjarg, val);

@@ -3094,8 +3110,8 @@ slow_map_char_table_fun (struct chartab_range *range,
 }
 
 DEFUN ("map-char-table", Fmap_char_table, 2, 3, 0, /*
 }
 
 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.
+Map FUNCTION over CHAR-TABLE until it returns non-nil; return that value.
+FUNCTION is called with two arguments, each key and entry 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
 
 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

@@ -3254,6 +3270,43 @@ Return the alist of attributes of CHARACTER.
   return alist;
 }
 
   return alist;
 }
 

+DEFUN ("char-feature-base-name=", Fchar_feature_base_name_eq, 2, 2, 0, /*
+Return the alist of attributes of CHARACTER.
+*/
+       (base_name, feature_name))
+{
+  Lisp_String *bn, *fn;
+  Bytecount len_bn, len_fn, i;
+  Bufbyte *ptr_bn, *ptr_fn;
+
+  CHECK_SYMBOL (base_name);
+  CHECK_SYMBOL (feature_name);
+
+  bn = XSYMBOL (base_name)->name;
+  fn = XSYMBOL (feature_name)->name;
+  len_bn = string_length (bn);
+  len_fn = string_length (fn);
+
+  if ( len_bn > len_fn )
+    return Qnil;
+
+  ptr_bn = string_data (bn);
+  ptr_fn = string_data (fn);
+  for ( i = len_fn - 1; i >= 0; i-- )
+    {
+      if ( ptr_fn[i] == '*' )
+       return Qnil;
+      if ( ptr_fn[i] == '@' )
+       break;
+    }
+  if ( i < 0 )
+    i = len_fn;
+  if ( (len_bn == i) && (memcmp (ptr_bn, ptr_fn, len_bn) == 0) )
+    return Qt;
+  else
+    return Qnil;
+}
+

 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.
 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.

@@ -3287,6 +3340,7 @@ find_char_feature_in_family (Lisp_Object character,
 {
   Lisp_Object ancestors
     = Fget_char_attribute (character, con_feature, Qnil);
 {
   Lisp_Object ancestors
     = Fget_char_attribute (character, con_feature, Qnil);

+#if 0

 
   while (!NILP (ancestors))
     {
 
   while (!NILP (ancestors))
     {

@@ -3311,6 +3365,38 @@ find_char_feature_in_family (Lisp_Object character,
       if (!NILP (ret))
        ancestors = nconc2 (Fcopy_sequence (ancestors), ret);
     }
       if (!NILP (ret))
        ancestors = nconc2 (Fcopy_sequence (ancestors), ret);
     }

+#else
+  Lisp_Object ancestor;
+
+  if (CONSP (ancestors))
+    ancestor = XCAR (ancestors);
+  else
+    ancestor = ancestors;
+
+  if (!NILP (ancestor))
+    {
+      Lisp_Object ret;
+      Lisp_Object anc;
+
+      if (EQ (ancestor, character))
+       return Qunbound;
+
+      ret = Fchar_feature (ancestor, feature, Qunbound,
+                          Qnil, make_int (0));
+      if (!UNBOUNDP (ret))
+       return ret;
+
+      ret = find_char_feature_in_family (ancestor, Q_subsumptive_from,
+                                        feature, feature_rel_max);
+      if (!UNBOUNDP (ret))
+       return ret;
+
+      ret = find_char_feature_in_family (ancestor, Q_denotational_from,
+                                        feature, feature_rel_max);
+      if (!UNBOUNDP (ret))
+       return ret;
+    }
+#endif

   return Qunbound;
 }
 
   return Qunbound;
 }
 

@@ -3327,6 +3413,7 @@ Return DEFAULT-VALUE if the value is not exist.
   if (!UNBOUNDP (ret))
     return ret;
 
   if (!UNBOUNDP (ret))
     return ret;
 

+#if 0

   if (NILP (feature_rel_max)
       || (INTP (feature_rel_max) &&
          XINT (feature_rel_max) > 0))
   if (NILP (feature_rel_max)
       || (INTP (feature_rel_max) &&
          XINT (feature_rel_max) > 0))

@@ -3351,6 +3438,7 @@ Return DEFAULT-VALUE if the value is not exist.
            return ret;
        }
     }
            return ret;
        }
     }

+#endif

 
   if ( !(EQ (attribute, Q_identical)) &&
        !(EQ (attribute, Q_subsumptive_from)) &&
 
   if ( !(EQ (attribute, Q_identical)) &&
        !(EQ (attribute, Q_subsumptive_from)) &&

@@ -3359,11 +3447,13 @@ Return DEFAULT-VALUE if the value is not exist.
          || (INTP (char_rel_max) &&
              XINT (char_rel_max) > 0)) ) )
     {
          || (INTP (char_rel_max) &&
              XINT (char_rel_max) > 0)) ) )
     {

+#if 0

       Lisp_String* name = symbol_name (XSYMBOL (attribute));
       Bufbyte *name_str = string_data (name);
 
       if ( (name_str[0] != '=') || (name_str[1] == '>') )
        {
       Lisp_String* name = symbol_name (XSYMBOL (attribute));
       Bufbyte *name_str = string_data (name);
 
       if ( (name_str[0] != '=') || (name_str[1] == '>') )
        {

+#endif

          ret = find_char_feature_in_family (character, Q_identical,
                                             attribute, feature_rel_max);
          if (!UNBOUNDP (ret))
          ret = find_char_feature_in_family (character, Q_identical,
                                             attribute, feature_rel_max);
          if (!UNBOUNDP (ret))

@@ -3378,25 +3468,28 @@ Return DEFAULT-VALUE if the value is not exist.
                                             attribute, feature_rel_max);
          if (!UNBOUNDP (ret))
            return ret;
                                             attribute, feature_rel_max);
          if (!UNBOUNDP (ret))
            return ret;

+#if 0

        }
        }

+#endif

     }
   return default_value;
 }
 
     }
   return default_value;
 }
 

-void put_char_composition (Lisp_Object character, Lisp_Object value);
-void
+Lisp_Object
+put_char_composition (Lisp_Object character, Lisp_Object value);
+Lisp_Object

 put_char_composition (Lisp_Object character, Lisp_Object value)
 {
   if (!CONSP (value))
 put_char_composition (Lisp_Object character, Lisp_Object value)
 {
   if (!CONSP (value))

-    signal_simple_error ("Invalid value for ->decomposition",
+    signal_simple_error ("Invalid value for =decomposition",

                         value);
 
                         value);
 

-  if (CONSP (Fcdr (value)))
+  if (CONSP (XCDR (value)))

     {
     {

-      if (NILP (Fcdr (Fcdr (value))))
+      if (NILP (Fcdr (XCDR (value))))

        {
        {

-         Lisp_Object base = Fcar (value);
-         Lisp_Object modifier = Fcar (Fcdr (value));
+         Lisp_Object base = XCAR (value);
+         Lisp_Object modifier = XCAR (XCDR (value));

 
          if (INTP (base))
            {
 
          if (INTP (base))
            {

@@ -3406,7 +3499,7 @@ put_char_composition (Lisp_Object character, Lisp_Object value)
          if (INTP (modifier))
            {
              modifier = make_char (XINT (modifier));
          if (INTP (modifier))
            {
              modifier = make_char (XINT (modifier));

-             Fsetcar (Fcdr (value), modifier);
+             Fsetcar (XCDR (value), modifier);

            }
          if (CHARP (base))
            {
            }
          if (CHARP (base))
            {

@@ -3422,15 +3515,47 @@ put_char_composition (Lisp_Object character, Lisp_Object value)
              else
                Fsetcdr (ret, character);
            }
              else
                Fsetcdr (ret, character);
            }

+         else if (EQ (base, Qnarrow))
+           return Q_halfwidth_of;
+         else if (EQ (base, Qsuper))
+           return Q_superscript_of;
+         else if (EQ (base, Qsub))
+           return Q_subscript_of;
+         else if (EQ (base, Qcircle))
+           return Q_circled_of;
+         else if ( EQ (base, Qisolated)||
+                   EQ (base, Qinitial) ||
+                   EQ (base, Qmedial)  ||
+                   EQ (base, Qfinal) )
+           return
+             Fintern (concat2 (build_string ("<-formed@"),
+                               Fsymbol_name (base)),
+                      Qnil);
+         else if (SYMBOLP (base))
+           return
+             Fintern (concat2 (build_string ("<-"),
+                               Fsymbol_name (base)),
+                      Qnil);

        }
        }

+      else if (EQ (XCAR (value), Qsuper))
+       return Qto_decomposition_at_superscript;
+      else if (EQ (XCAR (value), Qcircle))
+       return Qto_decomposition_at_circled;
+      else
+       return
+         Fintern (concat2 (build_string ("=>decomposition@"),
+                           Fsymbol_name (XCAR (value))),
+                  Qnil);

     }
   else
     {
     }
   else
     {

+      return Q_canonical;
+#if 0

       Lisp_Object v = Fcar (value);
 
       if (INTP (v))
        {
       Lisp_Object v = Fcar (value);
 
       if (INTP (v))
        {

-         Emchar c = XINT (v);
+         Emchar c = DECODE_CHAR (Vcharset_ucs, XINT (v), 0);

          Lisp_Object ret
            = Fchar_feature (make_char (c), Q_ucs_unified, Qnil,
                             Qnil, Qnil);
          Lisp_Object ret
            = Fchar_feature (make_char (c), Q_ucs_unified, Qnil,
                             Qnil, Qnil);

@@ -3446,7 +3571,9 @@ put_char_composition (Lisp_Object character, Lisp_Object value)
                                   Fcons (character, ret));
            }
        }
                                   Fcons (character, ret));
            }
        }

+#endif

     }
     }

+  return Qrep_decomposition;

 }
 
 static Lisp_Object
 }
 
 static Lisp_Object

@@ -3480,11 +3607,36 @@ Store CHARACTER's ATTRIBUTE with VALUE.
 
   if (!NILP (ccs))
     {
 
   if (!NILP (ccs))
     {

-      value = put_char_ccs_code_point (character, ccs, value);
+      if ( !NILP (value) )
+       value = put_char_ccs_code_point (character, ccs, value);

       attribute = XCHARSET_NAME (ccs);
     }
       attribute = XCHARSET_NAME (ccs);
     }

-  else if (EQ (attribute, Q_decomposition))
-    put_char_composition (character, value);
+  else if (
+#if 0
+           EQ (attribute, Qrep_decomposition) ||
+#else
+           !NILP (Fchar_feature_base_name_eq (Qrep_decomposition,
+                                              attribute)) ||
+#endif
+           EQ (attribute, Q_decomposition) /* || */
+#if 0
+           !NILP (Fstring_match (build_string ("^=decomposition@[^*]+$"),
+                                 Fsymbol_name (attribute),
+                                 Qnil, Qnil))
+#endif
+           )
+    {
+      Lisp_Object ret;
+
+      value = Fcopy_sequence (Fchar_refs_simplify_char_specs (value));
+      ret = put_char_composition (character, value);
+      if ( !EQ (ret, Qrep_decomposition) &&
+          SYMBOLP (XCAR (value)) )
+       {
+         attribute = ret;
+         value = XCDR (value);
+       }
+    }

   else if (EQ (attribute, Qto_ucs))
     {
       Lisp_Object ret;
   else if (EQ (attribute, Qto_ucs))
     {
       Lisp_Object ret;

@@ -3493,7 +3645,7 @@ 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 = Fchar_feature (make_char (c), Q_ucs_unified, Qnil,
                           Qnil, Qnil);
 
       ret = Fchar_feature (make_char (c), Q_ucs_unified, Qnil,
                           Qnil, Qnil);

@@ -3504,20 +3656,26 @@ Store CHARACTER's ATTRIBUTE with VALUE.
        Fput_char_attribute (make_char (c), Q_ucs_unified,
                             Fcons (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 ("^\\(<-\\|->\\)\\(simplified"
-                                 "\\|same\\|vulgar\\|wrong"
-                                 "\\)[^*]*$"),
+  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_canonical)             ||
+       EQ (attribute, Q_halfwidth_of)          ||
+       EQ (attribute, Q_superscript_of)                ||
+       EQ (attribute, Q_subscript_of)          ||
+       EQ (attribute, Q_circled_of)            ||
+       EQ (attribute, Q_component)             ||
+       EQ (attribute, Q_component_of)          ||
+       ( !EQ (attribute, Q_ucs_unified)
+        && !NILP (Fstring_match
+                  (build_string ("^\\(<-\\|->\\)[^*]*$"),

                    Fsymbol_name (attribute),
                    Fsymbol_name (attribute),

-                   Qnil, Qnil)) )
+                   Qnil, Qnil))
+        )
+       )

     {
       Lisp_Object rest = value;
       Lisp_Object ret;
     {
       Lisp_Object rest = value;
       Lisp_Object ret;

@@ -3574,7 +3732,17 @@ Store CHARACTER's ATTRIBUTE with VALUE.
 
          if (CONSP (ret))
            ret = Fdefine_char (ret);
 
          if (CONSP (ret))
            ret = Fdefine_char (ret);

-         
+         else if (INTP (ret))
+           {
+             int code_point = XINT (ret);
+             Emchar cid = DECODE_CHAR (Vcharset_ucs, code_point, 0);
+
+             if (cid >= 0)
+               ret = make_char (cid);
+             else
+               ret = make_char (code_point);
+           }
+

          if ( !NILP (ret) && !EQ (ret, character) )
            {
              Lisp_Object ffv;
          if ( !NILP (ret) && !EQ (ret, character) )
            {
              Lisp_Object ffv;

@@ -3593,7 +3761,11 @@ Store CHARACTER's ATTRIBUTE with VALUE.
       UNGCPRO;
     }
 #if 1
       UNGCPRO;
     }
 #if 1

-  else if (EQ (attribute, Qideographic_structure))
+  else if ( EQ (attribute, Qideographic_structure) ||
+           !NILP (Fstring_match
+                  (build_string ("^=>decomposition\\(\\|@[^*]+\\)$"),
+                   Fsymbol_name (attribute),
+                   Qnil, Qnil)) )

     value = Fcopy_sequence (Fchar_refs_simplify_char_specs (value));
 #endif
   return put_char_attribute (character, attribute, value);
     value = Fcopy_sequence (Fchar_refs_simplify_char_specs (value));
 #endif
   return put_char_attribute (character, attribute, value);

@@ -3638,16 +3810,41 @@ open_chise_data_source_maybe ()
 {
   if (default_chise_data_source == NULL)
     {
 {
   if (default_chise_data_source == NULL)
     {

-      Lisp_Object db_dir = Vexec_directory;

       int modemask = 0755;             /* rwxr-xr-x */
       int modemask = 0755;             /* rwxr-xr-x */

+      char* db_dir_name;
+      size_t len;

 
 

-      if (NILP (db_dir))
-       db_dir = build_string ("../lib-src");
-      db_dir = Fexpand_file_name (build_string ("chise-db"), db_dir);
+      if (STRINGP (Vdata_directory))
+       {
+         char* dir_name = XSTRING_DATA (Vdata_directory);

 
 

-      default_chise_data_source
-       = CHISE_DS_open (CHISE_DS_Berkeley_DB, XSTRING_DATA (db_dir),
-                        0 /* DB_HASH */, modemask);
+         len = strlen (dir_name) + 8;
+         db_dir_name = alloca (len + 1);
+         strncpy (db_dir_name, dir_name, len);
+       }
+      else
+       {
+         if (STRINGP (current_buffer->directory))
+           {
+             char* dir_name = XSTRING_DATA (current_buffer->directory);
+
+             len = strlen (dir_name) + 7 + 8;
+             db_dir_name = alloca (len + 1);
+             strncpy (db_dir_name, dir_name, len);
+             strncat(db_dir_name, "../etc/", 15);
+           }
+         else
+           {
+             len = 7 + 8;
+             db_dir_name = alloca (len + 1);
+             strncpy (db_dir_name, "../etc/", len);
+           }
+       }
+      strncat(db_dir_name, "chise-db", 8);
+
+      default_chise_data_source = CHISE_DS_open (CHISE_DS_Berkeley_DB,
+                                                db_dir_name,
+                                                0 /* DB_HASH */, modemask);

       if (default_chise_data_source == NULL)
        return -1;
     }
       if (default_chise_data_source == NULL)
        return -1;
     }

@@ -3725,8 +3922,8 @@ char_table_get_db (Lisp_Char_Table* cit, Emchar ch)
 
   if (!status)
     {
 
   if (!status)
     {

-      val = Fread (make_string (chise_value_data (&value),
-                               chise_value_size (&value) ));
+      val = read_from_c_string (chise_value_data (&value),
+                               chise_value_size (&value) );

     }
   else
     val = Qunbound;
     }
   else
     val = Qunbound;

@@ -3741,15 +3938,26 @@ char_table_get_db (Lisp_Char_Table* cit, Emchar ch)
   return val;
 }
 
   return val;
 }
 

+#ifdef USE_CONCORD_OBJECT_SYSTEM
+COS_object
+char_table_get_db_cos (Lisp_Char_Table* cit, Emchar ch)
+{
+  return
+    concord_object_get_attribute
+    (cos_make_char (ch),
+     cos_intern (XSTRING_DATA (Fsymbol_name (cit->name))));
+}
+#endif
+

 #ifndef HAVE_LIBCHISE
 Lisp_Object
 char_attribute_system_db_file (Lisp_Object key_type, Lisp_Object attribute,
                               int writing_mode)
 {
 #ifndef HAVE_LIBCHISE
 Lisp_Object
 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)))

@@ -3832,15 +4040,23 @@ Save values of ATTRIBUTE into database file.
     {
       Lisp_Object (*filter)(Lisp_Object value);
 
     {
       Lisp_Object (*filter)(Lisp_Object value);
 

-      if ( EQ (attribute, Qideographic_structure)
-          || EQ (attribute, Q_identical)
-          || EQ (attribute, Q_identical_from)
-          || !NILP (Fstring_match
-                    (build_string ("^\\(<-\\|->\\)\\(simplified"
-                                   "\\|same\\|vulgar\\|wrong"
-                                   "\\)[^*]*$"),
-                     Fsymbol_name (attribute),
-                     Qnil, Qnil)) )
+      if ( !NILP (Ffind_charset (attribute)) )
+       filter = NULL;
+      else if ( EQ (attribute, Qideographic_structure) ||
+               EQ (attribute, Q_identical)             ||
+               EQ (attribute, Q_identical_from)        ||
+               EQ (attribute, Q_canonical)             ||
+               EQ (attribute, Q_halfwidth_of)          ||
+               EQ (attribute, Q_superscript_of)        ||
+               EQ (attribute, Q_subscript_of)          ||
+               EQ (attribute, Q_circled_of)            ||
+               !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;

@@ -4003,6 +4219,27 @@ load_char_attribute_maybe (Lisp_Char_Table* cit, Emchar ch)
   return Qunbound;
 }
 
   return Qunbound;
 }
 

+#ifdef USE_CONCORD_OBJECT_SYSTEM
+COS_object
+load_char_attribute_maybe_cos (Lisp_Char_Table* cit, Emchar ch)
+{
+  Lisp_Object attribute = CHAR_TABLE_NAME (cit);
+
+  if (!NILP (attribute))
+    {
+      COS_object val;
+
+      if (char_table_open_db_maybe (cit))
+       return NULL;
+
+      val = char_table_get_db_cos (cit, ch);
+
+      return val;
+    }
+  return NULL;
+}
+#endif
+

 Lisp_Char_Table* char_attribute_table_to_load;
 
 #ifdef HAVE_LIBCHISE
 Lisp_Char_Table* char_attribute_table_to_load;
 
 #ifdef HAVE_LIBCHISE

@@ -4082,12 +4319,18 @@ Load values of ATTRIBUTE into database file.
 #endif /* HAVE_CHISE */
 
 DEFUN ("map-char-attribute", Fmap_char_attribute, 2, 3, 0, /*
 #endif /* HAVE_CHISE */
 
 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.
+Map FUNCTION over ATTRIBUTE until it returns non-nil; return that value.
+FUNCTION is called with two arguments, each key and entry 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
+RANGE specifies a subrange to map over.  If omitted or t, it defaults to

 the entire table.
 the entire table.

+
+Both RANGE and the keys passed to FUNCTION are in the same format as the
+RANGE argument to `put-char-table'.  N.B. This function does NOT map over
+all characters in RANGE, but over the subranges that have been assigned to.
+Thus this function is most suitable for searching a char-table, or for
+populating one char-table based on the contents of another.  The current
+implementation does not coalesce ranges all of whose values are the same.

 */
        (function, attribute, range))
 {
 */
        (function, attribute, range))
 {

@@ -4132,13 +4375,27 @@ the entire table.
   return slarg.retval;
 }
 
   return slarg.retval;
 }
 

+static Lisp_Object
+allocate_character ()
+{
+  int cid = XINT (Vnext_defined_char_id);
+
+  if (cid <= 0xE00000)
+    {
+      Vnext_defined_char_id = make_int (cid + 1);
+      return make_char (cid);
+    }
+  else
+    return Qnil;
+}
+

 DEFUN ("define-char", Fdefine_char, 1, 1, 0, /*
 Store character's ATTRIBUTES.
 */
        (attributes))
 {
   Lisp_Object rest;
 DEFUN ("define-char", Fdefine_char, 1, 1, 0, /*
 Store character's ATTRIBUTES.
 */
        (attributes))
 {
   Lisp_Object rest;

-  Lisp_Object code = Fcdr (Fassq (Qmap_ucs, attributes));
+  Lisp_Object code = Fcdr (Fassq (Qrep_ucs, attributes));

   Lisp_Object character;
 
   if (NILP (code))
   Lisp_Object character;
 
   if (NILP (code))

@@ -4180,7 +4437,7 @@ Store character's ATTRIBUTES.
            }
          rest = Fcdr (rest);
        }
            }
          rest = Fcdr (rest);
        }

-#if 1
+#if 0

       {
        int cid = XINT (Vnext_defined_char_id);
 
       {
        int cid = XINT (Vnext_defined_char_id);
 

@@ -4192,16 +4449,9 @@ Store character's ATTRIBUTES.
          }
       }
 #else
          }
       }
 #else

-      if ( (!NILP (code = Fcdr (Fassq (Qto_ucs, attributes)))) )
-       {
-         if (!INTP (code))
-           signal_simple_error ("Invalid argument", attributes);
-         else
-           character = make_char (XINT (code) + 0x100000);
-         goto setup_attributes;
-       }
+      if ( NILP (character = allocate_character ()) )

 #endif
 #endif

-      return Qnil;
+       return Qnil;

     }
   else if (!INTP (code))
     signal_simple_error ("Invalid argument", attributes);
     }
   else if (!INTP (code))
     signal_simple_error ("Invalid argument", attributes);

@@ -4262,6 +4512,62 @@ Retrieve the character of the given ATTRIBUTES.
 
 \f
 /************************************************************************/
 
 \f
 /************************************************************************/

+/*                      Character Feature Property                      */
+/************************************************************************/
+
+#ifdef HAVE_LIBCHISE
+DEFUN ("char-feature-property", Fchar_feature_property, 2, 3, 0, /*
+Return the value of FEATURE's PROPERTY.
+Return DEFAULT-VALUE if the value is not exist.
+*/
+       (feature, property, default_value))
+{
+  unsigned char* feature_name;
+  unsigned char* property_name;
+  CHISE_Value value;
+  int status;
+
+  feature_name = XSTRING_DATA (Fsymbol_name (feature));
+  property_name = XSTRING_DATA (Fsymbol_name (property));
+  status
+    = chise_feature_load_property_value (chise_ds_get_feature
+                                        (default_chise_data_source,
+                                         feature_name),
+                                        chise_ds_get_property
+                                        (default_chise_data_source,
+                                         property_name),
+                                        &value);
+  if (!status)
+    return read_from_c_string (chise_value_data (&value),
+                              chise_value_size (&value) );
+  else
+    return default_value;
+}
+
+DEFUN ("put-char-feature-property", Fput_char_feature_property, 3, 3, 0, /*
+Store FEATURE's PROPERTY with VALUE.
+*/
+       (feature, property, value))
+{
+  unsigned char* feature_name;
+  unsigned char* property_name;
+  CHISE_Property prop;
+
+  feature_name = XSTRING_DATA (Fsymbol_name (feature));
+  property_name = XSTRING_DATA (Fsymbol_name (property));
+  prop = chise_ds_get_property (default_chise_data_source,
+                               property_name);
+  chise_feature_set_property_value
+    (chise_ds_get_feature (default_chise_data_source, feature_name),
+     prop, XSTRING_DATA (Fprin1_to_string
+                        (value, Qnil)));
+  chise_property_sync (prop);
+  return Qnil;
+}
+#endif
+
+\f
+/************************************************************************/

 /*                         Char table read syntax                       */
 /************************************************************************/
 
 /*                         Char table read syntax                       */
 /************************************************************************/
 

@@ -4346,7 +4652,7 @@ chartab_instantiate (Lisp_Object data)
                 Fput_char_table (make_char (i), val, chartab);
            }
          else
                 Fput_char_table (make_char (i), val, chartab);
            }
          else

-           abort ();
+           ABORT ();

        }
       else
        Fput_char_table (range, val, chartab);
        }
       else
        Fput_char_table (range, val, chartab);

@@ -4599,6 +4905,12 @@ word_boundary_p (Emchar c1, Emchar c2)
 void
 syms_of_chartab (void)
 {
 void
 syms_of_chartab (void)
 {

+#if defined(UTF2000) || defined(HAVE_CONCORD)
+  defsymbol (&Q_subsumptive,           "->subsumptive");
+  defsymbol (&Q_subsumptive_from,      "<-subsumptive");
+  defsymbol (&Q_denotational,          "->denotational");
+  defsymbol (&Q_denotational_from,     "<-denotational");
+#endif

 #ifdef UTF2000
   INIT_LRECORD_IMPLEMENTATION (uint8_byte_table);
   INIT_LRECORD_IMPLEMENTATION (uint16_byte_table);
 #ifdef UTF2000
   INIT_LRECORD_IMPLEMENTATION (uint8_byte_table);
   INIT_LRECORD_IMPLEMENTATION (uint16_byte_table);

@@ -4606,15 +4918,20 @@ syms_of_chartab (void)
 
   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_identical,             "->identical");
   defsymbol (&Q_identical_from,                "<-identical");
   defsymbol (&Q_component,             "->ideographic-component-forms");
   defsymbol (&Q_component_of,          "<-ideographic-component-forms");
   defsymbol (&Qcomposition,            "composition");

+  defsymbol (&Qrep_decomposition,      "=decomposition");
+  defsymbol (&Qto_decomposition_at_superscript,
+            "=>decomposition@superscript");
+  defsymbol (&Qto_decomposition_at_circled, "=>decomposition@circled");
+  defsymbol (&Q_canonical,             "->canonical");
+  defsymbol (&Q_halfwidth_of,          "<-halfwidth");
+  defsymbol (&Q_superscript_of,                "<-superscript");
+  defsymbol (&Q_subscript_of,          "<-subscript");
+  defsymbol (&Q_circled_of,            "<-circled");

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

@@ -4650,6 +4967,7 @@ syms_of_chartab (void)
 #endif
   DEFSUBR (Fload_char_attribute_table);
 #endif
 #endif
   DEFSUBR (Fload_char_attribute_table);
 #endif

+  DEFSUBR (Fchar_feature_base_name_eq);

   DEFSUBR (Fchar_feature);
   DEFSUBR (Fchar_attribute_alist);
   DEFSUBR (Fget_char_attribute);
   DEFSUBR (Fchar_feature);
   DEFSUBR (Fchar_attribute_alist);
   DEFSUBR (Fget_char_attribute);

@@ -4661,6 +4979,10 @@ syms_of_chartab (void)
   DEFSUBR (Fchar_variants);
 
   DEFSUBR (Fget_composite_char);
   DEFSUBR (Fchar_variants);
 
   DEFSUBR (Fget_composite_char);

+#ifdef HAVE_LIBCHISE
+  DEFSUBR (Fchar_feature_property);
+  DEFSUBR (Fput_char_feature_property);
+#endif /* HAVE_LIBCHISE */

 #endif
 
   INIT_LRECORD_IMPLEMENTATION (char_table);
 #endif
 
   INIT_LRECORD_IMPLEMENTATION (char_table);