(put_char_composition): Return

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

diff --git a/src/chartab.c b/src/chartab.c
index 02ef2df..b23f3d9 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) 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.
 
 
 This file is part of XEmacs.
 

@@ -1130,6 +1130,13 @@ make_char_id_table (Lisp_Object initval)
 
 
 Lisp_Object Qcomposition;
 
 
 Lisp_Object Qcomposition;

+Lisp_Object Qmap_decomposition;
+Lisp_Object Qto_decomposition_at_superscript;
+Lisp_Object Qto_decomposition_at_circled;
+Lisp_Object Q_canonical;
+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;

@@ -1235,15 +1242,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

@@ -1391,7 +1399,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;

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

-      abort ();
+      ABORT ();

     }
 
   return Qnil;
     }
 
   return Qnil;

@@ -2032,7 +2040,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;
     }
 }

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

-       abort ();
+       ABORT ();

     }
   else
     {
     }
   else
     {

@@ -2327,8 +2335,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 */

@@ -2378,7 +2391,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 */

@@ -2824,7 +2837,7 @@ map_char_table_for_charset_fun (struct chartab_range *range,
       break;
 
     default:
       break;
 
     default:

-      abort ();
+      ABORT ();

     }
 
   return 0;
     }
 
   return 0;

@@ -3035,7 +3048,7 @@ map_char_table (Lisp_Char_Table *ct,
       }
 
     default:
       }
 
     default:

-      abort ();
+      ABORT ();

     }
 
   return 0;
     }
 
   return 0;

@@ -3081,7 +3094,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);

@@ -3378,20 +3391,21 @@ Return DEFAULT-VALUE if the value is not exist.
   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))
            {

@@ -3401,7 +3415,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))
            {

@@ -3417,10 +3431,40 @@ put_char_composition (Lisp_Object character, Lisp_Object value)
              else
                Fsetcdr (ret, character);
            }
              else
                Fsetcdr (ret, character);
            }

+         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))

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

+#endif

     }
     }

+  return Qmap_decomposition;

 }
 
 static Lisp_Object
 }
 
 static Lisp_Object

@@ -3478,8 +3524,14 @@ 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, 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, Qmap_decomposition) &&
+          SYMBOLP (XCAR (value)) )
+       value = XCDR (value);
+    }

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

@@ -3499,21 +3551,29 @@ 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"
-                                 "\\|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_superscript_of)                ||
+       EQ (attribute, Q_subscript_of)          ||
+       EQ (attribute, Q_circled_of)            ||
+       EQ (attribute, Q_component)             ||
+       EQ (attribute, Q_component_of)          ||
+       !NILP (Fstring_match
+             (build_string ("^\\(<-\\|->\\)\\("
+                            "canonical"
+                            "\\|superscript\\|subscript"
+                            "\\|circled\\|font\\|compat"
+                            "\\|fullwidth\\|halfwidth"
+                            "\\|simplified\\|vulgar\\|wrong"
+                            "\\|same\\|original\\|ancient"
+                            "\\|Oracle-Bones\\)[^*]*$"),
+              Fsymbol_name (attribute),
+              Qnil, Qnil)) )

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

@@ -3570,7 +3630,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;

@@ -3589,7 +3659,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);

@@ -3646,6 +3720,10 @@ open_chise_data_source_maybe ()
                         0 /* DB_HASH */, modemask);
       if (default_chise_data_source == NULL)
        return -1;
                         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;
 }
     }
   return 0;
 }

@@ -3721,8 +3799,13 @@ char_table_get_db (Lisp_Char_Table* cit, Emchar ch)
 
   if (!status)
     {
 
   if (!status)
     {

+#if 0

       val = Fread (make_string (chise_value_data (&value),
                                chise_value_size (&value) ));
       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;
     }
   else
     val = Qunbound;

@@ -3830,16 +3913,20 @@ Save values of ATTRIBUTE into database file.
 
       if ( !NILP (Ffind_charset (attribute)) )
        filter = NULL;
 
       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_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;

@@ -4345,7 +4432,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);

@@ -4614,6 +4701,14 @@ syms_of_chartab (void)
   defsymbol (&Q_component,             "->ideographic-component-forms");
   defsymbol (&Q_component_of,          "<-ideographic-component-forms");
   defsymbol (&Qcomposition,            "composition");
   defsymbol (&Q_component,             "->ideographic-component-forms");
   defsymbol (&Q_component_of,          "<-ideographic-component-forms");
   defsymbol (&Qcomposition,            "composition");

+  defsymbol (&Qmap_decomposition,      "=decomposition");
+  defsymbol (&Qto_decomposition_at_superscript,
+            "=>decomposition@superscript");
+  defsymbol (&Qto_decomposition_at_circled, "=>decomposition@circled");
+  defsymbol (&Q_canonical,             "->canonical");
+  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");