X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=src%2Fchartab.c;h=94dcb8800bb16859c50ff65c207a3797c1aa514f;hb=c9f14ce28e39392a58533664da6264f0b9f06c56;hp=d955a1a128eb390b0862f107b6a88615db88b826;hpb=77c54524956a8f35710ffa721c0f30831d105dcc;p=chise%2Fxemacs-chise.git.1 diff --git a/src/chartab.c b/src/chartab.c index d955a1a..94dcb88 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); @@ -1131,6 +1130,10 @@ make_char_id_table (Lisp_Object initval) Lisp_Object Qcomposition; +Lisp_Object Qmap_decomposition; +Lisp_Object Qto_decomposition_at_compat; +Lisp_Object Q_canonical; +Lisp_Object Q_compat_of; Lisp_Object Q_decomposition; Lisp_Object Q_identical; Lisp_Object Q_identical_from; @@ -1236,15 +1239,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 +1396,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 +1854,7 @@ Reset CHAR-TABLE to its default state. break; default: - abort (); + ABORT (); } return Qnil; @@ -2033,7 +2037,7 @@ XCHARSET_CELL_RANGE (Lisp_Object ccs) return (0 << 8) | 255; #endif default: - abort (); + ABORT (); return 0; } } @@ -2095,7 +2099,7 @@ decode_char_table_range (Lisp_Object range, struct chartab_range *outrange) } #endif else - abort (); + ABORT (); } else { @@ -2328,8 +2332,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 +2388,7 @@ check_valid_char_table_value (Lisp_Object value, enum char_table_type type, break; default: - abort (); + ABORT (); } return 0; /* not reached */ @@ -2825,7 +2834,7 @@ map_char_table_for_charset_fun (struct chartab_range *range, break; default: - abort (); + ABORT (); } return 0; @@ -3036,7 +3045,7 @@ map_char_table (Lisp_Char_Table *ct, } default: - abort (); + ABORT (); } return 0; @@ -3082,7 +3091,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); @@ -3379,20 +3388,21 @@ Return DEFAULT-VALUE if the value is not exist. 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)) - signal_simple_error ("Invalid value for ->decomposition", + signal_simple_error ("Invalid value for =decomposition", 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)) { @@ -3402,7 +3412,7 @@ put_char_composition (Lisp_Object character, Lisp_Object value) if (INTP (modifier)) { modifier = make_char (XINT (modifier)); - Fsetcar (Fcdr (value), modifier); + Fsetcar (XCDR (value), modifier); } if (CHARP (base)) { @@ -3418,15 +3428,27 @@ put_char_composition (Lisp_Object character, Lisp_Object value) else Fsetcdr (ret, character); } + else if (EQ (base, Qcompat)) + return Q_compat_of; } + else if (EQ (XCAR (value), Qcompat)) + return Qto_decomposition_at_compat; + else + return + Fintern + (concat2 (build_string ("=>decomposition@"), + symbol_name (XSYMBOL (XCAR (value)))), + Qnil); } else { + return Q_canonical; +#if 0 Lisp_Object v = Fcar (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); @@ -3442,7 +3464,9 @@ put_char_composition (Lisp_Object character, Lisp_Object value) Fcons (character, ret)); } } +#endif } + return Qmap_decomposition; } static Lisp_Object @@ -3479,8 +3503,18 @@ 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)) - put_char_composition (character, value); + else if ( EQ (attribute, Qmap_decomposition) || + EQ (attribute, Q_decomposition) ) + { + attribute = put_char_composition (character, value); + if ( /* + EQ (attribute, Q_compat_of) || + EQ (attribute, Qto_decomposition_at_compat) + */ + /* SYMBOLP (XCAR (value)) */ + !EQ (attribute, Qmap_decomposition) ) + value = XCDR (value); + } else if (EQ (attribute, Qto_ucs)) { Lisp_Object ret; @@ -3489,7 +3523,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); @@ -3500,21 +3534,26 @@ Store CHARACTER's ATTRIBUTE with VALUE. 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_compat_of) || + EQ (attribute, Q_component) || + EQ (attribute, Q_component_of) || + !NILP (Fstring_match + (build_string ("^\\(<-\\|->\\)\\(" + "canonical" + "\\|compat" + "\\|fullwidth\\|halfwidth" + "\\|simplified\\|vulgar\\|wrong" + "\\|same\\|original\\|ancient" + "\\|Oracle-Bones\\)[^*]*$"), + Fsymbol_name (attribute), + Qnil, Qnil)) ) { Lisp_Object rest = value; Lisp_Object ret; @@ -3571,7 +3610,17 @@ Store CHARACTER's ATTRIBUTE with VALUE. 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; @@ -3590,7 +3639,11 @@ Store CHARACTER's ATTRIBUTE with VALUE. 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); @@ -3647,6 +3700,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; } @@ -3722,8 +3779,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; @@ -3831,16 +3893,18 @@ Save values of ATTRIBUTE into database file. 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_compat_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; @@ -4346,7 +4410,7 @@ chartab_instantiate (Lisp_Object data) Fput_char_table (make_char (i), val, chartab); } else - abort (); + ABORT (); } else Fput_char_table (range, val, chartab); @@ -4615,6 +4679,10 @@ syms_of_chartab (void) defsymbol (&Q_component, "->ideographic-component-forms"); defsymbol (&Q_component_of, "<-ideographic-component-forms"); defsymbol (&Qcomposition, "composition"); + defsymbol (&Qmap_decomposition, "=decomposition"); + defsymbol (&Qto_decomposition_at_compat, "=>decomposition@compat"); + defsymbol (&Q_canonical, "->canonical"); + defsymbol (&Q_compat_of, "<-compat"); defsymbol (&Q_decomposition, "->decomposition"); defsymbol (&Qcompat, "compat"); defsymbol (&Qisolated, "isolated");