(vars_of_mule): Update `xemacs-chise-version' to 0.25 (Ōkawara).

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

diff --git a/src/chartab.c b/src/chartab.c
index b05f7d7..0b3c130 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,2005 MORIOKA Tomohiko
+   Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2008,
+     2010 MORIOKA Tomohiko

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

@@ -354,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)
        {

@@ -678,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,7 +1131,7 @@ make_char_id_table (Lisp_Object initval)
 
 
 Lisp_Object Qcomposition;
 
 
 Lisp_Object Qcomposition;

-Lisp_Object Qmap_decomposition;
+Lisp_Object Qrep_decomposition;

 Lisp_Object Qto_decomposition_at_superscript;
 Lisp_Object Qto_decomposition_at_circled;
 Lisp_Object Q_canonical;
 Lisp_Object Qto_decomposition_at_superscript;
 Lisp_Object Qto_decomposition_at_circled;
 Lisp_Object Q_canonical;

@@ -1721,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'.

@@ -2231,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))
 {

@@ -2627,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.

@@ -3103,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

@@ -3490,7 +3497,7 @@ put_char_composition (Lisp_Object character, Lisp_Object value)
        }
 #endif
     }
        }
 #endif
     }

-  return Qmap_decomposition;
+  return Qrep_decomposition;

 }
 
 static Lisp_Object
 }
 
 static Lisp_Object

@@ -3527,12 +3534,12 @@ Store CHARACTER's ATTRIBUTE with VALUE.
       value = put_char_ccs_code_point (character, ccs, value);
       attribute = XCHARSET_NAME (ccs);
     }
       value = put_char_ccs_code_point (character, ccs, value);
       attribute = XCHARSET_NAME (ccs);
     }

-  else if ( EQ (attribute, Qmap_decomposition) ||
+  else if ( EQ (attribute, Qrep_decomposition) ||

            EQ (attribute, Q_decomposition) )
     {
       value = Fcopy_sequence (Fchar_refs_simplify_char_specs (value));
       attribute = put_char_composition (character, value);
            EQ (attribute, Q_decomposition) )
     {
       value = Fcopy_sequence (Fchar_refs_simplify_char_specs (value));
       attribute = put_char_composition (character, value);

-      if ( !EQ (attribute, Qmap_decomposition) &&
+      if ( !EQ (attribute, Qrep_decomposition) &&

           SYMBOLP (XCAR (value)) )
        value = XCDR (value);
     }
           SYMBOLP (XCAR (value)) )
        value = XCDR (value);
     }

@@ -4170,12 +4177,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))
 {

@@ -4226,7 +4239,7 @@ Store character's ATTRIBUTES.
        (attributes))
 {
   Lisp_Object rest;
        (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))

@@ -4350,6 +4363,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                       */
 /************************************************************************/
 

@@ -4687,6 +4756,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);

@@ -4694,16 +4769,12 @@ 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 (&Qmap_decomposition,      "=decomposition");
+  defsymbol (&Qrep_decomposition,      "=decomposition");

   defsymbol (&Qto_decomposition_at_superscript,
             "=>decomposition@superscript");
   defsymbol (&Qto_decomposition_at_circled, "=>decomposition@circled");
   defsymbol (&Qto_decomposition_at_superscript,
             "=>decomposition@superscript");
   defsymbol (&Qto_decomposition_at_circled, "=>decomposition@circled");

@@ -4758,6 +4829,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);