X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=src%2Fmule-charset.c;h=0965a216b5201cb6ae497dec6712ab725ff2cc94;hb=bdd33b388156837b59e1b3f92286c503bb80db6c;hp=6f350e7779a0e23576dd9fdbf5af75a2bfda21a9;hpb=5a534333b2beb1083d60954d6e1e4044fcd5cf64;p=chise%2Fxemacs-chise.git diff --git a/src/mule-charset.c b/src/mule-charset.c index 6f350e7..0965a21 100644 --- a/src/mule-charset.c +++ b/src/mule-charset.c @@ -65,10 +65,12 @@ Lisp_Object Vcharset_chinese_cns11643_2; #ifdef UTF2000 Lisp_Object Vcharset_ucs; Lisp_Object Vcharset_ucs_bmp; +Lisp_Object Vcharset_ucs_cns; Lisp_Object Vcharset_latin_viscii; Lisp_Object Vcharset_latin_tcvn5712; Lisp_Object Vcharset_latin_viscii_lower; Lisp_Object Vcharset_latin_viscii_upper; +Lisp_Object Vcharset_chinese_big5; Lisp_Object Vcharset_ideograph_daikanwa; Lisp_Object Vcharset_mojikyo; Lisp_Object Vcharset_mojikyo_2022_1; @@ -229,7 +231,7 @@ mark_uint8_byte_table (Lisp_Object obj) static void print_uint8_byte_table (Lisp_Object obj, - Lisp_Object printcharfun, int escapeflag) + Lisp_Object printcharfun, int escapeflag) { Lisp_Uint8_Byte_Table *bte = XUINT8_BYTE_TABLE (obj); int i; @@ -487,6 +489,24 @@ make_uint16_byte_table (unsigned short initval) 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) { @@ -652,14 +672,8 @@ put_byte_table (Lisp_Object table, unsigned char idx, Lisp_Object value) } else if (UINT16_VALUE_P (value)) { - Lisp_Object new = make_uint16_byte_table (Qnil); - int i; + Lisp_Object new = expand_uint8_byte_table_to_uint16 (table); - 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; } @@ -1092,10 +1106,11 @@ Return the alist of attributes of CHARACTER. return alist; } -DEFUN ("get-char-attribute", Fget_char_attribute, 2, 2, 0, /* +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)) + (character, attribute, default_value)) { Lisp_Object ccs; @@ -1106,8 +1121,6 @@ Return the value of CHARACTER's ATTRIBUTE. if (CHAR_ID_TABLE_P (encoding_table)) return get_char_id_table (XCHAR (character), encoding_table); - else - return Qnil; } else { @@ -1121,7 +1134,7 @@ Return the value of CHARACTER's ATTRIBUTE. return ret; } } - return Qnil; + return default_value; } DEFUN ("put-char-attribute", Fput_char_attribute, 3, 3, 0, /* @@ -1416,7 +1429,7 @@ put_char_ccs_code_point (Lisp_Object character, if (VECTORP (v)) { - Lisp_Object cpos = Fget_char_attribute (character, ccs); + Lisp_Object cpos = Fget_char_attribute (character, ccs, Qnil); if (!NILP (cpos)) { decoding_table_remove_char (v, dim, byte_offset, XINT (cpos)); @@ -1447,7 +1460,7 @@ remove_char_ccs (Lisp_Object character, Lisp_Object ccs) if (VECTORP (decoding_table)) { - Lisp_Object cpos = Fget_char_attribute (character, ccs); + Lisp_Object cpos = Fget_char_attribute (character, ccs, Qnil); if (!NILP (cpos)) { @@ -1475,9 +1488,6 @@ 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)) { @@ -1521,36 +1531,11 @@ 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 character; @@ -1596,12 +1581,14 @@ Lisp_Object Qascii, Qchinese_cns11643_2, #ifdef UTF2000 Qucs_bmp, + Qucs_cns, Qlatin_viscii, Qlatin_tcvn5712, Qlatin_viscii_lower, Qlatin_viscii_upper, Qvietnamese_viscii_lower, Qvietnamese_viscii_upper, + Qchinese_big5, Qmojikyo, Qmojikyo_2022_1, Qmojikyo_pj_1, @@ -1896,30 +1883,18 @@ non_ascii_valid_char_p (Emchar ch) /* Basic string functions */ /************************************************************************/ -/* Copy the character pointed to by PTR into STR, assuming it's - non-ASCII. Do not call this directly. Use the macro - charptr_copy_char() instead. */ +/* Copy the character pointed to by SRC into DST. Do not call this + directly. Use the macro charptr_copy_char() instead. + Return the number of bytes copied. */ Bytecount -non_ascii_charptr_copy_char (const Bufbyte *ptr, Bufbyte *str) +non_ascii_charptr_copy_char (const Bufbyte *src, Bufbyte *dst) { - Bufbyte *strptr = str; - *strptr = *ptr++; - switch (REP_BYTES_BY_FIRST_BYTE (*strptr)) - { - /* Notice fallthrough. */ -#ifdef UTF2000 - case 6: *++strptr = *ptr++; - case 5: *++strptr = *ptr++; -#endif - case 4: *++strptr = *ptr++; - case 3: *++strptr = *ptr++; - case 2: *++strptr = *ptr; - break; - default: - abort (); - } - return strptr + 1 - str; + unsigned int bytes = REP_BYTES_BY_FIRST_BYTE (*src); + unsigned int i; + for (i = bytes; i; i--, dst++, src++) + *dst = *src; + return bytes; } @@ -1936,36 +1911,15 @@ Lstream_get_emchar_1 (Lstream *stream, int ch) { Bufbyte str[MAX_EMCHAR_LEN]; Bufbyte *strptr = str; + unsigned int bytes; str[0] = (Bufbyte) ch; - switch (REP_BYTES_BY_FIRST_BYTE (ch)) + + for (bytes = REP_BYTES_BY_FIRST_BYTE (ch) - 1; bytes; bytes--) { - /* Notice fallthrough. */ -#ifdef UTF2000 - case 6: - ch = Lstream_getc (stream); - assert (ch >= 0); - *++strptr = (Bufbyte) ch; - case 5: - ch = Lstream_getc (stream); - assert (ch >= 0); - *++strptr = (Bufbyte) ch; -#endif - case 4: - ch = Lstream_getc (stream); - assert (ch >= 0); - *++strptr = (Bufbyte) ch; - case 3: - ch = Lstream_getc (stream); - assert (ch >= 0); - *++strptr = (Bufbyte) ch; - case 2: - ch = Lstream_getc (stream); - assert (ch >= 0); - *++strptr = (Bufbyte) ch; - break; - default: - abort (); + int c = Lstream_getc (stream); + bufpos_checking_assert (c >= 0); + *++strptr = (Bufbyte) c; } return charptr_emchar (str); } @@ -2059,8 +2013,9 @@ DEFINE_LRECORD_IMPLEMENTATION ("charset", charset, mark_charset, print_charset, 0, 0, 0, charset_description, Lisp_Charset); -/* Make a new charset. */ +/* Make a new charset. */ +/* #### SJT Should generic properties be allowed? */ static Lisp_Object make_charset (Charset_ID id, Lisp_Object name, unsigned short chars, unsigned char dimension, @@ -2177,6 +2132,10 @@ get_unallocated_leading_byte (int dimension) } #ifdef UTF2000 +/* Number of Big5 characters which have the same code in 1st byte. */ + +#define BIG5_SAME_ROW (0xFF - 0xA1 + 0x7F - 0x40) + Emchar make_builtin_char (Lisp_Object charset, int c1, int c2) { @@ -2212,6 +2171,25 @@ make_builtin_char (Lisp_Object charset, int c1, int c2) } else { + if (EQ (charset, Vcharset_chinese_big5)) + { + int B1 = c1, B2 = c2; + unsigned int I + = (B1 - 0xA1) * BIG5_SAME_ROW + + B2 - (B2 < 0x7F ? 0x40 : 0x62); + + if (B1 < 0xC9) + { + charset = Vcharset_chinese_big5_1; + } + else + { + charset = Vcharset_chinese_big5_2; + I -= (BIG5_SAME_ROW) * (0xC9 - 0xA1); + } + c1 = I / 94 + 33; + c2 = I % 94 + 33; + } switch (XCHARSET_CHARS (charset)) { case 94: @@ -2385,17 +2363,15 @@ encode_builtin_char_1 (Emchar c, Lisp_Object* charset) *charset = Vcharset_ucs; return c; } - /* else if (c <= MAX_CHAR_DAIKANWA) { *charset = Vcharset_ideograph_daikanwa; return c - MIN_CHAR_DAIKANWA; } - */ - else if (c <= MAX_CHAR_MOJIKYO) + else if (c <= MAX_CHAR_MOJIKYO_0) { *charset = Vcharset_mojikyo; - return c - MIN_CHAR_MOJIKYO; + return c - MIN_CHAR_MOJIKYO_0; } else if (c < MIN_CHAR_94) { @@ -2458,6 +2434,16 @@ encode_builtin_char_1 (Emchar c, Lisp_Object* charset) return c; } } + else if (c < MIN_CHAR_MOJIKYO) + { + *charset = Vcharset_ucs; + return c; + } + else if (c <= MAX_CHAR_MOJIKYO) + { + *charset = Vcharset_mojikyo; + return c - MIN_CHAR_MOJIKYO; + } else { *charset = Vcharset_ucs; @@ -2550,13 +2536,14 @@ Return a list of the names of all defined charsets. } DEFUN ("charset-name", Fcharset_name, 1, 1, 0, /* -Return the name of the given charset. +Return the name of charset CHARSET. */ (charset)) { return XCHARSET_NAME (Fget_charset (charset)); } +/* #### SJT Should generic properties be allowed? */ DEFUN ("make-charset", Fmake_charset, 3, 3, 0, /* Define a new character set. This function is for use with Mule support. @@ -2610,7 +2597,6 @@ character set. Recognized properties are: int direction = CHARSET_LEFT_TO_RIGHT; Lisp_Object registry = Qnil; Lisp_Object charset; - Lisp_Object rest, keyword, value; Lisp_Object ccl_program = Qnil; Lisp_Object short_name = Qnil, long_name = Qnil; int byte_offset = -1; @@ -2623,89 +2609,94 @@ character set. Recognized properties are: if (!NILP (charset)) signal_simple_error ("Cannot redefine existing charset", name); - EXTERNAL_PROPERTY_LIST_LOOP (rest, keyword, value, props) - { - if (EQ (keyword, Qshort_name)) - { - CHECK_STRING (value); - short_name = value; - } + { + EXTERNAL_PROPERTY_LIST_LOOP_3 (keyword, value, props) + { + if (EQ (keyword, Qshort_name)) + { + CHECK_STRING (value); + short_name = value; + } - if (EQ (keyword, Qlong_name)) - { - CHECK_STRING (value); - long_name = value; - } + if (EQ (keyword, Qlong_name)) + { + CHECK_STRING (value); + long_name = value; + } - else if (EQ (keyword, Qdimension)) - { - CHECK_INT (value); - dimension = XINT (value); - if (dimension < 1 || dimension > 2) - signal_simple_error ("Invalid value for 'dimension", value); - } + else if (EQ (keyword, Qdimension)) + { + CHECK_INT (value); + dimension = XINT (value); + if (dimension < 1 || dimension > 2) + signal_simple_error ("Invalid value for 'dimension", value); + } - else if (EQ (keyword, Qchars)) - { - CHECK_INT (value); - chars = XINT (value); - if (chars != 94 && chars != 96) - signal_simple_error ("Invalid value for 'chars", value); - } + else if (EQ (keyword, Qchars)) + { + CHECK_INT (value); + chars = XINT (value); + if (chars != 94 && chars != 96) + signal_simple_error ("Invalid value for 'chars", value); + } - else if (EQ (keyword, Qcolumns)) - { - CHECK_INT (value); - columns = XINT (value); - if (columns != 1 && columns != 2) - signal_simple_error ("Invalid value for 'columns", value); - } + else if (EQ (keyword, Qcolumns)) + { + CHECK_INT (value); + columns = XINT (value); + if (columns != 1 && columns != 2) + signal_simple_error ("Invalid value for 'columns", value); + } - else if (EQ (keyword, Qgraphic)) - { - CHECK_INT (value); - graphic = XINT (value); + else if (EQ (keyword, Qgraphic)) + { + CHECK_INT (value); + graphic = XINT (value); #ifdef UTF2000 - if (graphic < 0 || graphic > 2) + if (graphic < 0 || graphic > 2) #else - if (graphic < 0 || graphic > 1) + if (graphic < 0 || graphic > 1) #endif - signal_simple_error ("Invalid value for 'graphic", value); - } + signal_simple_error ("Invalid value for 'graphic", value); + } - else if (EQ (keyword, Qregistry)) - { - CHECK_STRING (value); - registry = value; - } + else if (EQ (keyword, Qregistry)) + { + CHECK_STRING (value); + registry = value; + } - else if (EQ (keyword, Qdirection)) - { - if (EQ (value, Ql2r)) - direction = CHARSET_LEFT_TO_RIGHT; - else if (EQ (value, Qr2l)) - direction = CHARSET_RIGHT_TO_LEFT; - else - signal_simple_error ("Invalid value for 'direction", value); - } + else if (EQ (keyword, Qdirection)) + { + if (EQ (value, Ql2r)) + direction = CHARSET_LEFT_TO_RIGHT; + else if (EQ (value, Qr2l)) + direction = CHARSET_RIGHT_TO_LEFT; + else + signal_simple_error ("Invalid value for 'direction", value); + } - else if (EQ (keyword, Qfinal)) - { - CHECK_CHAR_COERCE_INT (value); - final = XCHAR (value); - if (final < '0' || final > '~') - signal_simple_error ("Invalid value for 'final", value); - } + else if (EQ (keyword, Qfinal)) + { + CHECK_CHAR_COERCE_INT (value); + final = XCHAR (value); + if (final < '0' || final > '~') + signal_simple_error ("Invalid value for 'final", value); + } - else if (EQ (keyword, Qccl_program)) - { - CHECK_VECTOR (value); - ccl_program = value; - } + else if (EQ (keyword, Qccl_program)) + { + struct ccl_program test_ccl; - else - signal_simple_error ("Unrecognized property", keyword); - } + if (setup_ccl_program (&test_ccl, value) < 0) + signal_simple_error ("Invalid value for 'ccl-program", value); + ccl_program = value; + } + + else + signal_simple_error ("Unrecognized property", keyword); + } + } if (!final) error ("'final must be specified"); @@ -2925,7 +2916,7 @@ Return dimension of CHARSET. } DEFUN ("charset-property", Fcharset_property, 2, 2, 0, /* -Return property PROP of CHARSET. +Return property PROP of CHARSET, a charset object or symbol naming a charset. Recognized properties are those listed in `make-charset', as well as 'name and 'doc-string. */ @@ -2953,10 +2944,8 @@ Recognized properties are those listed in `make-charset', as well as if (EQ (prop, Qreverse_direction_charset)) { Lisp_Object obj = CHARSET_REVERSE_DIRECTION_CHARSET (cs); - if (NILP (obj)) - return Qnil; - else - return XCHARSET_NAME (obj); + /* #### Is this translation OK? If so, error checking sufficient? */ + return CHARSETP (obj) ? XCHARSET_NAME (obj) : obj; } signal_simple_error ("Unrecognized charset property name", prop); return Qnil; /* not reached */ @@ -2978,8 +2967,11 @@ Set the 'ccl-program property of CHARSET to CCL-PROGRAM. */ (charset, ccl_program)) { + struct ccl_program test_ccl; + charset = Fget_charset (charset); - CHECK_VECTOR (ccl_program); + if (setup_ccl_program (&test_ccl, ccl_program) < 0) + signal_simple_error ("Invalid ccl-program", ccl_program); XCHARSET_CCL_PROGRAM (charset) = ccl_program; return Qnil; } @@ -3223,7 +3215,7 @@ character s with caron. CHECK_INT (arg1); /* It is useful (and safe, according to Olivier Galibert) to strip - the 8th bit off ARG1 and ARG2 becaue it allows programmers to + the 8th bit off ARG1 and ARG2 because it allows programmers to write (make-char 'latin-iso8859-2 CODE) where code is the actual Latin 2 code of the character. */ #ifdef UTF2000 @@ -3259,27 +3251,27 @@ character s with caron. } DEFUN ("char-charset", Fchar_charset, 1, 1, 0, /* -Return the character set of char CH. +Return the character set of CHARACTER. */ - (ch)) + (character)) { - CHECK_CHAR_COERCE_INT (ch); + CHECK_CHAR_COERCE_INT (character); - return XCHARSET_NAME (CHAR_CHARSET (XCHAR (ch))); + return XCHARSET_NAME (CHAR_CHARSET (XCHAR (character))); } DEFUN ("char-octet", Fchar_octet, 1, 2, 0, /* -Return the octet numbered N (should be 0 or 1) of char CH. +Return the octet numbered N (should be 0 or 1) of CHARACTER. N defaults to 0 if omitted. */ - (ch, n)) + (character, n)) { Lisp_Object charset; int octet0, octet1; - CHECK_CHAR_COERCE_INT (ch); + CHECK_CHAR_COERCE_INT (character); - BREAKUP_CHAR (XCHAR (ch), charset, octet0, octet1); + BREAKUP_CHAR (XCHAR (character), charset, octet0, octet1); if (NILP (n) || EQ (n, Qzero)) return make_int (octet0); @@ -3290,7 +3282,7 @@ N defaults to 0 if omitted. } DEFUN ("split-char", Fsplit_char, 1, 1, 0, /* -Return list of charset and one or two position-codes of CHAR. +Return list of charset and one or two position-codes of CHARACTER. */ (character)) { @@ -3528,6 +3520,7 @@ syms_of_mule_charset (void) defsymbol (&Qfont, "font"); defsymbol (&Qucs, "ucs"); defsymbol (&Qucs_bmp, "ucs-bmp"); + defsymbol (&Qucs_cns, "ucs-cns"); defsymbol (&Qlatin_viscii, "latin-viscii"); defsymbol (&Qlatin_tcvn5712, "latin-tcvn5712"); defsymbol (&Qlatin_viscii_lower, "latin-viscii-lower"); @@ -3535,6 +3528,7 @@ syms_of_mule_charset (void) defsymbol (&Qvietnamese_viscii_lower, "vietnamese-viscii-lower"); defsymbol (&Qvietnamese_viscii_upper, "vietnamese-viscii-upper"); defsymbol (&Qideograph_daikanwa, "ideograph-daikanwa"); + defsymbol (&Qchinese_big5, "chinese-big5"); defsymbol (&Qmojikyo, "mojikyo"); defsymbol (&Qmojikyo_2022_1, "mojikyo-2022-1"); defsymbol (&Qmojikyo_pj_1, "mojikyo-pj-1"); @@ -3662,6 +3656,15 @@ complex_vars_of_mule_charset (void) build_string ("ISO/IEC 10646 Group 0 Plane 0 (BMP)"), build_string ("\\(ISO10646.*-1\\|UNICODE[23]?-0\\)"), Qnil, 0, 0xFFFF, 0, 0); + staticpro (&Vcharset_ucs_cns); + Vcharset_ucs_cns = + make_charset (LEADING_BYTE_UCS_CNS, Qucs_cns, 256, 4, + 1, 2, 0, CHARSET_LEFT_TO_RIGHT, + build_string ("UCS for CNS"), + build_string ("UCS for CNS 11643"), + build_string ("ISO/IEC 10646 for CNS 11643"), + build_string (""), + Qnil, 0, 0xFFFFFFF, 0, 0); #else # define MIN_CHAR_THAI 0 # define MAX_CHAR_THAI 0 @@ -3920,6 +3923,15 @@ complex_vars_of_mule_charset (void) build_string ("VISCII 1.1 (Vietnamese)"), build_string ("VISCII1\\.1"), Qnil, 0, 0, 0, 0); + staticpro (&Vcharset_chinese_big5); + Vcharset_chinese_big5 = + make_charset (LEADING_BYTE_CHINESE_BIG5, Qchinese_big5, 256, 2, + 2, 2, 0, CHARSET_LEFT_TO_RIGHT, + build_string ("Big5"), + build_string ("Big5"), + build_string ("Big5 Chinese traditional"), + build_string ("big5"), + Qnil, 0, 0, 0, 0); staticpro (&Vcharset_ideograph_daikanwa); Vcharset_ideograph_daikanwa = make_charset (LEADING_BYTE_DAIKANWA, Qideograph_daikanwa, 256, 2,