Merge r21-4-18-chise-0_23-1.
[chise/xemacs-chise.git] / src / chartab.c
index 6b33280..3cf4c35 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) 1999,2000,2001,2002,2003,2004,2005 MORIOKA Tomohiko
+   Copyright (C) 1999,2000,2001,2002,2003,2004,2005,2006 MORIOKA Tomohiko
 
 This file is part of XEmacs.
 
@@ -1134,9 +1134,10 @@ Lisp_Object Qmap_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_compat_of;
+Lisp_Object Q_circled_of;
 Lisp_Object Q_decomposition;
 Lisp_Object Q_identical;
 Lisp_Object Q_identical_from;
@@ -1720,15 +1721,17 @@ once per character).
 When Mule support exists, the types of ranges that can be assigned
 values are
 
--- all characters
+-- all characters (represented by t)
 -- 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
 
--- all characters
+-- all characters (represented by t)
 -- a single character
 
 To create a char table, use `make-char-table'.
@@ -2230,8 +2233,11 @@ Find value for CHARACTER in CHAR-TABLE.
 }
 
 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).
+
+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))
 {
@@ -2626,8 +2632,9 @@ one of the following:
 
 -- t (all characters are affected)
 -- A charset (only allowed when Mule support is present)
--- A vector of two elements: a two-octet charset and a row number
-   (only allowed when Mule support is present)
+-- A 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.
@@ -3102,8 +3109,8 @@ slow_map_char_table_fun (struct chartab_range *range,
 }
 
 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
@@ -3431,12 +3438,27 @@ put_char_composition (Lisp_Object character, Lisp_Object value)
              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, Qcompat))
-           return Q_compat_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;
@@ -3445,7 +3467,7 @@ put_char_composition (Lisp_Object character, Lisp_Object value)
       else
        return
          Fintern (concat2 (build_string ("=>decomposition@"),
-                           symbol_name (XSYMBOL (XCAR (value)))),
+                           Fsymbol_name (XCAR (value))),
                   Qnil);
     }
   else
@@ -3514,6 +3536,7 @@ Store CHARACTER's ATTRIBUTE with VALUE.
   else if ( EQ (attribute, Qmap_decomposition) ||
            EQ (attribute, Q_decomposition) )
     {
+      value = Fcopy_sequence (Fchar_refs_simplify_char_specs (value));
       attribute = put_char_composition (character, value);
       if ( !EQ (attribute, Qmap_decomposition) &&
           SYMBOLP (XCAR (value)) )
@@ -3545,21 +3568,19 @@ Store CHARACTER's ATTRIBUTE with VALUE.
        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_compat_of)             ||
+       EQ (attribute, Q_circled_of)            ||
        EQ (attribute, Q_component)             ||
        EQ (attribute, Q_component_of)          ||
-       !NILP (Fstring_match
-             (build_string ("^\\(<-\\|->\\)\\("
-                            "canonical"
-                            "\\|superscript\\|subscript\\|compat"
-                            "\\|fullwidth\\|halfwidth"
-                            "\\|simplified\\|vulgar\\|wrong"
-                            "\\|same\\|original\\|ancient"
-                            "\\|Oracle-Bones\\)[^*]*$"),
-              Fsymbol_name (attribute),
-              Qnil, Qnil)) )
+       ( !EQ (attribute, Q_ucs_unified)
+        && !NILP (Fstring_match
+                  (build_string ("^\\(<-\\|->\\)[^*]*$"),
+                   Fsymbol_name (attribute),
+                   Qnil, Qnil))
+        )
+       )
     {
       Lisp_Object rest = value;
       Lisp_Object ret;
@@ -3903,9 +3924,10 @@ Save values of ATTRIBUTE into database file.
                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_compat_of)             ||
+               EQ (attribute, Q_circled_of)            ||
                !NILP (Fstring_match
                       (build_string ("^\\(<-\\|->\\)\\(simplified"
                                      "\\|same\\|vulgar\\|wrong"
@@ -4154,12 +4176,18 @@ Load values of ATTRIBUTE into database file.
 #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.
+
+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))
 {
@@ -4692,9 +4720,10 @@ syms_of_chartab (void)
             "=>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_compat_of,             "<-compat");
+  defsymbol (&Q_circled_of,            "<-circled");
   defsymbol (&Q_decomposition,         "->decomposition");
   defsymbol (&Qcompat,                 "compat");
   defsymbol (&Qisolated,               "isolated");