update.

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

diff --git a/src/chartab.c b/src/chartab.c
index d955a1a..94dcb88 100644 (file)
--- a/src/chartab.c
+++ b/src/chartab.c
@@ -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 MORIOKA Tomohiko
+   Copyright (C) 1999,2000,2001,2002,2003,2004,2005 MORIOKA Tomohiko
 
 This file is part of XEmacs.
 
@@ -76,7 +76,6 @@ EXFUN (Fchar_refs_simplify_char_specs, 1);
 extern Lisp_Object Qideographic_structure;
 
 Lisp_Object Vnext_defined_char_id;
-EXFUN (Fdefine_char, 1);
 
 EXFUN (Fmap_char_attribute, 3);
 
@@ -1131,6 +1130,10 @@ make_char_id_table (Lisp_Object initval)
 
 
 Lisp_Object Qcomposition;
+Lisp_Object Qmap_decomposition;
+Lisp_Object Qto_decomposition_at_compat;
+Lisp_Object Q_canonical;
+Lisp_Object Q_compat_of;
 Lisp_Object Q_decomposition;
 Lisp_Object Q_identical;
 Lisp_Object Q_identical_from;
@@ -1236,15 +1239,16 @@ Return variants of CHARACTER.
 */
        (character))
 {
-  Lisp_Object ret;
-
   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
@@ -1392,7 +1396,7 @@ char_table_type_to_symbol (enum char_table_type 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;
@@ -1850,7 +1854,7 @@ Reset CHAR-TABLE to its default state.
       break;
 
     default:
-      abort ();
+      ABORT ();
     }
 
   return Qnil;
@@ -2033,7 +2037,7 @@ XCHARSET_CELL_RANGE (Lisp_Object ccs)
       return (0 << 8) | 255;
 #endif
     default:
-      abort ();
+      ABORT ();
       return 0;
     }
 }
@@ -2095,7 +2099,7 @@ decode_char_table_range (Lisp_Object range, struct chartab_range *outrange)
        }
 #endif
       else
-       abort ();
+       ABORT ();
     }
   else
     {
@@ -2328,8 +2332,13 @@ If there is more than one value, return MULTI (defaults to nil).
 #endif /* not UTF2000 */
 #endif /* not MULE */
 
+#ifdef UTF2000
+    case CHARTAB_RANGE_DEFAULT:
+      return ct->default_value;
+#endif /* not UTF2000 */
+
     default:
-      abort ();
+      ABORT ();
     }
 
   return Qnil; /* not reached */
@@ -2379,7 +2388,7 @@ check_valid_char_table_value (Lisp_Object value, enum char_table_type type,
       break;
 
     default:
-      abort ();
+      ABORT ();
     }
 
   return 0; /* not reached */
@@ -2825,7 +2834,7 @@ map_char_table_for_charset_fun (struct chartab_range *range,
       break;
 
     default:
-      abort ();
+      ABORT ();
     }
 
   return 0;
@@ -3036,7 +3045,7 @@ map_char_table (Lisp_Char_Table *ct,
       }
 
     default:
-      abort ();
+      ABORT ();
     }
 
   return 0;
@@ -3082,7 +3091,7 @@ slow_map_char_table_fun (struct chartab_range *range,
       ranjarg = make_char (range->ch);
       break;
     default:
-      abort ();
+      ABORT ();
     }
 
   closure->retval = call2 (closure->function, ranjarg, val);
@@ -3379,20 +3388,21 @@ Return DEFAULT-VALUE if the value is not exist.
   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))
-    signal_simple_error ("Invalid value for ->decomposition",
+    signal_simple_error ("Invalid value for =decomposition",
                         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))
            {
@@ -3402,7 +3412,7 @@ put_char_composition (Lisp_Object character, Lisp_Object value)
          if (INTP (modifier))
            {
              modifier = make_char (XINT (modifier));
-             Fsetcar (Fcdr (value), modifier);
+             Fsetcar (XCDR (value), modifier);
            }
          if (CHARP (base))
            {
@@ -3418,15 +3428,27 @@ put_char_composition (Lisp_Object character, Lisp_Object value)
              else
                Fsetcdr (ret, character);
            }
+         else if (EQ (base, Qcompat))
+           return Q_compat_of;
        }
+      else if (EQ (XCAR (value), Qcompat))
+       return Qto_decomposition_at_compat;
+      else
+       return
+         Fintern
+         (concat2 (build_string ("=>decomposition@"),
+                   symbol_name (XSYMBOL (XCAR (value)))),
+          Qnil);
     }
   else
     {
+      return Q_canonical;
+#if 0
       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);
@@ -3442,7 +3464,9 @@ put_char_composition (Lisp_Object character, Lisp_Object value)
                                   Fcons (character, ret));
            }
        }
+#endif
     }
+  return Qmap_decomposition;
 }
 
 static Lisp_Object
@@ -3479,8 +3503,18 @@ Store CHARACTER's ATTRIBUTE with VALUE.
       value = put_char_ccs_code_point (character, ccs, value);
       attribute = XCHARSET_NAME (ccs);
     }
-  else if (EQ (attribute, Q_decomposition))
-    put_char_composition (character, value);
+  else if ( EQ (attribute, Qmap_decomposition) ||
+           EQ (attribute, Q_decomposition) )
+    {
+      attribute = put_char_composition (character, value);
+      if ( /*
+            EQ (attribute, Q_compat_of) ||
+            EQ (attribute, Qto_decomposition_at_compat)
+          */
+         /* SYMBOLP (XCAR (value)) */
+         !EQ (attribute, Qmap_decomposition) )
+       value = XCDR (value);
+    }
   else if (EQ (attribute, Qto_ucs))
     {
       Lisp_Object ret;
@@ -3489,7 +3523,7 @@ Store CHARACTER's ATTRIBUTE with 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);
@@ -3500,21 +3534,26 @@ Store CHARACTER's ATTRIBUTE with VALUE.
        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"
-                                 "\\|original\\|ancient"
-                                 "\\)[^*]*$"),
-                   Fsymbol_name (attribute),
-                   Qnil, Qnil)) )
+  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_compat_of)     ||
+       EQ (attribute, Q_component)             ||
+       EQ (attribute, Q_component_of)          ||
+       !NILP (Fstring_match
+             (build_string ("^\\(<-\\|->\\)\\("
+                            "canonical"
+                            "\\|compat"
+                            "\\|fullwidth\\|halfwidth"
+                            "\\|simplified\\|vulgar\\|wrong"
+                            "\\|same\\|original\\|ancient"
+                            "\\|Oracle-Bones\\)[^*]*$"),
+              Fsymbol_name (attribute),
+              Qnil, Qnil)) )
     {
       Lisp_Object rest = value;
       Lisp_Object ret;
@@ -3571,7 +3610,17 @@ Store CHARACTER's ATTRIBUTE with VALUE.
 
          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;
@@ -3590,7 +3639,11 @@ Store CHARACTER's ATTRIBUTE with VALUE.
       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);
@@ -3647,6 +3700,10 @@ open_chise_data_source_maybe ()
                         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;
 }
@@ -3722,8 +3779,13 @@ char_table_get_db (Lisp_Char_Table* cit, Emchar ch)
 
   if (!status)
     {
+#if 0
       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;
@@ -3831,16 +3893,18 @@ Save values of ATTRIBUTE into database file.
 
       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"
-                                   "\\)[^*]*$"),
-                     Fsymbol_name (attribute),
-                     Qnil, Qnil)) )
+      else if ( EQ (attribute, Qideographic_structure) ||
+               EQ (attribute, Q_identical)             ||
+               EQ (attribute, Q_identical_from)        ||
+               EQ (attribute, Q_canonical)             ||
+               EQ (attribute, Q_compat_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;
@@ -4346,7 +4410,7 @@ chartab_instantiate (Lisp_Object data)
                 Fput_char_table (make_char (i), val, chartab);
            }
          else
-           abort ();
+           ABORT ();
        }
       else
        Fput_char_table (range, val, chartab);
@@ -4615,6 +4679,10 @@ syms_of_chartab (void)
   defsymbol (&Q_component,             "->ideographic-component-forms");
   defsymbol (&Q_component_of,          "<-ideographic-component-forms");
   defsymbol (&Qcomposition,            "composition");
+  defsymbol (&Qmap_decomposition,      "=decomposition");
+  defsymbol (&Qto_decomposition_at_compat, "=>decomposition@compat");
+  defsymbol (&Q_canonical,             "->canonical");
+  defsymbol (&Q_compat_of,             "<-compat");
   defsymbol (&Q_decomposition,         "->decomposition");
   defsymbol (&Qcompat,                 "compat");
   defsymbol (&Qisolated,               "isolated");