X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=src%2Fchartab.c;h=1a22127101394a3ee43582676336b86669e5285c;hb=edb1d7f5d06e1f3ca783853fe435f41eaa32ea8e;hp=b95bad85b5ff357b2f08cae020ad6b894c80ff6c;hpb=a42ff4d79fc0a10305ce024b0d7b3125e366fc28;p=chise%2Fxemacs-chise.git- diff --git a/src/chartab.c b/src/chartab.c index b95bad8..1a22127 100644 --- a/src/chartab.c +++ b/src/chartab.c @@ -34,6 +34,7 @@ Boston, MA 02111-1307, USA. */ loosely based on the original Mule. Jareth Hein: fixed a couple of bugs in the implementation, and added regex support for categories with check_category_at + MORIOKA Tomohiko: Rewritten for XEmacs UTF-2000 */ #include @@ -64,9 +65,12 @@ Lisp_Object Vword_combining_categories, Vword_separating_categories; #ifdef UTF2000 +EXFUN (Fmap_char_attribute, 3); + #if defined(HAVE_DATABASE) EXFUN (Fload_char_attribute_table, 1); -EXFUN (Fmap_char_attribute, 3); + +Lisp_Object Vchar_db_stingy_mode; #endif #define BT_UINT8_MIN 0 @@ -340,7 +344,6 @@ save_uint8_byte_table (Lisp_Uint8_Byte_Table *ct, Lisp_Char_Table* root, Fprin1_to_string (UINT8_DECODE (ct->property[i]), Qnil), db, Qt); - put_char_id_table (root, make_char (c), Qunloaded); } } else @@ -652,7 +655,6 @@ save_uint16_byte_table (Lisp_Uint16_Byte_Table *ct, Lisp_Char_Table* root, Fprin1_to_string (UINT16_DECODE (ct->property[i]), Qnil), db, Qt); - put_char_id_table (root, make_char (c), Qunloaded); } } else @@ -932,7 +934,6 @@ save_byte_table (Lisp_Byte_Table *ct, Lisp_Char_Table* root, Fput_database (Fprin1_to_string (make_char (c), Qnil), Fprin1_to_string (v, Qnil), db, Qt); - put_char_id_table (root, make_char (c), Qunloaded); } } else @@ -1058,12 +1059,9 @@ make_char_id_table (Lisp_Object initval) } -Lisp_Object Vcharacter_composition_table; -Lisp_Object Vcharacter_variant_table; - - Lisp_Object Qsystem_char_id; +Lisp_Object Qcomposition; Lisp_Object Q_decomposition; Lisp_Object Qto_ucs; Lisp_Object Q_ucs; @@ -1135,33 +1133,25 @@ Return character corresponding with list. */ (list)) { - Lisp_Object table = Vcharacter_composition_table; - Lisp_Object rest = list; + Lisp_Object base, modifier; + Lisp_Object rest; - while (CONSP (rest)) + if (!CONSP (list)) + signal_simple_error ("Invalid value for composition", list); + base = Fcar (list); + rest = Fcdr (list); + while (!NILP (rest)) { - Lisp_Object v = Fcar (rest); - Lisp_Object ret; - Emchar c = to_char_id (v, "Invalid value for composition", list); - - ret = get_char_id_table (XCHAR_TABLE(table), c); - + if (!CHARP (base)) + return Qnil; + if (!CONSP (rest)) + signal_simple_error ("Invalid value for composition", list); + modifier = Fcar (rest); rest = Fcdr (rest); - if (NILP (rest)) - { - if (!CHAR_TABLEP (ret)) - return ret; - else - return Qt; - } - else if (!CONSP (rest)) - break; - else if (CHAR_TABLEP (ret)) - table = ret; - else - signal_simple_error ("Invalid table is found with", list); + base = Fcdr (Fassq (modifier, + Fget_char_attribute (base, Qcomposition, Qnil))); } - signal_simple_error ("Invalid value for composition", list); + return base; } DEFUN ("char-variants", Fchar_variants, 1, 1, 0, /* @@ -1172,8 +1162,7 @@ Return variants of CHARACTER. Lisp_Object ret; CHECK_CHAR (character); - ret = get_char_id_table (XCHAR_TABLE(Vcharacter_variant_table), - XCHAR(character)); + ret = Fget_char_attribute (character, Q_ucs_variants, Qnil); if (CONSP (ret)) return Fcopy_list (ret); else @@ -1275,7 +1264,6 @@ mark_char_table (Lisp_Object obj) mark_object (ct->table); mark_object (ct->name); - mark_object (ct->db_file); mark_object (ct->db); #else int i; @@ -1606,7 +1594,6 @@ static const struct lrecord_description char_table_description[] = { { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, table) }, { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, default_value) }, { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, name) }, - { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, db_file) }, { XD_LISP_OBJECT, offsetof(Lisp_Char_Table, db) }, #else { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, ascii), NUM_ASCII_CHARS }, @@ -1809,7 +1796,6 @@ and 'syntax. See `valid-char-table-type-p'. ct->mirror_table = Qnil; #else ct->name = Qnil; - ct->db_file = Qnil; ct->db = Qnil; #endif ct->next_table = Qnil; @@ -1885,7 +1871,6 @@ as CHAR-TABLE. The values will not themselves be copied. ctnew->default_value = ct->default_value; /* [tomo:2002-01-21] Perhaps this code seems wrong */ ctnew->name = ct->name; - ctnew->db_file = ct->db_file; ctnew->db = ct->db; if (UINT8_BYTE_TABLE_P (ct->table)) @@ -3169,8 +3154,6 @@ Store CHARACTER's ATTRIBUTE with VALUE. } else if (EQ (attribute, Q_decomposition)) { - Lisp_Object seq; - CHECK_CHAR (character); if (!CONSP (value)) signal_simple_error ("Invalid value for ->decomposition", @@ -3178,42 +3161,31 @@ Store CHARACTER's ATTRIBUTE with VALUE. if (CONSP (Fcdr (value))) { - Lisp_Object rest = value; - Lisp_Object table = Vcharacter_composition_table; - size_t len; - int i = 0; - - GET_EXTERNAL_LIST_LENGTH (rest, len); - seq = make_vector (len, Qnil); - - while (CONSP (rest)) + if (NILP (Fcdr (Fcdr (value)))) { - Lisp_Object v = Fcar (rest); - Lisp_Object ntable; - Emchar c - = to_char_id (v, "Invalid value for ->decomposition", value); + Lisp_Object base = Fcar (value); + Lisp_Object modifier = Fcar (Fcdr (value)); - if (c < 0) - XVECTOR_DATA(seq)[i++] = v; - else - XVECTOR_DATA(seq)[i++] = make_char (c); - rest = Fcdr (rest); - if (!CONSP (rest)) + if (INTP (base)) { - put_char_id_table (XCHAR_TABLE(table), - make_char (c), character); - break; + base = make_char (XINT (base)); + Fsetcar (value, base); } - else + if (INTP (modifier)) { - ntable = get_char_id_table (XCHAR_TABLE(table), c); - if (!CHAR_TABLEP (ntable)) - { - ntable = make_char_id_table (Qnil); - put_char_id_table (XCHAR_TABLE(table), - make_char (c), ntable); - } - table = ntable; + modifier = make_char (XINT (modifier)); + Fsetcar (Fcdr (value), modifier); + } + if (CHARP (base)) + { + Lisp_Object alist = Fget_char_attribute (base, Qcomposition, Qnil); + Lisp_Object ret = Fassq (modifier, alist); + + if (NILP (ret)) + Fput_char_attribute (base, Qcomposition, + Fcons (Fcons (modifier, character), alist)); + else + Fsetcdr (ret, character); } } } @@ -3225,23 +3197,20 @@ Store CHARACTER's ATTRIBUTE with VALUE. { Emchar c = XINT (v); Lisp_Object ret - = get_char_id_table (XCHAR_TABLE(Vcharacter_variant_table), - c); + = Fget_char_attribute (make_char (c), Q_ucs_variants, Qnil); if (!CONSP (ret)) { - put_char_id_table (XCHAR_TABLE(Vcharacter_variant_table), - make_char (c), Fcons (character, Qnil)); + Fput_char_attribute (make_char (c), Q_ucs_variants, + Fcons (character, Qnil)); } - else if (NILP (Fmemq (v, ret))) + else if (NILP (Fmemq (character, ret))) { - put_char_id_table (XCHAR_TABLE(Vcharacter_variant_table), - make_char (c), Fcons (character, ret)); + Fput_char_attribute (make_char (c), Q_ucs_variants, + Fcons (character, ret)); } } - seq = make_vector (1, v); } - value = seq; } else if (EQ (attribute, Qto_ucs) || EQ (attribute, Q_ucs)) { @@ -3254,16 +3223,16 @@ Store CHARACTER's ATTRIBUTE with VALUE. c = XINT (value); - ret = get_char_id_table (XCHAR_TABLE(Vcharacter_variant_table), c); + ret = Fget_char_attribute (make_char (c), Q_ucs_variants, Qnil); if (!CONSP (ret)) { - put_char_id_table (XCHAR_TABLE(Vcharacter_variant_table), - make_char (c), Fcons (character, Qnil)); + Fput_char_attribute (make_char (c), Q_ucs_variants, + Fcons (character, Qnil)); } else if (NILP (Fmemq (character, ret))) { - put_char_id_table (XCHAR_TABLE(Vcharacter_variant_table), - make_char (c), Fcons (character, ret)); + Fput_char_attribute (make_char (c), Q_ucs_variants, + Fcons (character, ret)); } #if 0 if (EQ (attribute, Q_ucs)) @@ -3315,6 +3284,7 @@ Remove CHARACTER's ATTRIBUTE. return Qnil; } +#ifdef HAVE_DATABASE Lisp_Object char_attribute_system_db_file (Lisp_Object key_type, Lisp_Object attribute, int writing_mode) @@ -3366,7 +3336,7 @@ char_attribute_system_db_file (Lisp_Object key_type, Lisp_Object attribute, return Fexpand_file_name (Fsymbol_name (attribute), db_dir); #endif } - + DEFUN ("save-char-attribute-table", Fsave_char_attribute_table, 1, 1, 0, /* Save values of ATTRIBUTE into database file. */ @@ -3376,29 +3346,25 @@ Save values of ATTRIBUTE into database file. Lisp_Object table = Fgethash (attribute, Vchar_attribute_hash_table, Qunbound); Lisp_Char_Table *ct; + Lisp_Object db_file; + Lisp_Object db; if (CHAR_TABLEP (table)) ct = XCHAR_TABLE (table); else return Qnil; - if (NILP (Fdatabase_live_p (ct->db))) - { - if (NILP (ct->db_file)) - ct->db_file - = char_attribute_system_db_file (Qsystem_char_id, attribute, 1); - ct->db = Fopen_database (ct->db_file, Qnil, Qnil, Qnil, Qnil); - } - if (!NILP (ct->db)) + db_file = char_attribute_system_db_file (Qsystem_char_id, attribute, 1); + db = Fopen_database (db_file, Qnil, Qnil, build_string ("w+"), Qnil); + if (!NILP (db)) { if (UINT8_BYTE_TABLE_P (ct->table)) - save_uint8_byte_table (XUINT8_BYTE_TABLE(ct->table), ct, ct->db, 0, 3); + save_uint8_byte_table (XUINT8_BYTE_TABLE(ct->table), ct, db, 0, 3); else if (UINT16_BYTE_TABLE_P (ct->table)) - save_uint16_byte_table (XUINT16_BYTE_TABLE(ct->table), ct, ct->db, 0, 3); + save_uint16_byte_table (XUINT16_BYTE_TABLE(ct->table), ct, db, 0, 3); else if (BYTE_TABLE_P (ct->table)) - save_byte_table (XBYTE_TABLE(ct->table), ct, ct->db, 0, 3); - Fclose_database (ct->db); - ct->db = Qnil; + save_byte_table (XBYTE_TABLE(ct->table), ct, db, 0, 3); + Fclose_database (db); return Qt; } else @@ -3408,6 +3374,32 @@ Save values of ATTRIBUTE into database file. #endif } +DEFUN ("mount-char-attribute-table", Fmount_char_attribute_table, 1, 1, 0, /* +Mount database file on char-attribute-table ATTRIBUTE. +*/ + (attribute)) +{ +#ifdef HAVE_DATABASE + Lisp_Object table = Fgethash (attribute, + Vchar_attribute_hash_table, Qunbound); + + if (UNBOUNDP (table)) + { + Lisp_Char_Table *ct; + + table = make_char_id_table (Qunbound); + Fputhash (attribute, table, Vchar_attribute_hash_table); + XCHAR_TABLE_NAME(table) = attribute; + ct = XCHAR_TABLE (table); + ct->table = Qunloaded; + XCHAR_TABLE_UNLOADED(table) = 1; + ct->db = Qnil; + return Qt; + } +#endif + return Qnil; +} + DEFUN ("close-char-attribute-table", Fclose_char_attribute_table, 1, 1, 0, /* Close database of ATTRIBUTE. */ @@ -3429,7 +3421,6 @@ Close database of ATTRIBUTE. Fclose_database (ct->db); ct->db = Qnil; } - ct->db_file = Qnil; #endif return Qnil; } @@ -3456,7 +3447,6 @@ Reset values of ATTRIBUTE with database file. } ct = XCHAR_TABLE (table); ct->table = Qunloaded; - ct->db_file = db_file; if (!NILP (Fdatabase_live_p (ct->db))) Fclose_database (ct->db); ct->db = Qnil; @@ -3467,7 +3457,6 @@ Reset values of ATTRIBUTE with database file. return Qnil; } -#ifdef HAVE_DATABASE Lisp_Object load_char_attribute_maybe (Lisp_Char_Table* cit, Emchar ch) { @@ -3477,11 +3466,11 @@ load_char_attribute_maybe (Lisp_Char_Table* cit, Emchar ch) { if (NILP (Fdatabase_live_p (cit->db))) { - if (NILP (cit->db_file)) - cit->db_file - = char_attribute_system_db_file (Qsystem_char_id, attribute, 0); - cit->db = Fopen_database (cit->db_file, Qnil, Qnil, Qnil, Qnil); - cit->db_file = Qnil; + Lisp_Object db_file + = char_attribute_system_db_file (Qsystem_char_id, attribute, 0); + + cit->db = Fopen_database (db_file, Qnil, Qnil, + build_string ("r"), Qnil); } if (!NILP (cit->db)) { @@ -3492,6 +3481,11 @@ load_char_attribute_maybe (Lisp_Char_Table* cit, Emchar ch) val = Fread (val); else val = Qunbound; + if (!NILP (Vchar_db_stingy_mode)) + { + Fclose_database (cit->db); + cit->db = Qnil; + } return val; } } @@ -3510,20 +3504,18 @@ For internal use. Don't use it. { Lisp_Object c = Fread (key); Emchar code = XCHAR (c); - Lisp_Object ret = get_char_id_table (char_attribute_table_to_load, code); + Lisp_Object ret = get_char_id_table_0 (char_attribute_table_to_load, code); if (EQ (ret, Qunloaded)) put_char_id_table_0 (char_attribute_table_to_load, code, Fread (value)); return Qnil; } -#endif DEFUN ("load-char-attribute-table", Fload_char_attribute_table, 1, 1, 0, /* Load values of ATTRIBUTE into database file. */ (attribute)) { -#ifdef HAVE_DATABASE Lisp_Object table = Fgethash (attribute, Vchar_attribute_hash_table, Qunbound); @@ -3533,11 +3525,11 @@ Load values of ATTRIBUTE into database file. if (NILP (Fdatabase_live_p (ct->db))) { - if (NILP (ct->db_file)) - ct->db_file + Lisp_Object db_file = char_attribute_system_db_file (Qsystem_char_id, attribute, 0); - ct->db = Fopen_database (ct->db_file, Qnil, Qnil, Qnil, Qnil); - ct->db_file = Qnil; + + ct->db = Fopen_database (db_file, Qnil, Qnil, + build_string ("r"), Qnil); } if (!NILP (ct->db)) { @@ -3554,8 +3546,8 @@ Load values of ATTRIBUTE into database file. } } return Qnil; -#endif } +#endif DEFUN ("map-char-attribute", Fmap_char_attribute, 2, 3, 0, /* Map FUNCTION over entries in ATTRIBUTE, calling it with two args, @@ -4056,6 +4048,7 @@ syms_of_chartab (void) defsymbol (&Qto_ucs, "=>ucs"); defsymbol (&Q_ucs, "->ucs"); defsymbol (&Q_ucs_variants, "->ucs-variants"); + defsymbol (&Qcomposition, "composition"); defsymbol (&Q_decomposition, "->decomposition"); defsymbol (&Qcompat, "compat"); defsymbol (&Qisolated, "isolated"); @@ -4078,15 +4071,16 @@ syms_of_chartab (void) DEFSUBR (Ffind_char_attribute_table); defsymbol (&Qput_char_table_map_function, "put-char-table-map-function"); DEFSUBR (Fput_char_table_map_function); +#ifdef HAVE_DATABASE DEFSUBR (Fsave_char_attribute_table); + DEFSUBR (Fmount_char_attribute_table); DEFSUBR (Freset_char_attribute_table); DEFSUBR (Fclose_char_attribute_table); -#ifdef HAVE_DATABASE defsymbol (&Qload_char_attribute_table_map_function, "load-char-attribute-table-map-function"); DEFSUBR (Fload_char_attribute_table_map_function); -#endif DEFSUBR (Fload_char_attribute_table); +#endif DEFSUBR (Fchar_attribute_alist); DEFSUBR (Fget_char_attribute); DEFSUBR (Fput_char_attribute); @@ -4146,11 +4140,11 @@ void vars_of_chartab (void) { #ifdef UTF2000 - staticpro (&Vcharacter_composition_table); - Vcharacter_composition_table = make_char_id_table (Qnil); - - staticpro (&Vcharacter_variant_table); - Vcharacter_variant_table = make_char_id_table (Qunbound); +#ifdef HAVE_DATABASE + DEFVAR_LISP ("char-db-stingy-mode", &Vchar_db_stingy_mode /* +*/ ); + Vchar_db_stingy_mode = Qt; +#endif /* HAVE_DATABASE */ #endif /* DO NOT staticpro this. It works just like Vweak_hash_tables. */ Vall_syntax_tables = Qnil; @@ -4175,11 +4169,6 @@ complex_vars_of_chartab (void) staticpro (&Vchar_attribute_hash_table); Vchar_attribute_hash_table = make_lisp_hash_table (16, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); -#ifdef HAVE_DATABASE - Fputhash (Q_ucs_variants, Vcharacter_variant_table, - Vchar_attribute_hash_table); - XCHAR_TABLE_NAME (Vcharacter_variant_table) = Q_ucs_variants; -#endif /* HAVE_DATABASE */ #endif /* UTF2000 */ #ifdef MULE /* Set this now, so first buffer creation can refer to it. */