X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=src%2Fmule-charset.c;h=222ce973345ec2189438d2c6ade7441a700527a4;hb=9816585ded614fa87be5a2ecfda6dc16c60beb2c;hp=3badc13ccfb3db09b38c82062db31274d3353675;hpb=ced41746a0d554e40ec3b760134cbe11efa61c16;p=chise%2Fxemacs-chise.git- diff --git a/src/mule-charset.c b/src/mule-charset.c index 3badc13..222ce97 100644 --- a/src/mule-charset.c +++ b/src/mule-charset.c @@ -25,6 +25,9 @@ Boston, MA 02111-1307, USA. */ /* Rewritten by Ben Wing . */ #include +#ifdef UTF2000 +#include +#endif #include "lisp.h" #include "buffer.h" @@ -159,6 +162,346 @@ const Bytecount rep_bytes_by_first_byte[0xA0] = #ifdef UTF2000 +#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 + +INLINE_HEADER int INT_UINT8_P (Lisp_Object obj); +INLINE_HEADER int UINT8_VALUE_P (Lisp_Object obj); +INLINE_HEADER unsigned char UINT8_ENCODE (Lisp_Object obj); +INLINE_HEADER Lisp_Object UINT8_DECODE (unsigned char n); +INLINE_HEADER unsigned short UINT8_TO_UINT16 (unsigned char n); + +INLINE_HEADER int +INT_UINT8_P (Lisp_Object obj) +{ + if (INTP (obj)) + { + int num = XINT (obj); + + return (BT_UINT8_MIN <= num) && (num <= BT_UINT8_MAX); + } + else + return 0; +} + +INLINE_HEADER int +UINT8_VALUE_P (Lisp_Object obj) +{ + return 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)) + return BT_UINT8_unbound; + else if (EQ (obj, Qnil)) + return BT_UINT8_nil; + else if (EQ (obj, Qt)) + return BT_UINT8_t; + else + return XINT (obj); +} + +INLINE_HEADER Lisp_Object +UINT8_DECODE (unsigned char n) +{ + if (n == BT_UINT8_unbound) + return Qunbound; + else if (n == BT_UINT8_nil) + return Qnil; + else if (n == BT_UINT8_t) + return Qt; + else + return make_int (n); +} + +static Lisp_Object +mark_uint8_byte_table (Lisp_Object obj) +{ + return Qnil; +} + +static void +print_uint8_byte_table (Lisp_Object obj, + Lisp_Object printcharfun, int escapeflag) +{ + Lisp_Uint8_Byte_Table *bte = XUINT8_BYTE_TABLE (obj); + int i; + struct gcpro gcpro1, gcpro2; + GCPRO2 (obj, printcharfun); + + write_c_string ("\n#property[i]; + if ( (i & 15) == 0 ) + write_c_string ("\n ", printcharfun); + write_c_string (" ", printcharfun); + if (n == BT_UINT8_unbound) + write_c_string ("void", printcharfun); + else if (n == BT_UINT8_nil) + write_c_string ("nil", printcharfun); + else if (n == BT_UINT8_t) + write_c_string ("t", printcharfun); + else + { + char buf[4]; + + sprintf (buf, "%hd", n); + write_c_string (buf, printcharfun); + } + } + UNGCPRO; + write_c_string (">", printcharfun); +} + +static int +uint8_byte_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) +{ + Lisp_Uint8_Byte_Table *te1 = XUINT8_BYTE_TABLE (obj1); + Lisp_Uint8_Byte_Table *te2 = XUINT8_BYTE_TABLE (obj2); + int i; + + for (i = 0; i < 256; i++) + if (te1->property[i] != te2->property[i]) + return 0; + return 1; +} + +static unsigned long +uint8_byte_table_hash (Lisp_Object obj, int depth) +{ + Lisp_Uint8_Byte_Table *te = XUINT8_BYTE_TABLE (obj); + int i; + hashcode_t hash = 0; + + for (i = 0; i < 256; i++) + hash = HASH2 (hash, te->property[i]); + return hash; +} + +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 */, + Lisp_Uint8_Byte_Table); + +static Lisp_Object +make_uint8_byte_table (unsigned char initval) +{ + Lisp_Object obj; + int i; + Lisp_Uint8_Byte_Table *cte; + + cte = alloc_lcrecord_type (Lisp_Uint8_Byte_Table, + &lrecord_uint8_byte_table); + + for (i = 0; i < 256; i++) + cte->property[i] = initval; + + XSETUINT8_BYTE_TABLE (obj, cte); + return obj; +} + +static int +uint8_byte_table_same_value_p (Lisp_Object obj) +{ + Lisp_Uint8_Byte_Table *bte = XUINT8_BYTE_TABLE (obj); + unsigned char v0 = bte->property[0]; + int i; + + for (i = 1; i < 256; i++) + { + if (bte->property[i] != v0) + return 0; + } + return -1; +} + + +#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 + +INLINE_HEADER int INT_UINT16_P (Lisp_Object obj); +INLINE_HEADER int UINT16_VALUE_P (Lisp_Object obj); +INLINE_HEADER unsigned short UINT16_ENCODE (Lisp_Object obj); +INLINE_HEADER Lisp_Object UINT16_DECODE (unsigned short us); + +INLINE_HEADER int +INT_UINT16_P (Lisp_Object obj) +{ + if (INTP (obj)) + { + int num = XINT (obj); + + return (BT_UINT16_MIN <= num) && (num <= BT_UINT16_MAX); + } + else + return 0; +} + +INLINE_HEADER int +UINT16_VALUE_P (Lisp_Object obj) +{ + return 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)) + return BT_UINT16_unbound; + else if (EQ (obj, Qnil)) + return BT_UINT16_nil; + else if (EQ (obj, Qt)) + return BT_UINT16_t; + else + return XINT (obj); +} + +INLINE_HEADER Lisp_Object +UINT16_DECODE (unsigned short n) +{ + if (n == BT_UINT16_unbound) + return Qunbound; + else if (n == BT_UINT16_nil) + return Qnil; + else if (n == BT_UINT16_t) + return Qt; + else + return make_int (n); +} + +INLINE_HEADER unsigned short +UINT8_TO_UINT16 (unsigned char n) +{ + if (n == BT_UINT8_unbound) + return BT_UINT16_unbound; + else if (n == BT_UINT8_nil) + return BT_UINT16_nil; + else if (n == BT_UINT8_t) + return BT_UINT16_t; + else + return n; +} + +static Lisp_Object +mark_uint16_byte_table (Lisp_Object obj) +{ + return Qnil; +} + +static void +print_uint16_byte_table (Lisp_Object obj, + Lisp_Object printcharfun, int escapeflag) +{ + Lisp_Uint16_Byte_Table *bte = XUINT16_BYTE_TABLE (obj); + int i; + struct gcpro gcpro1, gcpro2; + GCPRO2 (obj, printcharfun); + + write_c_string ("\n#property[i]; + if ( (i & 15) == 0 ) + write_c_string ("\n ", printcharfun); + write_c_string (" ", printcharfun); + if (n == BT_UINT16_unbound) + write_c_string ("void", printcharfun); + else if (n == BT_UINT16_nil) + write_c_string ("nil", printcharfun); + else if (n == BT_UINT16_t) + write_c_string ("t", printcharfun); + else + { + char buf[7]; + + sprintf (buf, "%hd", n); + write_c_string (buf, printcharfun); + } + } + UNGCPRO; + write_c_string (">", printcharfun); +} + +static int +uint16_byte_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) +{ + Lisp_Uint16_Byte_Table *te1 = XUINT16_BYTE_TABLE (obj1); + Lisp_Uint16_Byte_Table *te2 = XUINT16_BYTE_TABLE (obj2); + int i; + + for (i = 0; i < 256; i++) + if (te1->property[i] != te2->property[i]) + return 0; + return 1; +} + +static unsigned long +uint16_byte_table_hash (Lisp_Object obj, int depth) +{ + Lisp_Uint16_Byte_Table *te = XUINT16_BYTE_TABLE (obj); + int i; + hashcode_t hash = 0; + + for (i = 0; i < 256; i++) + hash = HASH2 (hash, te->property[i]); + return hash; +} + +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 */, + Lisp_Uint16_Byte_Table); + +static Lisp_Object +make_uint16_byte_table (unsigned short initval) +{ + Lisp_Object obj; + int i; + Lisp_Uint16_Byte_Table *cte; + + cte = alloc_lcrecord_type (Lisp_Uint16_Byte_Table, + &lrecord_uint16_byte_table); + + for (i = 0; i < 256; i++) + cte->property[i] = initval; + + XSETUINT16_BYTE_TABLE (obj, cte); + return obj; +} + +static int +uint16_byte_table_same_value_p (Lisp_Object obj) +{ + Lisp_Uint16_Byte_Table *bte = XUINT16_BYTE_TABLE (obj); + unsigned short v0 = bte->property[0]; + int i; + + for (i = 1; i < 256; i++) + { + if (bte->property[i] != v0) + return 0; + } + return -1; +} + + static Lisp_Object mark_byte_table (Lisp_Object obj) { @@ -172,6 +515,30 @@ mark_byte_table (Lisp_Object obj) return Qnil; } +static void +print_byte_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) +{ + Lisp_Byte_Table *bte = XBYTE_TABLE (obj); + int i; + struct gcpro gcpro1, gcpro2; + GCPRO2 (obj, printcharfun); + + write_c_string ("\n#property[i]; + if ( (i & 15) == 0 ) + write_c_string ("\n ", printcharfun); + write_c_string (" ", printcharfun); + if (EQ (elt, Qunbound)) + write_c_string ("void", printcharfun); + else + print_internal (elt, printcharfun, escapeflag); + } + UNGCPRO; + write_c_string (">", printcharfun); +} + static int byte_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) { @@ -212,23 +579,20 @@ static const struct lrecord_description byte_table_description[] = { DEFINE_LRECORD_IMPLEMENTATION ("byte-table", byte_table, mark_byte_table, - internal_object_printer, + print_byte_table, 0, byte_table_equal, byte_table_hash, byte_table_description, Lisp_Byte_Table); static Lisp_Object -make_byte_table (Lisp_Object initval, int older) +make_byte_table (Lisp_Object initval) { Lisp_Object obj; int i; Lisp_Byte_Table *cte; - if (older) - cte = alloc_older_lcrecord_type (Lisp_Byte_Table, &lrecord_byte_table); - else - cte = alloc_lcrecord_type (Lisp_Byte_Table, &lrecord_byte_table); + cte = alloc_lcrecord_type (Lisp_Byte_Table, &lrecord_byte_table); for (i = 0; i < 256; i++) cte->property[i] = initval; @@ -237,28 +601,137 @@ make_byte_table (Lisp_Object initval, int older) return obj; } -static Lisp_Object -copy_byte_table (Lisp_Object entry) +static int +byte_table_same_value_p (Lisp_Object obj) { - Lisp_Byte_Table *cte = XBYTE_TABLE (entry); - Lisp_Object obj; + Lisp_Byte_Table *bte = XBYTE_TABLE (obj); + Lisp_Object v0 = bte->property[0]; int i; - Lisp_Byte_Table *ctenew - = alloc_lcrecord_type (Lisp_Byte_Table, &lrecord_byte_table); - for (i = 0; i < 256; i++) + for (i = 1; i < 256; i++) { - Lisp_Object new = cte->property[i]; - if (BYTE_TABLE_P (new)) - ctenew->property[i] = copy_byte_table (new); - else - ctenew->property[i] = new; + if (!internal_equal (bte->property[i], v0, 0)) + return 0; } + return -1; +} - XSETBYTE_TABLE (obj, ctenew); - return obj; + +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) +{ + if (UINT8_BYTE_TABLE_P (table)) + return UINT8_DECODE (XUINT8_BYTE_TABLE(table)->property[idx]); + else if (UINT16_BYTE_TABLE_P (table)) + return UINT16_DECODE (XUINT16_BYTE_TABLE(table)->property[idx]); + else if (BYTE_TABLE_P (table)) + return XBYTE_TABLE(table)->property[idx]; + else + return table; } +Lisp_Object +put_byte_table (Lisp_Object table, unsigned char idx, Lisp_Object value) +{ + if (UINT8_BYTE_TABLE_P (table)) + { + if (UINT8_VALUE_P (value)) + { + XUINT8_BYTE_TABLE(table)->property[idx] = UINT8_ENCODE (value); + if (!UINT8_BYTE_TABLE_P (value) && + !UINT16_BYTE_TABLE_P (value) && !BYTE_TABLE_P (value) + && uint8_byte_table_same_value_p (table)) + { + return value; + } + } + else if (UINT16_VALUE_P (value)) + { + Lisp_Object new = make_uint16_byte_table (Qnil); + int i; + + for (i = 0; i < 256; i++) + { + XUINT16_BYTE_TABLE(new)->property[i] + = UINT8_TO_UINT16 (XUINT8_BYTE_TABLE(table)->property[i]); + } + XUINT16_BYTE_TABLE(new)->property[idx] = UINT16_ENCODE (value); + return new; + } + else + { + Lisp_Object new = make_byte_table (Qnil); + int i; + + for (i = 0; i < 256; i++) + { + XBYTE_TABLE(new)->property[i] + = UINT8_DECODE (XUINT8_BYTE_TABLE(table)->property[i]); + } + XBYTE_TABLE(new)->property[idx] = value; + return new; + } + } + else if (UINT16_BYTE_TABLE_P (table)) + { + if (UINT16_VALUE_P (value)) + { + XUINT16_BYTE_TABLE(table)->property[idx] = UINT16_ENCODE (value); + if (!UINT8_BYTE_TABLE_P (value) && + !UINT16_BYTE_TABLE_P (value) && !BYTE_TABLE_P (value) + && uint16_byte_table_same_value_p (table)) + { + return value; + } + } + else + { + Lisp_Object new = make_byte_table (Qnil); + int i; + + for (i = 0; i < 256; i++) + { + XBYTE_TABLE(new)->property[i] + = UINT16_DECODE (XUINT16_BYTE_TABLE(table)->property[i]); + } + XBYTE_TABLE(new)->property[idx] = value; + return new; + } + } + else if (BYTE_TABLE_P (table)) + { + XBYTE_TABLE(table)->property[idx] = value; + if (!UINT8_BYTE_TABLE_P (value) && + !UINT16_BYTE_TABLE_P (value) && !BYTE_TABLE_P (value) + && byte_table_same_value_p (table)) + { + return value; + } + } + else if (!internal_equal (table, value, 0)) + { + if (UINT8_VALUE_P (table) && UINT8_VALUE_P (value)) + { + table = make_uint8_byte_table (UINT8_ENCODE (table)); + XUINT8_BYTE_TABLE(table)->property[idx] = UINT8_ENCODE (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) @@ -268,13 +741,42 @@ mark_char_id_table (Lisp_Object 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_Char_ID_Table *cte1 = XCHAR_ID_TABLE (obj1); - Lisp_Char_ID_Table *cte2 = XCHAR_ID_TABLE (obj2); + Lisp_Object table1 = XCHAR_ID_TABLE (obj1)->table; + Lisp_Object table2 = XCHAR_ID_TABLE (obj2)->table; + int i; - return byte_table_equal (cte1->table, cte2->table, depth + 1); + 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 @@ -292,73 +794,42 @@ static const struct lrecord_description char_id_table_description[] = { DEFINE_LRECORD_IMPLEMENTATION ("char-id-table", char_id_table, mark_char_id_table, - internal_object_printer, + print_char_id_table, 0, char_id_table_equal, char_id_table_hash, char_id_table_description, Lisp_Char_ID_Table); static Lisp_Object -make_char_id_table (Lisp_Object initval, int older) +make_char_id_table (Lisp_Object initval) { Lisp_Object obj; Lisp_Char_ID_Table *cte; - if (older) - cte = alloc_older_lcrecord_type (Lisp_Char_ID_Table, - &lrecord_char_id_table); - else - cte = alloc_lcrecord_type (Lisp_Char_ID_Table, &lrecord_char_id_table); + cte = alloc_lcrecord_type (Lisp_Char_ID_Table, &lrecord_char_id_table); - cte->table = make_byte_table (initval, older); + cte->table = make_byte_table (initval); XSETCHAR_ID_TABLE (obj, cte); return obj; } -/* not used */ -#if 0 -static Lisp_Object -copy_char_id_table (Lisp_Object entry) -{ - Lisp_Char_ID_Table *cte = XCHAR_ID_TABLE (entry); - Lisp_Object obj; - Lisp_Char_ID_Table *ctenew - = alloc_lcrecord_type (Lisp_Char_ID_Table, &lrecord_char_id_table); - - ctenew->table = copy_byte_table (cte->table); - XSETCHAR_ID_TABLE (obj, ctenew); - return obj; -} -#endif - Lisp_Object get_char_id_table (Emchar ch, Lisp_Object table) { unsigned int code = ch; - Lisp_Byte_Table* cpt - = XBYTE_TABLE (XCHAR_ID_TABLE (table)->table); - Lisp_Object ret = cpt->property [(unsigned char)(code >> 24)]; - - if (BYTE_TABLE_P (ret)) - cpt = XBYTE_TABLE (ret); - else - return ret; - ret = cpt->property [(unsigned char) (code >> 16)]; - if (BYTE_TABLE_P (ret)) - cpt = XBYTE_TABLE (ret); - else - return ret; - - ret = cpt->property [(unsigned char) (code >> 8)]; - if (BYTE_TABLE_P (ret)) - cpt = XBYTE_TABLE (ret); - else - return ret; - - return cpt->property [(unsigned char) code]; + return + get_byte_table + (get_byte_table + (get_byte_table + (get_byte_table + (XCHAR_ID_TABLE (table)->table, + (unsigned char)(code >> 24)), + (unsigned char) (code >> 16)), + (unsigned char) (code >> 8)), + (unsigned char) code); } void put_char_id_table (Emchar ch, Lisp_Object value, Lisp_Object table); @@ -366,66 +837,28 @@ void put_char_id_table (Emchar ch, Lisp_Object value, Lisp_Object table) { unsigned int code = ch; - Lisp_Byte_Table* cpt1 = XBYTE_TABLE (XCHAR_ID_TABLE (table)->table); - Lisp_Object ret = cpt1->property[(unsigned char)(code >> 24)]; - - if (BYTE_TABLE_P (ret)) - { - Lisp_Byte_Table* cpt2 = XBYTE_TABLE (ret); - - ret = cpt2->property[(unsigned char)(code >> 16)]; - if (BYTE_TABLE_P (ret)) - { - Lisp_Byte_Table* cpt3 = XBYTE_TABLE (ret); - - ret = cpt3->property[(unsigned char)(code >> 8)]; - if (BYTE_TABLE_P (ret)) - { - Lisp_Byte_Table* cpt4 = XBYTE_TABLE (ret); - - cpt4->property[(unsigned char)code] = value; - } - else if (!EQ (ret, value)) - { - Lisp_Object cpt4 - = make_byte_table (ret, OLDER_RECORD_P (table)); - - XBYTE_TABLE(cpt4)->property[(unsigned char)code] = value; - cpt3->property[(unsigned char)(code >> 8)] = cpt4; - } - } - else if (!EQ (ret, value)) - { - int older = OLDER_RECORD_P (table); - Lisp_Object cpt3 = make_byte_table (ret, older); - Lisp_Object cpt4 = make_byte_table (ret, older); - - XBYTE_TABLE(cpt4)->property[(unsigned char)code] = value; - XBYTE_TABLE(cpt3)->property[(unsigned char)(code >> 8)] - = cpt4; - cpt2->property[(unsigned char)(code >> 16)] = cpt3; - } - } - else if (!EQ (ret, value)) - { - int older = OLDER_RECORD_P (table); - Lisp_Object cpt2 = make_byte_table (ret, older); - Lisp_Object cpt3 = make_byte_table (ret, older); - Lisp_Object cpt4 = make_byte_table (ret, older); - - XBYTE_TABLE(cpt4)->property[(unsigned char)code] = value; - XBYTE_TABLE(cpt3)->property[(unsigned char)(code >> 8)] = cpt4; - XBYTE_TABLE(cpt2)->property[(unsigned char)(code >> 16)] = cpt3; - cpt1->property[(unsigned char)(code >> 24)] = cpt2; - } + Lisp_Object table1, table2, table3, table4; + + table1 = XCHAR_ID_TABLE (table)->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); + XCHAR_ID_TABLE (table)->table + = put_byte_table (table1, (unsigned char)(code >> 24), table2); } -Lisp_Object Vcharacter_attribute_table; +Lisp_Object Vchar_attribute_hash_table; Lisp_Object Vcharacter_composition_table; Lisp_Object Vcharacter_variant_table; +Lisp_Object Qideograph_daikanwa; Lisp_Object Q_decomposition; +Lisp_Object Qucs; Lisp_Object Q_ucs; Lisp_Object Qcompat; Lisp_Object Qisolated; @@ -445,6 +878,11 @@ Lisp_Object Qsmall; Lisp_Object Qfont; Emchar to_char_id (Lisp_Object v, char* err_msg, Lisp_Object err_arg); + +Lisp_Object put_char_ccs_code_point (Lisp_Object character, + Lisp_Object ccs, Lisp_Object value); +Lisp_Object remove_char_ccs (Lisp_Object character, Lisp_Object ccs); + Emchar to_char_id (Lisp_Object v, char* err_msg, Lisp_Object err_arg) { @@ -522,14 +960,93 @@ Return character corresponding with list. signal_simple_error ("Invalid value for composition", list); } -DEFUN ("char-variants", Fchar_variants, 1, 1, 0, /* -Return variants of CHARACTER. +DEFUN ("char-variants", Fchar_variants, 1, 1, 0, /* +Return variants of CHARACTER. +*/ + (character)) +{ + CHECK_CHAR (character); + return Fcopy_list (get_char_id_table (XCHAR (character), + Vcharacter_variant_table)); +} + + +/* We store the char-attributes in hash tables with the names as the + key and the actual char-id-table object as the value. Occasionally + we need to use them in a list format. These routines provide us + with that. */ +struct char_attribute_list_closure +{ + Lisp_Object *char_attribute_list; +}; + +static int +add_char_attribute_to_list_mapper (Lisp_Object key, Lisp_Object value, + void *char_attribute_list_closure) +{ + /* This function can GC */ + struct char_attribute_list_closure *calcl + = (struct char_attribute_list_closure*) char_attribute_list_closure; + Lisp_Object *char_attribute_list = calcl->char_attribute_list; + + *char_attribute_list = Fcons (key, *char_attribute_list); + return 0; +} + +DEFUN ("char-attribute-list", Fchar_attribute_list, 0, 0, 0, /* +Return the list of all existing character attributes except coded-charsets. +*/ + ()) +{ + Lisp_Object char_attribute_list = Qnil; + struct gcpro gcpro1; + struct char_attribute_list_closure char_attribute_list_closure; + + GCPRO1 (char_attribute_list); + char_attribute_list_closure.char_attribute_list = &char_attribute_list; + elisp_maphash (add_char_attribute_to_list_mapper, + Vchar_attribute_hash_table, + &char_attribute_list_closure); + UNGCPRO; + return char_attribute_list; +} + +DEFUN ("find-char-attribute-table", Ffind_char_attribute_table, 1, 1, 0, /* +Return char-id-table corresponding to ATTRIBUTE. */ - (character)) + (attribute)) { - CHECK_CHAR (character); - return Fcopy_list (get_char_id_table (XCHAR (character), - Vcharacter_variant_table)); + return Fgethash (attribute, Vchar_attribute_hash_table, Qnil); +} + + +/* We store the char-id-tables in hash tables with the attributes as + the key and the actual char-id-table object as the value. Each + char-id-table stores values of an attribute corresponding with + characters. Occasionally we need to get attributes of a character + in a association-list format. These routines provide us with + that. */ +struct char_attribute_alist_closure +{ + Emchar char_id; + Lisp_Object *char_attribute_alist; +}; + +static int +add_char_attribute_alist_mapper (Lisp_Object key, Lisp_Object value, + void *char_attribute_alist_closure) +{ + /* 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 (caacl->char_id, value); + if (!UNBOUNDP (ret)) + { + Lisp_Object *char_attribute_alist = caacl->char_attribute_alist; + *char_attribute_alist + = Fcons (Fcons (key, ret), *char_attribute_alist); + } + return 0; } DEFUN ("char-attribute-alist", Fchar_attribute_alist, 1, 1, 0, /* @@ -537,9 +1054,41 @@ Return the alist of attributes of CHARACTER. */ (character)) { + Lisp_Object alist = Qnil; + int i; + CHECK_CHAR (character); - return Fcopy_alist (get_char_id_table (XCHAR (character), - Vcharacter_attribute_table)); + { + 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; + + if ( CHAR_ID_TABLE_P (encoding_table) + && INTP (cpos = get_char_id_table (XCHAR (character), + encoding_table)) ) + { + alist = Fcons (Fcons (ccs, cpos), alist); + } + } + } + return alist; } DEFUN ("get-char-attribute", Fget_char_attribute, 2, 2, 0, /* @@ -561,74 +1110,19 @@ Return the value of CHARACTER's ATTRIBUTE. } else { - Lisp_Object ret - = get_char_id_table (XCHAR (character), Vcharacter_attribute_table); - - if (EQ (ret, Qnil)) - return Qnil; - else - return Fcdr (Fassq (attribute, ret)); - } -} - -Lisp_Object put_char_attribute (Lisp_Object character, - Lisp_Object attribute, Lisp_Object value); -Lisp_Object -put_char_attribute (Lisp_Object character, Lisp_Object attribute, - Lisp_Object value) -{ - Emchar char_id = XCHAR (character); - Lisp_Object ret = get_char_id_table (char_id, Vcharacter_attribute_table); - Lisp_Object cell; - - cell = Fassq (attribute, ret); - - if (NILP (cell)) - { - ret = Fcons (Fcons (attribute, value), ret); - } - else if (!EQ (Fcdr (cell), value)) - { - Fsetcdr (cell, value); - } - put_char_id_table (char_id, ret, Vcharacter_attribute_table); - return ret; -} - -Lisp_Object remove_char_attribute (Lisp_Object character, - Lisp_Object attribute); -Lisp_Object -remove_char_attribute (Lisp_Object character, Lisp_Object attribute) -{ - Emchar char_id = XCHAR (character); - Lisp_Object alist = get_char_id_table (char_id, Vcharacter_attribute_table); - - if (EQ (attribute, Fcar (Fcar (alist)))) - { - alist = Fcdr (alist); - } - else - { - Lisp_Object pr = alist; - Lisp_Object r = Fcdr (alist); - - while (!NILP (r)) + Lisp_Object table = Fgethash (attribute, + Vchar_attribute_hash_table, + Qunbound); + if (!UNBOUNDP (table)) { - if (EQ (attribute, Fcar (Fcar (r)))) - { - XCDR (pr) = Fcdr (r); - break; - } - pr = r; - r = Fcdr (r); + Lisp_Object ret = get_char_id_table (XCHAR (character), table); + if (!UNBOUNDP (ret)) + return ret; } } - put_char_id_table (char_id, alist, Vcharacter_attribute_table); - return alist; + return Qnil; } -Lisp_Object Qucs; - DEFUN ("put-char-attribute", Fput_char_attribute, 3, 3, 0, /* Store CHARACTER's ATTRIBUTE with VALUE. */ @@ -640,125 +1134,12 @@ Store CHARACTER's ATTRIBUTE with VALUE. ccs = Ffind_charset (attribute); if (!NILP (ccs)) { - Lisp_Object encoding_table; - - if (!EQ (XCHARSET_NAME (ccs), Qucs) - || (XCHAR (character) != XINT (value))) - { - Lisp_Object cpos, rest; - Lisp_Object v = XCHARSET_DECODING_TABLE (ccs); - Lisp_Object nv; - int i = -1; - int ccs_len; - int dim; - int code_point; - - /* ad-hoc method for `ascii' */ - if ((XCHARSET_CHARS (ccs) == 94) && - (XCHARSET_BYTE_OFFSET (ccs) != 33)) - ccs_len = 128 - XCHARSET_BYTE_OFFSET (ccs); - else - ccs_len = XCHARSET_CHARS (ccs); - - if (CONSP (value)) - { - Lisp_Object ret = Fcar (value); - - if (!INTP (ret)) - signal_simple_error ("Invalid value for coded-charset", value); - code_point = XINT (ret); - if (XCHARSET_GRAPHIC (ccs) == 1) - code_point &= 0x7F; - rest = Fcdr (value); - while (!NILP (rest)) - { - int j; - - if (!CONSP (rest)) - signal_simple_error ("Invalid value for coded-charset", - value); - ret = Fcar (rest); - if (!INTP (ret)) - signal_simple_error ("Invalid value for coded-charset", - value); - j = XINT (ret); - if (XCHARSET_GRAPHIC (ccs) == 1) - j &= 0x7F; - code_point = (code_point << 8) | j; - rest = Fcdr (rest); - } - value = make_int (code_point); - } - else if (INTP (value)) - { - if (XCHARSET_GRAPHIC (ccs) == 1) - value = make_int (XINT (value) & 0x7F7F7F7F); - } - else - signal_simple_error ("Invalid value for coded-charset", value); - - attribute = ccs; - cpos = Fget_char_attribute (character, attribute); - if (VECTORP (v)) - { - if (!NILP (cpos)) - { - dim = XCHARSET_DIMENSION (ccs); - code_point = XINT (cpos); - while (dim > 0) - { - dim--; - i = ((code_point >> (8 * dim)) & 255) - - XCHARSET_BYTE_OFFSET (ccs); - nv = XVECTOR_DATA(v)[i]; - if (!VECTORP (nv)) - break; - v = nv; - } - if (i >= 0) - XVECTOR_DATA(v)[i] = Qnil; - v = XCHARSET_DECODING_TABLE (ccs); - } - } - else - { - XCHARSET_DECODING_TABLE (ccs) = v - = make_older_vector (ccs_len, Qnil); - } - - dim = XCHARSET_DIMENSION (ccs); - code_point = XINT (value); - i = -1; - while (dim > 0) - { - dim--; - i = ((code_point >> (8 * dim)) & 255) - - XCHARSET_BYTE_OFFSET (ccs); - nv = XVECTOR_DATA(v)[i]; - if (dim > 0) - { - if (!VECTORP (nv)) - nv = (XVECTOR_DATA(v)[i] - = make_older_vector (ccs_len, Qnil)); - v = nv; - } - else - break; - } - XVECTOR_DATA(v)[i] = character; - } - else - attribute = ccs; - if (NILP (encoding_table = XCHARSET_ENCODING_TABLE (ccs))) - { - XCHARSET_ENCODING_TABLE (ccs) = encoding_table - = make_char_id_table (Qnil, -1); - } - put_char_id_table (XCHAR (character), value, encoding_table); - return Qt; + return put_char_ccs_code_point (character, ccs, value); } else if (EQ (attribute, Q_decomposition)) { + Lisp_Object seq; + if (!CONSP (value)) signal_simple_error ("Invalid value for ->decomposition", value); @@ -767,6 +1148,11 @@ Store CHARACTER's ATTRIBUTE with 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)) { @@ -775,6 +1161,10 @@ Store CHARACTER's ATTRIBUTE with VALUE. Emchar c = to_char_id (v, "Invalid value for ->decomposition", value); + if (c < 0) + XVECTOR_DATA(seq)[i++] = v; + else + XVECTOR_DATA(seq)[i++] = make_char (c); rest = Fcdr (rest); if (!CONSP (rest)) { @@ -786,8 +1176,7 @@ Store CHARACTER's ATTRIBUTE with VALUE. ntable = get_char_id_table (c, table); if (!CHAR_ID_TABLE_P (ntable)) { - ntable - = make_char_id_table (Qnil, OLDER_RECORD_P (table)); + ntable = make_char_id_table (Qnil); put_char_id_table (c, ntable, table); } table = ntable; @@ -810,7 +1199,9 @@ Store CHARACTER's ATTRIBUTE with VALUE. Vcharacter_variant_table); } } + seq = make_vector (1, v); } + value = seq; } else if (EQ (attribute, Q_ucs)) { @@ -829,7 +1220,19 @@ Store CHARACTER's ATTRIBUTE with VALUE. Vcharacter_variant_table); } } - return put_char_attribute (character, attribute, value); + { + Lisp_Object table = Fgethash (attribute, + Vchar_attribute_hash_table, + Qnil); + + if (NILP (table)) + { + table = make_char_id_table (Qunbound); + Fputhash (attribute, table, Vchar_attribute_hash_table); + } + put_char_id_table (XCHAR (character), value, table); + return value; + } } DEFUN ("remove-char-attribute", Fremove_char_attribute, 2, 2, 0, /* @@ -843,52 +1246,221 @@ Remove CHARACTER's ATTRIBUTE. ccs = Ffind_charset (attribute); if (!NILP (ccs)) { - Lisp_Object cpos; - Lisp_Object v = XCHARSET_DECODING_TABLE (ccs); + return remove_char_ccs (character, ccs); + } + else + { + Lisp_Object table = Fgethash (attribute, + Vchar_attribute_hash_table, + Qunbound); + if (!UNBOUNDP (table)) + { + put_char_id_table (XCHAR (character), Qunbound, table); + return Qt; + } + } + return Qnil; +} + +INLINE_HEADER int CHARSET_BYTE_SIZE (Lisp_Charset* cs); +INLINE_HEADER int +CHARSET_BYTE_SIZE (Lisp_Charset* cs) +{ + /* ad-hoc method for `ascii' */ + if ((CHARSET_CHARS (cs) == 94) && + (CHARSET_BYTE_OFFSET (cs) != 33)) + return 128 - CHARSET_BYTE_OFFSET (cs); + else + return CHARSET_CHARS (cs); +} + +#define XCHARSET_BYTE_SIZE(ccs) CHARSET_BYTE_SIZE (XCHARSET (ccs)) + +int decoding_table_check_elements (Lisp_Object v, int dim, int ccs_len); +int +decoding_table_check_elements (Lisp_Object v, int dim, int ccs_len) +{ + int i; + + if (XVECTOR_LENGTH (v) > ccs_len) + return -1; + + for (i = 0; i < XVECTOR_LENGTH (v); i++) + { + Lisp_Object c = XVECTOR_DATA(v)[i]; + + if (!NILP (c) && !CHARP (c)) + { + if (VECTORP (c)) + { + int ret = decoding_table_check_elements (c, dim - 1, ccs_len); + if (ret) + return ret; + } + else + return -2; + } + } + return 0; +} + +INLINE_HEADER void +decoding_table_remove_char (Lisp_Object v, int dim, int byte_offset, + int code_point); +INLINE_HEADER void +decoding_table_remove_char (Lisp_Object v, int dim, int byte_offset, + int code_point) +{ + int i = -1; + + while (dim > 0) + { Lisp_Object nv; - int i = -1; - int ccs_len; - int dim; + + dim--; + i = ((code_point >> (8 * dim)) & 255) - byte_offset; + nv = XVECTOR_DATA(v)[i]; + if (!VECTORP (nv)) + break; + v = nv; + } + if (i >= 0) + XVECTOR_DATA(v)[i] = Qnil; +} + +INLINE_HEADER void +decoding_table_put_char (Lisp_Object v, int dim, int byte_offset, + int code_point, Lisp_Object character); +INLINE_HEADER void +decoding_table_put_char (Lisp_Object v, int dim, int byte_offset, + int code_point, Lisp_Object character) +{ + int i = -1; + Lisp_Object nv; + int ccs_len = XVECTOR_LENGTH (v); + + while (dim > 0) + { + dim--; + i = ((code_point >> (8 * dim)) & 255) - byte_offset; + nv = XVECTOR_DATA(v)[i]; + if (dim > 0) + { + if (!VECTORP (nv)) + nv = (XVECTOR_DATA(v)[i] = make_older_vector (ccs_len, Qnil)); + v = nv; + } + else + break; + } + XVECTOR_DATA(v)[i] = character; +} + +Lisp_Object +put_char_ccs_code_point (Lisp_Object character, + Lisp_Object ccs, Lisp_Object value) +{ + Lisp_Object encoding_table; + + if (!EQ (XCHARSET_NAME (ccs), Qucs) + || (XCHAR (character) != XINT (value))) + { + Lisp_Object v = XCHARSET_DECODING_TABLE (ccs); + int dim = XCHARSET_DIMENSION (ccs); + int ccs_len = XCHARSET_BYTE_SIZE (ccs); + int byte_offset = XCHARSET_BYTE_OFFSET (ccs); int code_point; - Lisp_Object encoding_table; - /* ad-hoc method for `ascii' */ - if ((XCHARSET_CHARS (ccs) == 94) && - (XCHARSET_BYTE_OFFSET (ccs) != 33)) - ccs_len = 128 - XCHARSET_BYTE_OFFSET (ccs); + if (CONSP (value)) + { /* obsolete representation: value must be a list of bytes */ + Lisp_Object ret = Fcar (value); + Lisp_Object rest; + + if (!INTP (ret)) + signal_simple_error ("Invalid value for coded-charset", value); + code_point = XINT (ret); + if (XCHARSET_GRAPHIC (ccs) == 1) + code_point &= 0x7F; + rest = Fcdr (value); + while (!NILP (rest)) + { + int j; + + if (!CONSP (rest)) + signal_simple_error ("Invalid value for coded-charset", + value); + ret = Fcar (rest); + if (!INTP (ret)) + signal_simple_error ("Invalid value for coded-charset", + value); + j = XINT (ret); + if (XCHARSET_GRAPHIC (ccs) == 1) + j &= 0x7F; + code_point = (code_point << 8) | j; + rest = Fcdr (rest); + } + value = make_int (code_point); + } + else if (INTP (value)) + { + code_point = XINT (value); + if (XCHARSET_GRAPHIC (ccs) == 1) + { + code_point &= 0x7F7F7F7F; + value = make_int (code_point); + } + } else - ccs_len = XCHARSET_CHARS (ccs); + signal_simple_error ("Invalid value for coded-charset", value); - attribute = ccs; - cpos = Fget_char_attribute (character, attribute); if (VECTORP (v)) { + Lisp_Object cpos = Fget_char_attribute (character, ccs); if (!NILP (cpos)) { - dim = XCHARSET_DIMENSION (ccs); - code_point = XINT (cpos); - while (dim > 0) - { - dim--; - i = ((code_point >> (8 * dim)) & 255) - - XCHARSET_BYTE_OFFSET (ccs); - nv = XVECTOR_DATA(v)[i]; - if (!VECTORP (nv)) - break; - v = nv; - } - if (i >= 0) - XVECTOR_DATA(v)[i] = Qnil; - v = XCHARSET_DECODING_TABLE (ccs); + decoding_table_remove_char (v, dim, byte_offset, XINT (cpos)); } } - if (!NILP (encoding_table = XCHARSET_ENCODING_TABLE (ccs))) + else + { + XCHARSET_DECODING_TABLE (ccs) + = v = make_older_vector (ccs_len, Qnil); + } + + decoding_table_put_char (v, dim, byte_offset, code_point, character); + } + if (NILP (encoding_table = XCHARSET_ENCODING_TABLE (ccs))) + { + XCHARSET_ENCODING_TABLE (ccs) + = encoding_table = make_char_id_table (Qnil); + } + put_char_id_table (XCHAR (character), value, encoding_table); + return Qt; +} + +Lisp_Object +remove_char_ccs (Lisp_Object character, Lisp_Object ccs) +{ + Lisp_Object decoding_table = XCHARSET_DECODING_TABLE (ccs); + Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (ccs); + + if (VECTORP (decoding_table)) + { + Lisp_Object cpos = Fget_char_attribute (character, ccs); + + if (!NILP (cpos)) { - put_char_id_table (XCHAR (character), Qnil, encoding_table); + decoding_table_remove_char (decoding_table, + XCHARSET_DIMENSION (ccs), + XCHARSET_BYTE_OFFSET (ccs), + XINT (cpos)); } - return Qt; } - return remove_char_attribute (character, attribute); + if (CHAR_ID_TABLE_P (encoding_table)) + { + put_char_id_table (XCHAR (character), Qnil, encoding_table); + } + return Qt; } EXFUN (Fmake_char, 3); @@ -902,6 +1474,9 @@ Store character's ATTRIBUTES. Lisp_Object rest = attributes; Lisp_Object code = Fcdr (Fassq (Qucs, attributes)); Lisp_Object character; +#if 0 + Lisp_Object daikanwa = Qnil; +#endif if (NILP (code)) { @@ -945,14 +1520,39 @@ Store character's ATTRIBUTES. while (CONSP (rest)) { Lisp_Object cell = Fcar (rest); +#if 0 + Lisp_Object key = Fcar (cell); + Lisp_Object value = Fcdr (cell); +#endif if (!LISTP (cell)) signal_simple_error ("Invalid argument", attributes); + +#if 0 + if (EQ (key, Qmorohashi_daikanwa)) + { + size_t len; + GET_EXTERNAL_LIST_LENGTH (value, len); + + if (len == 1) + { + if (NILP (daikanwa)) + daikanwa = Fcdr (Fassq (Qideograph_daikanwa, rest)); + if (EQ (Fcar (value), daikanwa)) + goto ignored; + } + } + else if (EQ (key, Qideograph_daikanwa)) + daikanwa = value; +#endif + Fput_char_attribute (character, Fcar (cell), Fcdr (cell)); +#if 0 + ignored: +#endif rest = Fcdr (rest); } - return - get_char_id_table (XCHAR (character), Vcharacter_attribute_table); + return character; } Lisp_Object Vutf_2000_version; @@ -1001,7 +1601,6 @@ Lisp_Object Qascii, Qlatin_viscii_upper, Qvietnamese_viscii_lower, Qvietnamese_viscii_upper, - Qideograph_daikanwa, Qmojikyo, Qmojikyo_pj_1, Qmojikyo_pj_2, @@ -1401,7 +2000,7 @@ mark_charset (Lisp_Object obj) mark_object (cs->registry); mark_object (cs->ccl_program); #ifdef UTF2000 - /* mark_object (cs->encoding_table); */ + mark_object (cs->encoding_table); /* mark_object (cs->decoding_table); */ #endif return cs->name; @@ -1963,7 +2562,7 @@ add_charset_to_list_mapper (Lisp_Object key, Lisp_Object value, (struct charset_list_closure*) charset_list_closure; Lisp_Object *charset_list = chcl->charset_list; - *charset_list = Fcons (XCHARSET_NAME (value), *charset_list); + *charset_list = Fcons (key /* XCHARSET_NAME (value) */, *charset_list); return 0; } @@ -2472,39 +3071,42 @@ Set mapping-table of CHARSET to TABLE. (charset, table)) { struct Lisp_Charset *cs; - Lisp_Object old_table; size_t i; + int byte_offset; charset = Fget_charset (charset); cs = XCHARSET (charset); - if (EQ (table, Qnil)) + if (NILP (table)) { - CHARSET_DECODING_TABLE(cs) = table; + if (VECTORP (CHARSET_DECODING_TABLE(cs))) + make_vector_newer (CHARSET_DECODING_TABLE(cs)); + CHARSET_DECODING_TABLE(cs) = Qnil; return table; } else if (VECTORP (table)) { - int ccs_len; - - /* ad-hoc method for `ascii' */ - if ((CHARSET_CHARS (cs) == 94) && - (CHARSET_BYTE_OFFSET (cs) != 33)) - ccs_len = 128 - CHARSET_BYTE_OFFSET (cs); - else - ccs_len = CHARSET_CHARS (cs); - - if (XVECTOR_LENGTH (table) > ccs_len) - args_out_of_range (table, make_int (CHARSET_CHARS (cs))); - old_table = CHARSET_DECODING_TABLE(cs); - CHARSET_DECODING_TABLE(cs) = table; + int ccs_len = CHARSET_BYTE_SIZE (cs); + int ret = decoding_table_check_elements (table, + CHARSET_DIMENSION (cs), + ccs_len); + if (ret) + { + if (ret == -1) + signal_simple_error ("Too big table", table); + else if (ret == -2) + signal_simple_error ("Invalid element is found", table); + else + signal_simple_error ("Something wrong", table); + } + CHARSET_DECODING_TABLE(cs) = Qnil; } else signal_error (Qwrong_type_argument, list2 (build_translated_string ("vector-or-nil-p"), table)); - /* signal_simple_error ("Wrong type argument: vector-or-nil-p", table); */ + byte_offset = CHARSET_BYTE_OFFSET (cs); switch (CHARSET_DIMENSION (cs)) { case 1: @@ -2513,9 +3115,8 @@ Set mapping-table of CHARSET to TABLE. Lisp_Object c = XVECTOR_DATA(table)[i]; if (CHARP (c)) - put_char_attribute - (c, charset, - make_int (i + CHARSET_BYTE_OFFSET (cs))); + put_char_ccs_code_point (c, charset, + make_int (i + byte_offset)); } break; case 2: @@ -2527,25 +3128,21 @@ Set mapping-table of CHARSET to TABLE. { size_t j; - if (XVECTOR_LENGTH (v) > CHARSET_CHARS (cs)) - { - CHARSET_DECODING_TABLE(cs) = old_table; - args_out_of_range (v, make_int (CHARSET_CHARS (cs))); - } for (j = 0; j < XVECTOR_LENGTH (v); j++) { Lisp_Object c = XVECTOR_DATA(v)[j]; if (CHARP (c)) - put_char_attribute + put_char_ccs_code_point (c, charset, - make_int ( ((i + CHARSET_BYTE_OFFSET (cs)) << 8) - | (j + CHARSET_BYTE_OFFSET (cs)) )); + make_int ( ( (i + byte_offset) << 8 ) + | (j + byte_offset) + ) ); } } else if (CHARP (v)) - put_char_attribute (v, charset, - make_int (i + CHARSET_BYTE_OFFSET (cs))); + put_char_ccs_code_point (v, charset, + make_int (i + byte_offset)); } break; } @@ -2573,6 +3170,77 @@ Make a character from CHARSET and code-point CODE. c &= 0x7F7F7F7F; return make_char (DECODE_CHAR (charset, c)); } + +DEFUN ("decode-builtin-char", Fdecode_builtin_char, 2, 2, 0, /* +Make a builtin character from CHARSET and code-point CODE. +*/ + (charset, code)) +{ + int c; + int final; + + charset = Fget_charset (charset); + CHECK_INT (code); + c = XINT (code); + + if ((final = XCHARSET_FINAL (charset)) >= '0') + { + if (XCHARSET_DIMENSION (charset) == 1) + { + switch (XCHARSET_CHARS (charset)) + { + case 94: + return + make_char (MIN_CHAR_94 + (final - '0') * 94 + + ((c & 0x7F) - 33)); + case 96: + return + make_char (MIN_CHAR_96 + (final - '0') * 96 + + ((c & 0x7F) - 32)); + default: + return Fdecode_char (charset, code); + } + } + else + { + switch (XCHARSET_CHARS (charset)) + { + case 94: + return + make_char (MIN_CHAR_94x94 + + (final - '0') * 94 * 94 + + (((c >> 8) & 0x7F) - 33) * 94 + + ((c & 0x7F) - 33)); + case 96: + return + make_char (MIN_CHAR_96x96 + + (final - '0') * 96 * 96 + + (((c >> 8) & 0x7F) - 32) * 96 + + ((c & 0x7F) - 32)); + default: + return Fdecode_char (charset, code); + } + } + } + else if (XCHARSET_UCS_MAX (charset)) + { + Emchar cid + = (XCHARSET_DIMENSION (charset) == 1 + ? + c - XCHARSET_BYTE_OFFSET (charset) + : + ((c >> 8) - XCHARSET_BYTE_OFFSET (charset)) + * XCHARSET_CHARS (charset) + + (c & 0xFF) - XCHARSET_BYTE_OFFSET (charset)) + - XCHARSET_CODE_OFFSET (charset) + XCHARSET_UCS_MIN (charset); + if ((cid < XCHARSET_UCS_MIN (charset)) + || (XCHARSET_UCS_MAX (charset) < cid)) + return Fdecode_char (charset, code); + return make_char (cid); + } + else + return Fdecode_char (charset, code); +} #endif DEFUN ("make-char", Fmake_char, 2, 3, 0, /* @@ -2795,6 +3463,8 @@ void syms_of_mule_charset (void) { #ifdef UTF2000 + INIT_LRECORD_IMPLEMENTATION (uint8_byte_table); + INIT_LRECORD_IMPLEMENTATION (uint16_byte_table); INIT_LRECORD_IMPLEMENTATION (byte_table); INIT_LRECORD_IMPLEMENTATION (char_id_table); #endif @@ -2819,6 +3489,8 @@ syms_of_mule_charset (void) DEFSUBR (Fset_charset_ccl_program); DEFSUBR (Fset_charset_registry); #ifdef UTF2000 + DEFSUBR (Fchar_attribute_list); + DEFSUBR (Ffind_char_attribute_table); DEFSUBR (Fchar_attribute_alist); DEFSUBR (Fget_char_attribute); DEFSUBR (Fput_char_attribute); @@ -2832,6 +3504,7 @@ syms_of_mule_charset (void) #ifdef UTF2000 DEFSUBR (Fdecode_char); + DEFSUBR (Fdecode_builtin_char); #endif DEFSUBR (Fmake_char); DEFSUBR (Fchar_charset); @@ -2981,19 +3654,16 @@ Leading-code of private TYPE9N charset of column-width 1. #endif #ifdef UTF2000 - Vutf_2000_version = build_string("0.15 (Sangō)"); + Vutf_2000_version = build_string("0.16 (Ōji)"); DEFVAR_LISP ("utf-2000-version", &Vutf_2000_version /* Version number of UTF-2000. */ ); - staticpro (&Vcharacter_attribute_table); - Vcharacter_attribute_table = make_char_id_table (Qnil, 0); - - /* staticpro (&Vcharacter_composition_table); */ - Vcharacter_composition_table = make_char_id_table (Qnil, -1); + staticpro (&Vcharacter_composition_table); + Vcharacter_composition_table = make_char_id_table (Qnil); staticpro (&Vcharacter_variant_table); - Vcharacter_variant_table = make_char_id_table (Qnil, 0); + Vcharacter_variant_table = make_char_id_table (Qnil); Vdefault_coded_charset_priority_list = Qnil; DEFVAR_LISP ("default-coded-charset-priority-list", @@ -3014,6 +3684,10 @@ complex_vars_of_mule_charset (void) ease of access. */ #ifdef UTF2000 + staticpro (&Vchar_attribute_hash_table); + Vchar_attribute_hash_table + = make_lisp_hash_table (16, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); + staticpro (&Vcharset_ucs); Vcharset_ucs = make_charset (LEADING_BYTE_UCS, Qucs, 256, 4,