X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=src%2Fchartab.c;h=37598ca623a3203937d66264db01cdfb86337d03;hb=153c92fa2a3b77ce954a1e54a5dc9ec15370cfd6;hp=d3b8b9de3d2f0dce2991722c83a1ace9582ae5e2;hpb=b4a45788f94f698b052268e43b0b151bcfc0ea3a;p=chise%2Fxemacs-chise.git- diff --git a/src/chartab.c b/src/chartab.c index d3b8b9d..37598ca 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 MORIOKA Tomohiko + Copyright (C) 1999,2000,2001,2002 MORIOKA Tomohiko This file is part of XEmacs. @@ -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 @@ -42,11 +43,8 @@ Boston, MA 02111-1307, USA. */ #include "buffer.h" #include "chartab.h" #include "syntax.h" - #ifdef UTF2000 #include "elhash.h" - -Lisp_Object Vutf_2000_version; #endif /* UTF2000 */ Lisp_Object Qchar_tablep, Qchar_table; @@ -67,21 +65,20 @@ Lisp_Object Vword_combining_categories, Vword_separating_categories; #ifdef UTF2000 -static void -decode_char_table_range (Lisp_Object range, struct chartab_range *outrange); +EXFUN (Fmap_char_attribute, 3); -int -map_char_id_table (Lisp_Char_ID_Table *ct, - struct chartab_range *range, - int (*fn) (struct chartab_range *range, - Lisp_Object val, void *arg), - void *arg); +#if defined(HAVE_DATABASE) +EXFUN (Fload_char_attribute_table, 1); + +Lisp_Object Vchar_db_stingy_mode; +#endif #define BT_UINT8_MIN 0 -#define BT_UINT8_MAX (UCHAR_MAX - 3) -#define BT_UINT8_t (UCHAR_MAX - 2) -#define BT_UINT8_nil (UCHAR_MAX - 1) -#define BT_UINT8_unbound UCHAR_MAX +#define BT_UINT8_MAX (UCHAR_MAX - 4) +#define BT_UINT8_t (UCHAR_MAX - 3) +#define BT_UINT8_nil (UCHAR_MAX - 2) +#define BT_UINT8_unbound (UCHAR_MAX - 1) +#define BT_UINT8_unloaded UCHAR_MAX INLINE_HEADER int INT_UINT8_P (Lisp_Object obj); INLINE_HEADER int UINT8_VALUE_P (Lisp_Object obj); @@ -105,14 +102,16 @@ INT_UINT8_P (Lisp_Object obj) INLINE_HEADER int UINT8_VALUE_P (Lisp_Object obj) { - return EQ (obj, Qunbound) + return EQ (obj, Qunloaded) || EQ (obj, Qunbound) || EQ (obj, Qnil) || EQ (obj, Qt) || INT_UINT8_P (obj); } INLINE_HEADER unsigned char UINT8_ENCODE (Lisp_Object obj) { - if (EQ (obj, Qunbound)) + if (EQ (obj, Qunloaded)) + return BT_UINT8_unloaded; + else if (EQ (obj, Qunbound)) return BT_UINT8_unbound; else if (EQ (obj, Qnil)) return BT_UINT8_nil; @@ -125,7 +124,9 @@ UINT8_ENCODE (Lisp_Object obj) INLINE_HEADER Lisp_Object UINT8_DECODE (unsigned char n) { - if (n == BT_UINT8_unbound) + if (n == BT_UINT8_unloaded) + return Qunloaded; + else if (n == BT_UINT8_unbound) return Qunbound; else if (n == BT_UINT8_nil) return Qnil; @@ -200,12 +201,16 @@ uint8_byte_table_hash (Lisp_Object obj, int depth) return hash; } +static const struct lrecord_description uint8_byte_table_description[] = { + { XD_END } +}; + DEFINE_LRECORD_IMPLEMENTATION ("uint8-byte-table", uint8_byte_table, mark_uint8_byte_table, print_uint8_byte_table, 0, uint8_byte_table_equal, uint8_byte_table_hash, - 0 /* uint8_byte_table_description */, + uint8_byte_table_description, Lisp_Uint8_Byte_Table); static Lisp_Object @@ -225,6 +230,25 @@ make_uint8_byte_table (unsigned char initval) return obj; } +static Lisp_Object +copy_uint8_byte_table (Lisp_Object entry) +{ + Lisp_Uint8_Byte_Table *cte = XUINT8_BYTE_TABLE (entry); + Lisp_Object obj; + int i; + Lisp_Uint8_Byte_Table *ctenew + = alloc_lcrecord_type (Lisp_Uint8_Byte_Table, + &lrecord_uint8_byte_table); + + for (i = 0; i < 256; i++) + { + ctenew->property[i] = cte->property[i]; + } + + XSETUINT8_BYTE_TABLE (obj, ctenew); + return obj; +} + static int uint8_byte_table_same_value_p (Lisp_Object obj) { @@ -241,8 +265,8 @@ uint8_byte_table_same_value_p (Lisp_Object obj) } static int -map_over_uint8_byte_table (Lisp_Uint8_Byte_Table *ct, Emchar ofs, int place, - Lisp_Object ccs, +map_over_uint8_byte_table (Lisp_Uint8_Byte_Table *ct, Lisp_Char_Table* root, + Emchar ofs, int place, int (*fn) (struct chartab_range *range, Lisp_Object val, void *arg), void *arg) @@ -257,17 +281,33 @@ map_over_uint8_byte_table (Lisp_Uint8_Byte_Table *ct, Emchar ofs, int place, for (i = 0, retval = 0; i < 256 && retval == 0; i++) { - if (ct->property[i] != BT_UINT8_unbound) + if (ct->property[i] == BT_UINT8_unloaded) { +#if 0 c1 = c + unit; for (; c < c1 && retval == 0; c++) { - if ( NILP (ccs) || charset_code_point (ccs, c) >= 0 ) + Lisp_Object ret = get_char_id_table (root, c); + + if (!UNBOUNDP (ret)) { rainj.ch = c; - retval = (fn) (&rainj, UINT8_DECODE (ct->property[i]), arg); + retval = (fn) (&rainj, ret, arg); } } +#else + ct->property[i] = BT_UINT8_unbound; + c += unit; +#endif + } + else if (ct->property[i] != BT_UINT8_unbound) + { + c1 = c + unit; + for (; c < c1 && retval == 0; c++) + { + rainj.ch = c; + retval = (fn) (&rainj, UINT8_DECODE (ct->property[i]), arg); + } } else c += unit; @@ -275,11 +315,49 @@ map_over_uint8_byte_table (Lisp_Uint8_Byte_Table *ct, Emchar ofs, int place, return retval; } +#ifdef HAVE_DATABASE +static void +save_uint8_byte_table (Lisp_Uint8_Byte_Table *ct, Lisp_Char_Table* root, + Lisp_Object db, + Emchar ofs, int place) +{ + struct chartab_range rainj; + int i, retval; + int unit = 1 << (8 * place); + Emchar c = ofs; + Emchar c1; + + rainj.type = CHARTAB_RANGE_CHAR; + + for (i = 0, retval = 0; i < 256 && retval == 0; i++) + { + if (ct->property[i] == BT_UINT8_unloaded) + { + c1 = c + unit; + } + else if (ct->property[i] != BT_UINT8_unbound) + { + c1 = c + unit; + for (; c < c1 && retval == 0; c++) + { + Fput_database (Fprin1_to_string (make_char (c), Qnil), + Fprin1_to_string (UINT8_DECODE (ct->property[i]), + Qnil), + db, Qt); + } + } + else + c += unit; + } +} +#endif + #define BT_UINT16_MIN 0 -#define BT_UINT16_MAX (USHRT_MAX - 3) -#define BT_UINT16_t (USHRT_MAX - 2) -#define BT_UINT16_nil (USHRT_MAX - 1) -#define BT_UINT16_unbound USHRT_MAX +#define BT_UINT16_MAX (USHRT_MAX - 4) +#define BT_UINT16_t (USHRT_MAX - 3) +#define BT_UINT16_nil (USHRT_MAX - 2) +#define BT_UINT16_unbound (USHRT_MAX - 1) +#define BT_UINT16_unloaded USHRT_MAX INLINE_HEADER int INT_UINT16_P (Lisp_Object obj); INLINE_HEADER int UINT16_VALUE_P (Lisp_Object obj); @@ -302,14 +380,16 @@ INT_UINT16_P (Lisp_Object obj) INLINE_HEADER int UINT16_VALUE_P (Lisp_Object obj) { - return EQ (obj, Qunbound) + return EQ (obj, Qunloaded) || EQ (obj, Qunbound) || EQ (obj, Qnil) || EQ (obj, Qt) || INT_UINT16_P (obj); } INLINE_HEADER unsigned short UINT16_ENCODE (Lisp_Object obj) { - if (EQ (obj, Qunbound)) + if (EQ (obj, Qunloaded)) + return BT_UINT16_unloaded; + else if (EQ (obj, Qunbound)) return BT_UINT16_unbound; else if (EQ (obj, Qnil)) return BT_UINT16_nil; @@ -322,7 +402,9 @@ UINT16_ENCODE (Lisp_Object obj) INLINE_HEADER Lisp_Object UINT16_DECODE (unsigned short n) { - if (n == BT_UINT16_unbound) + if (n == BT_UINT16_unloaded) + return Qunloaded; + else if (n == BT_UINT16_unbound) return Qunbound; else if (n == BT_UINT16_nil) return Qnil; @@ -335,7 +417,9 @@ UINT16_DECODE (unsigned short n) INLINE_HEADER unsigned short UINT8_TO_UINT16 (unsigned char n) { - if (n == BT_UINT8_unbound) + if (n == BT_UINT8_unloaded) + return BT_UINT16_unloaded; + else if (n == BT_UINT8_unbound) return BT_UINT16_unbound; else if (n == BT_UINT8_nil) return BT_UINT16_nil; @@ -410,12 +494,16 @@ uint16_byte_table_hash (Lisp_Object obj, int depth) return hash; } +static const struct lrecord_description uint16_byte_table_description[] = { + { XD_END } +}; + DEFINE_LRECORD_IMPLEMENTATION ("uint16-byte-table", uint16_byte_table, mark_uint16_byte_table, print_uint16_byte_table, 0, uint16_byte_table_equal, uint16_byte_table_hash, - 0 /* uint16_byte_table_description */, + uint16_byte_table_description, Lisp_Uint16_Byte_Table); static Lisp_Object @@ -436,6 +524,25 @@ make_uint16_byte_table (unsigned short initval) } static Lisp_Object +copy_uint16_byte_table (Lisp_Object entry) +{ + Lisp_Uint16_Byte_Table *cte = XUINT16_BYTE_TABLE (entry); + Lisp_Object obj; + int i; + Lisp_Uint16_Byte_Table *ctenew + = alloc_lcrecord_type (Lisp_Uint16_Byte_Table, + &lrecord_uint16_byte_table); + + for (i = 0; i < 256; i++) + { + ctenew->property[i] = cte->property[i]; + } + + XSETUINT16_BYTE_TABLE (obj, ctenew); + return obj; +} + +static Lisp_Object expand_uint8_byte_table_to_uint16 (Lisp_Object table) { Lisp_Object obj; @@ -469,8 +576,8 @@ uint16_byte_table_same_value_p (Lisp_Object obj) } static int -map_over_uint16_byte_table (Lisp_Uint16_Byte_Table *ct, Emchar ofs, int place, - Lisp_Object ccs, +map_over_uint16_byte_table (Lisp_Uint16_Byte_Table *ct, Lisp_Char_Table* root, + Emchar ofs, int place, int (*fn) (struct chartab_range *range, Lisp_Object val, void *arg), void *arg) @@ -485,18 +592,33 @@ map_over_uint16_byte_table (Lisp_Uint16_Byte_Table *ct, Emchar ofs, int place, for (i = 0, retval = 0; i < 256 && retval == 0; i++) { - if (ct->property[i] != BT_UINT16_unbound) + if (ct->property[i] == BT_UINT16_unloaded) { +#if 0 c1 = c + unit; for (; c < c1 && retval == 0; c++) { - if ( NILP (ccs) || charset_code_point (ccs, c) >= 0 ) + Lisp_Object ret = get_char_id_table (root, c); + + if (!UNBOUNDP (ret)) { rainj.ch = c; - retval = (fn) (&rainj, UINT16_DECODE (ct->property[i]), - arg); + retval = (fn) (&rainj, ret, arg); } } +#else + ct->property[i] = BT_UINT16_unbound; + c += unit; +#endif + } + else if (ct->property[i] != BT_UINT16_unbound) + { + c1 = c + unit; + for (; c < c1 && retval == 0; c++) + { + rainj.ch = c; + retval = (fn) (&rainj, UINT16_DECODE (ct->property[i]), arg); + } } else c += unit; @@ -504,6 +626,43 @@ map_over_uint16_byte_table (Lisp_Uint16_Byte_Table *ct, Emchar ofs, int place, return retval; } +#ifdef HAVE_DATABASE +static void +save_uint16_byte_table (Lisp_Uint16_Byte_Table *ct, Lisp_Char_Table* root, + Lisp_Object db, + Emchar ofs, int place) +{ + struct chartab_range rainj; + int i, retval; + int unit = 1 << (8 * place); + Emchar c = ofs; + Emchar c1; + + rainj.type = CHARTAB_RANGE_CHAR; + + for (i = 0, retval = 0; i < 256 && retval == 0; i++) + { + if (ct->property[i] == BT_UINT16_unloaded) + { + c1 = c + unit; + } + else if (ct->property[i] != BT_UINT16_unbound) + { + c1 = c + unit; + for (; c < c1 && retval == 0; c++) + { + Fput_database (Fprin1_to_string (make_char (c), Qnil), + Fprin1_to_string (UINT16_DECODE (ct->property[i]), + Qnil), + db, Qt); + } + } + else + c += unit; + } +} +#endif + static Lisp_Object mark_byte_table (Lisp_Object obj) @@ -604,6 +763,37 @@ make_byte_table (Lisp_Object initval) return obj; } +static Lisp_Object +copy_byte_table (Lisp_Object entry) +{ + Lisp_Byte_Table *cte = XBYTE_TABLE (entry); + Lisp_Object obj; + int i; + Lisp_Byte_Table *ctnew + = alloc_lcrecord_type (Lisp_Byte_Table, &lrecord_byte_table); + + for (i = 0; i < 256; i++) + { + if (UINT8_BYTE_TABLE_P (cte->property[i])) + { + ctnew->property[i] = copy_uint8_byte_table (cte->property[i]); + } + else if (UINT16_BYTE_TABLE_P (cte->property[i])) + { + ctnew->property[i] = copy_uint16_byte_table (cte->property[i]); + } + else if (BYTE_TABLE_P (cte->property[i])) + { + ctnew->property[i] = copy_byte_table (cte->property[i]); + } + else + ctnew->property[i] = cte->property[i]; + } + + XSETBYTE_TABLE (obj, ctnew); + return obj; +} + static int byte_table_same_value_p (Lisp_Object obj) { @@ -620,8 +810,8 @@ byte_table_same_value_p (Lisp_Object obj) } static int -map_over_byte_table (Lisp_Byte_Table *ct, Emchar ofs, int place, - Lisp_Object ccs, +map_over_byte_table (Lisp_Byte_Table *ct, Lisp_Char_Table* root, + Emchar ofs, int place, int (*fn) (struct chartab_range *range, Lisp_Object val, void *arg), void *arg) @@ -637,25 +827,26 @@ map_over_byte_table (Lisp_Byte_Table *ct, Emchar ofs, int place, if (UINT8_BYTE_TABLE_P (v)) { retval - = map_over_uint8_byte_table (XUINT8_BYTE_TABLE(v), - c, place - 1, ccs, fn, arg); + = map_over_uint8_byte_table (XUINT8_BYTE_TABLE(v), root, + c, place - 1, fn, arg); c += unit; } else if (UINT16_BYTE_TABLE_P (v)) { retval - = map_over_uint16_byte_table (XUINT16_BYTE_TABLE(v), - c, place - 1, ccs, fn, arg); + = map_over_uint16_byte_table (XUINT16_BYTE_TABLE(v), root, + c, place - 1, fn, arg); c += unit; } else if (BYTE_TABLE_P (v)) { - retval = map_over_byte_table (XBYTE_TABLE(v), - c, place - 1, ccs, fn, arg); + retval = map_over_byte_table (XBYTE_TABLE(v), root, + c, place - 1, fn, arg); c += unit; } - else if (!UNBOUNDP (v)) + else if (EQ (v, Qunloaded)) { +#if 0 struct chartab_range rainj; Emchar c1 = c + unit; @@ -663,12 +854,31 @@ map_over_byte_table (Lisp_Byte_Table *ct, Emchar ofs, int place, for (; c < c1 && retval == 0; c++) { - if ( NILP (ccs) || charset_code_point (ccs, c) >= 0 ) + Lisp_Object ret = get_char_id_table (root, c); + + if (!UNBOUNDP (ret)) { rainj.ch = c; - retval = (fn) (&rainj, v, arg); + retval = (fn) (&rainj, ret, arg); } } +#else + ct->property[i] = Qunbound; + c += unit; +#endif + } + else if (!UNBOUNDP (v)) + { + struct chartab_range rainj; + Emchar c1 = c + unit; + + rainj.type = CHARTAB_RANGE_CHAR; + + for (; c < c1 && retval == 0; c++) + { + rainj.ch = c; + retval = (fn) (&rainj, v, arg); + } } else c += unit; @@ -676,10 +886,61 @@ map_over_byte_table (Lisp_Byte_Table *ct, Emchar ofs, int place, return retval; } +#ifdef HAVE_DATABASE +static void +save_byte_table (Lisp_Byte_Table *ct, Lisp_Char_Table* root, + Lisp_Object db, + Emchar ofs, int place) +{ + int i, retval; + Lisp_Object v; + int unit = 1 << (8 * place); + Emchar c = ofs; + + for (i = 0, retval = 0; i < 256 && retval == 0; i++) + { + v = ct->property[i]; + if (UINT8_BYTE_TABLE_P (v)) + { + save_uint8_byte_table (XUINT8_BYTE_TABLE(v), root, db, + c, place - 1); + c += unit; + } + else if (UINT16_BYTE_TABLE_P (v)) + { + save_uint16_byte_table (XUINT16_BYTE_TABLE(v), root, db, + c, place - 1); + c += unit; + } + else if (BYTE_TABLE_P (v)) + { + save_byte_table (XBYTE_TABLE(v), root, db, + c, place - 1); + c += unit; + } + else if (EQ (v, Qunloaded)) + { + c += unit; + } + else if (!UNBOUNDP (v)) + { + struct chartab_range rainj; + Emchar c1 = c + unit; + + rainj.type = CHARTAB_RANGE_CHAR; -Lisp_Object get_byte_table (Lisp_Object table, unsigned char idx); -Lisp_Object put_byte_table (Lisp_Object table, unsigned char idx, - Lisp_Object value); + for (; c < c1 && retval == 0; c++) + { + Fput_database (Fprin1_to_string (make_char (c), Qnil), + Fprin1_to_string (v, Qnil), + db, Qt); + } + } + else + c += unit; + } +} +#endif Lisp_Object get_byte_table (Lisp_Object table, unsigned char idx) @@ -775,400 +1036,38 @@ put_byte_table (Lisp_Object table, unsigned char idx, Lisp_Object value) } else if (UINT16_VALUE_P (table) && UINT16_VALUE_P (value)) { - table = make_uint16_byte_table (UINT16_ENCODE (table)); - XUINT16_BYTE_TABLE(table)->property[idx] = UINT16_ENCODE (value); - } - else - { - table = make_byte_table (table); - XBYTE_TABLE(table)->property[idx] = value; - } - } - return table; -} - -static Lisp_Object -mark_char_id_table (Lisp_Object obj) -{ - Lisp_Char_ID_Table *cte = XCHAR_ID_TABLE (obj); - - return cte->table; -} - -static void -print_char_id_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) -{ - Lisp_Object table = XCHAR_ID_TABLE (obj)->table; - int i; - struct gcpro gcpro1, gcpro2; - GCPRO2 (obj, printcharfun); - - write_c_string ("#", printcharfun); -} - -static int -char_id_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) -{ - Lisp_Object table1 = XCHAR_ID_TABLE (obj1)->table; - Lisp_Object table2 = XCHAR_ID_TABLE (obj2)->table; - int i; - - for (i = 0; i < 256; i++) - { - if (!internal_equal (get_byte_table (table1, i), - get_byte_table (table2, i), 0)) - return 0; - } - return -1; -} - -static unsigned long -char_id_table_hash (Lisp_Object obj, int depth) -{ - Lisp_Char_ID_Table *cte = XCHAR_ID_TABLE (obj); - - return char_id_table_hash (cte->table, depth + 1); -} - -static const struct lrecord_description char_id_table_description[] = { - { XD_LISP_OBJECT, offsetof(Lisp_Char_ID_Table, table) }, - { XD_END } -}; - -DEFINE_LRECORD_IMPLEMENTATION ("char-id-table", char_id_table, - mark_char_id_table, - print_char_id_table, - 0, char_id_table_equal, - char_id_table_hash, - char_id_table_description, - Lisp_Char_ID_Table); - -Lisp_Object -make_char_id_table (Lisp_Object initval) -{ - Lisp_Object obj; - Lisp_Char_ID_Table *cte; - - cte = alloc_lcrecord_type (Lisp_Char_ID_Table, &lrecord_char_id_table); - - cte->table = make_byte_table (initval); - - XSETCHAR_ID_TABLE (obj, cte); - return obj; -} - - -Lisp_Object -get_char_id_table (Lisp_Char_ID_Table* cit, Emchar ch) -{ - unsigned int code = ch; - - return get_byte_table (get_byte_table - (get_byte_table - (get_byte_table - (cit->table, - (unsigned char)(code >> 24)), - (unsigned char) (code >> 16)), - (unsigned char) (code >> 8)), - (unsigned char) code); -} - -INLINE_HEADER void -put_char_id_table_0 (Lisp_Char_ID_Table* cit, Emchar code, Lisp_Object value); -INLINE_HEADER void -put_char_id_table_0 (Lisp_Char_ID_Table* cit, Emchar code, Lisp_Object value) -{ - Lisp_Object table1, table2, table3, table4; - - table1 = cit->table; - table2 = get_byte_table (table1, (unsigned char)(code >> 24)); - table3 = get_byte_table (table2, (unsigned char)(code >> 16)); - table4 = get_byte_table (table3, (unsigned char)(code >> 8)); - - table4 = put_byte_table (table4, (unsigned char) code, value); - table3 = put_byte_table (table3, (unsigned char)(code >> 8), table4); - table2 = put_byte_table (table2, (unsigned char)(code >> 16), table3); - cit->table = put_byte_table (table1, (unsigned char)(code >> 24), table2); -} - -void -put_char_id_table (Lisp_Char_ID_Table* cit, - Lisp_Object character, Lisp_Object value) -{ - struct chartab_range range; - - decode_char_table_range (character, &range); - switch (range.type) - { - case CHARTAB_RANGE_ALL: - cit->table = value; - break; - case CHARTAB_RANGE_CHARSET: - { - Emchar c; - Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (range.charset); - - if ( CHAR_ID_TABLE_P (encoding_table) ) - { - for (c = 0; c < 1 << 24; c++) - { - if ( INTP (get_char_id_table (XCHAR_ID_TABLE(encoding_table), - c)) ) - put_char_id_table_0 (cit, c, value); - } - } - else - { - for (c = 0; c < 1 << 24; c++) - { - if ( charset_code_point (range.charset, c) >= 0 ) - put_char_id_table_0 (cit, c, value); - } - } - } - break; - case CHARTAB_RANGE_ROW: - { - int cell_min, cell_max, i; - - if (XCHARSET_DIMENSION (range.charset) < 2) - signal_simple_error ("Charset in row vector must be multi-byte", - range.charset); - else - { - switch (XCHARSET_CHARS (range.charset)) - { - case 94: - cell_min = 33; cell_max = 126; - break; - case 96: - cell_min = 32; cell_max = 127; - break; - case 128: - cell_min = 0; cell_max = 127; - break; - case 256: - cell_min = 0; cell_max = 255; - break; - default: - abort (); - } - } - if (XCHARSET_DIMENSION (range.charset) == 2) - check_int_range (range.row, cell_min, cell_max); - else if (XCHARSET_DIMENSION (range.charset) == 3) - { - check_int_range (range.row >> 8 , cell_min, cell_max); - check_int_range (range.row & 0xFF, cell_min, cell_max); - } - else if (XCHARSET_DIMENSION (range.charset) == 4) - { - check_int_range ( range.row >> 16 , cell_min, cell_max); - check_int_range ((range.row >> 8) & 0xFF, cell_min, cell_max); - check_int_range ( range.row & 0xFF, cell_min, cell_max); - } - else - abort (); - - for (i = cell_min; i <= cell_max; i++) - { - Emchar ch = DECODE_CHAR (range.charset, (range.row << 8) | i); - if ( charset_code_point (range.charset, ch) >= 0 ) - put_char_id_table_0 (cit, ch, value); - } - } - break; - case CHARTAB_RANGE_CHAR: - put_char_id_table_0 (cit, range.ch, value); - break; - } -} - -/* Map FN (with client data ARG) in char table CT. - Mapping stops the first time FN returns non-zero, and that value - becomes the return value of map_char_id_table(). */ -int -map_char_id_table (Lisp_Char_ID_Table *ct, - struct chartab_range *range, - int (*fn) (struct chartab_range *range, - Lisp_Object val, void *arg), - void *arg) -{ - Lisp_Object v = ct->table; - - switch (range->type) - { - case CHARTAB_RANGE_ALL: - if (UINT8_BYTE_TABLE_P (v)) - return map_over_uint8_byte_table (XUINT8_BYTE_TABLE(v), 0, 3, - Qnil, fn, arg); - else if (UINT16_BYTE_TABLE_P (v)) - return map_over_uint16_byte_table (XUINT16_BYTE_TABLE(v), 0, 3, - Qnil, fn, arg); - else if (BYTE_TABLE_P (v)) - return map_over_byte_table (XBYTE_TABLE(v), 0, 3, Qnil, fn, arg); - else if (!UNBOUNDP (v)) - { - struct chartab_range rainj; - int unit = 1 << 24; - Emchar c = 0; - Emchar c1 = c + unit; - int retval; - - rainj.type = CHARTAB_RANGE_CHAR; - - for (retval = 0; c < c1 && retval == 0; c++) - { - rainj.ch = c; - retval = (fn) (&rainj, v, arg); - } - } - return 0; - case CHARTAB_RANGE_CHARSET: - if (UINT8_BYTE_TABLE_P (v)) - return map_over_uint8_byte_table (XUINT8_BYTE_TABLE(v), 0, 3, - range->charset, fn, arg); - else if (UINT16_BYTE_TABLE_P (v)) - return map_over_uint16_byte_table (XUINT16_BYTE_TABLE(v), 0, 3, - range->charset, fn, arg); - else if (BYTE_TABLE_P (v)) - return map_over_byte_table (XBYTE_TABLE(v), 0, 3, - range->charset, fn, arg); - else if (!UNBOUNDP (v)) + table = make_uint16_byte_table (UINT16_ENCODE (table)); + XUINT16_BYTE_TABLE(table)->property[idx] = UINT16_ENCODE (value); + } + else { - struct chartab_range rainj; - int unit = 1 << 24; - Emchar c = 0; - Emchar c1 = c + unit; - int retval; - - rainj.type = CHARTAB_RANGE_CHAR; - - for (retval = 0; c < c1 && retval == 0; c++) - { - if ( charset_code_point (range->charset, c) >= 0 ) - { - rainj.ch = c; - retval = (fn) (&rainj, v, arg); - } - } + table = make_byte_table (table); + XBYTE_TABLE(table)->property[idx] = value; } - return 0; - case CHARTAB_RANGE_ROW: - { - int cell_min, cell_max, i; - int retval; - struct chartab_range rainj; - - if (XCHARSET_DIMENSION (range->charset) < 2) - signal_simple_error ("Charset in row vector must be multi-byte", - range->charset); - else - { - switch (XCHARSET_CHARS (range->charset)) - { - case 94: - cell_min = 33; cell_max = 126; - break; - case 96: - cell_min = 32; cell_max = 127; - break; - case 128: - cell_min = 0; cell_max = 127; - break; - case 256: - cell_min = 0; cell_max = 255; - break; - default: - abort (); - } - } - if (XCHARSET_DIMENSION (range->charset) == 2) - check_int_range (range->row, cell_min, cell_max); - else if (XCHARSET_DIMENSION (range->charset) == 3) - { - check_int_range (range->row >> 8 , cell_min, cell_max); - check_int_range (range->row & 0xFF, cell_min, cell_max); - } - else if (XCHARSET_DIMENSION (range->charset) == 4) - { - check_int_range ( range->row >> 16 , cell_min, cell_max); - check_int_range ((range->row >> 8) & 0xFF, cell_min, cell_max); - check_int_range ( range->row & 0xFF, cell_min, cell_max); - } - else - abort (); + } + return table; +} - rainj.type = CHARTAB_RANGE_CHAR; - for (retval =0, i = cell_min; i <= cell_max && retval == 0; i++) - { - Emchar ch = DECODE_CHAR (range->charset, (range->row << 8) | i); - Lisp_Object val - = get_byte_table (get_byte_table - (get_byte_table - (get_byte_table - (v, - (unsigned char)(ch >> 24)), - (unsigned char) (ch >> 16)), - (unsigned char) (ch >> 8)), - (unsigned char) ch); - - if (!UNBOUNDP (val)) - { - rainj.ch = ch; - retval = (fn) (&rainj, val, arg); - } - } - return retval; - } - case CHARTAB_RANGE_CHAR: - { - Emchar ch = range->ch; - Lisp_Object val - = get_byte_table (get_byte_table - (get_byte_table - (get_byte_table - (v, - (unsigned char)(ch >> 24)), - (unsigned char) (ch >> 16)), - (unsigned char) (ch >> 8)), - (unsigned char) ch); - struct chartab_range rainj; - if (!UNBOUNDP (val)) - { - rainj.type = CHARTAB_RANGE_CHAR; - rainj.ch = ch; - return (fn) (&rainj, val, arg); - } - else - return 0; - } - default: - abort (); - } - return 0; +Lisp_Object +make_char_id_table (Lisp_Object initval) +{ + Lisp_Object obj; + obj = Fmake_char_table (Qgeneric); + fill_char_table (XCHAR_TABLE (obj), initval); + return obj; } -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; +Lisp_Object Q_ucs_variants; Lisp_Object Qcompat; Lisp_Object Qisolated; Lisp_Object Qinitial; @@ -1236,33 +1135,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_ID_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_ID_TABLE_P (ret)) - return ret; - else - return Qt; - } - else if (!CONSP (rest)) - break; - else if (CHAR_ID_TABLE_P (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, /* @@ -1270,10 +1161,15 @@ Return variants of CHARACTER. */ (character)) { + Lisp_Object ret; + CHECK_CHAR (character); - return Fcopy_list (get_char_id_table - (XCHAR_ID_TABLE(Vcharacter_variant_table), - XCHAR (character))); + ret = get_char_id_table (XCHAR_TABLE(Vcharacter_variant_table), + XCHAR(character)); + if (CONSP (ret)) + return Fcopy_list (ret); + else + return Qnil; } #endif @@ -1313,7 +1209,7 @@ Return variants of CHARACTER. /* Char Table object */ /************************************************************************/ -#ifdef MULE +#if defined(MULE)&&!defined(UTF2000) static Lisp_Object mark_char_table_entry (Lisp_Object obj) @@ -1367,6 +1263,12 @@ static Lisp_Object mark_char_table (Lisp_Object obj) { Lisp_Char_Table *ct = XCHAR_TABLE (obj); +#ifdef UTF2000 + + mark_object (ct->table); + mark_object (ct->name); + mark_object (ct->db); +#else int i; for (i = 0; i < NUM_ASCII_CHARS; i++) @@ -1375,7 +1277,12 @@ mark_char_table (Lisp_Object obj) for (i = 0; i < NUM_LEADING_BYTES; i++) mark_object (ct->level1[i]); #endif +#endif +#ifdef UTF2000 + return ct->default_value; +#else return ct->mirror_table; +#endif } /* WARNING: All functions of this nature need to be written extremely @@ -1457,7 +1364,7 @@ print_chartab_range (Emchar first, Emchar last, Lisp_Object val, print_internal (val, printcharfun, 1); } -#ifdef MULE +#if defined(MULE)&&!defined(UTF2000) static void print_chartab_charset_row (Lisp_Object charset, @@ -1541,6 +1448,30 @@ static void print_char_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) { Lisp_Char_Table *ct = XCHAR_TABLE (obj); +#ifdef UTF2000 + int i; + struct gcpro gcpro1, gcpro2; + GCPRO2 (obj, printcharfun); + + write_c_string ("#s(char-table ", printcharfun); + write_c_string (" ", printcharfun); + write_c_string (string_data + (symbol_name + (XSYMBOL (char_table_type_to_symbol (ct->type)))), + printcharfun); + write_c_string ("\n ", printcharfun); + print_internal (ct->default_value, printcharfun, escapeflag); + for (i = 0; i < 256; i++) + { + Lisp_Object elt = get_byte_table (ct->table, i); + if (i != 0) write_c_string ("\n ", printcharfun); + if (EQ (elt, Qunbound)) + write_c_string ("void", printcharfun); + else + print_internal (elt, printcharfun, escapeflag); + } + UNGCPRO; +#else /* non UTF2000 */ char buf[200]; sprintf (buf, "#s(char-table type %s data (", @@ -1607,6 +1538,7 @@ print_char_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) } } #endif /* MULE */ +#endif /* non UTF2000 */ write_c_string ("))", printcharfun); } @@ -1621,6 +1553,14 @@ char_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) if (CHAR_TABLE_TYPE (ct1) != CHAR_TABLE_TYPE (ct2)) return 0; +#ifdef UTF2000 + for (i = 0; i < 256; i++) + { + if (!internal_equal (get_byte_table (ct1->table, i), + get_byte_table (ct2->table, i), 0)) + return 0; + } +#else for (i = 0; i < NUM_ASCII_CHARS; i++) if (!internal_equal (ct1->ascii[i], ct2->ascii[i], depth + 1)) return 0; @@ -1630,6 +1570,7 @@ char_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) if (!internal_equal (ct1->level1[i], ct2->level1[i], depth + 1)) return 0; #endif /* MULE */ +#endif /* non UTF2000 */ return 1; } @@ -1638,6 +1579,9 @@ static unsigned long char_table_hash (Lisp_Object obj, int depth) { Lisp_Char_Table *ct = XCHAR_TABLE (obj); +#ifdef UTF2000 + return byte_table_hash (ct->table, depth + 1); +#else unsigned long hashval = internal_array_hash (ct->ascii, NUM_ASCII_CHARS, depth); #ifdef MULE @@ -1645,14 +1589,24 @@ char_table_hash (Lisp_Object obj, int depth) internal_array_hash (ct->level1, NUM_LEADING_BYTES, depth)); #endif /* MULE */ return hashval; +#endif } static const struct lrecord_description char_table_description[] = { +#ifdef UTF2000 + { 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) }, +#else { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, ascii), NUM_ASCII_CHARS }, #ifdef MULE { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, level1), NUM_LEADING_BYTES }, #endif +#endif +#ifndef UTF2000 { XD_LISP_OBJECT, offsetof (Lisp_Char_Table, mirror_table) }, +#endif { XD_LO_LINK, offsetof (Lisp_Char_Table, next_table) }, { XD_END } }; @@ -1766,6 +1720,11 @@ See `valid-char-table-type-p'. void fill_char_table (Lisp_Char_Table *ct, Lisp_Object value) { +#ifdef UTF2000 + ct->table = Qunbound; + ct->default_value = value; + ct->unloaded = 0; +#else int i; for (i = 0; i < NUM_ASCII_CHARS; i++) @@ -1774,9 +1733,12 @@ fill_char_table (Lisp_Char_Table *ct, Lisp_Object value) for (i = 0; i < NUM_LEADING_BYTES; i++) ct->level1[i] = value; #endif /* MULE */ +#endif +#ifndef UTF2000 if (ct->type == CHAR_TABLE_TYPE_SYNTAX) update_syntax_table (ct); +#endif } DEFUN ("reset-char-table", Freset_char_table, 1, 1, 0, /* @@ -1826,6 +1788,7 @@ and 'syntax. See `valid-char-table-type-p'. ct = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table); ct->type = ty; +#ifndef UTF2000 if (ty == CHAR_TABLE_TYPE_SYNTAX) { ct->mirror_table = Fmake_char_table (Qgeneric); @@ -1834,6 +1797,10 @@ and 'syntax. See `valid-char-table-type-p'. } else ct->mirror_table = Qnil; +#else + ct->name = Qnil; + ct->db = Qnil; +#endif ct->next_table = Qnil; XSETCHAR_TABLE (obj, ct); if (ty == CHAR_TABLE_TYPE_SYNTAX) @@ -1845,7 +1812,7 @@ and 'syntax. See `valid-char-table-type-p'. return obj; } -#ifdef MULE +#if defined(MULE)&&!defined(UTF2000) static Lisp_Object make_char_table_entry (Lisp_Object initval) @@ -1895,12 +1862,35 @@ as CHAR-TABLE. The values will not themselves be copied. { Lisp_Char_Table *ct, *ctnew; Lisp_Object obj; +#ifndef UTF2000 int i; +#endif CHECK_CHAR_TABLE (char_table); ct = XCHAR_TABLE (char_table); ctnew = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table); ctnew->type = ct->type; +#ifdef UTF2000 + ctnew->default_value = ct->default_value; + /* [tomo:2002-01-21] Perhaps this code seems wrong */ + ctnew->name = ct->name; + ctnew->db = ct->db; + + if (UINT8_BYTE_TABLE_P (ct->table)) + { + ctnew->table = copy_uint8_byte_table (ct->table); + } + else if (UINT16_BYTE_TABLE_P (ct->table)) + { + ctnew->table = copy_uint16_byte_table (ct->table); + } + else if (BYTE_TABLE_P (ct->table)) + { + ctnew->table = copy_byte_table (ct->table); + } + else if (!UNBOUNDP (ct->table)) + ctnew->table = ct->table; +#else /* non UTF2000 */ for (i = 0; i < NUM_ASCII_CHARS; i++) { @@ -1923,11 +1913,14 @@ as CHAR-TABLE. The values will not themselves be copied. } #endif /* MULE */ +#endif /* non UTF2000 */ +#ifndef UTF2000 if (CHAR_TABLEP (ct->mirror_table)) ctnew->mirror_table = Fcopy_char_table (ct->mirror_table); else ctnew->mirror_table = ct->mirror_table; +#endif ctnew->next_table = Qnil; XSETCHAR_TABLE (obj, ctnew); if (ctnew->type == CHAR_TABLE_TYPE_SYNTAX) @@ -1938,11 +1931,38 @@ as CHAR-TABLE. The values will not themselves be copied. return obj; } -static void +INLINE_HEADER int XCHARSET_CELL_RANGE (Lisp_Object ccs); +INLINE_HEADER int +XCHARSET_CELL_RANGE (Lisp_Object ccs) +{ + switch (XCHARSET_CHARS (ccs)) + { + case 94: + return (33 << 8) | 126; + case 96: + return (32 << 8) | 127; +#ifdef UTF2000 + case 128: + return (0 << 8) | 127; + case 256: + return (0 << 8) | 255; +#endif + default: + abort (); + return 0; + } +} + +#ifndef UTF2000 +static +#endif +void decode_char_table_range (Lisp_Object range, struct chartab_range *outrange) { if (EQ (range, Qt)) outrange->type = CHARTAB_RANGE_ALL; + else if (EQ (range, Qnil)) + outrange->type = CHARTAB_RANGE_DEFAULT; else if (CHAR_OR_CHAR_INTP (range)) { outrange->type = CHARTAB_RANGE_CHAR; @@ -1956,30 +1976,39 @@ decode_char_table_range (Lisp_Object range, struct chartab_range *outrange) { Lisp_Vector *vec = XVECTOR (range); Lisp_Object *elts = vector_data (vec); - if (vector_length (vec) != 2) - signal_simple_error ("Length of charset row vector must be 2", - range); + int cell_min, cell_max; + outrange->type = CHARTAB_RANGE_ROW; outrange->charset = Fget_charset (elts[0]); CHECK_INT (elts[1]); outrange->row = XINT (elts[1]); - if (XCHARSET_DIMENSION (outrange->charset) >= 2) + if (XCHARSET_DIMENSION (outrange->charset) < 2) + signal_simple_error ("Charset in row vector must be multi-byte", + outrange->charset); + else { - switch (XCHARSET_CHARS (outrange->charset)) - { - case 94: - check_int_range (outrange->row, 33, 126); - break; - case 96: - check_int_range (outrange->row, 32, 127); - break; - default: - abort (); - } + int ret = XCHARSET_CELL_RANGE (outrange->charset); + + cell_min = ret >> 8; + cell_max = ret & 0xFF; + } + if (XCHARSET_DIMENSION (outrange->charset) == 2) + check_int_range (outrange->row, cell_min, cell_max); +#ifdef UTF2000 + else if (XCHARSET_DIMENSION (outrange->charset) == 3) + { + check_int_range (outrange->row >> 8 , cell_min, cell_max); + check_int_range (outrange->row & 0xFF, cell_min, cell_max); + } + else if (XCHARSET_DIMENSION (outrange->charset) == 4) + { + check_int_range ( outrange->row >> 16 , cell_min, cell_max); + check_int_range ((outrange->row >> 8) & 0xFF, cell_min, cell_max); + check_int_range ( outrange->row & 0xFF, cell_min, cell_max); } +#endif else - signal_simple_error ("Charset in row vector must be multi-byte", - outrange->charset); + abort (); } else { @@ -1992,7 +2021,7 @@ decode_char_table_range (Lisp_Object range, struct chartab_range *outrange) #endif /* MULE */ } -#ifdef MULE +#if defined(MULE)&&!defined(UTF2000) /* called from CHAR_TABLE_VALUE(). */ Lisp_Object @@ -2034,7 +2063,9 @@ get_non_ascii_char_table_value (Lisp_Char_Table *ct, Charset_ID leading_byte, Lisp_Object get_char_table (Emchar ch, Lisp_Char_Table *ct) { -#ifdef MULE +#ifdef UTF2000 + return get_char_id_table (ct, ch); +#elif defined(MULE) { Lisp_Object charset; int byte1, byte2; @@ -2102,6 +2133,16 @@ If there is more than one value, return MULTI (defaults to nil). { case CHARTAB_RANGE_ALL: { +#ifdef UTF2000 + if (UINT8_BYTE_TABLE_P (ct->table)) + return multi; + else if (UINT16_BYTE_TABLE_P (ct->table)) + return multi; + else if (BYTE_TABLE_P (ct->table)) + return multi; + else + return ct->table; +#else /* non UTF2000 */ int i; Lisp_Object first = ct->ascii[0]; @@ -2123,10 +2164,14 @@ If there is more than one value, return MULTI (defaults to nil). #endif /* MULE */ return first; +#endif /* non UTF2000 */ } #ifdef MULE case CHARTAB_RANGE_CHARSET: +#ifdef UTF2000 + return multi; +#else if (EQ (rainj.charset, Vcharset_ascii)) { int i; @@ -2156,8 +2201,12 @@ If there is more than one value, return MULTI (defaults to nil). return multi; return val; } +#endif case CHARTAB_RANGE_ROW: +#ifdef UTF2000 + return multi; +#else { Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (rainj.charset) - MIN_LEADING_BYTE]; @@ -2168,6 +2217,7 @@ If there is more than one value, return MULTI (defaults to nil). return multi; return val; } +#endif /* not UTF2000 */ #endif /* not MULE */ default: @@ -2271,6 +2321,22 @@ Signal an error if VALUE is not a valid value for CHAR-TABLE-TYPE. return Qnil; } +#ifdef UTF2000 +Lisp_Char_Table* char_attribute_table_to_put; +Lisp_Object Qput_char_table_map_function; +Lisp_Object value_to_put; + +DEFUN ("put-char-table-map-function", + Fput_char_table_map_function, 2, 2, 0, /* +For internal use. Don't use it. +*/ + (c, value)) +{ + put_char_id_table_0 (char_attribute_table_to_put, c, value_to_put); + return Qnil; +} +#endif + /* Assign VAL to all characters in RANGE in char table CT. */ void @@ -2280,12 +2346,54 @@ 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. */ +#ifdef UTF2000 + case CHARTAB_RANGE_DEFAULT: + ct->default_value = val; + return; +#endif + #ifdef MULE case CHARTAB_RANGE_CHARSET: +#ifdef UTF2000 + { + Emchar c; + 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) ) + { +#if 1 + char_attribute_table_to_put = ct; + value_to_put = val; + Fmap_char_attribute (Qput_char_table_map_function, + XCHAR_TABLE_NAME (encoding_table), + Qnil); +#else + for (c = 0; c < 1 << 24; c++) + { + if ( INTP (get_char_id_table (XCHAR_TABLE(encoding_table), + c)) ) + put_char_id_table_0 (ct, c, val); + } +#endif + } + else + { + for (c = 0; c < 1 << 24; c++) + { + if ( charset_code_point (range->charset, c) >= 0 ) + put_char_id_table_0 (ct, c, val); + } + } + } +#else if (EQ (range->charset, Vcharset_ascii)) { int i; @@ -2303,9 +2411,26 @@ put_char_table (Lisp_Char_Table *ct, struct chartab_range *range, int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE; ct->level1[lb] = val; } +#endif break; case CHARTAB_RANGE_ROW: +#ifdef UTF2000 + { + int cell_min, cell_max, i; + + i = XCHARSET_CELL_RANGE (range->charset); + cell_min = i >> 8; + cell_max = i & 0xFF; + for (i = cell_min; i <= cell_max; i++) + { + Emchar ch = DECODE_CHAR (range->charset, (range->row << 8) | i); + + if ( charset_code_point (range->charset, ch) >= 0 ) + put_char_id_table_0 (ct, ch, val); + } + } +#else { Lisp_Char_Table_Entry *cte; int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE; @@ -2315,11 +2440,16 @@ put_char_table (Lisp_Char_Table *ct, struct chartab_range *range, cte = XCHAR_TABLE_ENTRY (ct->level1[lb]); cte->level2[range->row - 32] = val; } +#endif /* not UTF2000 */ break; #endif /* MULE */ case CHARTAB_RANGE_CHAR: -#ifdef MULE +#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) { Lisp_Object charset; int byte1, byte2; @@ -2361,8 +2491,10 @@ put_char_table (Lisp_Char_Table *ct, struct chartab_range *range, #endif /* not MULE */ } +#ifndef UTF2000 if (ct->type == CHAR_TABLE_TYPE_SYNTAX) update_syntax_table (ct); +#endif } DEFUN ("put-char-table", Fput_char_table, 3, 3, 0, /* @@ -2394,6 +2526,7 @@ See `valid-char-table-type-p'. return Qnil; } +#ifndef UTF2000 /* Map FN over the ASCII chars in CT. */ static int @@ -2539,11 +2672,57 @@ map_over_other_charset (Lisp_Char_Table *ct, Charset_ID lb, retval = map_over_charset_row (cte, charset, i, fn, arg); } - return retval; - } + return retval; + } +} + +#endif /* MULE */ +#endif /* not UTF2000 */ + +#ifdef UTF2000 +struct map_char_table_for_charset_arg +{ + int (*fn) (struct chartab_range *range, Lisp_Object val, void *arg); + Lisp_Char_Table *ct; + void *arg; +}; + +static int +map_char_table_for_charset_fun (struct chartab_range *range, + Lisp_Object val, void *arg) +{ + struct map_char_table_for_charset_arg *closure = + (struct map_char_table_for_charset_arg *) arg; + Lisp_Object ret; + + switch (range->type) + { + case CHARTAB_RANGE_ALL: + break; + + case CHARTAB_RANGE_DEFAULT: + break; + + case CHARTAB_RANGE_CHARSET: + break; + + case CHARTAB_RANGE_ROW: + break; + + case CHARTAB_RANGE_CHAR: + ret = get_char_table (range->ch, closure->ct); + if (!UNBOUNDP (ret)) + return (closure->fn) (range, ret, closure->arg); + break; + + default: + abort (); + } + + return 0; } -#endif /* MULE */ +#endif /* Map FN (with client data ARG) over range RANGE in char table CT. Mapping stops the first time FN returns non-zero, and that value @@ -2559,6 +2738,56 @@ map_char_table (Lisp_Char_Table *ct, switch (range->type) { case CHARTAB_RANGE_ALL: +#ifdef UTF2000 + if (!UNBOUNDP (ct->default_value)) + { + struct chartab_range rainj; + int retval; + + rainj.type = CHARTAB_RANGE_DEFAULT; + retval = (fn) (&rainj, ct->default_value, arg); + if (retval != 0) + return retval; + } + if (UINT8_BYTE_TABLE_P (ct->table)) + return map_over_uint8_byte_table (XUINT8_BYTE_TABLE(ct->table), ct, + 0, 3, fn, arg); + else if (UINT16_BYTE_TABLE_P (ct->table)) + return map_over_uint16_byte_table (XUINT16_BYTE_TABLE(ct->table), ct, + 0, 3, fn, arg); + else if (BYTE_TABLE_P (ct->table)) + return map_over_byte_table (XBYTE_TABLE(ct->table), ct, + 0, 3, fn, arg); + else if (EQ (ct->table, Qunloaded)) + { +#if 0 + struct chartab_range rainj; + int unit = 1 << 30; + Emchar c = 0; + Emchar c1 = c + unit; + int retval; + + rainj.type = CHARTAB_RANGE_CHAR; + + for (retval = 0; c < c1 && retval == 0; c++) + { + Lisp_Object ret = get_char_id_table (ct, c); + + if (!UNBOUNDP (ret)) + { + rainj.ch = c; + retval = (fn) (&rainj, ct->table, arg); + } + } + return retval; +#else + ct->table = Qunbound; +#endif + } + else if (!UNBOUNDP (ct->table)) + return (fn) (range, ct->table, arg); + return 0; +#else { int retval; @@ -2582,14 +2811,84 @@ map_char_table (Lisp_Char_Table *ct, #endif /* MULE */ return retval; } +#endif + +#ifdef UTF2000 + case CHARTAB_RANGE_DEFAULT: + if (!UNBOUNDP (ct->default_value)) + return (fn) (range, ct->default_value, arg); + return 0; +#endif #ifdef MULE case CHARTAB_RANGE_CHARSET: +#ifdef UTF2000 + { + Lisp_Object encoding_table + = XCHARSET_ENCODING_TABLE (range->charset); + + if (!NILP (encoding_table)) + { + struct chartab_range rainj; + struct map_char_table_for_charset_arg mcarg; + +#ifdef HAVE_DATABASE + if (XCHAR_TABLE_UNLOADED(encoding_table)) + Fload_char_attribute_table (XCHAR_TABLE_NAME (encoding_table)); +#endif + mcarg.fn = fn; + mcarg.ct = ct; + mcarg.arg = arg; + rainj.type = CHARTAB_RANGE_ALL; + return map_char_table (XCHAR_TABLE(encoding_table), + &rainj, + &map_char_table_for_charset_fun, + &mcarg); + } + } + return 0; +#else return map_over_other_charset (ct, XCHARSET_LEADING_BYTE (range->charset), fn, arg); +#endif case CHARTAB_RANGE_ROW: +#ifdef UTF2000 + { + int cell_min, cell_max, i; + int retval; + struct chartab_range rainj; + + i = XCHARSET_CELL_RANGE (range->charset); + cell_min = i >> 8; + cell_max = i & 0xFF; + rainj.type = CHARTAB_RANGE_CHAR; + for (retval =0, i = cell_min; i <= cell_max && retval == 0; i++) + { + Emchar ch = DECODE_CHAR (range->charset, (range->row << 8) | i); + + if ( charset_code_point (range->charset, ch) >= 0 ) + { + Lisp_Object val + = get_byte_table (get_byte_table + (get_byte_table + (get_byte_table + (ct->table, + (unsigned char)(ch >> 24)), + (unsigned char) (ch >> 16)), + (unsigned char) (ch >> 8)), + (unsigned char) ch); + + if (UNBOUNDP (val)) + val = ct->default_value; + rainj.ch = ch; + retval = (fn) (&rainj, val, arg); + } + } + return retval; + } +#else { Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE]; @@ -2607,17 +2906,23 @@ map_char_table (Lisp_Char_Table *ct, range->charset, range->row, fn, arg); } +#endif /* not UTF2000 */ #endif /* MULE */ case CHARTAB_RANGE_CHAR: { Emchar ch = range->ch; Lisp_Object val = CHAR_TABLE_VALUE_UNSAFE (ct, ch); - struct chartab_range rainj; - rainj.type = CHARTAB_RANGE_CHAR; - rainj.ch = ch; - return (fn) (&rainj, val, arg); + if (!UNBOUNDP (val)) + { + struct chartab_range rainj; + + rainj.type = CHARTAB_RANGE_CHAR; + rainj.ch = ch; + return (fn) (&rainj, val, arg); + } + return 0; } default: @@ -2647,6 +2952,12 @@ slow_map_char_table_fun (struct chartab_range *range, ranjarg = Qt; break; +#ifdef UTF2000 + case CHARTAB_RANGE_DEFAULT: + ranjarg = Qnil; + break; +#endif + #ifdef MULE case CHARTAB_RANGE_CHARSET: ranjarg = XCHARSET_NAME (range->charset); @@ -2774,7 +3085,8 @@ add_char_attribute_alist_mapper (Lisp_Object key, Lisp_Object value, /* This function can GC */ struct char_attribute_alist_closure *caacl = (struct char_attribute_alist_closure*) char_attribute_alist_closure; - Lisp_Object ret = get_char_id_table (XCHAR_ID_TABLE(caacl->char_id), value); + Lisp_Object ret + = get_char_id_table (XCHAR_TABLE(value), caacl->char_id); if (!UNBOUNDP (ret)) { Lisp_Object *char_attribute_alist = caacl->char_attribute_alist; @@ -2789,41 +3101,20 @@ Return the alist of attributes of CHARACTER. */ (character)) { + struct gcpro gcpro1; + struct char_attribute_alist_closure char_attribute_alist_closure; Lisp_Object alist = Qnil; - int i; CHECK_CHAR (character); - { - struct gcpro gcpro1; - struct char_attribute_alist_closure char_attribute_alist_closure; - - GCPRO1 (alist); - char_attribute_alist_closure.char_id = XCHAR (character); - char_attribute_alist_closure.char_attribute_alist = &alist; - elisp_maphash (add_char_attribute_alist_mapper, - Vchar_attribute_hash_table, - &char_attribute_alist_closure); - UNGCPRO; - } - - for (i = 0; i < countof (chlook->charset_by_leading_byte); i++) - { - Lisp_Object ccs = chlook->charset_by_leading_byte[i]; - if (!NILP (ccs)) - { - Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (ccs); - Lisp_Object cpos; + GCPRO1 (alist); + char_attribute_alist_closure.char_id = XCHAR (character); + char_attribute_alist_closure.char_attribute_alist = &alist; + elisp_maphash (add_char_attribute_alist_mapper, + Vchar_attribute_hash_table, + &char_attribute_alist_closure); + UNGCPRO; - if ( CHAR_ID_TABLE_P (encoding_table) - && INTP (cpos - = get_char_id_table (XCHAR_ID_TABLE(encoding_table), - XCHAR (character))) ) - { - alist = Fcons (Fcons (ccs, cpos), alist); - } - } - } return alist; } @@ -2833,29 +3124,21 @@ Return DEFAULT-VALUE if the value is not exist. */ (character, attribute, default_value)) { - Lisp_Object ccs; + Lisp_Object table; CHECK_CHAR (character); - if (!NILP (ccs = Ffind_charset (attribute))) - { - Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (ccs); - if (CHAR_ID_TABLE_P (encoding_table)) - return get_char_id_table (XCHAR_ID_TABLE(encoding_table), - XCHAR (character)); - } - else + if (CHARSETP (attribute)) + attribute = XCHARSET_NAME (attribute); + + table = Fgethash (attribute, Vchar_attribute_hash_table, + Qunbound); + if (!UNBOUNDP (table)) { - Lisp_Object table = Fgethash (attribute, - Vchar_attribute_hash_table, - Qunbound); - if (!UNBOUNDP (table)) - { - Lisp_Object ret = get_char_id_table (XCHAR_ID_TABLE(table), - XCHAR (character)); - if (!UNBOUNDP (ret)) - return ret; - } + Lisp_Object ret = get_char_id_table (XCHAR_TABLE(table), + XCHAR (character)); + if (!UNBOUNDP (ret)) + return ret; } return default_value; } @@ -2865,18 +3148,15 @@ Store CHARACTER's ATTRIBUTE with VALUE. */ (character, attribute, value)) { - Lisp_Object ccs; + Lisp_Object ccs = Ffind_charset (attribute); - ccs = Ffind_charset (attribute); if (!NILP (ccs)) { CHECK_CHAR (character); - return put_char_ccs_code_point (character, ccs, value); + value = put_char_ccs_code_point (character, ccs, value); } else if (EQ (attribute, Q_decomposition)) { - Lisp_Object seq; - CHECK_CHAR (character); if (!CONSP (value)) signal_simple_error ("Invalid value for ->decomposition", @@ -2884,42 +3164,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_ID_TABLE(table), - make_char (c), character); - break; + base = make_char (XINT (base)); + Fsetcar (value, base); } - else + if (INTP (modifier)) + { + modifier = make_char (XINT (modifier)); + Fsetcar (Fcdr (value), modifier); + } + if (CHARP (base)) { - ntable = get_char_id_table (XCHAR_ID_TABLE(table), c); - if (!CHAR_ID_TABLE_P (ntable)) - { - ntable = make_char_id_table (Qnil); - put_char_id_table (XCHAR_ID_TABLE(table), - make_char (c), ntable); - } - table = ntable; + 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); } } } @@ -2931,18 +3200,21 @@ Store CHARACTER's ATTRIBUTE with VALUE. { Emchar c = XINT (v); Lisp_Object ret - = get_char_id_table (XCHAR_ID_TABLE(Vcharacter_variant_table), + = get_char_id_table (XCHAR_TABLE(Vcharacter_variant_table), c); - if (NILP (Fmemq (v, ret))) + if (!CONSP (ret)) + { + put_char_id_table (XCHAR_TABLE(Vcharacter_variant_table), + make_char (c), Fcons (character, Qnil)); + } + else if (NILP (Fmemq (v, ret))) { - put_char_id_table (XCHAR_ID_TABLE(Vcharacter_variant_table), + put_char_id_table (XCHAR_TABLE(Vcharacter_variant_table), make_char (c), Fcons (character, ret)); } } - seq = make_vector (1, v); } - value = seq; } else if (EQ (attribute, Qto_ucs) || EQ (attribute, Q_ucs)) { @@ -2955,10 +3227,15 @@ Store CHARACTER's ATTRIBUTE with VALUE. c = XINT (value); - ret = get_char_id_table (XCHAR_ID_TABLE(Vcharacter_variant_table), c); - if (NILP (Fmemq (character, ret))) + ret = get_char_id_table (XCHAR_TABLE(Vcharacter_variant_table), c); + if (!CONSP (ret)) + { + put_char_id_table (XCHAR_TABLE(Vcharacter_variant_table), + make_char (c), Fcons (character, Qnil)); + } + else if (NILP (Fmemq (character, ret))) { - put_char_id_table (XCHAR_ID_TABLE(Vcharacter_variant_table), + put_char_id_table (XCHAR_TABLE(Vcharacter_variant_table), make_char (c), Fcons (character, ret)); } #if 0 @@ -2975,8 +3252,11 @@ Store CHARACTER's ATTRIBUTE with VALUE. { table = make_char_id_table (Qunbound); Fputhash (attribute, table, Vchar_attribute_hash_table); +#ifdef HAVE_DATABASE + XCHAR_TABLE_NAME (table) = attribute; +#endif } - put_char_id_table (XCHAR_ID_TABLE(table), character, value); + put_char_id_table (XCHAR_TABLE(table), character, value); return value; } } @@ -3001,12 +3281,277 @@ Remove CHARACTER's ATTRIBUTE. Qunbound); if (!UNBOUNDP (table)) { - put_char_id_table (XCHAR_ID_TABLE(table), character, Qunbound); + put_char_id_table (XCHAR_TABLE(table), character, Qunbound); + return Qt; + } + } + return Qnil; +} + +#ifdef HAVE_DATABASE +Lisp_Object +char_attribute_system_db_file (Lisp_Object key_type, Lisp_Object attribute, + int writing_mode) +{ + Lisp_Object db_dir = Vexec_directory; + + if (NILP (db_dir)) + db_dir = build_string ("../lib-src"); + + db_dir = Fexpand_file_name (build_string ("char-db"), db_dir); + if (writing_mode && NILP (Ffile_exists_p (db_dir))) + Fmake_directory_internal (db_dir); + + db_dir = Fexpand_file_name (Fsymbol_name (key_type), db_dir); + if (writing_mode && NILP (Ffile_exists_p (db_dir))) + Fmake_directory_internal (db_dir); + + { + Lisp_Object attribute_name = Fsymbol_name (attribute); + Lisp_Object dest = Qnil, ret; + int base = 0; + struct gcpro gcpro1, gcpro2; + int len = XSTRING_CHAR_LENGTH (attribute_name); + int i; + + GCPRO2 (dest, ret); + for (i = 0; i < len; i++) + { + Emchar c = string_char (XSTRING (attribute_name), i); + + if ( (c == '/') || (c == '%') ) + { + char str[4]; + + sprintf (str, "%%%02X", c); + dest = concat3 (dest, + Fsubstring (attribute_name, + make_int (base), make_int (i)), + build_string (str)); + base = i + 1; + } + } + ret = Fsubstring (attribute_name, make_int (base), make_int (len)); + dest = concat2 (dest, ret); + UNGCPRO; + return Fexpand_file_name (dest, db_dir); + } +#if 0 + 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. +*/ + (attribute)) +{ +#ifdef HAVE_DATABASE + 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; + + 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, db, 0, 3); + else if (UINT16_BYTE_TABLE_P (ct->table)) + 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, db, 0, 3); + Fclose_database (db); + return Qt; + } + else + return Qnil; +#else + return Qnil; +#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. +*/ + (attribute)) +{ +#ifdef HAVE_DATABASE + Lisp_Object table = Fgethash (attribute, + Vchar_attribute_hash_table, Qunbound); + Lisp_Char_Table *ct; + + if (CHAR_TABLEP (table)) + ct = XCHAR_TABLE (table); + else + return Qnil; + + if (!NILP (ct->db)) + { + if (!NILP (Fdatabase_live_p (ct->db))) + Fclose_database (ct->db); + ct->db = Qnil; + } +#endif + return Qnil; +} + +DEFUN ("reset-char-attribute-table", Freset_char_attribute_table, 1, 1, 0, /* +Reset values of ATTRIBUTE with database file. +*/ + (attribute)) +{ +#ifdef HAVE_DATABASE + Lisp_Object table = Fgethash (attribute, + Vchar_attribute_hash_table, Qunbound); + Lisp_Char_Table *ct; + Lisp_Object db_file + = char_attribute_system_db_file (Qsystem_char_id, attribute, 0); + + if (!NILP (Ffile_exists_p (db_file))) + { + if (UNBOUNDP (table)) + { + 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; + if (!NILP (Fdatabase_live_p (ct->db))) + Fclose_database (ct->db); + ct->db = Qnil; + XCHAR_TABLE_UNLOADED(table) = 1; + return Qt; + } +#endif + return Qnil; +} + +Lisp_Object +load_char_attribute_maybe (Lisp_Char_Table* cit, Emchar ch) +{ + Lisp_Object attribute = CHAR_TABLE_NAME (cit); + + if (!NILP (attribute)) + { + if (NILP (Fdatabase_live_p (cit->db))) + { + 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)) + { + Lisp_Object val + = Fget_database (Fprin1_to_string (make_char (ch), Qnil), + cit->db, Qunbound); + if (!UNBOUNDP (val)) + val = Fread (val); + else + val = Qunbound; + if (!NILP (Vchar_db_stingy_mode)) + { + Fclose_database (cit->db); + cit->db = Qnil; + } + return val; + } + } + return Qunbound; +} + +Lisp_Char_Table* char_attribute_table_to_load; + +Lisp_Object Qload_char_attribute_table_map_function; + +DEFUN ("load-char-attribute-table-map-function", + Fload_char_attribute_table_map_function, 2, 2, 0, /* +For internal use. Don't use it. +*/ + (key, value)) +{ + Lisp_Object c = Fread (key); + Emchar code = XCHAR (c); + 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; +} + +DEFUN ("load-char-attribute-table", Fload_char_attribute_table, 1, 1, 0, /* +Load values of ATTRIBUTE into database file. +*/ + (attribute)) +{ + Lisp_Object table = Fgethash (attribute, + Vchar_attribute_hash_table, + Qunbound); + if (CHAR_TABLEP (table)) + { + Lisp_Char_Table *ct = XCHAR_TABLE (table); + + if (NILP (Fdatabase_live_p (ct->db))) + { + Lisp_Object db_file + = char_attribute_system_db_file (Qsystem_char_id, attribute, 0); + + ct->db = Fopen_database (db_file, Qnil, Qnil, + build_string ("r"), Qnil); + } + if (!NILP (ct->db)) + { + struct gcpro gcpro1; + + char_attribute_table_to_load = XCHAR_TABLE (table); + GCPRO1 (table); + Fmap_database (Qload_char_attribute_table_map_function, ct->db); + UNGCPRO; + Fclose_database (ct->db); + ct->db = Qnil; + XCHAR_TABLE_UNLOADED(table) = 0; return Qt; } } return Qnil; } +#endif DEFUN ("map-char-attribute", Fmap_char_attribute, 2, 3, 0, /* Map FUNCTION over entries in ATTRIBUTE, calling it with two args, @@ -3019,7 +3564,7 @@ the entire table. (function, attribute, range)) { Lisp_Object ccs; - Lisp_Char_ID_Table *ct; + Lisp_Char_Table *ct; struct slow_map_char_table_arg slarg; struct gcpro gcpro1, gcpro2; struct chartab_range rainj; @@ -3028,8 +3573,8 @@ the entire table. { Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (ccs); - if (CHAR_ID_TABLE_P (encoding_table)) - ct = XCHAR_ID_TABLE (encoding_table); + if (CHAR_TABLEP (encoding_table)) + ct = XCHAR_TABLE (encoding_table); else return Qnil; } @@ -3038,26 +3583,27 @@ the entire table. Lisp_Object table = Fgethash (attribute, Vchar_attribute_hash_table, Qunbound); - if (CHAR_ID_TABLE_P (table)) - ct = XCHAR_ID_TABLE (table); + if (CHAR_TABLEP (table)) + ct = XCHAR_TABLE (table); else return Qnil; } if (NILP (range)) range = Qt; decode_char_table_range (range, &rainj); +#ifdef HAVE_DATABASE + if (CHAR_TABLE_UNLOADED(ct)) + Fload_char_attribute_table (attribute); +#endif slarg.function = function; slarg.retval = Qnil; GCPRO2 (slarg.function, slarg.retval); - map_char_id_table (ct, &rainj, slow_map_char_table_fun, &slarg); + map_char_table (ct, &rainj, slow_map_char_table_fun, &slarg); UNGCPRO; return slarg.retval; } -EXFUN (Fmake_char, 3); -EXFUN (Fdecode_char, 2); - DEFUN ("define-char", Fdefine_char, 1, 1, 0, /* Store character's ATTRIBUTES. */ @@ -3078,13 +3624,14 @@ Store character's ATTRIBUTES. signal_simple_error ("Invalid argument", attributes); if (!NILP (ccs = Ffind_charset (Fcar (cell))) && ((XCHARSET_FINAL (ccs) != 0) || - (XCHARSET_UCS_MAX (ccs) > 0)) ) + (XCHARSET_MAX_CODE (ccs) > 0) || + (EQ (ccs, Vcharset_chinese_big5))) ) { cell = Fcdr (cell); if (CONSP (cell)) character = Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell))); else - character = Fdecode_char (ccs, cell); + character = Fdecode_char (ccs, cell, Qnil); if (!NILP (character)) goto setup_attributes; } @@ -3143,7 +3690,7 @@ Retrieve the character of the given ATTRIBUTES. if (CONSP (cell)) return Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell))); else - return Fdecode_char (ccs, cell); + return Fdecode_char (ccs, cell, Qnil); } rest = Fcdr (rest); } @@ -3305,7 +3852,7 @@ check_category_table (Lisp_Object object, Lisp_Object default_) int check_category_char (Emchar ch, Lisp_Object table, - unsigned int designator, unsigned int not) + unsigned int designator, unsigned int not_p) { REGISTER Lisp_Object temp; Lisp_Char_Table *ctbl; @@ -3316,10 +3863,10 @@ check_category_char (Emchar ch, Lisp_Object table, ctbl = XCHAR_TABLE (table); temp = get_char_table (ch, ctbl); if (NILP (temp)) - return not; + return not_p; designator -= ' '; - return bit_vector_bit (XBIT_VECTOR (temp), designator) ? !not : not; + return bit_vector_bit (XBIT_VECTOR (temp), designator) ? !not_p : not_p; } DEFUN ("check-category-at", Fcheck_category_at, 2, 4, 0, /* @@ -3499,10 +4046,13 @@ syms_of_chartab (void) INIT_LRECORD_IMPLEMENTATION (uint8_byte_table); INIT_LRECORD_IMPLEMENTATION (uint16_byte_table); INIT_LRECORD_IMPLEMENTATION (byte_table); - INIT_LRECORD_IMPLEMENTATION (char_id_table); + + defsymbol (&Qsystem_char_id, "system-char-id"); 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"); @@ -3523,6 +4073,18 @@ syms_of_chartab (void) DEFSUBR (Fchar_attribute_list); 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); + defsymbol (&Qload_char_attribute_table_map_function, + "load-char-attribute-table-map-function"); + DEFSUBR (Fload_char_attribute_table_map_function); + DEFSUBR (Fload_char_attribute_table); +#endif DEFSUBR (Fchar_attribute_alist); DEFSUBR (Fget_char_attribute); DEFSUBR (Fput_char_attribute); @@ -3538,7 +4100,9 @@ syms_of_chartab (void) INIT_LRECORD_IMPLEMENTATION (char_table); #ifdef MULE +#ifndef UTF2000 INIT_LRECORD_IMPLEMENTATION (char_table_entry); +#endif defsymbol (&Qcategory_table_p, "category-table-p"); defsymbol (&Qcategory_designator_p, "category-designator-p"); @@ -3580,16 +4144,14 @@ void vars_of_chartab (void) { #ifdef UTF2000 - Vutf_2000_version = build_string("0.17 (Hōryūji)"); - DEFVAR_LISP ("utf-2000-version", &Vutf_2000_version /* -Version number of XEmacs UTF-2000. -*/ ); - - staticpro (&Vcharacter_composition_table); - Vcharacter_composition_table = make_char_id_table (Qnil); - staticpro (&Vcharacter_variant_table); - Vcharacter_variant_table = make_char_id_table (Qnil); + 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; @@ -3614,6 +4176,11 @@ 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. */