X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=src%2Fchartab.c;h=7c1408ae227f3718f1b14b411614f0334e946b83;hp=6eb6b32722ca1f1b4c73da66f54a99aeded6b5c4;hb=0a57cba46779af884cc537d18923dcb6313b9904;hpb=6e8f204c9e1f490b2752de46c111744d1deb3ee0 diff --git a/src/chartab.c b/src/chartab.c index 6eb6b32..7c1408ae 100644 --- a/src/chartab.c +++ b/src/chartab.c @@ -4,7 +4,8 @@ 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, 2006, 2008, + 2010, 2011, 2012, 2013, 2015, 2016 MORIOKA Tomohiko This file is part of XEmacs. @@ -99,7 +100,7 @@ Lisp_Object Vchar_db_stingy_mode; INLINE_HEADER int INT_UINT8_P (Lisp_Object obj); INLINE_HEADER int UINT8_VALUE_P (Lisp_Object obj); INLINE_HEADER unsigned char UINT8_ENCODE (Lisp_Object obj); -INLINE_HEADER Lisp_Object UINT8_DECODE (unsigned char n); +/* INLINE_HEADER */ Lisp_Object UINT8_DECODE (unsigned char n); INLINE_HEADER unsigned short UINT8_TO_UINT16 (unsigned char n); INLINE_HEADER int @@ -137,7 +138,7 @@ UINT8_ENCODE (Lisp_Object obj) return XINT (obj); } -INLINE_HEADER Lisp_Object +/* INLINE_HEADER */ Lisp_Object UINT8_DECODE (unsigned char n) { if (n == BT_UINT8_unloaded) @@ -354,7 +355,7 @@ save_uint8_byte_table (Lisp_Uint8_Byte_Table *ct, Lisp_Char_Table* root, { if (ct->property[i] == BT_UINT8_unloaded) { - c1 = c + unit; + c += unit; } else if (ct->property[i] != BT_UINT8_unbound) { @@ -391,7 +392,7 @@ save_uint8_byte_table (Lisp_Uint8_Byte_Table *ct, Lisp_Char_Table* root, INLINE_HEADER int INT_UINT16_P (Lisp_Object obj); INLINE_HEADER int UINT16_VALUE_P (Lisp_Object obj); INLINE_HEADER unsigned short UINT16_ENCODE (Lisp_Object obj); -INLINE_HEADER Lisp_Object UINT16_DECODE (unsigned short us); +/* INLINE_HEADER */ Lisp_Object UINT16_DECODE (unsigned short us); INLINE_HEADER int INT_UINT16_P (Lisp_Object obj) @@ -428,7 +429,7 @@ UINT16_ENCODE (Lisp_Object obj) return XINT (obj); } -INLINE_HEADER Lisp_Object +/* INLINE_HEADER */ Lisp_Object UINT16_DECODE (unsigned short n) { if (n == BT_UINT16_unloaded) @@ -678,7 +679,7 @@ save_uint16_byte_table (Lisp_Uint16_Byte_Table *ct, Lisp_Char_Table* root, { if (ct->property[i] == BT_UINT16_unloaded) { - c1 = c + unit; + c += unit; } else if (ct->property[i] != BT_UINT16_unbound) { @@ -1130,6 +1131,14 @@ make_char_id_table (Lisp_Object initval) Lisp_Object Qcomposition; +Lisp_Object Qrep_decomposition; +Lisp_Object Qto_decomposition_at_superscript; +Lisp_Object Qto_decomposition_at_circled; +Lisp_Object Q_canonical; +Lisp_Object Q_halfwidth_of; +Lisp_Object Q_superscript_of; +Lisp_Object Q_subscript_of; +Lisp_Object Q_circled_of; Lisp_Object Q_decomposition; Lisp_Object Q_identical; Lisp_Object Q_identical_from; @@ -1713,15 +1722,17 @@ once per character). When Mule support exists, the types of ranges that can be assigned values are --- all characters +-- all characters (represented by t) -- an entire charset --- a single row in a two-octet charset +-- a single row in a two-octet charset (represented by a vector of two + elements: a two-octet charset and a row number; the row must be an + integer, not a character) -- a single character When Mule support is not present, the types of ranges that can be assigned values are --- all characters +-- all characters (represented by t) -- a single character To create a char table, use `make-char-table'. @@ -2223,8 +2234,11 @@ Find value for CHARACTER in CHAR-TABLE. } DEFUN ("get-range-char-table", Fget_range_char_table, 2, 3, 0, /* -Find value for a range in CHAR-TABLE. +Find value for RANGE in CHAR-TABLE. If there is more than one value, return MULTI (defaults to nil). + +Valid values for RANGE are single characters, charsets, a row in a +two-octet charset, and all characters. See `put-char-table'. */ (range, char_table, multi)) { @@ -2328,6 +2342,11 @@ 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 (); } @@ -2614,8 +2633,9 @@ one of the following: -- t (all characters are affected) -- A charset (only allowed when Mule support is present) --- A vector of two elements: a two-octet charset and a row number - (only allowed when Mule support is present) +-- A vector of two elements: a two-octet charset and a row number; the row + must be an integer, not a character (only allowed when Mule support is + present) -- A single character VALUE must be a value appropriate for the type of CHAR-TABLE. @@ -3090,8 +3110,8 @@ slow_map_char_table_fun (struct chartab_range *range, } DEFUN ("map-char-table", Fmap_char_table, 2, 3, 0, /* -Map FUNCTION over entries in CHAR-TABLE, calling it with two args, -each key and value in the table. +Map FUNCTION over CHAR-TABLE until it returns non-nil; return that value. +FUNCTION is called with two arguments, each key and entry in the table. RANGE specifies a subrange to map over and is in the same format as the RANGE argument to `put-range-table'. If omitted or t, it defaults to @@ -3250,6 +3270,43 @@ Return the alist of attributes of CHARACTER. return alist; } +DEFUN ("char-feature-base-name=", Fchar_feature_base_name_eq, 2, 2, 0, /* +Return the alist of attributes of CHARACTER. +*/ + (base_name, feature_name)) +{ + Lisp_String *bn, *fn; + Bytecount len_bn, len_fn, i; + Bufbyte *ptr_bn, *ptr_fn; + + CHECK_SYMBOL (base_name); + CHECK_SYMBOL (feature_name); + + bn = XSYMBOL (base_name)->name; + fn = XSYMBOL (feature_name)->name; + len_bn = string_length (bn); + len_fn = string_length (fn); + + if ( len_bn > len_fn ) + return Qnil; + + ptr_bn = string_data (bn); + ptr_fn = string_data (fn); + for ( i = len_fn - 1; i >= 0; i-- ) + { + if ( ptr_fn[i] == '*' ) + return Qnil; + if ( ptr_fn[i] == '@' ) + break; + } + if ( i < 0 ) + i = len_fn; + if ( (len_bn == i) && (memcmp (ptr_bn, ptr_fn, len_bn) == 0) ) + return Qt; + else + return Qnil; +} + DEFUN ("get-char-attribute", Fget_char_attribute, 2, 3, 0, /* Return the value of CHARACTER's ATTRIBUTE. Return DEFAULT-VALUE if the value is not exist. @@ -3283,6 +3340,7 @@ find_char_feature_in_family (Lisp_Object character, { Lisp_Object ancestors = Fget_char_attribute (character, con_feature, Qnil); +#if 0 while (!NILP (ancestors)) { @@ -3307,6 +3365,38 @@ find_char_feature_in_family (Lisp_Object character, if (!NILP (ret)) ancestors = nconc2 (Fcopy_sequence (ancestors), ret); } +#else + Lisp_Object ancestor; + + if (CONSP (ancestors)) + ancestor = XCAR (ancestors); + else + ancestor = ancestors; + + if (!NILP (ancestor)) + { + Lisp_Object ret; + Lisp_Object anc; + + if (EQ (ancestor, character)) + return Qunbound; + + ret = Fchar_feature (ancestor, feature, Qunbound, + Qnil, make_int (0)); + if (!UNBOUNDP (ret)) + return ret; + + ret = find_char_feature_in_family (ancestor, Q_subsumptive_from, + feature, feature_rel_max); + if (!UNBOUNDP (ret)) + return ret; + + ret = find_char_feature_in_family (ancestor, Q_denotational_from, + feature, feature_rel_max); + if (!UNBOUNDP (ret)) + return ret; + } +#endif return Qunbound; } @@ -3323,6 +3413,7 @@ Return DEFAULT-VALUE if the value is not exist. if (!UNBOUNDP (ret)) return ret; +#if 0 if (NILP (feature_rel_max) || (INTP (feature_rel_max) && XINT (feature_rel_max) > 0)) @@ -3347,6 +3438,7 @@ Return DEFAULT-VALUE if the value is not exist. return ret; } } +#endif if ( !(EQ (attribute, Q_identical)) && !(EQ (attribute, Q_subsumptive_from)) && @@ -3355,11 +3447,13 @@ Return DEFAULT-VALUE if the value is not exist. || (INTP (char_rel_max) && XINT (char_rel_max) > 0)) ) ) { +#if 0 Lisp_String* name = symbol_name (XSYMBOL (attribute)); Bufbyte *name_str = string_data (name); if ( (name_str[0] != '=') || (name_str[1] == '>') ) { +#endif ret = find_char_feature_in_family (character, Q_identical, attribute, feature_rel_max); if (!UNBOUNDP (ret)) @@ -3374,25 +3468,28 @@ Return DEFAULT-VALUE if the value is not exist. attribute, feature_rel_max); if (!UNBOUNDP (ret)) return ret; +#if 0 } +#endif } 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 +3499,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,10 +3515,42 @@ put_char_composition (Lisp_Object character, Lisp_Object value) else Fsetcdr (ret, character); } + else if (EQ (base, Qnarrow)) + return Q_halfwidth_of; + else if (EQ (base, Qsuper)) + return Q_superscript_of; + else if (EQ (base, Qsub)) + return Q_subscript_of; + else if (EQ (base, Qcircle)) + return Q_circled_of; + else if ( EQ (base, Qisolated)|| + EQ (base, Qinitial) || + EQ (base, Qmedial) || + EQ (base, Qfinal) ) + return + Fintern (concat2 (build_string ("<-formed@"), + Fsymbol_name (base)), + Qnil); + else if (SYMBOLP (base)) + return + Fintern (concat2 (build_string ("<-"), + Fsymbol_name (base)), + Qnil); } + else if (EQ (XCAR (value), Qsuper)) + return Qto_decomposition_at_superscript; + else if (EQ (XCAR (value), Qcircle)) + return Qto_decomposition_at_circled; + else + return + Fintern (concat2 (build_string ("=>decomposition@"), + Fsymbol_name (XCAR (value))), + Qnil); } else { + return Q_canonical; +#if 0 Lisp_Object v = Fcar (value); if (INTP (v)) @@ -3442,7 +3571,9 @@ put_char_composition (Lisp_Object character, Lisp_Object value) Fcons (character, ret)); } } +#endif } + return Qrep_decomposition; } static Lisp_Object @@ -3476,11 +3607,36 @@ Store CHARACTER's ATTRIBUTE with VALUE. if (!NILP (ccs)) { - value = put_char_ccs_code_point (character, ccs, value); + if ( !NILP (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 ( +#if 0 + EQ (attribute, Qrep_decomposition) || +#else + !NILP (Fchar_feature_base_name_eq (Qrep_decomposition, + attribute)) || +#endif + EQ (attribute, Q_decomposition) /* || */ +#if 0 + !NILP (Fstring_match (build_string ("^=decomposition@[^*]+$"), + Fsymbol_name (attribute), + Qnil, Qnil)) +#endif + ) + { + Lisp_Object ret; + + value = Fcopy_sequence (Fchar_refs_simplify_char_specs (value)); + ret = put_char_composition (character, value); + if ( !EQ (ret, Qrep_decomposition) && + SYMBOLP (XCAR (value)) ) + { + attribute = ret; + value = XCDR (value); + } + } else if (EQ (attribute, Qto_ucs)) { Lisp_Object ret; @@ -3500,22 +3656,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 ("^\\(<-\\|->\\)\\(" - "fullwidth\\|halfwidth" - "\\|simplified\\|vulgar\\|wrong" - "\\|same\\|original\\|ancient" - "\\|Oracle-Bones\\)[^*]*$"), + 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_halfwidth_of) || + EQ (attribute, Q_superscript_of) || + EQ (attribute, Q_subscript_of) || + EQ (attribute, Q_circled_of) || + EQ (attribute, Q_component) || + EQ (attribute, Q_component_of) || + ( !EQ (attribute, Q_ucs_unified) + && !NILP (Fstring_match + (build_string ("^\\(<-\\|->\\)[^*]*$"), Fsymbol_name (attribute), - Qnil, Qnil)) ) + Qnil, Qnil)) + ) + ) { Lisp_Object rest = value; Lisp_Object ret; @@ -3572,7 +3732,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; @@ -3591,7 +3761,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); @@ -3636,22 +3810,43 @@ open_chise_data_source_maybe () { if (default_chise_data_source == NULL) { - Lisp_Object db_dir = Vdata_directory; int modemask = 0755; /* rwxr-xr-x */ + char* db_dir_name; + size_t len; - if (NILP (db_dir)) - db_dir = build_string ("../etc"); - db_dir = Fexpand_file_name (build_string ("chise-db"), db_dir); + if (STRINGP (Vdata_directory)) + { + char* dir_name = XSTRING_DATA (Vdata_directory); - default_chise_data_source - = CHISE_DS_open (CHISE_DS_Berkeley_DB, XSTRING_DATA (db_dir), - 0 /* DB_HASH */, modemask); + len = strlen (dir_name) + 8; + db_dir_name = alloca (len + 1); + strncpy (db_dir_name, dir_name, len); + } + else + { + if (STRINGP (current_buffer->directory)) + { + char* dir_name = XSTRING_DATA (current_buffer->directory); + + len = strlen (dir_name) + 7 + 8; + db_dir_name = alloca (len + 1); + strncpy (db_dir_name, dir_name, len); + strncat(db_dir_name, "../etc/", 15); + } + else + { + len = 7 + 8; + db_dir_name = alloca (len + 1); + strncpy (db_dir_name, "../etc/", len); + } + } + strncat(db_dir_name, "chise-db", 8); + + default_chise_data_source = CHISE_DS_open (CHISE_DS_Berkeley_DB, + db_dir_name, + 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; } @@ -3727,13 +3922,8 @@ 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; @@ -3748,6 +3938,17 @@ char_table_get_db (Lisp_Char_Table* cit, Emchar ch) return val; } +#ifdef USE_CONCORD_OBJECT_SYSTEM +COS_object +char_table_get_db_cos (Lisp_Char_Table* cit, Emchar ch) +{ + return + concord_object_get_attribute + (cos_make_char (ch), + cos_intern (XSTRING_DATA (Fsymbol_name (cit->name)))); +} +#endif + #ifndef HAVE_LIBCHISE Lisp_Object char_attribute_system_db_file (Lisp_Object key_type, Lisp_Object attribute, @@ -3841,16 +4042,21 @@ 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" - "\\|Oracle-Bones\\)[^*]*$"), - 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_halfwidth_of) || + EQ (attribute, Q_superscript_of) || + EQ (attribute, Q_subscript_of) || + EQ (attribute, Q_circled_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; @@ -4013,6 +4219,27 @@ load_char_attribute_maybe (Lisp_Char_Table* cit, Emchar ch) return Qunbound; } +#ifdef USE_CONCORD_OBJECT_SYSTEM +COS_object +load_char_attribute_maybe_cos (Lisp_Char_Table* cit, Emchar ch) +{ + Lisp_Object attribute = CHAR_TABLE_NAME (cit); + + if (!NILP (attribute)) + { + COS_object val; + + if (char_table_open_db_maybe (cit)) + return NULL; + + val = char_table_get_db_cos (cit, ch); + + return val; + } + return NULL; +} +#endif + Lisp_Char_Table* char_attribute_table_to_load; #ifdef HAVE_LIBCHISE @@ -4092,12 +4319,18 @@ Load values of ATTRIBUTE into database file. #endif /* HAVE_CHISE */ DEFUN ("map-char-attribute", Fmap_char_attribute, 2, 3, 0, /* -Map FUNCTION over entries in ATTRIBUTE, calling it with two args, -each key and value in the table. +Map FUNCTION over ATTRIBUTE until it returns non-nil; return that value. +FUNCTION is called with two arguments, each key and entry in the table. -RANGE specifies a subrange to map over and is in the same format as -the RANGE argument to `put-range-table'. If omitted or t, it defaults to +RANGE specifies a subrange to map over. If omitted or t, it defaults to the entire table. + +Both RANGE and the keys passed to FUNCTION are in the same format as the +RANGE argument to `put-char-table'. N.B. This function does NOT map over +all characters in RANGE, but over the subranges that have been assigned to. +Thus this function is most suitable for searching a char-table, or for +populating one char-table based on the contents of another. The current +implementation does not coalesce ranges all of whose values are the same. */ (function, attribute, range)) { @@ -4142,13 +4375,27 @@ the entire table. return slarg.retval; } +static Lisp_Object +allocate_character () +{ + int cid = XINT (Vnext_defined_char_id); + + if (cid <= 0xE00000) + { + Vnext_defined_char_id = make_int (cid + 1); + return make_char (cid); + } + else + return Qnil; +} + DEFUN ("define-char", Fdefine_char, 1, 1, 0, /* Store character's ATTRIBUTES. */ (attributes)) { Lisp_Object rest; - Lisp_Object code = Fcdr (Fassq (Qmap_ucs, attributes)); + Lisp_Object code = Fcdr (Fassq (Qrep_ucs, attributes)); Lisp_Object character; if (NILP (code)) @@ -4190,7 +4437,7 @@ Store character's ATTRIBUTES. } rest = Fcdr (rest); } -#if 1 +#if 0 { int cid = XINT (Vnext_defined_char_id); @@ -4202,16 +4449,9 @@ Store character's ATTRIBUTES. } } #else - if ( (!NILP (code = Fcdr (Fassq (Qto_ucs, attributes)))) ) - { - if (!INTP (code)) - signal_simple_error ("Invalid argument", attributes); - else - character = make_char (XINT (code) + 0x100000); - goto setup_attributes; - } + if ( NILP (character = allocate_character ()) ) #endif - return Qnil; + return Qnil; } else if (!INTP (code)) signal_simple_error ("Invalid argument", attributes); @@ -4272,6 +4512,62 @@ Retrieve the character of the given ATTRIBUTES. /************************************************************************/ +/* Character Feature Property */ +/************************************************************************/ + +#ifdef HAVE_LIBCHISE +DEFUN ("char-feature-property", Fchar_feature_property, 2, 3, 0, /* +Return the value of FEATURE's PROPERTY. +Return DEFAULT-VALUE if the value is not exist. +*/ + (feature, property, default_value)) +{ + unsigned char* feature_name; + unsigned char* property_name; + CHISE_Value value; + int status; + + feature_name = XSTRING_DATA (Fsymbol_name (feature)); + property_name = XSTRING_DATA (Fsymbol_name (property)); + status + = chise_feature_load_property_value (chise_ds_get_feature + (default_chise_data_source, + feature_name), + chise_ds_get_property + (default_chise_data_source, + property_name), + &value); + if (!status) + return read_from_c_string (chise_value_data (&value), + chise_value_size (&value) ); + else + return default_value; +} + +DEFUN ("put-char-feature-property", Fput_char_feature_property, 3, 3, 0, /* +Store FEATURE's PROPERTY with VALUE. +*/ + (feature, property, value)) +{ + unsigned char* feature_name; + unsigned char* property_name; + CHISE_Property prop; + + feature_name = XSTRING_DATA (Fsymbol_name (feature)); + property_name = XSTRING_DATA (Fsymbol_name (property)); + prop = chise_ds_get_property (default_chise_data_source, + property_name); + chise_feature_set_property_value + (chise_ds_get_feature (default_chise_data_source, feature_name), + prop, XSTRING_DATA (Fprin1_to_string + (value, Qnil))); + chise_property_sync (prop); + return Qnil; +} +#endif + + +/************************************************************************/ /* Char table read syntax */ /************************************************************************/ @@ -4609,6 +4905,12 @@ word_boundary_p (Emchar c1, Emchar c2) void syms_of_chartab (void) { +#if defined(UTF2000) || defined(HAVE_CONCORD) + defsymbol (&Q_subsumptive, "->subsumptive"); + defsymbol (&Q_subsumptive_from, "<-subsumptive"); + defsymbol (&Q_denotational, "->denotational"); + defsymbol (&Q_denotational_from, "<-denotational"); +#endif #ifdef UTF2000 INIT_LRECORD_IMPLEMENTATION (uint8_byte_table); INIT_LRECORD_IMPLEMENTATION (uint16_byte_table); @@ -4616,15 +4918,20 @@ syms_of_chartab (void) 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 (&Qrep_decomposition, "=decomposition"); + defsymbol (&Qto_decomposition_at_superscript, + "=>decomposition@superscript"); + defsymbol (&Qto_decomposition_at_circled, "=>decomposition@circled"); + defsymbol (&Q_canonical, "->canonical"); + defsymbol (&Q_halfwidth_of, "<-halfwidth"); + defsymbol (&Q_superscript_of, "<-superscript"); + defsymbol (&Q_subscript_of, "<-subscript"); + defsymbol (&Q_circled_of, "<-circled"); defsymbol (&Q_decomposition, "->decomposition"); defsymbol (&Qcompat, "compat"); defsymbol (&Qisolated, "isolated"); @@ -4660,6 +4967,7 @@ syms_of_chartab (void) #endif DEFSUBR (Fload_char_attribute_table); #endif + DEFSUBR (Fchar_feature_base_name_eq); DEFSUBR (Fchar_feature); DEFSUBR (Fchar_attribute_alist); DEFSUBR (Fget_char_attribute); @@ -4671,6 +4979,10 @@ syms_of_chartab (void) DEFSUBR (Fchar_variants); DEFSUBR (Fget_composite_char); +#ifdef HAVE_LIBCHISE + DEFSUBR (Fchar_feature_property); + DEFSUBR (Fput_char_feature_property); +#endif /* HAVE_LIBCHISE */ #endif INIT_LRECORD_IMPLEMENTATION (char_table);