X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=src%2Fchartab.c;h=cd306198feefe4bbc8e580d7f46a78bfed8dc312;hb=4f14f955e64fbf24dd2f85fc22c2976c5aad47a0;hp=d3b8b9de3d2f0dce2991722c83a1ace9582ae5e2;hpb=b4a45788f94f698b052268e43b0b151bcfc0ea3a;p=chise%2Fxemacs-chise.git- diff --git a/src/chartab.c b/src/chartab.c index d3b8b9d..cd30619 100644 --- a/src/chartab.c +++ b/src/chartab.c @@ -67,16 +67,6 @@ Lisp_Object Vword_combining_categories, Vword_separating_categories; #ifdef UTF2000 -static void -decode_char_table_range (Lisp_Object range, struct chartab_range *outrange); - -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); - #define BT_UINT8_MIN 0 #define BT_UINT8_MAX (UCHAR_MAX - 3) #define BT_UINT8_t (UCHAR_MAX - 2) @@ -200,12 +190,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 +219,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) { @@ -242,7 +255,6 @@ 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, int (*fn) (struct chartab_range *range, Lisp_Object val, void *arg), void *arg) @@ -262,11 +274,8 @@ map_over_uint8_byte_table (Lisp_Uint8_Byte_Table *ct, Emchar ofs, int place, c1 = c + unit; for (; c < c1 && retval == 0; c++) { - if ( NILP (ccs) || charset_code_point (ccs, c) >= 0 ) - { - rainj.ch = c; - retval = (fn) (&rainj, UINT8_DECODE (ct->property[i]), arg); - } + rainj.ch = c; + retval = (fn) (&rainj, UINT8_DECODE (ct->property[i]), arg); } } else @@ -410,12 +419,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 +449,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; @@ -470,7 +502,6 @@ 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, int (*fn) (struct chartab_range *range, Lisp_Object val, void *arg), void *arg) @@ -490,12 +521,8 @@ map_over_uint16_byte_table (Lisp_Uint16_Byte_Table *ct, Emchar ofs, int place, c1 = c + unit; for (; c < c1 && retval == 0; c++) { - if ( NILP (ccs) || charset_code_point (ccs, c) >= 0 ) - { - rainj.ch = c; - retval = (fn) (&rainj, UINT16_DECODE (ct->property[i]), - arg); - } + rainj.ch = c; + retval = (fn) (&rainj, UINT16_DECODE (ct->property[i]), arg); } } else @@ -604,6 +631,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) { @@ -621,7 +679,6 @@ 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, int (*fn) (struct chartab_range *range, Lisp_Object val, void *arg), void *arg) @@ -638,20 +695,20 @@ map_over_byte_table (Lisp_Byte_Table *ct, Emchar ofs, int place, { retval = map_over_uint8_byte_table (XUINT8_BYTE_TABLE(v), - c, place - 1, ccs, fn, arg); + 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); + 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); + c, place - 1, fn, arg); c += unit; } else if (!UNBOUNDP (v)) @@ -663,11 +720,8 @@ 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 ) - { - rainj.ch = c; - retval = (fn) (&rainj, v, arg); - } + rainj.ch = c; + retval = (fn) (&rainj, v, arg); } } else @@ -677,10 +731,6 @@ map_over_byte_table (Lisp_Byte_Table *ct, Emchar ofs, int place, } -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); - Lisp_Object get_byte_table (Lisp_Object table, unsigned char idx) { @@ -787,381 +837,17 @@ put_byte_table (Lisp_Object table, unsigned char idx, Lisp_Object 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); + obj = Fmake_char_table (Qgeneric); + fill_char_table (XCHAR_TABLE (obj), initval); 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)) - { - 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); - } - } - } - 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 (); - - 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 Vcharacter_composition_table; Lisp_Object Vcharacter_variant_table; @@ -1245,19 +931,19 @@ Return character corresponding with list. Lisp_Object ret; Emchar c = to_char_id (v, "Invalid value for composition", list); - ret = get_char_id_table (XCHAR_ID_TABLE(table), c); + ret = get_char_id_table (XCHAR_TABLE(table), c); rest = Fcdr (rest); if (NILP (rest)) { - if (!CHAR_ID_TABLE_P (ret)) + if (!CHAR_TABLEP (ret)) return ret; else return Qt; } else if (!CONSP (rest)) break; - else if (CHAR_ID_TABLE_P (ret)) + else if (CHAR_TABLEP (ret)) table = ret; else signal_simple_error ("Invalid table is found with", list); @@ -1272,7 +958,7 @@ Return variants of CHARACTER. { CHECK_CHAR (character); return Fcopy_list (get_char_id_table - (XCHAR_ID_TABLE(Vcharacter_variant_table), + (XCHAR_TABLE(Vcharacter_variant_table), XCHAR (character))); } @@ -1313,7 +999,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 +1053,10 @@ static Lisp_Object mark_char_table (Lisp_Object obj) { Lisp_Char_Table *ct = XCHAR_TABLE (obj); +#ifdef UTF2000 + + mark_object (ct->table); +#else int i; for (i = 0; i < NUM_ASCII_CHARS; i++) @@ -1375,7 +1065,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 +1152,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, @@ -1533,14 +1228,38 @@ print_chartab_two_byte_charset (Lisp_Object charset, print_chartab_charset_row (charset, i, XCHAR_TABLE_ENTRY (jen), printcharfun); } -} - -#endif /* MULE */ - -static void -print_char_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) -{ - Lisp_Char_Table *ct = XCHAR_TABLE (obj); +} + +#endif /* MULE */ + +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 +1326,7 @@ print_char_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) } } #endif /* MULE */ +#endif /* non UTF2000 */ write_c_string ("))", printcharfun); } @@ -1621,6 +1341,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 +1358,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 +1367,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 +1377,22 @@ 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) }, +#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 +1506,10 @@ 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; +#else int i; for (i = 0; i < NUM_ASCII_CHARS; i++) @@ -1774,9 +1518,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 +1573,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 +1582,7 @@ and 'syntax. See `valid-char-table-type-p'. } else ct->mirror_table = Qnil; +#endif ct->next_table = Qnil; XSETCHAR_TABLE (obj, ct); if (ty == CHAR_TABLE_TYPE_SYNTAX) @@ -1845,7 +1594,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 +1644,32 @@ 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; + + 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 +1692,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 +1710,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 +1755,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 +1800,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 +1842,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 +1912,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 +1943,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 +1980,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 +1996,7 @@ If there is more than one value, return MULTI (defaults to nil). return multi; return val; } +#endif /* not UTF2000 */ #endif /* not MULE */ default: @@ -2280,12 +2109,46 @@ 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) ) + { + 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); + } + } + 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 +2166,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 +2195,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 +2246,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 +2281,7 @@ See `valid-char-table-type-p'. return Qnil; } +#ifndef UTF2000 /* Map FN over the ASCII chars in CT. */ static int @@ -2544,6 +2432,51 @@ map_over_other_charset (Lisp_Char_Table *ct, Charset_ID lb, } #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 /* 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 +2492,49 @@ 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), + 0, 3, fn, arg); + else if (UINT16_BYTE_TABLE_P (ct->table)) + return map_over_uint16_byte_table (XUINT16_BYTE_TABLE(ct->table), + 0, 3, fn, arg); + else if (BYTE_TABLE_P (ct->table)) + return map_over_byte_table (XBYTE_TABLE(ct->table), + 0, 3, fn, arg); + else if (!UNBOUNDP (ct->table)) +#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++) + { + rainj.ch = c; + retval = (fn) (&rainj, ct->table, arg); + } + return retval; + } +#else + return (fn) (range, ct->table, arg); +#endif + return 0; +#else { int retval; @@ -2582,14 +2558,80 @@ 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; + + 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 +2649,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 +2695,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 +2828,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 +2844,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 +2867,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,13 +2891,12 @@ 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)) { @@ -2906,17 +2931,17 @@ Store CHARACTER's ATTRIBUTE with VALUE. rest = Fcdr (rest); if (!CONSP (rest)) { - put_char_id_table (XCHAR_ID_TABLE(table), + put_char_id_table (XCHAR_TABLE(table), make_char (c), character); break; } else { - ntable = get_char_id_table (XCHAR_ID_TABLE(table), c); - if (!CHAR_ID_TABLE_P (ntable)) + ntable = get_char_id_table (XCHAR_TABLE(table), c); + if (!CHAR_TABLEP (ntable)) { ntable = make_char_id_table (Qnil); - put_char_id_table (XCHAR_ID_TABLE(table), + put_char_id_table (XCHAR_TABLE(table), make_char (c), ntable); } table = ntable; @@ -2931,12 +2956,12 @@ 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))) { - 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)); } } @@ -2955,10 +2980,10 @@ Store CHARACTER's ATTRIBUTE with VALUE. c = XINT (value); - ret = get_char_id_table (XCHAR_ID_TABLE(Vcharacter_variant_table), c); + ret = get_char_id_table (XCHAR_TABLE(Vcharacter_variant_table), c); 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 @@ -2976,7 +3001,7 @@ Store CHARACTER's ATTRIBUTE with VALUE. table = make_char_id_table (Qunbound); Fputhash (attribute, table, Vchar_attribute_hash_table); } - put_char_id_table (XCHAR_ID_TABLE(table), character, value); + put_char_id_table (XCHAR_TABLE(table), character, value); return value; } } @@ -3001,7 +3026,7 @@ 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; } } @@ -3019,7 +3044,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 +3053,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,8 +3063,8 @@ 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; } @@ -3049,15 +3074,12 @@ the entire table. 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 +3100,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 +3166,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 +3328,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 +3339,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,7 +3522,6 @@ 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 (&Qto_ucs, "=>ucs"); defsymbol (&Q_ucs, "->ucs"); @@ -3538,7 +3560,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,7 +3604,7 @@ void vars_of_chartab (void) { #ifdef UTF2000 - Vutf_2000_version = build_string("0.17 (Hōryūji)"); + Vutf_2000_version = build_string("0.18 (Yamato-Koizumi)"); DEFVAR_LISP ("utf-2000-version", &Vutf_2000_version /* Version number of XEmacs UTF-2000. */ );