X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=src%2Fmule-charset.c;h=d093f54e7b6678893cd27c3a965fa98fd7636a97;hb=4ea9e31c43039a0d4b76dd0cd5d84a5ed7874e08;hp=d3c9fd423b0586816f4e41f089858f023009e7ca;hpb=72321376c53ccddd182d9e94fafd1ae1e6f98921;p=chise%2Fxemacs-chise.git diff --git a/src/mule-charset.c b/src/mule-charset.c index d3c9fd4..d093f54 100644 --- a/src/mule-charset.c +++ b/src/mule-charset.c @@ -62,6 +62,7 @@ Lisp_Object Vcharset_ucs_bmp; Lisp_Object Vcharset_latin_viscii; Lisp_Object Vcharset_latin_viscii_lower; Lisp_Object Vcharset_latin_viscii_upper; +Lisp_Object Vcharset_ethiopic_ucs; Lisp_Object Vcharset_hiragana_jisx0208; Lisp_Object Vcharset_katakana_jisx0208; #endif @@ -295,60 +296,62 @@ copy_char_code_table (Lisp_Object entry) Lisp_Object get_char_code_table (Emchar ch, Lisp_Object table) { + unsigned int code = ch; struct Lisp_Char_Byte_Table* cpt = XCHAR_BYTE_TABLE (XCHAR_CODE_TABLE (table)->table); - Lisp_Object ret = cpt->property [ch >> 24]; + Lisp_Object ret = cpt->property [(unsigned char)(code >> 24)]; if (CHAR_BYTE_TABLE_P (ret)) cpt = XCHAR_BYTE_TABLE (ret); else return ret; - ret = cpt->property [(unsigned char) (ch >> 16)]; + ret = cpt->property [(unsigned char) (code >> 16)]; if (CHAR_BYTE_TABLE_P (ret)) cpt = XCHAR_BYTE_TABLE (ret); else return ret; - ret = cpt->property [(unsigned char) (ch >> 8)]; + ret = cpt->property [(unsigned char) (code >> 8)]; if (CHAR_BYTE_TABLE_P (ret)) cpt = XCHAR_BYTE_TABLE (ret); else return ret; - return cpt->property [(unsigned char) ch]; + return cpt->property [(unsigned char) code]; } void put_char_code_table (Emchar ch, Lisp_Object value, Lisp_Object table) { + unsigned int code = ch; struct Lisp_Char_Byte_Table* cpt1 = XCHAR_BYTE_TABLE (XCHAR_CODE_TABLE (table)->table); - Lisp_Object ret = cpt1->property[ch >> 24]; + Lisp_Object ret = cpt1->property[(unsigned char)(code >> 24)]; if (CHAR_BYTE_TABLE_P (ret)) { struct Lisp_Char_Byte_Table* cpt2 = XCHAR_BYTE_TABLE (ret); - ret = cpt2->property[(unsigned char)(ch >> 16)]; + ret = cpt2->property[(unsigned char)(code >> 16)]; if (CHAR_BYTE_TABLE_P (ret)) { struct Lisp_Char_Byte_Table* cpt3 = XCHAR_BYTE_TABLE (ret); - ret = cpt3->property[(unsigned char)(ch >> 8)]; + ret = cpt3->property[(unsigned char)(code >> 8)]; if (CHAR_BYTE_TABLE_P (ret)) { struct Lisp_Char_Byte_Table* cpt4 = XCHAR_BYTE_TABLE (ret); - cpt4->property[(unsigned char)ch] = value; + cpt4->property[(unsigned char)code] = value; } else if (!EQ (ret, value)) { Lisp_Object cpt4 = make_char_byte_table (ret); - XCHAR_BYTE_TABLE(cpt4)->property[(unsigned char)ch] = value; - cpt3->property[(unsigned char)(ch >> 8)] = cpt4; + XCHAR_BYTE_TABLE(cpt4)->property[(unsigned char)code] = value; + cpt3->property[(unsigned char)(code >> 8)] = cpt4; } } else if (!EQ (ret, value)) @@ -356,10 +359,10 @@ put_char_code_table (Emchar ch, Lisp_Object value, Lisp_Object table) Lisp_Object cpt3 = make_char_byte_table (ret); Lisp_Object cpt4 = make_char_byte_table (ret); - XCHAR_BYTE_TABLE(cpt4)->property[(unsigned char)ch] = value; - XCHAR_BYTE_TABLE(cpt3)->property[(unsigned char)(ch >> 8)] + XCHAR_BYTE_TABLE(cpt4)->property[(unsigned char)code] = value; + XCHAR_BYTE_TABLE(cpt3)->property[(unsigned char)(code >> 8)] = cpt4; - cpt2->property[(unsigned char)(ch >> 16)] = cpt3; + cpt2->property[(unsigned char)(code >> 16)] = cpt3; } } else if (!EQ (ret, value)) @@ -368,15 +371,93 @@ put_char_code_table (Emchar ch, Lisp_Object value, Lisp_Object table) Lisp_Object cpt3 = make_char_byte_table (ret); Lisp_Object cpt4 = make_char_byte_table (ret); - XCHAR_BYTE_TABLE(cpt4)->property[(unsigned char)ch] = value; - XCHAR_BYTE_TABLE(cpt3)->property[(unsigned char)(ch >> 8)] = cpt4; - XCHAR_BYTE_TABLE(cpt2)->property[(unsigned char)(ch >> 16)] = cpt3; - cpt1->property[(unsigned char)(ch >> 24)] = cpt2; + XCHAR_BYTE_TABLE(cpt4)->property[(unsigned char)code] = value; + XCHAR_BYTE_TABLE(cpt3)->property[(unsigned char)(code >> 8)] = cpt4; + XCHAR_BYTE_TABLE(cpt2)->property[(unsigned char)(code >> 16)] = cpt3; + cpt1->property[(unsigned char)(code >> 24)] = cpt2; } } Lisp_Object Vcharacter_attribute_table; +Lisp_Object Vcharacter_composition_table; +Lisp_Object Vcharacter_variant_table; + +Lisp_Object Q_decomposition; +Lisp_Object Q_ucs; +Lisp_Object Qwide; +Lisp_Object Qnarrow; +Lisp_Object Qcompat; +Lisp_Object QnoBreak; +Lisp_Object Qsuper; +Lisp_Object Qfraction; + +Emchar +to_char_code (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, Qwide)) + return -1; + else if (EQ (v, Qnarrow)) + return -2; + else if (EQ (v, Qcompat)) + return -3; + else if (EQ (v, QnoBreak)) + return -4; + else if (EQ (v, Qsuper)) + return -5; + else if (EQ (v, Qfraction)) + return -6; + 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_code (v, "Invalid value for composition", list); + + ret = get_char_code_table (c, table); + + rest = Fcdr (rest); + if (NILP (rest)) + { + if (!CHAR_CODE_TABLE_P (ret)) + return ret; + else + return Qt; + } + else if (!CONSP (rest)) + break; + else if (CHAR_CODE_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_code_table (XCHAR (character), + Vcharacter_variant_table)); +} DEFUN ("char-attribute-alist", Fchar_attribute_alist, 1, 1, 0, /* Return the alist of attributes of CHARACTER. @@ -490,9 +571,11 @@ Store CHARACTER's ATTRIBUTE with VALUE. Lisp_Object ei = Fcar (rest); if (!INTP (ei)) - signal_simple_error ("Invalid value for coded-charset", - value); - i = XINT (ei) - XCHARSET_BYTE_OFFSET (ccs); + signal_simple_error ("Invalid value for coded-charset", value); + i = XINT (ei); + if ((i < 0) || (255 < i)) + signal_simple_error ("Invalid value for coded-charset", value); + i -= XCHARSET_BYTE_OFFSET (ccs); nv = XVECTOR_DATA(v)[i]; rest = Fcdr (rest); if (CONSP (rest)) @@ -508,6 +591,57 @@ Store CHARACTER's ATTRIBUTE with VALUE. } XVECTOR_DATA(v)[i] = character; } + else if (EQ (attribute, Q_decomposition)) + { + Lisp_Object rest = value; + Lisp_Object table = Vcharacter_composition_table; + + if (!CONSP (value)) + signal_simple_error ("Invalid value for ->decomposition", + value); + + while (CONSP (rest)) + { + Lisp_Object v = Fcar (rest); + Lisp_Object ntable; + Emchar c + = to_char_code (v, "Invalid value for ->decomposition", value); + + rest = Fcdr (rest); + if (!CONSP (rest)) + { + put_char_code_table (c, character, table); + break; + } + else + { + ntable = get_char_code_table (c, table); + if (!CHAR_CODE_TABLE_P (ntable)) + { + ntable = make_char_code_table (Qnil); + put_char_code_table (c, ntable, table); + } + table = ntable; + } + } + } + else if (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_code_table (c, Vcharacter_variant_table); + if (NILP (Fmemq (character, ret))) + { + put_char_code_table (c, Fcons (character, ret), + Vcharacter_variant_table); + } + } return put_char_attribute (character, attribute, value); } @@ -662,6 +796,7 @@ Lisp_Object Qascii, Qlatin_viscii_upper, Qvietnamese_viscii_lower, Qvietnamese_viscii_upper, + Qethiopic_ucs, Qhiragana_jisx0208, Qkatakana_jisx0208, #endif @@ -2028,7 +2163,16 @@ Set mapping-table of CHARSET to TABLE. } else if (VECTORP (table)) { - if (XVECTOR_LENGTH (table) > CHARSET_CHARS (cs)) + 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; @@ -2299,6 +2443,8 @@ syms_of_mule_charset (void) DEFSUBR (Fget_char_attribute); DEFSUBR (Fput_char_attribute); DEFSUBR (Fdefine_char); + DEFSUBR (Fchar_variants); + DEFSUBR (Fget_composite_char); DEFSUBR (Fcharset_mapping_table); DEFSUBR (Fset_charset_mapping_table); #endif @@ -2348,6 +2494,14 @@ syms_of_mule_charset (void) defsymbol (&Qchinese_cns11643_1, "chinese-cns11643-1"); defsymbol (&Qchinese_cns11643_2, "chinese-cns11643-2"); #ifdef UTF2000 + defsymbol (&Q_ucs, "->ucs"); + defsymbol (&Q_decomposition, "->decomposition"); + defsymbol (&Qwide, "wide"); + defsymbol (&Qnarrow, "narrow"); + defsymbol (&Qcompat, "compat"); + defsymbol (&QnoBreak, "noBreak"); + defsymbol (&Qsuper, "super"); + defsymbol (&Qfraction, "fraction"); defsymbol (&Qucs, "ucs"); defsymbol (&Qucs_bmp, "ucs-bmp"); defsymbol (&Qlatin_viscii, "latin-viscii"); @@ -2355,6 +2509,7 @@ syms_of_mule_charset (void) defsymbol (&Qlatin_viscii_upper, "latin-viscii-upper"); defsymbol (&Qvietnamese_viscii_lower, "vietnamese-viscii-lower"); defsymbol (&Qvietnamese_viscii_upper, "vietnamese-viscii-upper"); + defsymbol (&Qethiopic_ucs, "ethiopic-ucs"); defsymbol (&Qhiragana_jisx0208, "hiragana-jisx0208"); defsymbol (&Qkatakana_jisx0208, "katakana-jisx0208"); #endif @@ -2413,6 +2568,12 @@ Version number of UTF-2000. staticpro (&Vcharacter_attribute_table); Vcharacter_attribute_table = make_char_code_table (Qnil); + staticpro (&Vcharacter_composition_table); + Vcharacter_composition_table = make_char_code_table (Qnil); + + staticpro (&Vcharacter_variant_table); + Vcharacter_variant_table = make_char_code_table (Qnil); + Vdefault_coded_charset_priority_list = Qnil; DEFVAR_LISP ("default-coded-charset-priority-list", &Vdefault_coded_charset_priority_list /* @@ -2677,6 +2838,15 @@ complex_vars_of_mule_charset (void) build_string ("VISCII 1.1 (Vietnamese)"), build_string ("VISCII1\\.1"), Qnil, 0, 0, 0, 0); + Vcharset_ethiopic_ucs = + make_charset (LEADING_BYTE_ETHIOPIC_UCS, Qethiopic_ucs, + CHARSET_TYPE_256X256, 2, 2, 0, + CHARSET_LEFT_TO_RIGHT, + build_string ("Ethiopic (UCS)"), + build_string ("Ethiopic (UCS)"), + build_string ("Ethiopic of UCS"), + build_string ("Ethiopic-Unicode"), + Qnil, 0x1200, 0x137F, 0x1200, 0); Vcharset_hiragana_jisx0208 = make_charset (LEADING_BYTE_HIRAGANA_JISX0208, Qhiragana_jisx0208, CHARSET_TYPE_94X94, 2, 0, 'B',