Sync up with XEmacs 21.4.17.
[chise/xemacs-chise.git.1] / src / chartab.c
index 1ce7474..6eb6b32 100644 (file)
@@ -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);
 
@@ -1130,10 +1129,6 @@ 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 Q_decomposition;
 Lisp_Object Q_identical;
@@ -1144,8 +1139,6 @@ Lisp_Object Q_subsumptive;
 Lisp_Object Q_subsumptive_from;
 Lisp_Object Q_component;
 Lisp_Object Q_component_of;
-Lisp_Object Q_same;
-Lisp_Object Q_same_of;
 Lisp_Object Qto_ucs;
 Lisp_Object Q_ucs_unified;
 Lisp_Object Qcompat;
@@ -1242,15 +1235,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
@@ -1398,7 +1392,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;
@@ -1856,7 +1850,7 @@ Reset CHAR-TABLE to its default state.
       break;
 
     default:
-      abort ();
+      ABORT ();
     }
 
   return Qnil;
@@ -2039,7 +2033,7 @@ XCHARSET_CELL_RANGE (Lisp_Object ccs)
       return (0 << 8) | 255;
 #endif
     default:
-      abort ();
+      ABORT ();
       return 0;
     }
 }
@@ -2101,7 +2095,7 @@ decode_char_table_range (Lisp_Object range, struct chartab_range *outrange)
        }
 #endif
       else
-       abort ();
+       ABORT ();
     }
   else
     {
@@ -2335,7 +2329,7 @@ If there is more than one value, return MULTI (defaults to nil).
 #endif /* not MULE */
 
     default:
-      abort ();
+      ABORT ();
     }
 
   return Qnil; /* not reached */
@@ -2385,7 +2379,7 @@ check_valid_char_table_value (Lisp_Object value, enum char_table_type type,
       break;
 
     default:
-      abort ();
+      ABORT ();
     }
 
   return 0; /* not reached */
@@ -2831,7 +2825,7 @@ map_char_table_for_charset_fun (struct chartab_range *range,
       break;
 
     default:
-      abort ();
+      ABORT ();
     }
 
   return 0;
@@ -3042,7 +3036,7 @@ map_char_table (Lisp_Char_Table *ct,
       }
 
     default:
-      abort ();
+      ABORT ();
     }
 
   return 0;
@@ -3088,7 +3082,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);
@@ -3432,7 +3426,7 @@ put_char_composition (Lisp_Object character, Lisp_Object 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);
@@ -3495,7 +3489,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);
@@ -3514,11 +3508,14 @@ Store CHARACTER's ATTRIBUTE with VALUE.
            EQ (attribute, Q_identical_from) ||
            EQ (attribute, Q_component) ||
            EQ (attribute, Q_component_of) ||
-           EQ (attribute, Q_same) ||
-           EQ (attribute, Q_same_of) ||
-           !NILP (Fstring_match (build_string ("^<-simplified[^*]*$"),
-                                 Fsymbol_name (attribute),
-                                 Qnil, Qnil)) )
+           !NILP (Fstring_match
+                  (build_string ("^\\(<-\\|->\\)\\("
+                                 "fullwidth\\|halfwidth"
+                                 "\\|simplified\\|vulgar\\|wrong"
+                                 "\\|same\\|original\\|ancient"
+                                 "\\|Oracle-Bones\\)[^*]*$"),
+                   Fsymbol_name (attribute),
+                   Qnil, Qnil)) )
     {
       Lisp_Object rest = value;
       Lisp_Object ret;
@@ -3542,23 +3539,28 @@ Store CHARACTER's ATTRIBUTE with VALUE.
        rev_feature = Q_component_of;
       else if (EQ (attribute, Q_component_of))
        rev_feature = Q_component;
-      else if (EQ (attribute, Q_same))
-       rev_feature = Q_same_of;
-      else if (EQ (attribute, Q_same_of))
-       rev_feature = Q_same;
       else
        {
          Lisp_String* name = symbol_name (XSYMBOL (attribute));
          Bufbyte *name_str = string_data (name);
 
-         if (name_str[0] == '<' && name_str[1] == '-')
+         if ( (name_str[0] == '<' && name_str[1] == '-') || 
+              (name_str[0] == '-' && name_str[1] == '>') )
            {
              Bytecount length = string_length (name);
              Bufbyte *rev_name_str = alloca (length + 1);
 
              memcpy (rev_name_str + 2, name_str + 2, length - 2);
-             rev_name_str[0] = '-';
-             rev_name_str[1] = '>';
+             if (name_str[0] == '<')
+               {
+                 rev_name_str[0] = '-';
+                 rev_name_str[1] = '>';
+               }
+             else
+               {
+                 rev_name_str[0] = '<';
+                 rev_name_str[1] = '-';
+               }
              rev_name_str[length] = 0;
              rev_feature = intern (rev_name_str);
            }
@@ -3579,8 +3581,9 @@ Store CHARACTER's ATTRIBUTE with VALUE.
              if (!CONSP (ffv))
                put_char_attribute (ret, rev_feature, list1 (character));
              else if (NILP (Fmemq (character, ffv)))
-               put_char_attribute (ret, rev_feature,
-                                   Fcons (character, ffv));
+               put_char_attribute
+                 (ret, rev_feature,
+                  nconc2 (Fcopy_sequence (ffv), list1 (character)));
              Fsetcar (rest, ret);
            }
          rest = XCDR (rest);
@@ -3633,11 +3636,11 @@ open_chise_data_source_maybe ()
 {
   if (default_chise_data_source == NULL)
     {
-      Lisp_Object db_dir = Vexec_directory;
+      Lisp_Object db_dir = Vdata_directory;
       int modemask = 0755;             /* rwxr-xr-x */
 
       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);
 
       default_chise_data_source
@@ -3645,6 +3648,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;
 }
@@ -3720,8 +3727,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;
@@ -3741,10 +3753,10 @@ 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))
-    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)))
@@ -3827,13 +3839,16 @@ Save values of ATTRIBUTE into database file.
     {
       Lisp_Object (*filter)(Lisp_Object value);
 
-      if ( EQ (attribute, Qideographic_structure)
+      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_same)
-          || EQ (attribute, Q_same_of)
           || !NILP (Fstring_match
-                    (build_string ("^\\(<-\\|->\\)simplified[^*]*$"),
+                    (build_string ("^\\(<-\\|->\\)\\(simplified"
+                                   "\\|same\\|vulgar\\|wrong"
+                                   "\\|original\\|ancient"
+                                   "\\|Oracle-Bones\\)[^*]*$"),
                      Fsymbol_name (attribute),
                      Qnil, Qnil)) )
        filter = &Fchar_refs_simplify_char_specs;
@@ -4341,7 +4356,7 @@ chartab_instantiate (Lisp_Object data)
                 Fput_char_table (make_char (i), val, chartab);
            }
          else
-           abort ();
+           ABORT ();
        }
       else
        Fput_char_table (range, val, chartab);
@@ -4599,10 +4614,6 @@ syms_of_chartab (void)
   INIT_LRECORD_IMPLEMENTATION (uint16_byte_table);
   INIT_LRECORD_IMPLEMENTATION (byte_table);
 
-#if defined(HAVE_CHISE) && !defined(HAVE_LIBCHISE_LIBCHISE)
-  defsymbol (&Qsystem_char_id,         "system-char-id");
-#endif
-
   defsymbol (&Qto_ucs,                 "=>ucs");
   defsymbol (&Q_ucs_unified,           "->ucs-unified");
   defsymbol (&Q_subsumptive,           "->subsumptive");
@@ -4613,8 +4624,6 @@ syms_of_chartab (void)
   defsymbol (&Q_identical_from,                "<-identical");
   defsymbol (&Q_component,             "->ideographic-component-forms");
   defsymbol (&Q_component_of,          "<-ideographic-component-forms");
-  defsymbol (&Q_same,                  "->same");
-  defsymbol (&Q_same_of,               "<-same");
   defsymbol (&Qcomposition,            "composition");
   defsymbol (&Q_decomposition,         "->decomposition");
   defsymbol (&Qcompat,                 "compat");