Lisp_Object Vcoding_system_hash_table;
Lisp_Object Qcoding_system, Qcoding_aliases, Qeol_type;
-Lisp_Object Qunix, Qdos, Qmac;
+Lisp_Object Qunix, Qdos;
+extern Lisp_Object Qmac; /* frame.c */
Lisp_Object Qbuffer_file_coding_system;
Lisp_Object Qpost_read_conversion, Qpre_write_conversion;
Lisp_Object Qdefault_char;
error ("Undecodable char found"); \
c = ((c & 1) << 6) | *src++; \
} \
+ consumed_chars++; \
} while (0)
}
+/* Fixme: deal with surrogates? */
static void
decode_coding_utf_8 (coding)
struct coding_system *coding;
if (! UTF_8_EXTRA_OCTET_P (c2))
goto invalid_code;
if (UTF_8_2_OCTET_LEADING_P (c1))
- c = ((c1 & 0x1F) << 6) | (c2 & 0x3F);
+ {
+ c = ((c1 & 0x1F) << 6) | (c2 & 0x3F);
+ /* Reject overlong sequences here and below. Encoders
+ producing them are incorrect, they can be misleading,
+ and they mess up read/write invariance. */
+ if (c < 128)
+ goto invalid_code;
+ }
else
{
ONE_MORE_BYTE (c3);
if (! UTF_8_EXTRA_OCTET_P (c3))
goto invalid_code;
if (UTF_8_3_OCTET_LEADING_P (c1))
- c = (((c1 & 0xF) << 12)
- | ((c2 & 0x3F) << 6) | (c3 & 0x3F));
+ {
+ c = (((c1 & 0xF) << 12)
+ | ((c2 & 0x3F) << 6) | (c3 & 0x3F));
+ if (c < 0x800)
+ goto invalid_code;
+ }
else
{
ONE_MORE_BYTE (c4);
if (! UTF_8_EXTRA_OCTET_P (c4))
goto invalid_code;
if (UTF_8_4_OCTET_LEADING_P (c1))
+ {
c = (((c1 & 0x7) << 18) | ((c2 & 0x3F) << 12)
| ((c3 & 0x3F) << 6) | (c4 & 0x3F));
+ if (c < 0x10000)
+ goto invalid_code;
+ }
else
{
ONE_MORE_BYTE (c5);
c = (((c1 & 0x3) << 24) | ((c2 & 0x3F) << 18)
| ((c3 & 0x3F) << 12) | ((c4 & 0x3F) << 6)
| (c5 & 0x3F));
- if (c > MAX_CHAR)
+ if ((c > MAX_CHAR) || (c < 0x200000))
goto invalid_code;
}
else
int
-emacs_mule_char (coding, composition, nbytes, nchars)
+emacs_mule_char (coding, src, nbytes, nchars)
struct coding_system *coding;
- int composition;
+ unsigned char *src;
int *nbytes, *nchars;
{
- unsigned char *src = coding->source + coding->consumed;
unsigned char *src_end = coding->source + coding->src_bytes;
int multibytep = coding->src_multibyte;
unsigned char *src_base = src;
int consumed_chars = 0;
ONE_MORE_BYTE (c);
- if (composition)
- {
- c -= 0x20;
- if (c == 0x80)
- {
- ONE_MORE_BYTE (c);
- if (c < 0xA0)
- goto invalid_code;
- *nbytes = src - src_base;
- *nchars = consumed_chars;
- return (c - 0x80);
- }
- }
-
switch (emacs_mule_bytes[c])
{
case 2:
if (! (charset = emacs_mule_charset[c]))
goto invalid_code;
ONE_MORE_BYTE (c);
- code = (c & 0x7F) << 7;
+ code = (c & 0x7F) << 8;
ONE_MORE_BYTE (c);
code |= c & 0x7F;
}
break;
case 4:
+ ONE_MORE_BYTE (c);
if (! (charset = emacs_mule_charset[c]))
goto invalid_code;
ONE_MORE_BYTE (c);
- code = (c & 0x7F) << 7;
+ code = (c & 0x7F) << 8;
ONE_MORE_BYTE (c);
code |= c & 0x7F;
break;
\
if (src == src_end) \
break; \
- c = emacs_mule_char (coding, 1, &nbytes, &nchars); \
+ c = emacs_mule_char (coding, src, &nbytes, &nchars); \
if (c < 0) \
{ \
if (c == -2) \
/* Decode a composition rule represented as a component of composition
- sequence of Emacs 20 style at SRC. Set C to the rule. If SRC
- points an invalid byte sequence, set C to -1. */
+ sequence of Emacs 20 style at SRC. Store the decoded rule in *BUF,
+ and increment BUF. If SRC points an invalid byte sequence, set C
+ to -1. */
-#define DECODE_EMACS_MULE_COMPOSITION_RULE(buf) \
+#define DECODE_EMACS_MULE_COMPOSITION_RULE_20(buf) \
do { \
int c, gref, nref; \
\
- if (src < src_end) \
+ if (src >= src_end) \
goto invalid_code; \
ONE_MORE_BYTE_NO_CHECK (c); \
- c -= 0xA0; \
+ c -= 0x20; \
if (c < 0 || c >= 81) \
goto invalid_code; \
\
} while (0)
+/* Decode a composition rule represented as a component of composition
+ sequence of Emacs 21 style at SRC. Store the decoded rule in *BUF,
+ and increment BUF. If SRC points an invalid byte sequence, set C
+ to -1. */
+
+#define DECODE_EMACS_MULE_COMPOSITION_RULE_21(buf) \
+ do { \
+ int gref, nref; \
+ \
+ if (src + 1>= src_end) \
+ goto invalid_code; \
+ ONE_MORE_BYTE_NO_CHECK (gref); \
+ gref -= 0x20; \
+ ONE_MORE_BYTE_NO_CHECK (nref); \
+ nref -= 0x20; \
+ if (gref < 0 || gref >= 81 \
+ || nref < 0 || nref >= 81) \
+ goto invalid_code; \
+ *buf++ = COMPOSITION_ENCODE_RULE (gref, nref); \
+ } while (0)
+
+
#define ADD_COMPOSITION_DATA(buf, method, nchars) \
do { \
*buf++ = -5; \
#define DECODE_EMACS_MULE_21_COMPOSITION(c) \
do { \
/* Emacs 21 style format. The first three bytes at SRC are \
- (METHOD - 0xF0), (BYTES - 0xA0), (CHARS - 0xA0), where BYTES is \
+ (METHOD - 0xF2), (BYTES - 0xA0), (CHARS - 0xA0), where BYTES is \
the byte length of this composition information, CHARS is the \
number of characters composed by this composition. */ \
- enum composition_method method = c - 0xF0; \
+ enum composition_method method = c - 0xF2; \
+ int *charbuf_base = charbuf; \
int consumed_chars_limit; \
int nbytes, nchars; \
\
while (consumed_chars < consumed_chars_limit) \
{ \
if (i % 2 && method != COMPOSITION_WITH_ALTCHARS) \
- DECODE_EMACS_MULE_COMPOSITION_RULE (charbuf); \
+ DECODE_EMACS_MULE_COMPOSITION_RULE_21 (charbuf); \
else \
DECODE_EMACS_MULE_COMPOSITION_CHAR (charbuf); \
+ i++; \
} \
if (consumed_chars < consumed_chars_limit) \
goto invalid_code; \
+ charbuf_base[0] -= i; \
} \
} while (0)
DECODE_EMACS_MULE_COMPOSITION_CHAR (buf); \
for (i = 0; i < MAX_COMPOSITION_COMPONENTS; i++) \
{ \
- DECODE_EMACS_MULE_COMPOSITION_RULE (buf); \
+ DECODE_EMACS_MULE_COMPOSITION_RULE_20 (buf); \
DECODE_EMACS_MULE_COMPOSITION_CHAR (buf); \
} \
if (i < 1 || (buf - components) % 2 == 0) \
if (charbuf + 5 + (MAX_COMPOSITION_COMPONENTS * 2) - 1 > charbuf_end)
break;
ONE_MORE_BYTE (c);
- if (c - 0xF0 >= COMPOSITION_RELATIVE
- && c - 0xF0 <= COMPOSITION_WITH_RULE_ALTCHARS)
+ if (c - 0xF2 >= COMPOSITION_RELATIVE
+ && c - 0xF2 <= COMPOSITION_WITH_RULE_ALTCHARS)
DECODE_EMACS_MULE_21_COMPOSITION (c);
else if (c < 0xC0)
DECODE_EMACS_MULE_20_RELATIVE_COMPOSITION (c);
DECODE_EMACS_MULE_20_RULEBASE_COMPOSITION (c);
else
goto invalid_code;
+ coding->annotated = 1;
}
else if (c < 0xA0 && emacs_mule_bytes[c] > 1)
{
int nbytes, nchars;
- src--;
- c = emacs_mule_char (coding, 0, &nbytes, &nchars);
+ src = src_base;
+ consumed_chars = consumed_chars_base;
+ c = emacs_mule_char (coding, src, &nbytes, &nchars);
if (c < 0)
{
if (c == -2)
goto invalid_code;
}
*charbuf++ = c;
+ src += nbytes;
+ consumed_chars += nchars;
char_offset++;
}
continue;
(CODING_ISO_INITIAL (&coding_categories[category], 1) >= 0)
static void
-setup_iso_safe_charsets (Lisp_Object attrs)
+setup_iso_safe_charsets (attrs)
+ Lisp_Object attrs;
{
Lisp_Object charset_list, safe_charsets;
Lisp_Object request;
#define DECODE_COMPOSITION_START(c1) \
do { \
if (c1 == '0' \
- && composition_state == COMPOSING_COMPONENT_CHAR) \
+ && composition_state == COMPOSING_COMPONENT_RULE) \
{ \
component_len = component_idx; \
composition_state = COMPOSING_CHAR; \
composition_state--;
continue;
}
- else if (method == COMPOSITION_WITH_RULE)
- composition_state = COMPOSING_RULE;
- else if (method == COMPOSITION_WITH_RULE_ALTCHARS
- && composition_state == COMPOSING_COMPONENT_CHAR)
- composition_state = COMPOSING_COMPONENT_CHAR;
}
if (charset_id_0 < 0
|| ! CHARSET_ISO_CHARS_96 (CHARSET_FROM_ID (charset_id_0)))
- {
- /* This is SPACE or DEL. */
- charset = CHARSET_FROM_ID (charset_ascii);
- break;
- }
- /* This is a graphic character, we fall down ... */
+ /* This is SPACE or DEL. */
+ charset = CHARSET_FROM_ID (charset_ascii);
+ else
+ charset = CHARSET_FROM_ID (charset_id_0);
+ break;
case ISO_graphic_plane_0:
- if (composition_state == COMPOSING_RULE)
+ if (composition_state != COMPOSING_NO)
{
- DECODE_COMPOSITION_RULE (c1);
- components[component_idx++] = c1;
- composition_state = COMPOSING_CHAR;
+ if (composition_state == COMPOSING_RULE
+ || composition_state == COMPOSING_COMPONENT_RULE)
+ {
+ DECODE_COMPOSITION_RULE (c1);
+ components[component_idx++] = c1;
+ composition_state--;
+ continue;
+ }
}
charset = CHARSET_FROM_ID (charset_id_0);
break;
char_offset++;
}
else
- components[component_idx++] = c;
+ {
+ components[component_idx++] = c;
+ if (method == COMPOSITION_WITH_RULE
+ || (method == COMPOSITION_WITH_RULE_ALTCHARS
+ && composition_state == COMPOSING_COMPONENT_CHAR))
+ composition_state++;
+ }
continue;
invalid_code:
if (!charset)
{
- c = coding->default_char;
- charset = char_charset (c, charset_list, NULL);
+ if (coding->mode & CODING_MODE_SAFE_ENCODING)
+ {
+ c = CODING_INHIBIT_CHARACTER_SUBSTITUTION;
+ charset = CHARSET_FROM_ID (charset_ascii);
+ }
+ else
+ {
+ c = coding->default_char;
+ charset = char_charset (c, charset_list, NULL);
+ }
}
ENCODE_ISO_CHARACTER (charset, c);
}
if (!charset)
{
- c = coding->default_char;
- charset = char_charset (c, charset_list, &code);
+ if (coding->mode & CODING_MODE_SAFE_ENCODING)
+ {
+ code = CODING_INHIBIT_CHARACTER_SUBSTITUTION;
+ charset = CHARSET_FROM_ID (charset_ascii);
+ }
+ else
+ {
+ c = coding->default_char;
+ charset = char_charset (c, charset_list, &code);
+ }
}
if (code == CHARSET_INVALID_CODE (charset))
abort ();
if (! charset)
{
- c = coding->default_char;
- charset = char_charset (c, charset_list, &code);
+ if (coding->mode & CODING_MODE_SAFE_ENCODING)
+ {
+ code = CODING_INHIBIT_CHARACTER_SUBSTITUTION;
+ charset = CHARSET_FROM_ID (charset_ascii);
+ }
+ else
+ {
+ c = coding->default_char;
+ charset = char_charset (c, charset_list, &code);
+ }
}
if (code == CHARSET_INVALID_CODE (charset))
abort ();
ONE_MORE_BYTE (c);
if (c == '\r')
{
+ /* Here we assume that no charset maps '\r' to something
+ else. */
if (EQ (eol_type, Qdos))
{
if (src < src_end
{
Lisp_Object val;
struct charset *charset;
- int c1;
+ int dim;
+ int len = 1;
+ unsigned code = c;
val = AREF (valids, c);
if (NILP (val))
goto invalid_code;
- charset = CHARSET_FROM_ID (XFASTINT (val));
- if (CHARSET_DIMENSION (charset) > 1)
+ if (INTEGERP (val))
{
- ONE_MORE_BYTE (c1);
- c = (c << 8) | c1;
- if (CHARSET_DIMENSION (charset) > 2)
+ charset = CHARSET_FROM_ID (XFASTINT (val));
+ dim = CHARSET_DIMENSION (charset);
+ while (len < dim)
{
- ONE_MORE_BYTE (c1);
- c = (c << 8) | c1;
- if (CHARSET_DIMENSION (charset) > 3)
+ ONE_MORE_BYTE (c);
+ code = (code << 8) | c;
+ len++;
+ }
+ CODING_DECODE_CHAR (coding, src, src_base, src_end,
+ charset, code, c);
+ }
+ else
+ {
+ /* VAL is a list of charset IDs. It is assured that the
+ list is sorted by charset dimensions (smaller one
+ comes first). */
+ while (CONSP (val))
+ {
+ charset = CHARSET_FROM_ID (XFASTINT (XCAR (val)));
+ dim = CHARSET_DIMENSION (charset);
+ while (len < dim)
{
- ONE_MORE_BYTE (c1);
- c = (c << 8) | c1;
+ ONE_MORE_BYTE (c);
+ code = (code << 8) | c;
+ len++;
}
+ CODING_DECODE_CHAR (coding, src, src_base,
+ src_end, charset, code, c);
+ if (c >= 0)
+ break;
+ val = XCDR (val);
}
}
- CODING_DECODE_CHAR (coding, src, src_base, src_end, charset, c, c);
if (c < 0)
goto invalid_code;
}
(code >> 8) & 0xFF, code & 0xFF);
}
else
- EMIT_ONE_BYTE (coding->default_char);
+ {
+ if (coding->mode & CODING_MODE_SAFE_ENCODING)
+ c = CODING_INHIBIT_CHARACTER_SUBSTITUTION;
+ else
+ c = coding->default_char;
+ EMIT_ONE_BYTE (c);
+ }
}
}
DEFUN ("set-coding-system-priority", Fset_coding_system_priority,
Sset_coding_system_priority, 1, MANY, 0,
- doc: /* Assign higher priority to coding systems given as arguments.
+ doc: /* Assign higher priority to the coding systems given as arguments.
usage: (set-coding-system-priority CODING-SYSTEM ...) */)
(nargs, args)
int nargs;
DEFUN ("coding-system-priority-list", Fcoding_system_priority_list,
Scoding_system_priority_list, 0, 1, 0,
- doc: /* Return a list of coding systems ordered by their priorities. */)
+ doc: /* Return a list of coding systems ordered by their priorities.
+HIGHESTP non-nil means just return the highest priority one. */)
(highestp)
Lisp_Object highestp;
{
return Fnreverse (val);
}
+static char *suffixes[] = { "-unix", "-dos", "-mac" };
+
static Lisp_Object
make_subsidiaries (base)
Lisp_Object base;
{
Lisp_Object subsidiaries;
- char *suffixes[] = { "-unix", "-dos", "-mac" };
int base_name_len = STRING_BYTES (XSYMBOL (base)->name);
char *buf = (char *) alloca (base_name_len + 6);
int i;
if (EQ (coding_type, Qcharset))
{
+ /* Generate a lisp vector of 256 elements. Each element is nil,
+ integer, or a list of charset IDs.
+
+ If Nth element is nil, the byte code N is invalid in this
+ coding system.
+
+ If Nth element is a number NUM, N is the first byte of a
+ charset whose ID is NUM.
+
+ If Nth element is a list of charset IDs, N is the first byte
+ of one of them. The list is sorted by dimensions of the
+ charsets. A charset of smaller dimension comes firtst.
+ */
val = Fmake_vector (make_number (256), Qnil);
for (tail = charset_list; CONSP (tail); tail = XCDR (tail))
{
- struct charset *charset = CHARSET_FROM_ID (XINT (XCAR (tail)));
- int idx = (CHARSET_DIMENSION (charset) - 1) * 4;
-
+ struct charset *charset = CHARSET_FROM_ID (XFASTINT (XCAR (tail)));
+ int dim = CHARSET_DIMENSION (charset);
+ int idx = (dim - 1) * 4;
+
for (i = charset->code_space[idx];
i <= charset->code_space[idx + 1]; i++)
{
- if (NILP (AREF (val, i)))
- ASET (val, i, XCAR (tail));
+ Lisp_Object tmp, tmp2;
+ int dim2;
+
+ tmp = AREF (val, i);
+ if (NILP (tmp))
+ tmp = XCAR (tail);
+ else if (NUMBERP (tmp))
+ {
+ dim2 = CHARSET_DIMENSION (CHARSET_FROM_ID (XFASTINT (tmp)));
+ if (dim < dim2)
+ tmp = Fcons (XCAR (tail), Fcons (tmp, Qnil));
+ else
+ tmp = Fcons (tmp, Fcons (XCAR (tail), Qnil));
+ }
else
- error ("Charsets conflicts in the first byte");
+ {
+ for (tmp2 = tmp; CONSP (tmp2); tmp2 = XCDR (tmp2))
+ {
+ dim2 = CHARSET_DIMENSION (CHARSET_FROM_ID (XFASTINT (XCAR (tmp2))));
+ if (dim < dim2)
+ break;
+ }
+ if (NILP (tmp2))
+ tmp = nconc2 (tmp, Fcons (XCAR (tail), Qnil));
+ else
+ {
+ XSETCDR (tmp2, Fcons (XCAR (tmp2), XCDR (tmp2)));
+ XSETCAR (tmp2, XCAR (tail));
+ }
+ }
+ ASET (val, i, tmp);
}
}
ASET (attrs, coding_attr_charset_valids, val);
make_number (nargs)));
}
+/* Fixme: should this record the alias relationships for
+ diagnostics? */
DEFUN ("define-coding-system-alias", Fdefine_coding_system_alias,
Sdefine_coding_system_alias, 2, 2, 0,
doc: /* Define ALIAS as an alias for CODING-SYSTEM. */)
DEFUN ("coding-system-base", Fcoding_system_base, Scoding_system_base,
1, 1, 0,
doc: /* Return the base of CODING-SYSTEM.
-Any alias or subsidiary coding systems are not base coding system. */)
+Any alias or subsidiary coding system is not a base coding system. */)
(coding_system)
Lisp_Object coding_system;
{
DEFUN ("coding-system-aliases", Fcoding_system_aliases, Scoding_system_aliases,
1, 1, 0,
- doc: /* Return the list of aliases of CODING-SYSTEM.
-A base coding system is what made by `define-coding-system'.
-Any alias nor subsidiary coding systems are not base coding system. */)
+ doc: /* Return the list of aliases of CODING-SYSTEM. */)
(coding_system)
Lisp_Object coding_system;
{
if (NILP (coding_system))
coding_system = Qno_conversion;
CHECK_CODING_SYSTEM_GET_SPEC (coding_system, spec);
- return AREF (spec, 2);
+ return AREF (spec, 1);
}
DEFUN ("coding-system-eol-type", Fcoding_system_eol_type,
{
emacs_mule_bytes[i] = 1;
}
+ emacs_mule_bytes[LEADING_CODE_PRIVATE_11] = 3;
+ emacs_mule_bytes[LEADING_CODE_PRIVATE_12] = 3;
+ emacs_mule_bytes[LEADING_CODE_PRIVATE_21] = 4;
+ emacs_mule_bytes[LEADING_CODE_PRIVATE_22] = 4;
}
#ifdef emacs
DEFSYM (Qeol_type, "eol-type");
DEFSYM (Qunix, "unix");
DEFSYM (Qdos, "dos");
- DEFSYM (Qmac, "mac");
DEFSYM (Qbuffer_file_coding_system, "buffer-file-coding-system");
DEFSYM (Qpost_read_conversion, "post-read-conversion");
HCoop / bpt / emacs.git / blobdiff