}
-#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;
+Lisp_Object Q_identical_from;
Lisp_Object Q_denotational;
Lisp_Object Q_denotational_from;
-Lisp_Object Q_unified;
-Lisp_Object Q_unified_from;
+Lisp_Object Q_subsumptive;
+Lisp_Object Q_subsumptive_from;
+Lisp_Object Q_component;
+Lisp_Object Q_component_of;
Lisp_Object Qto_ucs;
Lisp_Object Q_ucs_unified;
Lisp_Object Qcompat;
return default_value;
}
+static Lisp_Object
+find_char_feature_in_family (Lisp_Object character,
+ Lisp_Object con_feature,
+ Lisp_Object feature,
+ Lisp_Object feature_rel_max)
+{
+ Lisp_Object ancestors
+ = Fget_char_attribute (character, con_feature, Qnil);
+
+ while (!NILP (ancestors))
+ {
+ Lisp_Object ancestor = XCAR (ancestors);
+ Lisp_Object ret;
+
+ if (EQ (ancestor, character))
+ return Qunbound;
+
+ ret = Fchar_feature (ancestor, feature, Qunbound,
+ Qnil, make_int (0));
+ if (!UNBOUNDP (ret))
+ return ret;
+
+ ancestors = XCDR (ancestors);
+
+ ret = Fget_char_attribute (ancestor, Q_subsumptive_from, Qnil);
+ if (!NILP (ret))
+ ancestors = nconc2 (Fcopy_sequence (ancestors), ret);
+
+ ret = Fget_char_attribute (ancestor, Q_denotational_from, Qnil);
+ if (!NILP (ret))
+ ancestors = nconc2 (Fcopy_sequence (ancestors), ret);
+ }
+ return Qunbound;
+}
+
DEFUN ("char-feature", Fchar_feature, 2, 5, 0, /*
Return the value of CHARACTER's FEATURE.
Return DEFAULT-VALUE if the value is not exist.
}
}
- if ( !(EQ (attribute, Q_unified_from)) &&
+ if ( !(EQ (attribute, Q_identical)) &&
+ !(EQ (attribute, Q_subsumptive_from)) &&
!(EQ (attribute, Q_denotational_from)) &&
( (NILP (char_rel_max)
|| (INTP (char_rel_max) &&
if ( (name_str[0] != '=') || (name_str[1] == '>') )
{
- Lisp_Object ancestors
- = Fget_char_attribute (character, Q_unified_from, Qnil);
-
- if (NILP (ancestors))
- ancestors
- = Fget_char_attribute (character, Q_denotational_from, Qnil);
+ ret = find_char_feature_in_family (character, Q_identical,
+ attribute, feature_rel_max);
+ if (!UNBOUNDP (ret))
+ return ret;
- while (!NILP (ancestors))
- {
- Lisp_Object ancestor = XCAR (ancestors);
+ ret = find_char_feature_in_family (character, Q_subsumptive_from,
+ attribute, feature_rel_max);
+ if (!UNBOUNDP (ret))
+ return ret;
- if (!EQ (ancestor, character))
- {
- ret = Fchar_feature (ancestor, attribute, Qunbound,
- Qnil, make_int (0));
- if (!UNBOUNDP (ret))
- return ret;
-
- ancestors = XCDR (ancestors);
- ret = Fget_char_attribute (ancestor, Q_unified_from, Qnil);
- if (!NILP (ret))
- ancestors = nconc2 (Fcopy_sequence (ancestors), ret);
- }
- else
- return default_value;
- /* ancestors = XCDR (ancestors); */
- }
+ ret = find_char_feature_in_family (character, Q_denotational_from,
+ attribute, feature_rel_max);
+ if (!UNBOUNDP (ret))
+ return ret;
}
}
return default_value;
Fput_char_attribute (make_char (c), Q_ucs_unified,
Fcons (character, ret));
}
- else if ( EQ (attribute, Q_unified) ||
- EQ (attribute, Q_unified_from) ||
+ else if ( EQ (attribute, Q_subsumptive) ||
+ EQ (attribute, Q_subsumptive_from) ||
EQ (attribute, Q_denotational) ||
- EQ (attribute, Q_denotational_from) )
+ 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)) )
{
Lisp_Object rest = value;
Lisp_Object ret;
+ Lisp_Object rev_feature = Qnil;
+ struct gcpro gcpro1;
+ GCPRO1 (rev_feature);
+
+ if (EQ (attribute, Q_identical))
+ rev_feature = Q_identical_from;
+ else if (EQ (attribute, Q_identical_from))
+ rev_feature = Q_identical;
+ else if (EQ (attribute, Q_subsumptive))
+ rev_feature = Q_subsumptive_from;
+ else if (EQ (attribute, Q_subsumptive_from))
+ rev_feature = Q_subsumptive;
+ else if (EQ (attribute, Q_denotational))
+ rev_feature = Q_denotational_from;
+ else if (EQ (attribute, Q_denotational_from))
+ rev_feature = Q_denotational;
+ else if (EQ (attribute, Q_component))
+ rev_feature = Q_component_of;
+ else if (EQ (attribute, Q_component_of))
+ rev_feature = Q_component;
+ else
+ {
+ Lisp_String* name = symbol_name (XSYMBOL (attribute));
+ Bufbyte *name_str = string_data (name);
+
+ 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);
+ 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);
+ }
+ }
while (CONSP (rest))
{
if ( !NILP (ret) && !EQ (ret, character) )
{
- Lisp_Object rev_feature;
Lisp_Object ffv;
- if (EQ (attribute, Q_unified))
- rev_feature = Q_unified_from;
- else if (EQ (attribute, Q_unified_from))
- rev_feature = Q_unified;
- else if (EQ (attribute, Q_denotational))
- rev_feature = Q_denotational_from;
- else /* if (EQ (attribute, Q_denotational_from)) */
- rev_feature = Q_denotational;
-
ffv = Fget_char_attribute (ret, rev_feature, Qnil);
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);
}
+ UNGCPRO;
}
-#if 0
+#if 1
else if (EQ (attribute, Qideographic_structure))
value = Fcopy_sequence (Fchar_refs_simplify_char_specs (value));
#endif
}
#endif /* not HAVE_LIBCHISE */
+#ifdef HAVE_LIBCHISE
+Lisp_Object save_charset_properties (Lisp_Object charset);
+#endif /* HAVE_LIBCHISE */
+
DEFUN ("save-char-attribute-table", Fsave_char_attribute_table, 1, 1, 0, /*
Save values of ATTRIBUTE into database file.
*/
{
Lisp_Object (*filter)(Lisp_Object value);
- if (EQ (attribute, Qideographic_structure))
+ if ( !NILP (Ffind_charset (attribute)) )
+ {
+#ifdef HAVE_LIBCHISE
+ save_charset_properties (attribute);
+#endif /* HAVE_LIBCHISE */
+ 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)) )
filter = &Fchar_refs_simplify_char_specs;
else
filter = NULL;
*/
(attributes))
{
- Lisp_Object rest = attributes;
+ Lisp_Object rest;
Lisp_Object code = Fcdr (Fassq (Qmap_ucs, attributes));
Lisp_Object character;
if (NILP (code))
code = Fcdr (Fassq (Qucs, attributes));
+
if (NILP (code))
{
+ rest = attributes;
while (CONSP (rest))
{
Lisp_Object cell = Fcar (rest);
Lisp_Object ccs;
- if (!LISTP (cell))
+ if ( !LISTP (cell) )
signal_simple_error ("Invalid argument", attributes);
- if (!NILP (ccs = Ffind_charset (Fcar (cell)))
- && ((XCHARSET_FINAL (ccs) != 0) ||
- (XCHARSET_MAX_CODE (ccs) > 0) ||
- (EQ (ccs, Vcharset_chinese_big5))) )
+
+ ccs = Ffind_charset (Fcar (cell));
+ if (!NILP (ccs))
{
cell = Fcdr (cell);
- if (CONSP (cell))
- character = Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
- else
- character = Fdecode_char (ccs, cell, Qnil, Qt);
- if (!NILP (character))
- goto setup_attributes;
+ if (INTP (cell))
+ {
+ character = Fdecode_char (ccs, cell, Qt, Qt);
+ if (!NILP (character))
+ goto setup_attributes;
+ }
+ if ( (XCHARSET_FINAL (ccs) != 0) ||
+ (XCHARSET_MAX_CODE (ccs) > 0) ||
+ (EQ (ccs, Vcharset_chinese_big5)) )
+ {
+ if (CONSP (cell))
+ character
+ = Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell)));
+ else
+ character = Fdecode_char (ccs, cell, Qnil, Qt);
+ if (!NILP (character))
+ goto setup_attributes;
+ }
}
rest = Fcdr (rest);
}
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_unified, "->unified");
- defsymbol (&Q_unified_from, "<-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_decomposition, "->decomposition");
defsymbol (&Qcompat, "compat");
projects / chise / xemacs-chise.git.1 / blobdiff