X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=src%2Fchartab.c;h=d22b611554a13421198b7641db746ddd62091f60;hb=da6d8669637d3c52deb282a55a5d0fb58d5e4e14;hp=bf1c5263d39057eb9aa8621c97b39de337622477;hpb=ba1479d56e7ed200182e975aab8c2219393da1fa;p=chise%2Fxemacs-chise.git.1 diff --git a/src/chartab.c b/src/chartab.c index bf1c526..d22b611 100644 --- a/src/chartab.c +++ b/src/chartab.c @@ -1130,14 +1130,16 @@ 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_unified; -Lisp_Object Q_unified_from; +Lisp_Object Q_identical; +Lisp_Object Q_identical_from; +Lisp_Object Q_denotational; +Lisp_Object Q_denotational_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; @@ -1223,7 +1225,8 @@ Return character corresponding with list. modifier = Fcar (rest); rest = Fcdr (rest); base = Fcdr (Fassq (modifier, - Fget_char_attribute (base, Qcomposition, Qnil))); + Fchar_feature (base, Qcomposition, Qnil, + Qnil, Qnil))); } return base; } @@ -1236,7 +1239,8 @@ Return variants of CHARACTER. Lisp_Object ret; CHECK_CHAR (character); - ret = Fget_char_attribute (character, Q_ucs_unified, Qnil); + ret = Fchar_feature (character, Q_ucs_unified, Qnil, + Qnil, Qnil); if (CONSP (ret)) return Fcopy_list (ret); else @@ -2154,9 +2158,11 @@ get_char_table (Emchar ch, Lisp_Char_Table *ct) if (NILP (ret)) { if (EQ (CHAR_TABLE_NAME (ct), Qdowncase)) - ret = Fget_char_attribute (make_char (ch), Q_lowercase, Qnil); + ret = Fchar_feature (make_char (ch), Q_lowercase, Qnil, + Qnil, Qnil); else if (EQ (CHAR_TABLE_NAME (ct), Qflippedcase)) - ret = Fget_char_attribute (make_char (ch), Q_uppercase, Qnil); + ret = Fchar_feature (make_char (ch), Q_uppercase, Qnil, + Qnil, Qnil); if (CONSP (ret)) { ret = XCAR (ret); @@ -2449,7 +2455,6 @@ put_char_table (Lisp_Char_Table *ct, struct chartab_range *range, switch (range->type) { case CHARTAB_RANGE_ALL: - /* printf ("put-char-table: range = all\n"); */ fill_char_table (ct, val); return; /* avoid the duplicate call to update_syntax_table() below, since fill_char_table() also did that. */ @@ -2466,9 +2471,6 @@ put_char_table (Lisp_Char_Table *ct, struct chartab_range *range, { Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (range->charset); - /* printf ("put-char-table: range = charset: %d\n", - XCHARSET_LEADING_BYTE (range->charset)); - */ if ( CHAR_TABLEP (encoding_table) ) { Lisp_Object mother = XCHARSET_MOTHER (range->charset); @@ -2554,7 +2556,6 @@ put_char_table (Lisp_Char_Table *ct, struct chartab_range *range, case CHARTAB_RANGE_CHAR: #ifdef UTF2000 - /* printf ("put-char-table: range = char: 0x%x\n", range->ch); */ put_char_id_table_0 (ct, range->ch, val); break; #elif defined(MULE) @@ -3274,6 +3275,110 @@ Return DEFAULT-VALUE if the value is not exist. 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. +*/ + (character, attribute, default_value, + feature_rel_max, char_rel_max)) +{ + Lisp_Object ret + = Fget_char_attribute (character, attribute, Qunbound); + + if (!UNBOUNDP (ret)) + return ret; + + if (NILP (feature_rel_max) + || (INTP (feature_rel_max) && + XINT (feature_rel_max) > 0)) + { + Lisp_String* name = symbol_name (XSYMBOL (attribute)); + Bufbyte *name_str = string_data (name); + + if (name_str[0] == '=' && name_str[1] == '>') + { + Bytecount length = string_length (name) - 1; + Lisp_Object map_to = make_uninit_string (length); + + memcpy (XSTRING_DATA (map_to) + 1, name_str + 2, length - 1); + XSTRING_DATA(map_to)[0] = '='; + ret = Fchar_feature (character, Fintern (map_to, Qnil), + Qunbound, + NILP (feature_rel_max) + ? feature_rel_max + : make_int (XINT (feature_rel_max) - 1), + char_rel_max); + if (!UNBOUNDP (ret)) + return ret; + } + } + + if ( !(EQ (attribute, Q_identical)) && + !(EQ (attribute, Q_subsumptive_from)) && + !(EQ (attribute, Q_denotational_from)) && + ( (NILP (char_rel_max) + || (INTP (char_rel_max) && + XINT (char_rel_max) > 0)) ) ) + { + Lisp_String* name = symbol_name (XSYMBOL (attribute)); + Bufbyte *name_str = string_data (name); + + if ( (name_str[0] != '=') || (name_str[1] == '>') ) + { + ret = find_char_feature_in_family (character, Q_identical, + attribute, feature_rel_max); + if (!UNBOUNDP (ret)) + return ret; + + ret = find_char_feature_in_family (character, Q_subsumptive_from, + attribute, feature_rel_max); + if (!UNBOUNDP (ret)) + return ret; + + ret = find_char_feature_in_family (character, Q_denotational_from, + attribute, feature_rel_max); + if (!UNBOUNDP (ret)) + return ret; + } + } + return default_value; +} + void put_char_composition (Lisp_Object character, Lisp_Object value); void put_char_composition (Lisp_Object character, Lisp_Object value) @@ -3302,7 +3407,8 @@ put_char_composition (Lisp_Object character, Lisp_Object value) if (CHARP (base)) { Lisp_Object alist - = Fget_char_attribute (base, Qcomposition, Qnil); + = Fchar_feature (base, Qcomposition, Qnil, + Qnil, Qnil); Lisp_Object ret = Fassq (modifier, alist); if (NILP (ret)) @@ -3322,7 +3428,8 @@ put_char_composition (Lisp_Object character, Lisp_Object value) { Emchar c = XINT (v); Lisp_Object ret - = Fget_char_attribute (make_char (c), Q_ucs_unified, Qnil); + = Fchar_feature (make_char (c), Q_ucs_unified, Qnil, + Qnil, Qnil); if (!CONSP (ret)) { @@ -3338,6 +3445,26 @@ put_char_composition (Lisp_Object character, Lisp_Object value) } } +static Lisp_Object +put_char_attribute (Lisp_Object character, Lisp_Object attribute, + Lisp_Object value) +{ + Lisp_Object table = Fgethash (attribute, + Vchar_attribute_hash_table, + Qnil); + + if (NILP (table)) + { + table = make_char_id_table (Qunbound); + Fputhash (attribute, table, Vchar_attribute_hash_table); +#ifdef HAVE_CHISE + XCHAR_TABLE_NAME (table) = attribute; +#endif + } + put_char_id_table (XCHAR_TABLE(table), character, value); + return value; +} + DEFUN ("put-char-attribute", Fput_char_attribute, 3, 3, 0, /* Store CHARACTER's ATTRIBUTE with VALUE. */ @@ -3364,22 +3491,79 @@ Store CHARACTER's ATTRIBUTE with VALUE. c = XINT (value); - ret = Fget_char_attribute (make_char (c), Q_ucs_unified, Qnil); + ret = Fchar_feature (make_char (c), Q_ucs_unified, Qnil, + Qnil, Qnil); if (!CONSP (ret)) - { - Fput_char_attribute (make_char (c), Q_ucs_unified, - Fcons (character, Qnil)); - } + put_char_attribute (make_char (c), Q_ucs_unified, + list1 (character)); else if (NILP (Fmemq (character, ret))) - { - 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_unified)) + 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)) ) { 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)) { @@ -3388,34 +3572,28 @@ Store CHARACTER's ATTRIBUTE with VALUE. if (CONSP (ret)) ret = Fdefine_char (ret); - if (!NILP (ret)) + if ( !NILP (ret) && !EQ (ret, character) ) { - Fput_char_attribute (ret, Q_unified_from, list1 (character)); + Lisp_Object ffv; + + 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, + 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 - { - Lisp_Object table = Fgethash (attribute, - Vchar_attribute_hash_table, - Qnil); - - if (NILP (table)) - { - table = make_char_id_table (Qunbound); - Fputhash (attribute, table, Vchar_attribute_hash_table); -#ifdef HAVE_CHISE - XCHAR_TABLE_NAME (table) = attribute; -#endif - } - put_char_id_table (XCHAR_TABLE(table), character, value); - return value; - } + return put_char_attribute (character, attribute, value); } DEFUN ("remove-char-attribute", Fremove_char_attribute, 2, 2, 0, /* @@ -3611,6 +3789,10 @@ char_attribute_system_db_file (Lisp_Object key_type, Lisp_Object attribute, } #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. */ @@ -3651,7 +3833,23 @@ 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; @@ -3948,33 +4146,46 @@ Store character's ATTRIBUTES. */ (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); } @@ -4402,14 +4613,16 @@ 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_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"); @@ -4446,6 +4659,7 @@ syms_of_chartab (void) #endif DEFSUBR (Fload_char_attribute_table); #endif + DEFSUBR (Fchar_feature); DEFSUBR (Fchar_attribute_alist); DEFSUBR (Fget_char_attribute); DEFSUBR (Fput_char_attribute);