X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=src%2Fmule-charset.c;h=c54162853b7f9cc07194751bd2ea52d13d827ae0;hb=0298dde5c47a900f2542bc7ec6c9dafc92ce3015;hp=bf0f718a7909279ef2ca88042be072b1082fc1f3;hpb=3e447015251ce6dcde843cbed10d9033d5538622;p=chise%2Fxemacs-chise.git- diff --git a/src/mule-charset.c b/src/mule-charset.c index bf0f718..c541628 100644 --- a/src/mule-charset.c +++ b/src/mule-charset.c @@ -150,9 +150,6 @@ Lisp_Object Ql2r, Qr2l; Lisp_Object Vcharset_hash_table; -static Bufbyte next_allocated_1_byte_leading_byte; -static Bufbyte next_allocated_2_byte_leading_byte; - /* Composite characters are characters constructed by overstriking two or more regular characters. @@ -325,26 +322,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. */ - 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; } @@ -361,26 +350,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. */ - 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); } @@ -467,8 +445,9 @@ static const struct lrecord_description charset_description[] = { 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 (int id, Lisp_Object name, unsigned char rep_bytes, unsigned char type, unsigned char columns, unsigned char graphic, @@ -529,17 +508,24 @@ get_unallocated_leading_byte (int dimension) if (dimension == 1) { - if (next_allocated_1_byte_leading_byte > MAX_LEADING_BYTE_PRIVATE_1) + if (chlook->next_allocated_1_byte_leading_byte > + MAX_LEADING_BYTE_PRIVATE_1) lb = 0; else - lb = next_allocated_1_byte_leading_byte++; + lb = chlook->next_allocated_1_byte_leading_byte++; } else { - if (next_allocated_2_byte_leading_byte > MAX_LEADING_BYTE_PRIVATE_2) - lb = 0; + /* awfully fragile, but correct */ +#if MAX_LEADING_BYTE_PRIVATE_2 == 255 + if (chlook->next_allocated_2_byte_leading_byte == 0) +#else + if (chlook->next_allocated_2_byte_leading_byte > + MAX_LEADING_BYTE_PRIVATE_2) +#endif + lb = 0; else - lb = next_allocated_2_byte_leading_byte++; + lb = chlook->next_allocated_2_byte_leading_byte++; } if (!lb) @@ -632,13 +618,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. @@ -693,7 +680,6 @@ character set. Recognized properties are: int type; 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; @@ -705,85 +691,90 @@ 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; - } - - 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, 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, Qgraphic)) - { - CHECK_INT (value); - graphic = XINT (value); - if (graphic < 0 || graphic > 1) - signal_simple_error ("Invalid value for 'graphic", 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, 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 - signal_simple_error ("Unrecognized property", keyword); - } + { + EXTERNAL_PROPERTY_LIST_LOOP_3 (keyword, value, props) + { + if (EQ (keyword, Qshort_name)) + { + CHECK_STRING (value); + short_name = value; + } + + else 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, 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, Qgraphic)) + { + CHECK_INT (value); + graphic = XINT (value); + if (graphic < 0 || graphic > 1) + signal_simple_error ("Invalid value for 'graphic", 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, 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)) + { + struct ccl_program test_ccl; + + 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"); @@ -979,7 +970,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. */ @@ -1007,10 +998,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 */ @@ -1032,8 +1021,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; } @@ -1093,7 +1085,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. */ a1 = XINT (arg1) & 0x7f; @@ -1117,28 +1109,28 @@ 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 (CHARSET_BY_LEADING_BYTE - (CHAR_LEADING_BYTE (XCHAR (ch)))); + (CHAR_LEADING_BYTE (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); @@ -1149,7 +1141,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)) { @@ -1259,6 +1251,8 @@ Return a string of the characters comprising a composite character. void syms_of_mule_charset (void) { + INIT_LRECORD_IMPLEMENTATION (charset); + DEFSUBR (Fcharsetp); DEFSUBR (Ffind_charset); DEFSUBR (Fget_charset); @@ -1333,8 +1327,8 @@ vars_of_mule_charset (void) { int i, j, k; - chlook = xnew (struct charset_lookup); - dumpstruct (&chlook, &charset_lookup_description); + chlook = xnew_and_zero (struct charset_lookup); /* zero for Purify. */ + dump_add_root_struct_ptr (&chlook, &charset_lookup_description); /* Table of charsets indexed by leading byte. */ for (i = 0; i < countof (chlook->charset_by_leading_byte); i++) @@ -1346,8 +1340,8 @@ vars_of_mule_charset (void) for (k = 0; k < countof (chlook->charset_by_attributes[0][0]); k++) chlook->charset_by_attributes[i][j][k] = Qnil; - next_allocated_1_byte_leading_byte = MIN_LEADING_BYTE_PRIVATE_1; - next_allocated_2_byte_leading_byte = MIN_LEADING_BYTE_PRIVATE_2; + chlook->next_allocated_1_byte_leading_byte = MIN_LEADING_BYTE_PRIVATE_1; + chlook->next_allocated_2_byte_leading_byte = MIN_LEADING_BYTE_PRIVATE_2; } void