X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=src%2Fchartab.c;h=532c71fac7fdabf01c18f90af4022326244612ab;hb=0da7db054d104050786fcd835b096d2007f08724;hp=8b0afd85e52ab68f54ba9494e30508dfa3aac716;hpb=37613857c376f274d47037ee2215890c26cba5b6;p=chise%2Fxemacs-chise.git diff --git a/src/chartab.c b/src/chartab.c index 8b0afd8..532c71f 100644 --- 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); @@ -1130,16 +1129,17 @@ 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 Qmap_decomposition; 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_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; @@ -1236,15 +1236,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 +1393,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 +1851,7 @@ Reset CHAR-TABLE to its default state. break; default: - abort (); + ABORT (); } return Qnil; @@ -2033,7 +2034,7 @@ XCHARSET_CELL_RANGE (Lisp_Object ccs) return (0 << 8) | 255; #endif default: - abort (); + ABORT (); return 0; } } @@ -2095,7 +2096,7 @@ decode_char_table_range (Lisp_Object range, struct chartab_range *outrange) } #endif else - abort (); + ABORT (); } else { @@ -2328,8 +2329,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 +2385,7 @@ check_valid_char_table_value (Lisp_Object value, enum char_table_type type, break; default: - abort (); + ABORT (); } return 0; /* not reached */ @@ -2825,7 +2831,7 @@ map_char_table_for_charset_fun (struct chartab_range *range, break; default: - abort (); + ABORT (); } return 0; @@ -3036,7 +3042,7 @@ map_char_table (Lisp_Char_Table *ct, } default: - abort (); + ABORT (); } return 0; @@ -3082,7 +3088,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); @@ -3275,6 +3281,41 @@ 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. @@ -3313,7 +3354,8 @@ Return DEFAULT-VALUE if the value is not exist. } } - if ( !(EQ (attribute, Q_subsumptive_from)) && + if ( !(EQ (attribute, Q_identical)) && + !(EQ (attribute, Q_subsumptive_from)) && !(EQ (attribute, Q_denotational_from)) && ( (NILP (char_rel_max) || (INTP (char_rel_max) && @@ -3324,34 +3366,20 @@ Return DEFAULT-VALUE if the value is not exist. if ( (name_str[0] != '=') || (name_str[1] == '>') ) { - Lisp_Object ancestors - = Fget_char_attribute (character, Q_subsumptive_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_subsumptive_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; @@ -3404,7 +3432,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); @@ -3457,8 +3485,13 @@ 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)) + else if (EQ (attribute, Qmap_decomposition)) put_char_composition (character, value); + else if (EQ (attribute, Q_decomposition)) + { + attribute = Qmap_decomposition; + put_char_composition (character, value); + } else if (EQ (attribute, Qto_ucs)) { Lisp_Object ret; @@ -3467,7 +3500,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); @@ -3482,9 +3515,18 @@ Store CHARACTER's ATTRIBUTE with VALUE. EQ (attribute, Q_subsumptive_from) || EQ (attribute, Q_denotational) || EQ (attribute, Q_denotational_from) || - !NILP (Fstring_match (build_string ("^<-simplified[^*]*$"), - Fsymbol_name (attribute), - Qnil, Qnil)) ) + EQ (attribute, Q_identical) || + EQ (attribute, Q_identical_from) || + EQ (attribute, Q_component) || + EQ (attribute, Q_component_of) || + !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; @@ -3492,7 +3534,11 @@ Store CHARACTER's ATTRIBUTE with VALUE. struct gcpro gcpro1; GCPRO1 (rev_feature); - if (EQ (attribute, Q_subsumptive)) + 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; @@ -3500,19 +3546,32 @@ Store CHARACTER's ATTRIBUTE with VALUE. 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] == '-') + 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); } @@ -3533,15 +3592,16 @@ 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); } UNGCPRO; } -#if 0 +#if 1 else if (EQ (attribute, Qideographic_structure)) value = Fcopy_sequence (Fchar_refs_simplify_char_specs (value)); #endif @@ -3587,11 +3647,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 @@ -3599,6 +3659,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; } @@ -3674,8 +3738,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; @@ -3695,10 +3764,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))) @@ -3781,7 +3850,18 @@ 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) + || !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; @@ -4078,33 +4158,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); } @@ -4274,7 +4367,7 @@ chartab_instantiate (Lisp_Object data) Fput_char_table (make_char (i), val, chartab); } else - abort (); + ABORT (); } else Fput_char_table (range, val, chartab); @@ -4532,17 +4625,18 @@ 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"); 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 (&Qmap_decomposition, "=decomposition"); defsymbol (&Q_decomposition, "->decomposition"); defsymbol (&Qcompat, "compat"); defsymbol (&Qisolated, "isolated");