X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=src%2Fmule-charset.c;h=3fb4030bee0a3b932bfef5d18e1e2df08a40812b;hb=7c20beeb0e0dae144d6cb5785761366d9b5c369a;hp=9ab731d342150a073671c373fcdaa1b4451a753c;hpb=4836e869212eaa972d5a2bdfe61730d8af7b2c61;p=chise%2Fxemacs-chise.git- diff --git a/src/mule-charset.c b/src/mule-charset.c index 9ab731d..3fb4030 100644 --- a/src/mule-charset.c +++ b/src/mule-charset.c @@ -75,6 +75,7 @@ Lisp_Object Vcharset_latin_viscii_lower; Lisp_Object Vcharset_latin_viscii_upper; Lisp_Object Vcharset_chinese_big5; Lisp_Object Vcharset_chinese_big5_cdp; +Lisp_Object Vcharset_japanese_jef_china3; Lisp_Object Vcharset_ideograph_gt; Lisp_Object Vcharset_ideograph_gt_pj_1; Lisp_Object Vcharset_ideograph_gt_pj_2; @@ -181,1303 +182,6 @@ 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; -} - -static int -map_over_uint8_byte_table (Lisp_Uint8_Byte_Table *ct, - int (*fn) (Emchar c, Lisp_Object val, void *arg), - void *arg, Emchar ofs, int place) -{ - int i, retval; - int unit = 1 << (8 * place); - Emchar c = ofs; - Emchar c1; - - for (i = 0, retval = 0; i < 256 && retval == 0; i++) - { - if (ct->property[i] != BT_UINT8_unbound) - { - c1 = c + unit; - for (; c < c1 && retval == 0; c++) - retval = (fn) (c, UINT8_DECODE (ct->property[i]), arg); - } - else - c += unit; - } - return retval; -} - -#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 Lisp_Object -expand_uint8_byte_table_to_uint16 (Lisp_Object table) -{ - Lisp_Object obj; - int i; - Lisp_Uint8_Byte_Table* bte = XUINT8_BYTE_TABLE(table); - 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] = UINT8_TO_UINT16 (bte->property[i]); - } - 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 int -map_over_uint16_byte_table (Lisp_Uint16_Byte_Table *ct, - int (*fn) (Emchar c, Lisp_Object val, void *arg), - void *arg, Emchar ofs, int place) -{ - int i, retval; - int unit = 1 << (8 * place); - Emchar c = ofs; - Emchar c1; - - for (i = 0, retval = 0; i < 256 && retval == 0; i++) - { - if (ct->property[i] != BT_UINT16_unbound) - { - c1 = c + unit; - for (; c < c1 && retval == 0; c++) - retval = (fn) (c, UINT16_DECODE (ct->property[i]), arg); - } - else - c += unit; - } - return retval; -} - - -static Lisp_Object -mark_byte_table (Lisp_Object obj) -{ - Lisp_Byte_Table *cte = XBYTE_TABLE (obj); - int i; - - for (i = 0; i < 256; i++) - { - mark_object (cte->property[i]); - } - 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) -{ - Lisp_Byte_Table *cte1 = XBYTE_TABLE (obj1); - Lisp_Byte_Table *cte2 = XBYTE_TABLE (obj2); - int i; - - for (i = 0; i < 256; i++) - if (BYTE_TABLE_P (cte1->property[i])) - { - if (BYTE_TABLE_P (cte2->property[i])) - { - if (!byte_table_equal (cte1->property[i], - cte2->property[i], depth + 1)) - return 0; - } - else - return 0; - } - else - if (!internal_equal (cte1->property[i], cte2->property[i], depth + 1)) - return 0; - return 1; -} - -static unsigned long -byte_table_hash (Lisp_Object obj, int depth) -{ - Lisp_Byte_Table *cte = XBYTE_TABLE (obj); - - return internal_array_hash (cte->property, 256, depth); -} - -static const struct lrecord_description byte_table_description[] = { - { XD_LISP_OBJECT_ARRAY, offsetof(Lisp_Byte_Table, property), 256 }, - { XD_END } -}; - -DEFINE_LRECORD_IMPLEMENTATION ("byte-table", byte_table, - mark_byte_table, - 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) -{ - Lisp_Object obj; - int i; - Lisp_Byte_Table *cte; - - cte = alloc_lcrecord_type (Lisp_Byte_Table, &lrecord_byte_table); - - for (i = 0; i < 256; i++) - cte->property[i] = initval; - - XSETBYTE_TABLE (obj, cte); - return obj; -} - -static int -byte_table_same_value_p (Lisp_Object obj) -{ - Lisp_Byte_Table *bte = XBYTE_TABLE (obj); - Lisp_Object v0 = bte->property[0]; - int i; - - for (i = 1; i < 256; i++) - { - if (!internal_equal (bte->property[i], v0, 0)) - return 0; - } - return -1; -} - -static int -map_over_byte_table (Lisp_Byte_Table *ct, - int (*fn) (Emchar c, Lisp_Object val, void *arg), - void *arg, 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)) - { - retval - = map_over_uint8_byte_table (XUINT8_BYTE_TABLE(v), - fn, arg, c, place - 1); - c += unit; - } - else if (UINT16_BYTE_TABLE_P (v)) - { - retval - = map_over_uint16_byte_table (XUINT16_BYTE_TABLE(v), - fn, arg, c, place - 1); - c += unit; - } - else if (BYTE_TABLE_P (v)) - { - retval = map_over_byte_table (XBYTE_TABLE(v), - fn, arg, c, place - 1); - c += unit; - } - else if (!UNBOUNDP (v)) - { - Emchar c1 = c + unit; - - for (; c < c1 && retval == 0; c++) - retval = (fn) (c, v, arg); - } - else - c += unit; - } - return retval; -} - - -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 = expand_uint8_byte_table_to_uint16 (table); - - 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) -{ - 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); - -static 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 (Emchar ch, Lisp_Object table) -{ - unsigned int code = ch; - - 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); -void -put_char_id_table (Emchar ch, Lisp_Object value, Lisp_Object table) -{ - unsigned int code = ch; - 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); -} - -/* 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, - int (*fn) (Emchar c, Lisp_Object val, void *arg), - void *arg); -int -map_char_id_table (Lisp_Char_ID_Table *ct, - int (*fn) (Emchar c, Lisp_Object val, void *arg), - void *arg) -{ - Lisp_Object v = ct->table; - - if (UINT8_BYTE_TABLE_P (v)) - return map_over_uint8_byte_table (XUINT8_BYTE_TABLE(v), fn, arg, 0, 3); - else if (UINT16_BYTE_TABLE_P (v)) - return map_over_uint16_byte_table (XUINT16_BYTE_TABLE(v), fn, arg, 0, 3); - else if (BYTE_TABLE_P (v)) - return map_over_byte_table (XBYTE_TABLE(v), fn, arg, 0, 3); - else if (!UNBOUNDP (v)) - { - int unit = 1 << 24; - Emchar c = 0; - Emchar c1 = c + unit; - int retval; - - for (retval = 0; c < c1 && retval == 0; c++) - retval = (fn) (c, v, arg); - } - return 0; -} - -struct slow_map_char_id_table_arg -{ - Lisp_Object function; - Lisp_Object retval; -}; - -static int -slow_map_char_id_table_fun (Emchar c, Lisp_Object val, void *arg) -{ - struct slow_map_char_id_table_arg *closure = - (struct slow_map_char_id_table_arg *) arg; - - closure->retval = call2 (closure->function, make_char (c), val); - return !NILP (closure->retval); -} - - -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 Qto_ucs; -Lisp_Object Q_ucs; -Lisp_Object Qcompat; -Lisp_Object Qisolated; -Lisp_Object Qinitial; -Lisp_Object Qmedial; -Lisp_Object Qfinal; -Lisp_Object Qvertical; -Lisp_Object QnoBreak; -Lisp_Object Qfraction; -Lisp_Object Qsuper; -Lisp_Object Qsub; -Lisp_Object Qcircle; -Lisp_Object Qsquare; -Lisp_Object Qwide; -Lisp_Object Qnarrow; -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) -{ - if (INTP (v)) - return XINT (v); - if (CHARP (v)) - return XCHAR (v); - else if (EQ (v, Qcompat)) - return -1; - else if (EQ (v, Qisolated)) - return -2; - else if (EQ (v, Qinitial)) - return -3; - else if (EQ (v, Qmedial)) - return -4; - else if (EQ (v, Qfinal)) - return -5; - else if (EQ (v, Qvertical)) - return -6; - else if (EQ (v, QnoBreak)) - return -7; - else if (EQ (v, Qfraction)) - return -8; - else if (EQ (v, Qsuper)) - return -9; - else if (EQ (v, Qsub)) - return -10; - else if (EQ (v, Qcircle)) - return -11; - else if (EQ (v, Qsquare)) - return -12; - else if (EQ (v, Qwide)) - return -13; - else if (EQ (v, Qnarrow)) - return -14; - else if (EQ (v, Qsmall)) - return -15; - else if (EQ (v, Qfont)) - return -16; - else - signal_simple_error (err_msg, err_arg); -} - -DEFUN ("get-composite-char", Fget_composite_char, 1, 1, 0, /* -Return character corresponding with list. -*/ - (list)) -{ - Lisp_Object table = Vcharacter_composition_table; - Lisp_Object rest = list; - - while (CONSP (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 (c, table); - - 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); - } - signal_simple_error ("Invalid value for composition", list); -} - -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. -*/ - (attribute)) -{ - 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, /* -Return the alist of attributes of CHARACTER. -*/ - (character)) -{ - 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; - - 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, 3, 0, /* -Return the value of CHARACTER's ATTRIBUTE. -Return DEFAULT-VALUE if the value is not exist. -*/ - (character, attribute, default_value)) -{ - Lisp_Object ccs; - - 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 (character), encoding_table); - } - else - { - Lisp_Object table = Fgethash (attribute, - Vchar_attribute_hash_table, - Qunbound); - if (!UNBOUNDP (table)) - { - Lisp_Object ret = get_char_id_table (XCHAR (character), table); - if (!UNBOUNDP (ret)) - return ret; - } - } - return default_value; -} - -DEFUN ("put-char-attribute", Fput_char_attribute, 3, 3, 0, /* -Store CHARACTER's ATTRIBUTE with VALUE. -*/ - (character, attribute, value)) -{ - Lisp_Object ccs; - - CHECK_CHAR (character); - ccs = Ffind_charset (attribute); - if (!NILP (ccs)) - { - 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); - - 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)) - { - Lisp_Object v = Fcar (rest); - Lisp_Object ntable; - 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)) - { - put_char_id_table (c, character, table); - break; - } - else - { - ntable = get_char_id_table (c, table); - if (!CHAR_ID_TABLE_P (ntable)) - { - ntable = make_char_id_table (Qnil); - put_char_id_table (c, ntable, table); - } - table = ntable; - } - } - } - else - { - Lisp_Object v = Fcar (value); - - if (INTP (v)) - { - Emchar c = XINT (v); - Lisp_Object ret - = get_char_id_table (c, Vcharacter_variant_table); - - if (NILP (Fmemq (v, ret))) - { - put_char_id_table (c, Fcons (character, ret), - Vcharacter_variant_table); - } - } - seq = make_vector (1, v); - } - value = seq; - } - else if (EQ (attribute, Qto_ucs) || EQ (attribute, Q_ucs)) - { - Lisp_Object ret; - Emchar c; - - if (!INTP (value)) - signal_simple_error ("Invalid value for ->ucs", value); - - c = XINT (value); - - ret = get_char_id_table (c, Vcharacter_variant_table); - if (NILP (Fmemq (character, ret))) - { - put_char_id_table (c, Fcons (character, ret), - Vcharacter_variant_table); - } -#if 0 - if (EQ (attribute, Q_ucs)) - attribute = Qto_ucs; -#endif - } - { - 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, /* -Remove CHARACTER's ATTRIBUTE. -*/ - (character, attribute)) -{ - Lisp_Object ccs; - - CHECK_CHAR (character); - ccs = Ffind_charset (attribute); - if (!NILP (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; -} - -DEFUN ("map-char-attribute", Fmap_char_attribute, 2, 2, 0, /* -Map FUNCTION over entries in ATTRIBUTE, calling it with two args, -each key and value in the table. -*/ - (function, attribute)) -{ - Lisp_Object ccs; - Lisp_Char_ID_Table *ct; - struct slow_map_char_id_table_arg slarg; - struct gcpro gcpro1, gcpro2; - - if (!NILP (ccs = Ffind_charset (attribute))) - { - Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (ccs); - - if (CHAR_ID_TABLE_P (encoding_table)) - ct = XCHAR_ID_TABLE (encoding_table); - else - return Qnil; - } - else - { - Lisp_Object table = Fgethash (attribute, - Vchar_attribute_hash_table, - Qunbound); - if (CHAR_ID_TABLE_P (table)) - ct = XCHAR_ID_TABLE (table); - else - return Qnil; - } - slarg.function = function; - slarg.retval = Qnil; - GCPRO2 (slarg.function, slarg.retval); - map_char_id_table (ct, slow_map_char_id_table_fun, &slarg); - UNGCPRO; - - return slarg.retval; -} - INLINE_HEADER int CHARSET_BYTE_SIZE (Lisp_Charset* cs); INLINE_HEADER int CHARSET_BYTE_SIZE (Lisp_Charset* cs) @@ -1650,7 +354,7 @@ put_char_ccs_code_point (Lisp_Object character, XCHARSET_ENCODING_TABLE (ccs) = encoding_table = make_char_id_table (Qnil); } - put_char_id_table (XCHAR (character), value, encoding_table); + put_char_id_table (XCHAR_TABLE(encoding_table), character, value); return Qt; } @@ -1672,117 +376,13 @@ remove_char_ccs (Lisp_Object character, Lisp_Object ccs) XINT (cpos)); } } - if (CHAR_ID_TABLE_P (encoding_table)) + if (CHAR_TABLEP (encoding_table)) { - put_char_id_table (XCHAR (character), Qnil, encoding_table); + put_char_id_table (XCHAR_TABLE(encoding_table), character, Qnil); } return Qt; } -EXFUN (Fmake_char, 3); -EXFUN (Fdecode_char, 2); - -DEFUN ("define-char", Fdefine_char, 1, 1, 0, /* -Store character's ATTRIBUTES. -*/ - (attributes)) -{ - Lisp_Object rest = attributes; - Lisp_Object code = Fcdr (Fassq (Qucs, attributes)); - Lisp_Object character; - - if (NILP (code)) - { - while (CONSP (rest)) - { - Lisp_Object cell = Fcar (rest); - Lisp_Object ccs; - - if (!LISTP (cell)) - signal_simple_error ("Invalid argument", attributes); - if (!NILP (ccs = Ffind_charset (Fcar (cell))) - && ((XCHARSET_FINAL (ccs) != 0) || - (XCHARSET_UCS_MAX (ccs) > 0)) ) - { - cell = Fcdr (cell); - if (CONSP (cell)) - character = Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell))); - else - character = Fdecode_char (ccs, cell); - if (!NILP (character)) - goto setup_attributes; - } - rest = Fcdr (rest); - } - if ( (!NILP (code = Fcdr (Fassq (Qto_ucs, attributes)))) || - (!NILP (code = Fcdr (Fassq (Q_ucs, attributes)))) ) - - { - if (!INTP (code)) - signal_simple_error ("Invalid argument", attributes); - else - character = make_char (XINT (code) + 0x100000); - goto setup_attributes; - } - return Qnil; - } - else if (!INTP (code)) - signal_simple_error ("Invalid argument", attributes); - else - character = make_char (XINT (code)); - - setup_attributes: - rest = attributes; - while (CONSP (rest)) - { - Lisp_Object cell = Fcar (rest); - - if (!LISTP (cell)) - signal_simple_error ("Invalid argument", attributes); - - Fput_char_attribute (character, Fcar (cell), Fcdr (cell)); - rest = Fcdr (rest); - } - return character; -} - -DEFUN ("find-char", Ffind_char, 1, 1, 0, /* -Retrieve the character of the given ATTRIBUTES. -*/ - (attributes)) -{ - Lisp_Object rest = attributes; - Lisp_Object code; - - while (CONSP (rest)) - { - Lisp_Object cell = Fcar (rest); - Lisp_Object ccs; - - if (!LISTP (cell)) - signal_simple_error ("Invalid argument", attributes); - if (!NILP (ccs = Ffind_charset (Fcar (cell)))) - { - cell = Fcdr (cell); - if (CONSP (cell)) - return Fmake_char (ccs, Fcar (cell), Fcar (Fcdr (cell))); - else - return Fdecode_char (ccs, cell); - } - rest = Fcdr (rest); - } - if ( (!NILP (code = Fcdr (Fassq (Qto_ucs, attributes)))) || - (!NILP (code = Fcdr (Fassq (Q_ucs, attributes)))) ) - { - if (!INTP (code)) - signal_simple_error ("Invalid argument", attributes); - else - return make_char (XINT (code) + 0x100000); - } - return Qnil; -} - -Lisp_Object Vutf_2000_version; #endif #ifndef UTF2000 @@ -1822,6 +422,7 @@ Lisp_Object Qascii, Qchinese_cns11643_1, Qchinese_cns11643_2, #ifdef UTF2000 + Qucs, Qucs_bmp, Qucs_cns, Qucs_jis, @@ -1834,6 +435,8 @@ Lisp_Object Qascii, Qvietnamese_viscii_upper, Qchinese_big5, Qchinese_big5_cdp, + Qjapanese_jef_china3, + Qideograph_daikanwa, Qideograph_gt, Qideograph_gt_pj_1, Qideograph_gt_pj_2, @@ -2709,6 +1312,16 @@ encode_builtin_char_1 (Emchar c, Lisp_Object* charset) *charset = Vcharset_mojikyo; return c - MIN_CHAR_MOJIKYO; } + else if (c < MIN_CHAR_JEF_CHINA3) + { + *charset = Vcharset_ucs; + return c; + } + else if (c <= MAX_CHAR_JEF_CHINA3) + { + *charset = Vcharset_japanese_jef_china3; + return c - MAX_CHAR_JEF_CHINA3; + } else { *charset = Vcharset_ucs; @@ -3647,12 +2260,6 @@ Return a string of the characters comprising a composite character. 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 INIT_LRECORD_IMPLEMENTATION (charset); DEFSUBR (Fcharsetp); @@ -3674,17 +2281,6 @@ 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); - DEFSUBR (Fremove_char_attribute); - DEFSUBR (Fmap_char_attribute); - DEFSUBR (Fdefine_char); - DEFSUBR (Ffind_char); - DEFSUBR (Fchar_variants); - DEFSUBR (Fget_composite_char); DEFSUBR (Fcharset_mapping_table); DEFSUBR (Fset_charset_mapping_table); #endif @@ -3741,25 +2337,6 @@ syms_of_mule_charset (void) defsymbol (&Qchinese_cns11643_1, "chinese-cns11643-1"); defsymbol (&Qchinese_cns11643_2, "chinese-cns11643-2"); #ifdef UTF2000 - defsymbol (&Qto_ucs, "=>ucs"); - defsymbol (&Q_ucs, "->ucs"); - defsymbol (&Q_decomposition, "->decomposition"); - defsymbol (&Qcompat, "compat"); - defsymbol (&Qisolated, "isolated"); - defsymbol (&Qinitial, "initial"); - defsymbol (&Qmedial, "medial"); - defsymbol (&Qfinal, "final"); - defsymbol (&Qvertical, "vertical"); - defsymbol (&QnoBreak, "noBreak"); - defsymbol (&Qfraction, "fraction"); - defsymbol (&Qsuper, "super"); - defsymbol (&Qsub, "sub"); - defsymbol (&Qcircle, "circle"); - defsymbol (&Qsquare, "square"); - defsymbol (&Qwide, "wide"); - defsymbol (&Qnarrow, "narrow"); - defsymbol (&Qsmall, "small"); - defsymbol (&Qfont, "font"); defsymbol (&Qucs, "ucs"); defsymbol (&Qucs_bmp, "ucs-bmp"); defsymbol (&Qucs_cns, "ucs-cns"); @@ -3786,6 +2363,7 @@ syms_of_mule_charset (void) defsymbol (&Qideograph_daikanwa, "ideograph-daikanwa"); defsymbol (&Qchinese_big5, "chinese-big5"); defsymbol (&Qchinese_big5_cdp, "chinese-big5-cdp"); + defsymbol (&Qjapanese_jef_china3, "japanese-jef-china3"); defsymbol (&Qmojikyo, "mojikyo"); defsymbol (&Qmojikyo_2022_1, "mojikyo-2022-1"); defsymbol (&Qmojikyo_pj_1, "mojikyo-pj-1"); @@ -3861,17 +2439,6 @@ Leading-code of private TYPE9N charset of column-width 1. #endif #ifdef UTF2000 - Vutf_2000_version = build_string("0.17 (Hōryūji)"); - DEFVAR_LISP ("utf-2000-version", &Vutf_2000_version /* -Version number of 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); - Vdefault_coded_charset_priority_list = Qnil; DEFVAR_LISP ("default-coded-charset-priority-list", &Vdefault_coded_charset_priority_list /* @@ -3891,10 +2458,6 @@ 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, @@ -4223,6 +2786,15 @@ complex_vars_of_mule_charset (void) build_string ("Big5 with CDP extension"), build_string ("big5\\.cdp-0"), Qnil, 0, 0, 0, 0); + staticpro (&Vcharset_japanese_jef_china3); + Vcharset_japanese_jef_china3 = + make_charset (LEADING_BYTE_JEF_CHINA3, Qjapanese_jef_china3, 256, 2, + 2, 2, 0, CHARSET_LEFT_TO_RIGHT, + build_string ("JC3"), + build_string ("JEF + CHINA3"), + build_string ("JEF + CHINA3 private characters"), + build_string ("china3jef-0"), + Qnil, MIN_CHAR_JEF_CHINA3, MAX_CHAR_JEF_CHINA3, 0, 0); staticpro (&Vcharset_ideograph_gt); Vcharset_ideograph_gt = make_charset (LEADING_BYTE_GT, Qideograph_gt, 256, 3,