Reformatted.
[chise/xemacs-chise.git.1] / src / text-coding.c
1 /* Code conversion functions.
2    Copyright (C) 1991, 1995 Free Software Foundation, Inc.
3    Copyright (C) 1995 Sun Microsystems, Inc.
4    Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2008, 2011,
5      2012, 2013 MORIOKA Tomohiko
6
7 This file is part of XEmacs.
8
9 XEmacs is free software; you can redistribute it and/or modify it
10 under the terms of the GNU General Public License as published by the
11 Free Software Foundation; either version 2, or (at your option) any
12 later version.
13
14 XEmacs is distributed in the hope that it will be useful, but WITHOUT
15 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
16 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
17 for more details.
18
19 You should have received a copy of the GNU General Public License
20 along with XEmacs; see the file COPYING.  If not, write to
21 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 Boston, MA 02111-1307, USA.  */
23
24 /* Synched up with: Mule 2.3.   Not in FSF. */
25
26 /* Rewritten by Ben Wing <ben@xemacs.org>. */
27 /* Rewritten by MORIOKA Tomohiko <tomo@m17n.org> for XEmacs CHISE. */
28
29 #include <config.h>
30 #include "lisp.h"
31
32 #include "buffer.h"
33 #include "elhash.h"
34 #include "insdel.h"
35 #include "lstream.h"
36 #include "opaque.h"
37 #ifdef MULE
38 #include "mule-ccl.h"
39 #include "chartab.h"
40 #endif
41 #ifdef HAVE_LIBCHISE
42 #include <cos.h>
43 #endif
44 #include "file-coding.h"
45
46 Lisp_Object Qcoding_system_error;
47
48 Lisp_Object Vkeyboard_coding_system;
49 Lisp_Object Vterminal_coding_system;
50 Lisp_Object Vcoding_system_for_read;
51 Lisp_Object Vcoding_system_for_write;
52 Lisp_Object Vfile_name_coding_system;
53
54 Lisp_Object Vcoded_charset_entity_reference_alist;
55
56 /* Table of symbols identifying each coding category. */
57 Lisp_Object coding_category_symbol[CODING_CATEGORY_LAST];
58
59
60
61 struct file_coding_dump {
62   /* Coding system currently associated with each coding category. */
63   Lisp_Object coding_category_system[CODING_CATEGORY_LAST];
64
65   /* Table of all coding categories in decreasing order of priority.
66      This describes a permutation of the possible coding categories. */
67   int coding_category_by_priority[CODING_CATEGORY_LAST];
68
69 #if defined(MULE) && !defined(UTF2000)
70   Lisp_Object ucs_to_mule_table[65536];
71 #endif
72 } *fcd;
73
74 static const struct lrecord_description fcd_description_1[] = {
75   { XD_LISP_OBJECT_ARRAY, offsetof (struct file_coding_dump, coding_category_system), CODING_CATEGORY_LAST },
76 #if defined(MULE) && !defined(UTF2000)
77   { XD_LISP_OBJECT_ARRAY, offsetof (struct file_coding_dump, ucs_to_mule_table), countof (fcd->ucs_to_mule_table) },
78 #endif
79   { XD_END }
80 };
81
82 static const struct struct_description fcd_description = {
83   sizeof (struct file_coding_dump),
84   fcd_description_1
85 };
86
87 Lisp_Object mule_to_ucs_table;
88
89 Lisp_Object Qcoding_systemp;
90
91 Lisp_Object Qraw_text, Qno_conversion, Qccl, Qiso2022;
92 /* Qinternal in general.c */
93
94 Lisp_Object Qmnemonic, Qeol_type;
95 Lisp_Object Qcr, Qcrlf, Qlf;
96 Lisp_Object Qeol_cr, Qeol_crlf, Qeol_lf;
97 Lisp_Object Qpost_read_conversion;
98 Lisp_Object Qpre_write_conversion;
99
100 #ifdef MULE
101 Lisp_Object Qucs4, Qutf16, Qutf8;
102 Lisp_Object Qbig5, Qshift_jis;
103 Lisp_Object Qcharset_g0, Qcharset_g1, Qcharset_g2, Qcharset_g3;
104 Lisp_Object Qforce_g0_on_output, Qforce_g1_on_output;
105 Lisp_Object Qforce_g2_on_output, Qforce_g3_on_output;
106 Lisp_Object Qno_iso6429;
107 Lisp_Object Qinput_charset_conversion, Qoutput_charset_conversion;
108 Lisp_Object Qescape_quoted;
109 Lisp_Object Qshort, Qno_ascii_eol, Qno_ascii_cntl, Qseven, Qlock_shift;
110 #endif
111 #ifdef UTF2000
112 Lisp_Object Qutf_8_mcs;
113 Lisp_Object Qdisable_composition, Qenable_decomposition;
114 Lisp_Object Qccs_priority_list;
115 Lisp_Object Quse_entity_reference;
116 Lisp_Object Qd, Qx, QX;
117 Lisp_Object Vdecomposition_feature_list;
118 #endif
119 Lisp_Object Qencode, Qdecode;
120
121 Lisp_Object Vcoding_system_hash_table;
122
123 int enable_multibyte_characters;
124
125 #ifdef MULE
126 /* Additional information used by the ISO2022 decoder and detector. */
127 struct iso2022_decoder
128 {
129   /* CHARSET holds the character sets currently assigned to the G0
130      through G3 variables.  It is initialized from the array
131      INITIAL_CHARSET in CODESYS. */
132   Lisp_Object charset[4];
133
134   /* Which registers are currently invoked into the left (GL) and
135      right (GR) halves of the 8-bit encoding space? */
136   int register_left, register_right;
137
138   /* ISO_ESC holds a value indicating part of an escape sequence
139      that has already been seen. */
140   enum iso_esc_flag esc;
141
142   /* This records the bytes we've seen so far in an escape sequence,
143      in case the sequence is invalid (we spit out the bytes unchanged). */
144   unsigned char esc_bytes[8];
145
146   /* Index for next byte to store in ISO escape sequence. */
147   int esc_bytes_index;
148
149 #ifdef ENABLE_COMPOSITE_CHARS
150   /* Stuff seen so far when composing a string. */
151   unsigned_char_dynarr *composite_chars;
152 #endif
153
154   /* If we saw an invalid designation sequence for a particular
155      register, we flag it here and switch to ASCII.  The next time we
156      see a valid designation for this register, we turn off the flag
157      and do the designation normally, but pretend the sequence was
158      invalid.  The effect of all this is that (most of the time) the
159      escape sequences for both the switch to the unknown charset, and
160      the switch back to the known charset, get inserted literally into
161      the buffer and saved out as such.  The hope is that we can
162      preserve the escape sequences so that the resulting written out
163      file makes sense.  If we don't do any of this, the designation
164      to the invalid charset will be preserved but that switch back
165      to the known charset will probably get eaten because it was
166      the same charset that was already present in the register. */
167   unsigned char invalid_designated[4];
168
169   /* We try to do similar things as above for direction-switching
170      sequences.  If we encountered a direction switch while an
171      invalid designation was present, or an invalid designation
172      just after a direction switch (i.e. no valid designation
173      encountered yet), we insert the direction-switch escape
174      sequence literally into the output stream, and later on
175      insert the corresponding direction-restoring escape sequence
176      literally also. */
177   unsigned int switched_dir_and_no_valid_charset_yet :1;
178   unsigned int invalid_switch_dir :1;
179
180   /* Tells the decoder to output the escape sequence literally
181      even though it was valid.  Used in the games we play to
182      avoid lossage when we encounter invalid designations. */
183   unsigned int output_literally :1;
184   /* We encountered a direction switch followed by an invalid
185      designation.  We didn't output the direction switch
186      literally because we didn't know about the invalid designation;
187      but we have to do so now. */
188   unsigned int output_direction_sequence :1;
189 };
190 #endif /* MULE */
191 EXFUN (Fcopy_coding_system, 2);
192 #ifdef MULE
193 struct detection_state;
194
195 static void
196 text_encode_generic (Lstream *encoding, const Bufbyte *src,
197                      unsigned_char_dynarr *dst, Lstream_data_count n);
198
199 static int detect_coding_sjis (struct detection_state *st,
200                                const Extbyte *src, Lstream_data_count n);
201 static void decode_coding_sjis (Lstream *decoding, const Extbyte *src,
202                                 unsigned_char_dynarr *dst, Lstream_data_count n);
203 void char_encode_shift_jis (struct encoding_stream *str, Emchar c,
204                             unsigned_char_dynarr *dst, unsigned int *flags);
205 void char_finish_shift_jis (struct encoding_stream *str,
206                             unsigned_char_dynarr *dst, unsigned int *flags);
207
208 static int detect_coding_big5 (struct detection_state *st,
209                                const Extbyte *src, Lstream_data_count n);
210 static void decode_coding_big5 (Lstream *decoding, const Extbyte *src,
211                                 unsigned_char_dynarr *dst, Lstream_data_count n);
212 void char_encode_big5 (struct encoding_stream *str, Emchar c,
213                        unsigned_char_dynarr *dst, unsigned int *flags);
214 void char_finish_big5 (struct encoding_stream *str,
215                        unsigned_char_dynarr *dst, unsigned int *flags);
216
217 static int detect_coding_ucs4 (struct detection_state *st,
218                                const Extbyte *src, Lstream_data_count n);
219 static void decode_coding_ucs4 (Lstream *decoding, const Extbyte *src,
220                                 unsigned_char_dynarr *dst, Lstream_data_count n);
221 void char_encode_ucs4 (struct encoding_stream *str, Emchar c,
222                        unsigned_char_dynarr *dst, unsigned int *flags);
223 void char_finish_ucs4 (struct encoding_stream *str,
224                        unsigned_char_dynarr *dst, unsigned int *flags);
225
226 static int detect_coding_utf16 (struct detection_state *st,
227                                const Extbyte *src, Lstream_data_count n);
228 static void decode_coding_utf16 (Lstream *decoding, const Extbyte *src,
229                                 unsigned_char_dynarr *dst, Lstream_data_count n);
230 void char_encode_utf16 (struct encoding_stream *str, Emchar c,
231                        unsigned_char_dynarr *dst, unsigned int *flags);
232 void char_finish_utf16 (struct encoding_stream *str,
233                        unsigned_char_dynarr *dst, unsigned int *flags);
234
235 static int detect_coding_utf8 (struct detection_state *st,
236                                const Extbyte *src, Lstream_data_count n);
237 static void decode_coding_utf8 (Lstream *decoding, const Extbyte *src,
238                                 unsigned_char_dynarr *dst, Lstream_data_count n);
239 void char_encode_utf8 (struct encoding_stream *str, Emchar c,
240                        unsigned_char_dynarr *dst, unsigned int *flags);
241 void char_finish_utf8 (struct encoding_stream *str,
242                        unsigned_char_dynarr *dst, unsigned int *flags);
243
244 static int postprocess_iso2022_mask (int mask);
245 static void reset_iso2022 (Lisp_Object coding_system,
246                            struct iso2022_decoder *iso);
247 static int detect_coding_iso2022 (struct detection_state *st,
248                                   const Extbyte *src, Lstream_data_count n);
249 static void decode_coding_iso2022 (Lstream *decoding, const Extbyte *src,
250                                    unsigned_char_dynarr *dst, Lstream_data_count n);
251 void char_encode_iso2022 (struct encoding_stream *str, Emchar c,
252                           unsigned_char_dynarr *dst, unsigned int *flags);
253 void char_finish_iso2022 (struct encoding_stream *str,
254                           unsigned_char_dynarr *dst, unsigned int *flags);
255 #endif /* MULE */
256 static void decode_coding_no_conversion (Lstream *decoding, const Extbyte *src,
257                                          unsigned_char_dynarr *dst, Lstream_data_count n);
258 static void encode_coding_no_conversion (Lstream *encoding, const Bufbyte *src,
259                                          unsigned_char_dynarr *dst, Lstream_data_count n);
260 static void mule_decode (Lstream *decoding, const Extbyte *src,
261                          unsigned_char_dynarr *dst, Lstream_data_count n);
262 static void mule_encode (Lstream *encoding, const Bufbyte *src,
263                          unsigned_char_dynarr *dst, Lstream_data_count n);
264
265 typedef struct codesys_prop codesys_prop;
266 struct codesys_prop
267 {
268   Lisp_Object sym;
269   int prop_type;
270 };
271
272 typedef struct
273 {
274   Dynarr_declare (codesys_prop);
275 } codesys_prop_dynarr;
276
277 static const struct lrecord_description codesys_prop_description_1[] = {
278   { XD_LISP_OBJECT, offsetof (codesys_prop, sym) },
279   { XD_END }
280 };
281
282 static const struct struct_description codesys_prop_description = {
283   sizeof (codesys_prop),
284   codesys_prop_description_1
285 };
286
287 static const struct lrecord_description codesys_prop_dynarr_description_1[] = {
288   XD_DYNARR_DESC (codesys_prop_dynarr, &codesys_prop_description),
289   { XD_END }
290 };
291
292 static const struct struct_description codesys_prop_dynarr_description = {
293   sizeof (codesys_prop_dynarr),
294   codesys_prop_dynarr_description_1
295 };
296
297 codesys_prop_dynarr *the_codesys_prop_dynarr;
298
299 enum codesys_prop_enum
300 {
301   CODESYS_PROP_ALL_OK,
302   CODESYS_PROP_ISO2022,
303   CODESYS_PROP_CCL
304 };
305
306 \f
307 /************************************************************************/
308 /*                       Coding system functions                        */
309 /************************************************************************/
310
311 static Lisp_Object mark_coding_system (Lisp_Object);
312 static void print_coding_system (Lisp_Object, Lisp_Object, int);
313 static void finalize_coding_system (void *header, int for_disksave);
314
315 #ifdef MULE
316 static const struct lrecord_description ccs_description_1[] = {
317   { XD_LISP_OBJECT, offsetof (charset_conversion_spec, from_charset) },
318   { XD_LISP_OBJECT, offsetof (charset_conversion_spec, to_charset) },
319   { XD_END }
320 };
321
322 static const struct struct_description ccs_description = {
323   sizeof (charset_conversion_spec),
324   ccs_description_1
325 };
326
327 static const struct lrecord_description ccsd_description_1[] = {
328   XD_DYNARR_DESC (charset_conversion_spec_dynarr, &ccs_description),
329   { XD_END }
330 };
331
332 static const struct struct_description ccsd_description = {
333   sizeof (charset_conversion_spec_dynarr),
334   ccsd_description_1
335 };
336 #endif
337
338 static const struct lrecord_description coding_system_description[] = {
339   { XD_LISP_OBJECT, offsetof (Lisp_Coding_System, name) },
340   { XD_LISP_OBJECT, offsetof (Lisp_Coding_System, doc_string) },
341   { XD_LISP_OBJECT, offsetof (Lisp_Coding_System, mnemonic) },
342   { XD_LISP_OBJECT, offsetof (Lisp_Coding_System, post_read_conversion) },
343   { XD_LISP_OBJECT, offsetof (Lisp_Coding_System, pre_write_conversion) },
344   { XD_LISP_OBJECT, offsetof (Lisp_Coding_System, eol_lf) },
345   { XD_LISP_OBJECT, offsetof (Lisp_Coding_System, eol_crlf) },
346   { XD_LISP_OBJECT, offsetof (Lisp_Coding_System, eol_cr) },
347 #ifdef MULE
348   { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Coding_System, iso2022.initial_charset), 4 },
349   { XD_STRUCT_PTR,  offsetof (Lisp_Coding_System, iso2022.input_conv),  1, &ccsd_description },
350   { XD_STRUCT_PTR,  offsetof (Lisp_Coding_System, iso2022.output_conv), 1, &ccsd_description },
351   { XD_LISP_OBJECT, offsetof (Lisp_Coding_System, ccl.decode) },
352   { XD_LISP_OBJECT, offsetof (Lisp_Coding_System, ccl.encode) },
353 #ifdef UTF2000
354   { XD_LISP_OBJECT, offsetof (Lisp_Coding_System, ccs_priority_list) },
355 #endif
356 #endif
357   { XD_END }
358 };
359
360 DEFINE_LRECORD_IMPLEMENTATION ("coding-system", coding_system,
361                                mark_coding_system, print_coding_system,
362                                finalize_coding_system,
363                                0, 0, coding_system_description,
364                                Lisp_Coding_System);
365
366 static Lisp_Object
367 mark_coding_system (Lisp_Object obj)
368 {
369   Lisp_Coding_System *codesys = XCODING_SYSTEM (obj);
370
371   mark_object (CODING_SYSTEM_NAME (codesys));
372   mark_object (CODING_SYSTEM_DOC_STRING (codesys));
373   mark_object (CODING_SYSTEM_MNEMONIC (codesys));
374   mark_object (CODING_SYSTEM_EOL_LF (codesys));
375   mark_object (CODING_SYSTEM_EOL_CRLF (codesys));
376   mark_object (CODING_SYSTEM_EOL_CR (codesys));
377
378   switch (CODING_SYSTEM_TYPE (codesys))
379     {
380 #ifdef MULE
381       int i;
382     case CODESYS_ISO2022:
383       for (i = 0; i < 4; i++)
384         mark_object (CODING_SYSTEM_ISO2022_INITIAL_CHARSET (codesys, i));
385       if (codesys->iso2022.input_conv)
386         {
387           for (i = 0; i < Dynarr_length (codesys->iso2022.input_conv); i++)
388             {
389               struct charset_conversion_spec *ccs =
390                 Dynarr_atp (codesys->iso2022.input_conv, i);
391               mark_object (ccs->from_charset);
392               mark_object (ccs->to_charset);
393             }
394         }
395       if (codesys->iso2022.output_conv)
396         {
397           for (i = 0; i < Dynarr_length (codesys->iso2022.output_conv); i++)
398             {
399               struct charset_conversion_spec *ccs =
400                 Dynarr_atp (codesys->iso2022.output_conv, i);
401               mark_object (ccs->from_charset);
402               mark_object (ccs->to_charset);
403             }
404         }
405       break;
406 #ifdef UTF2000
407
408     case CODESYS_BIG5:
409       mark_object (CODING_SYSTEM_ISO2022_INITIAL_CHARSET (codesys, 0));
410       mark_object (CODING_SYSTEM_ISO2022_INITIAL_CHARSET (codesys, 1));
411       break;
412 #endif
413
414     case CODESYS_CCL:
415       mark_object (CODING_SYSTEM_CCL_DECODE (codesys));
416       mark_object (CODING_SYSTEM_CCL_ENCODE (codesys));
417       break;
418 #endif /* MULE */
419     default:
420       break;
421     }
422
423   mark_object (CODING_SYSTEM_PRE_WRITE_CONVERSION (codesys));
424 #ifdef UTF2000
425   mark_object (CODING_SYSTEM_CCS_PRIORITY_LIST (codesys));
426 #endif
427   return CODING_SYSTEM_POST_READ_CONVERSION (codesys);
428 }
429
430 static void
431 print_coding_system (Lisp_Object obj, Lisp_Object printcharfun,
432                      int escapeflag)
433 {
434   Lisp_Coding_System *c = XCODING_SYSTEM (obj);
435   if (print_readably)
436     error ("printing unreadable object #<coding_system 0x%x>",
437            c->header.uid);
438
439   write_c_string ("#<coding_system ", printcharfun);
440   print_internal (c->name, printcharfun, 1);
441   write_c_string (">", printcharfun);
442 }
443
444 static void
445 finalize_coding_system (void *header, int for_disksave)
446 {
447   Lisp_Coding_System *c = (Lisp_Coding_System *) header;
448   /* Since coding systems never go away, this function is not
449      necessary.  But it would be necessary if we changed things
450      so that coding systems could go away. */
451   if (!for_disksave) /* see comment in lstream.c */
452     {
453       switch (CODING_SYSTEM_TYPE (c))
454         {
455 #ifdef MULE
456         case CODESYS_ISO2022:
457           if (c->iso2022.input_conv)
458             {
459               Dynarr_free (c->iso2022.input_conv);
460               c->iso2022.input_conv = 0;
461             }
462           if (c->iso2022.output_conv)
463             {
464               Dynarr_free (c->iso2022.output_conv);
465               c->iso2022.output_conv = 0;
466             }
467           break;
468 #endif /* MULE */
469         default:
470           break;
471         }
472     }
473 }
474
475 static eol_type_t
476 symbol_to_eol_type (Lisp_Object symbol)
477 {
478   CHECK_SYMBOL (symbol);
479   if (NILP (symbol))      return EOL_AUTODETECT;
480   if (EQ (symbol, Qlf))   return EOL_LF;
481   if (EQ (symbol, Qcrlf)) return EOL_CRLF;
482   if (EQ (symbol, Qcr))   return EOL_CR;
483
484   signal_simple_error ("Unrecognized eol type", symbol);
485   return EOL_AUTODETECT; /* not reached */
486 }
487
488 static Lisp_Object
489 eol_type_to_symbol (eol_type_t type)
490 {
491   switch (type)
492     {
493     default: abort ();
494     case EOL_LF:         return Qlf;
495     case EOL_CRLF:       return Qcrlf;
496     case EOL_CR:         return Qcr;
497     case EOL_AUTODETECT: return Qnil;
498     }
499 }
500
501 static void
502 setup_eol_coding_systems (Lisp_Coding_System *codesys)
503 {
504   Lisp_Object codesys_obj;
505   int len = string_length (XSYMBOL (CODING_SYSTEM_NAME (codesys))->name);
506   char *codesys_name = (char *) alloca (len + 7);
507   int mlen = -1;
508   char *codesys_mnemonic=0;
509
510   Lisp_Object codesys_name_sym, sub_codesys_obj;
511
512   /* kludge */
513
514   XSETCODING_SYSTEM (codesys_obj, codesys);
515
516   memcpy (codesys_name,
517           string_data (XSYMBOL (CODING_SYSTEM_NAME (codesys))->name), len);
518
519   if (STRINGP (CODING_SYSTEM_MNEMONIC (codesys)))
520     {
521       mlen = XSTRING_LENGTH (CODING_SYSTEM_MNEMONIC (codesys));
522       codesys_mnemonic = (char *) alloca (mlen + 7);
523       memcpy (codesys_mnemonic,
524               XSTRING_DATA (CODING_SYSTEM_MNEMONIC (codesys)), mlen);
525     }
526
527 #define DEFINE_SUB_CODESYS(op_sys, op_sys_abbr, Type) do {                      \
528   strcpy (codesys_name + len, "-" op_sys);                                      \
529   if (mlen != -1)                                                               \
530     strcpy (codesys_mnemonic + mlen, op_sys_abbr);                              \
531   codesys_name_sym = intern (codesys_name);                                     \
532   sub_codesys_obj = Fcopy_coding_system (codesys_obj, codesys_name_sym);        \
533   XCODING_SYSTEM_EOL_TYPE (sub_codesys_obj) = Type;                             \
534   if (mlen != -1)                                                               \
535     XCODING_SYSTEM_MNEMONIC(sub_codesys_obj) =                                  \
536       build_string (codesys_mnemonic);                                          \
537   CODING_SYSTEM_##Type (codesys) = sub_codesys_obj;                             \
538 } while (0)
539
540   DEFINE_SUB_CODESYS("unix", "", EOL_LF);
541   DEFINE_SUB_CODESYS("dos",  ":T", EOL_CRLF);
542   DEFINE_SUB_CODESYS("mac",  ":t", EOL_CR);
543 }
544
545 DEFUN ("coding-system-p", Fcoding_system_p, 1, 1, 0, /*
546 Return t if OBJECT is a coding system.
547 A coding system is an object that defines how text containing multiple
548 character sets is encoded into a stream of (typically 8-bit) bytes.
549 The coding system is used to decode the stream into a series of
550 characters (which may be from multiple charsets) when the text is read
551 from a file or process, and is used to encode the text back into the
552 same format when it is written out to a file or process.
553
554 For example, many ISO2022-compliant coding systems (such as Compound
555 Text, which is used for inter-client data under the X Window System)
556 use escape sequences to switch between different charsets -- Japanese
557 Kanji, for example, is invoked with "ESC $ ( B"; ASCII is invoked
558 with "ESC ( B"; and Cyrillic is invoked with "ESC - L".  See
559 `make-coding-system' for more information.
560
561 Coding systems are normally identified using a symbol, and the
562 symbol is accepted in place of the actual coding system object whenever
563 a coding system is called for. (This is similar to how faces work.)
564 */
565        (object))
566 {
567   return CODING_SYSTEMP (object) ? Qt : Qnil;
568 }
569
570 DEFUN ("find-coding-system", Ffind_coding_system, 1, 1, 0, /*
571 Retrieve the coding system of the given name.
572
573 If CODING-SYSTEM-OR-NAME is a coding-system object, it is simply
574 returned.  Otherwise, CODING-SYSTEM-OR-NAME should be a symbol.
575 If there is no such coding system, nil is returned.  Otherwise the
576 associated coding system object is returned.
577 */
578        (coding_system_or_name))
579 {
580   if (NILP (coding_system_or_name))
581     coding_system_or_name = Qbinary;
582   else if (CODING_SYSTEMP (coding_system_or_name))
583     return coding_system_or_name;
584   else
585     CHECK_SYMBOL (coding_system_or_name);
586
587   while (1)
588     {
589       coding_system_or_name =
590         Fgethash (coding_system_or_name, Vcoding_system_hash_table, Qnil);
591
592       if (CODING_SYSTEMP (coding_system_or_name) || NILP (coding_system_or_name))
593         return coding_system_or_name;
594     }
595 }
596
597 DEFUN ("get-coding-system", Fget_coding_system, 1, 1, 0, /*
598 Retrieve the coding system of the given name.
599 Same as `find-coding-system' except that if there is no such
600 coding system, an error is signaled instead of returning nil.
601 */
602        (name))
603 {
604   Lisp_Object coding_system = Ffind_coding_system (name);
605
606   if (NILP (coding_system))
607     signal_simple_error ("No such coding system", name);
608   return coding_system;
609 }
610
611 /* We store the coding systems in hash tables with the names as the key and the
612    actual coding system object as the value.  Occasionally we need to use them
613    in a list format.  These routines provide us with that. */
614 struct coding_system_list_closure
615 {
616   Lisp_Object *coding_system_list;
617 };
618
619 static int
620 add_coding_system_to_list_mapper (Lisp_Object key, Lisp_Object value,
621                                   void *coding_system_list_closure)
622 {
623   /* This function can GC */
624   struct coding_system_list_closure *cscl =
625     (struct coding_system_list_closure *) coding_system_list_closure;
626   Lisp_Object *coding_system_list = cscl->coding_system_list;
627
628   *coding_system_list = Fcons (key, *coding_system_list);
629   return 0;
630 }
631
632 DEFUN ("coding-system-list", Fcoding_system_list, 0, 0, 0, /*
633 Return a list of the names of all defined coding systems.
634 */
635        ())
636 {
637   Lisp_Object coding_system_list = Qnil;
638   struct gcpro gcpro1;
639   struct coding_system_list_closure coding_system_list_closure;
640
641   GCPRO1 (coding_system_list);
642   coding_system_list_closure.coding_system_list = &coding_system_list;
643   elisp_maphash (add_coding_system_to_list_mapper, Vcoding_system_hash_table,
644                  &coding_system_list_closure);
645   UNGCPRO;
646
647   return coding_system_list;
648 }
649
650 DEFUN ("coding-system-name", Fcoding_system_name, 1, 1, 0, /*
651 Return the name of the given coding system.
652 */
653        (coding_system))
654 {
655   coding_system = Fget_coding_system (coding_system);
656   return XCODING_SYSTEM_NAME (coding_system);
657 }
658
659 static Lisp_Coding_System *
660 allocate_coding_system (enum coding_system_type type, Lisp_Object name)
661 {
662   Lisp_Coding_System *codesys =
663     alloc_lcrecord_type (Lisp_Coding_System, &lrecord_coding_system);
664
665   zero_lcrecord (codesys);
666   CODING_SYSTEM_PRE_WRITE_CONVERSION (codesys) = Qnil;
667   CODING_SYSTEM_POST_READ_CONVERSION (codesys) = Qnil;
668   CODING_SYSTEM_EOL_TYPE (codesys) = EOL_AUTODETECT;
669   CODING_SYSTEM_EOL_CRLF (codesys) = Qnil;
670   CODING_SYSTEM_EOL_CR   (codesys) = Qnil;
671   CODING_SYSTEM_EOL_LF   (codesys) = Qnil;
672   CODING_SYSTEM_TYPE     (codesys) = type;
673   CODING_SYSTEM_MNEMONIC (codesys) = Qnil;
674 #ifdef MULE
675 #ifdef UTF2000
676   CODING_SYSTEM_CCS_PRIORITY_LIST (codesys) = Qnil;
677 #endif
678   if (type == CODESYS_ISO2022)
679     {
680       int i;
681       for (i = 0; i < 4; i++)
682         CODING_SYSTEM_ISO2022_INITIAL_CHARSET (codesys, i) = Qnil;
683     }
684 #ifdef UTF2000
685   if (type == CODESYS_UTF8)
686     {
687       CODING_SYSTEM_ISO2022_INITIAL_CHARSET (codesys, 0)
688         = Vcharset_ucs;
689       CODING_SYSTEM_ISO2022_INITIAL_CHARSET (codesys, 1)
690         = Qnil;
691       CODING_SYSTEM_ISO2022_INITIAL_CHARSET (codesys, 2)
692         = Qnil;
693       CODING_SYSTEM_ISO2022_INITIAL_CHARSET (codesys, 3)
694         = Qnil;
695     }
696   else if (type == CODESYS_BIG5)
697     {
698       CODING_SYSTEM_ISO2022_INITIAL_CHARSET (codesys, 0)
699         = Vcharset_ascii;
700       CODING_SYSTEM_ISO2022_INITIAL_CHARSET (codesys, 1)
701         = Vcharset_chinese_big5;
702       CODING_SYSTEM_ISO2022_INITIAL_CHARSET (codesys, 2)
703         = Qnil;
704       CODING_SYSTEM_ISO2022_INITIAL_CHARSET (codesys, 3)
705         = Qnil;
706     }
707 #endif
708   else if (type == CODESYS_CCL)
709     {
710       CODING_SYSTEM_CCL_DECODE (codesys) = Qnil;
711       CODING_SYSTEM_CCL_ENCODE (codesys) = Qnil;
712     }
713 #endif /* MULE */
714   CODING_SYSTEM_NAME (codesys) = name;
715
716   return codesys;
717 }
718
719 #ifdef MULE
720 /* Given a list of charset conversion specs as specified in a Lisp
721    program, parse it into STORE_HERE. */
722
723 static void
724 parse_charset_conversion_specs (charset_conversion_spec_dynarr *store_here,
725                                 Lisp_Object spec_list)
726 {
727   Lisp_Object rest;
728
729   EXTERNAL_LIST_LOOP (rest, spec_list)
730     {
731       Lisp_Object car = XCAR (rest);
732       Lisp_Object from, to;
733       struct charset_conversion_spec spec;
734
735       if (!CONSP (car) || !CONSP (XCDR (car)) || !NILP (XCDR (XCDR (car))))
736         signal_simple_error ("Invalid charset conversion spec", car);
737       from = Fget_charset (XCAR (car));
738       to = Fget_charset (XCAR (XCDR (car)));
739       if ( (XCHARSET_CHARS (from) != XCHARSET_CHARS (to)) ||
740            (XCHARSET_DIMENSION (from) != XCHARSET_DIMENSION (to)) )
741         signal_simple_error_2
742           ("Attempted conversion between different charset types",
743            from, to);
744       spec.from_charset = from;
745       spec.to_charset = to;
746
747       Dynarr_add (store_here, spec);
748     }
749 }
750
751 /* Given a dynarr LOAD_HERE of internally-stored charset conversion
752    specs, return the equivalent as the Lisp programmer would see it.
753
754    If LOAD_HERE is 0, return Qnil. */
755
756 static Lisp_Object
757 unparse_charset_conversion_specs (charset_conversion_spec_dynarr *load_here)
758 {
759   int i;
760   Lisp_Object result;
761
762   if (!load_here)
763     return Qnil;
764   for (i = 0, result = Qnil; i < Dynarr_length (load_here); i++)
765     {
766       struct charset_conversion_spec *ccs = Dynarr_atp (load_here, i);
767       result = Fcons (list2 (ccs->from_charset, ccs->to_charset), result);
768     }
769
770   return Fnreverse (result);
771 }
772
773 #endif /* MULE */
774
775 DEFUN ("make-coding-system", Fmake_coding_system, 2, 4, 0, /*
776 Register symbol NAME as a coding system.
777
778 TYPE describes the conversion method used and should be one of
779
780 nil or 'undecided
781      Automatic conversion.  XEmacs attempts to detect the coding system
782      used in the file.
783 'no-conversion
784      No conversion.  Use this for binary files and such.  On output,
785      graphic characters that are not in ASCII or Latin-1 will be
786      replaced by a ?. (For a no-conversion-encoded buffer, these
787      characters will only be present if you explicitly insert them.)
788 'shift-jis
789      Shift-JIS (a Japanese encoding commonly used in PC operating systems).
790 'ucs-4
791      ISO 10646 UCS-4 encoding.
792 'utf-8
793      ISO 10646 UTF-8 encoding.
794 'iso2022
795      Any ISO2022-compliant encoding.  Among other things, this includes
796      JIS (the Japanese encoding commonly used for e-mail), EUC (the
797      standard Unix encoding for Japanese and other languages), and
798      Compound Text (the encoding used in X11).  You can specify more
799      specific information about the conversion with the PROPS argument.
800 'big5
801      Big5 (the encoding commonly used for Taiwanese).
802 'ccl
803      The conversion is performed using a user-written pseudo-code
804      program.  CCL (Code Conversion Language) is the name of this
805      pseudo-code.
806 'internal
807      Write out or read in the raw contents of the memory representing
808      the buffer's text.  This is primarily useful for debugging
809      purposes, and is only enabled when XEmacs has been compiled with
810      DEBUG_XEMACS defined (via the --debug configure option).
811      WARNING: Reading in a file using 'internal conversion can result
812      in an internal inconsistency in the memory representing a
813      buffer's text, which will produce unpredictable results and may
814      cause XEmacs to crash.  Under normal circumstances you should
815      never use 'internal conversion.
816
817 DOC-STRING is a string describing the coding system.
818
819 PROPS is a property list, describing the specific nature of the
820 character set.  Recognized properties are:
821
822 'mnemonic
823      String to be displayed in the modeline when this coding system is
824      active.
825
826 'eol-type
827      End-of-line conversion to be used.  It should be one of
828
829         nil
830                 Automatically detect the end-of-line type (LF, CRLF,
831                 or CR).  Also generate subsidiary coding systems named
832                 `NAME-unix', `NAME-dos', and `NAME-mac', that are
833                 identical to this coding system but have an EOL-TYPE
834                 value of 'lf, 'crlf, and 'cr, respectively.
835         'lf
836                 The end of a line is marked externally using ASCII LF.
837                 Since this is also the way that XEmacs represents an
838                 end-of-line internally, specifying this option results
839                 in no end-of-line conversion.  This is the standard
840                 format for Unix text files.
841         'crlf
842                 The end of a line is marked externally using ASCII
843                 CRLF.  This is the standard format for MS-DOS text
844                 files.
845         'cr
846                 The end of a line is marked externally using ASCII CR.
847                 This is the standard format for Macintosh text files.
848         t
849                 Automatically detect the end-of-line type but do not
850                 generate subsidiary coding systems.  (This value is
851                 converted to nil when stored internally, and
852                 `coding-system-property' will return nil.)
853
854 'disable-composition
855      If non-nil, composition for combining characters is disabled.
856
857 'enable-decomposition
858      If non-nil, decomposition for combining characters is enabled.
859
860 'use-entity-reference
861      If non-nil, SGML style entity-reference is used for non-system-characters.
862
863 'post-read-conversion
864      Function called after a file has been read in, to perform the
865      decoding.  Called with two arguments, START and END, denoting
866      a region of the current buffer to be decoded.
867
868 'pre-write-conversion
869      Function called before a file is written out, to perform the
870      encoding.  Called with two arguments, START and END, denoting
871      a region of the current buffer to be encoded.
872
873
874 The following additional properties are recognized if TYPE is 'iso2022:
875
876 'charset-g0
877 'charset-g1
878 'charset-g2
879 'charset-g3
880      The character set initially designated to the G0 - G3 registers.
881      The value should be one of
882
883           -- A charset object (designate that character set)
884           -- nil (do not ever use this register)
885           -- t (no character set is initially designated to
886                 the register, but may be later on; this automatically
887                 sets the corresponding `force-g*-on-output' property)
888
889 'force-g0-on-output
890 'force-g1-on-output
891 'force-g2-on-output
892 'force-g2-on-output
893      If non-nil, send an explicit designation sequence on output before
894      using the specified register.
895
896 'short
897      If non-nil, use the short forms "ESC $ @", "ESC $ A", and
898      "ESC $ B" on output in place of the full designation sequences
899      "ESC $ ( @", "ESC $ ( A", and "ESC $ ( B".
900
901 'no-ascii-eol
902      If non-nil, don't designate ASCII to G0 at each end of line on output.
903      Setting this to non-nil also suppresses other state-resetting that
904      normally happens at the end of a line.
905
906 'no-ascii-cntl
907      If non-nil, don't designate ASCII to G0 before control chars on output.
908
909 'seven
910      If non-nil, use 7-bit environment on output.  Otherwise, use 8-bit
911      environment.
912
913 'lock-shift
914      If non-nil, use locking-shift (SO/SI) instead of single-shift
915      or designation by escape sequence.
916
917 'no-iso6429
918      If non-nil, don't use ISO6429's direction specification.
919
920 'escape-quoted
921      If non-nil, literal control characters that are the same as
922      the beginning of a recognized ISO2022 or ISO6429 escape sequence
923      (in particular, ESC (0x1B), SO (0x0E), SI (0x0F), SS2 (0x8E),
924      SS3 (0x8F), and CSI (0x9B)) are "quoted" with an escape character
925      so that they can be properly distinguished from an escape sequence.
926      (Note that doing this results in a non-portable encoding.) This
927      encoding flag is used for byte-compiled files.  Note that ESC
928      is a good choice for a quoting character because there are no
929      escape sequences whose second byte is a character from the Control-0
930      or Control-1 character sets; this is explicitly disallowed by the
931      ISO2022 standard.
932
933 'input-charset-conversion
934      A list of conversion specifications, specifying conversion of
935      characters in one charset to another when decoding is performed.
936      Each specification is a list of two elements: the source charset,
937      and the destination charset.
938
939 'output-charset-conversion
940      A list of conversion specifications, specifying conversion of
941      characters in one charset to another when encoding is performed.
942      The form of each specification is the same as for
943      'input-charset-conversion.
944
945
946 The following additional properties are recognized (and required)
947 if TYPE is 'ccl:
948
949 'decode
950      CCL program used for decoding (converting to internal format).
951
952 'encode
953      CCL program used for encoding (converting to external format).
954 */
955        (name, type, doc_string, props))
956 {
957   Lisp_Coding_System *codesys;
958   enum coding_system_type ty;
959   int need_to_setup_eol_systems = 1;
960
961   /* Convert type to constant */
962   if (NILP (type) || EQ (type, Qundecided))
963                                       { ty = CODESYS_AUTODETECT; }
964 #ifdef MULE
965   else if (EQ (type, Qshift_jis))     { ty = CODESYS_SHIFT_JIS; }
966   else if (EQ (type, Qiso2022))       { ty = CODESYS_ISO2022; }
967   else if (EQ (type, Qbig5))          { ty = CODESYS_BIG5; }
968   else if (EQ (type, Qucs4))          { ty = CODESYS_UCS4; }
969   else if (EQ (type, Qutf16))         { ty = CODESYS_UTF16; }
970   else if (EQ (type, Qutf8))          { ty = CODESYS_UTF8; }
971   else if (EQ (type, Qccl))           { ty = CODESYS_CCL; }
972 #endif
973   else if (EQ (type, Qno_conversion)) { ty = CODESYS_NO_CONVERSION; }
974 #ifdef DEBUG_XEMACS
975   else if (EQ (type, Qinternal))      { ty = CODESYS_INTERNAL; }
976 #endif
977   else
978     signal_simple_error ("Invalid coding system type", type);
979
980   CHECK_SYMBOL (name);
981
982   codesys = allocate_coding_system (ty, name);
983
984   if (NILP (doc_string))
985     doc_string = build_string ("");
986   else
987     CHECK_STRING (doc_string);
988   CODING_SYSTEM_DOC_STRING (codesys) = doc_string;
989
990   {
991     EXTERNAL_PROPERTY_LIST_LOOP_3 (key, value, props)
992       {
993         if (EQ (key, Qmnemonic))
994           {
995             if (!NILP (value))
996               CHECK_STRING (value);
997             CODING_SYSTEM_MNEMONIC (codesys) = value;
998           }
999
1000         else if (EQ (key, Qeol_type))
1001           {
1002             need_to_setup_eol_systems = NILP (value);
1003             if (EQ (value, Qt))
1004               value = Qnil;
1005             CODING_SYSTEM_EOL_TYPE (codesys) = symbol_to_eol_type (value);
1006           }
1007
1008         else if (EQ (key, Qpost_read_conversion))
1009           CODING_SYSTEM_POST_READ_CONVERSION (codesys) = value;
1010         else if (EQ (key, Qpre_write_conversion))
1011           CODING_SYSTEM_PRE_WRITE_CONVERSION (codesys) = value;
1012 #ifdef UTF2000
1013         else if (EQ (key, Qdisable_composition))
1014           CODING_SYSTEM_DISABLE_COMPOSITION (codesys) = !NILP (value);
1015         else if (EQ (key, Qenable_decomposition))
1016           CODING_SYSTEM_ENABLE_DECOMPOSITION (codesys) = !NILP (value);
1017         else if (EQ (key, Quse_entity_reference))
1018           CODING_SYSTEM_USE_ENTITY_REFERENCE (codesys) = !NILP (value);
1019 #endif
1020 #ifdef MULE
1021         else if (ty == CODESYS_ISO2022)
1022           {
1023 #define FROB_INITIAL_CHARSET(charset_num) \
1024   CODING_SYSTEM_ISO2022_INITIAL_CHARSET (codesys, charset_num) = \
1025     ((EQ (value, Qt) || EQ (value, Qnil)) ? value : Fget_charset (value))
1026
1027             if      (EQ (key, Qcharset_g0)) FROB_INITIAL_CHARSET (0);
1028             else if (EQ (key, Qcharset_g1)) FROB_INITIAL_CHARSET (1);
1029             else if (EQ (key, Qcharset_g2)) FROB_INITIAL_CHARSET (2);
1030             else if (EQ (key, Qcharset_g3)) FROB_INITIAL_CHARSET (3);
1031
1032 #define FROB_FORCE_CHARSET(charset_num) \
1033   CODING_SYSTEM_ISO2022_FORCE_CHARSET_ON_OUTPUT (codesys, charset_num) = !NILP (value)
1034
1035             else if (EQ (key, Qforce_g0_on_output)) FROB_FORCE_CHARSET (0);
1036             else if (EQ (key, Qforce_g1_on_output)) FROB_FORCE_CHARSET (1);
1037             else if (EQ (key, Qforce_g2_on_output)) FROB_FORCE_CHARSET (2);
1038             else if (EQ (key, Qforce_g3_on_output)) FROB_FORCE_CHARSET (3);
1039
1040 #define FROB_BOOLEAN_PROPERTY(prop) \
1041   CODING_SYSTEM_ISO2022_##prop (codesys) = !NILP (value)
1042
1043             else if (EQ (key, Qshort))         FROB_BOOLEAN_PROPERTY (SHORT);
1044             else if (EQ (key, Qno_ascii_eol))  FROB_BOOLEAN_PROPERTY (NO_ASCII_EOL);
1045             else if (EQ (key, Qno_ascii_cntl)) FROB_BOOLEAN_PROPERTY (NO_ASCII_CNTL);
1046             else if (EQ (key, Qseven))         FROB_BOOLEAN_PROPERTY (SEVEN);
1047             else if (EQ (key, Qlock_shift))    FROB_BOOLEAN_PROPERTY (LOCK_SHIFT);
1048             else if (EQ (key, Qno_iso6429))    FROB_BOOLEAN_PROPERTY (NO_ISO6429);
1049             else if (EQ (key, Qescape_quoted)) FROB_BOOLEAN_PROPERTY (ESCAPE_QUOTED);
1050
1051             else if (EQ (key, Qinput_charset_conversion))
1052               {
1053                 codesys->iso2022.input_conv =
1054                   Dynarr_new (charset_conversion_spec);
1055                 parse_charset_conversion_specs (codesys->iso2022.input_conv,
1056                                                 value);
1057               }
1058             else if (EQ (key, Qoutput_charset_conversion))
1059               {
1060                 codesys->iso2022.output_conv =
1061                   Dynarr_new (charset_conversion_spec);
1062                 parse_charset_conversion_specs (codesys->iso2022.output_conv,
1063                                                 value);
1064               }
1065 #ifdef UTF2000
1066             else if (EQ (key, Qccs_priority_list))
1067               {
1068                 codesys->ccs_priority_list = value;
1069               }
1070 #endif
1071             else
1072               signal_simple_error ("Unrecognized property", key);
1073           }
1074 #ifdef UTF2000
1075         else if (ty == CODESYS_UTF8)
1076           {
1077             if      (EQ (key, Qcharset_g0)) FROB_INITIAL_CHARSET (0);
1078             else if (EQ (key, Qcharset_g1))
1079               CODING_SYSTEM_ISO2022_INITIAL_CHARSET (codesys, 1) = value;
1080             else if (EQ (key, Qcharset_g2))
1081               CODING_SYSTEM_ISO2022_INITIAL_CHARSET (codesys, 2) = value;
1082             else
1083               signal_simple_error ("Unrecognized property", key);
1084           }
1085         else if (ty == CODESYS_BIG5)
1086           {
1087             if      (EQ (key, Qcharset_g0)) FROB_INITIAL_CHARSET (0);
1088             else if (EQ (key, Qcharset_g1)) FROB_INITIAL_CHARSET (1);
1089             else
1090               signal_simple_error ("Unrecognized property", key);
1091           }
1092 #endif
1093         else if (EQ (type, Qccl))
1094           {
1095             Lisp_Object sym;
1096             struct ccl_program test_ccl;
1097             Extbyte *suffix;
1098
1099             /* Check key first.  */
1100             if (EQ (key, Qdecode))
1101               suffix = "-ccl-decode";
1102             else if (EQ (key, Qencode))
1103               suffix = "-ccl-encode";
1104             else
1105               signal_simple_error ("Unrecognized property", key);
1106
1107             /* If value is vector, register it as a ccl program
1108                associated with an newly created symbol for
1109                backward compatibility.  */
1110             if (VECTORP (value))
1111               {
1112                 sym = Fintern (concat2 (Fsymbol_name (name),
1113                                         build_string (suffix)),
1114                                Qnil);
1115                 Fregister_ccl_program (sym, value);
1116               }
1117             else
1118               {
1119                 CHECK_SYMBOL (value);
1120                 sym = value;
1121               }
1122             /* check if the given ccl programs are valid.  */
1123             if (setup_ccl_program (&test_ccl, sym) < 0)
1124               signal_simple_error ("Invalid CCL program", value);
1125
1126             if (EQ (key, Qdecode))
1127               CODING_SYSTEM_CCL_DECODE (codesys) = sym;
1128             else if (EQ (key, Qencode))
1129               CODING_SYSTEM_CCL_ENCODE (codesys) = sym;
1130
1131           }
1132 #endif /* MULE */
1133         else
1134           signal_simple_error ("Unrecognized property", key);
1135       }
1136   }
1137
1138   if (need_to_setup_eol_systems)
1139     setup_eol_coding_systems (codesys);
1140
1141   {
1142     Lisp_Object codesys_obj;
1143     XSETCODING_SYSTEM (codesys_obj, codesys);
1144     Fputhash (name, codesys_obj, Vcoding_system_hash_table);
1145     return codesys_obj;
1146   }
1147 }
1148
1149 DEFUN ("copy-coding-system", Fcopy_coding_system, 2, 2, 0, /*
1150 Copy OLD-CODING-SYSTEM to NEW-NAME.
1151 If NEW-NAME does not name an existing coding system, a new one will
1152 be created.
1153 */
1154        (old_coding_system, new_name))
1155 {
1156   Lisp_Object new_coding_system;
1157   old_coding_system = Fget_coding_system (old_coding_system);
1158   new_coding_system = Ffind_coding_system (new_name);
1159   if (NILP (new_coding_system))
1160     {
1161       XSETCODING_SYSTEM (new_coding_system,
1162                          allocate_coding_system
1163                          (XCODING_SYSTEM_TYPE (old_coding_system),
1164                           new_name));
1165       Fputhash (new_name, new_coding_system, Vcoding_system_hash_table);
1166     }
1167
1168   {
1169     Lisp_Coding_System *to = XCODING_SYSTEM (new_coding_system);
1170     Lisp_Coding_System *from = XCODING_SYSTEM (old_coding_system);
1171     memcpy (((char *) to  ) + sizeof (to->header),
1172             ((char *) from) + sizeof (from->header),
1173             sizeof (*from) - sizeof (from->header));
1174     to->name = new_name;
1175   }
1176   return new_coding_system;
1177 }
1178
1179 DEFUN ("coding-system-canonical-name-p", Fcoding_system_canonical_name_p, 1, 1, 0, /*
1180 Return t if OBJECT names a coding system, and is not a coding system alias.
1181 */
1182        (object))
1183 {
1184   return CODING_SYSTEMP (Fgethash (object, Vcoding_system_hash_table, Qnil))
1185     ? Qt : Qnil;
1186 }
1187
1188 DEFUN ("coding-system-alias-p", Fcoding_system_alias_p, 1, 1, 0, /*
1189 Return t if OBJECT is a coding system alias.
1190 All coding system aliases are created by `define-coding-system-alias'.
1191 */
1192        (object))
1193 {
1194   return SYMBOLP (Fgethash (object, Vcoding_system_hash_table, Qzero))
1195     ? Qt : Qnil;
1196 }
1197
1198 DEFUN ("coding-system-aliasee", Fcoding_system_aliasee, 1, 1, 0, /*
1199 Return the coding-system symbol for which symbol ALIAS is an alias.
1200 */
1201        (alias))
1202 {
1203   Lisp_Object aliasee = Fgethash (alias, Vcoding_system_hash_table, Qnil);
1204   if (SYMBOLP (aliasee))
1205     return aliasee;
1206   else
1207     signal_simple_error ("Symbol is not a coding system alias", alias);
1208   return Qnil;          /* To keep the compiler happy */
1209 }
1210
1211 static Lisp_Object
1212 append_suffix_to_symbol (Lisp_Object symbol, const char *ascii_string)
1213 {
1214   return Fintern (concat2 (Fsymbol_name (symbol), build_string (ascii_string)),
1215                   Qnil);
1216 }
1217
1218 /* A maphash function, for removing dangling coding system aliases. */
1219 static int
1220 dangling_coding_system_alias_p (Lisp_Object alias,
1221                                 Lisp_Object aliasee,
1222                                 void *dangling_aliases)
1223 {
1224   if (SYMBOLP (aliasee)
1225       && NILP (Fgethash (aliasee, Vcoding_system_hash_table, Qnil)))
1226     {
1227       (*(int *) dangling_aliases)++;
1228       return 1;
1229     }
1230   else
1231     return 0;
1232 }
1233
1234 DEFUN ("define-coding-system-alias", Fdefine_coding_system_alias, 2, 2, 0, /*
1235 Define symbol ALIAS as an alias for coding system ALIASEE.
1236
1237 You can use this function to redefine an alias that has already been defined,
1238 but you cannot redefine a name which is the canonical name for a coding system.
1239 \(a canonical name of a coding system is what is returned when you call
1240 `coding-system-name' on a coding system).
1241
1242 ALIASEE itself can be an alias, which allows you to define nested aliases.
1243
1244 You are forbidden, however, from creating alias loops or `dangling' aliases.
1245 These will be detected, and an error will be signaled if you attempt to do so.
1246
1247 If ALIASEE is nil, then ALIAS will simply be undefined.
1248
1249 See also `coding-system-alias-p', `coding-system-aliasee',
1250 and `coding-system-canonical-name-p'.
1251 */
1252        (alias, aliasee))
1253 {
1254   Lisp_Object real_coding_system, probe;
1255
1256   CHECK_SYMBOL (alias);
1257
1258   if (!NILP (Fcoding_system_canonical_name_p (alias)))
1259     signal_simple_error
1260       ("Symbol is the canonical name of a coding system and cannot be redefined",
1261        alias);
1262
1263   if (NILP (aliasee))
1264     {
1265       Lisp_Object subsidiary_unix = append_suffix_to_symbol (alias, "-unix");
1266       Lisp_Object subsidiary_dos  = append_suffix_to_symbol (alias, "-dos");
1267       Lisp_Object subsidiary_mac  = append_suffix_to_symbol (alias, "-mac");
1268
1269       Fremhash (alias, Vcoding_system_hash_table);
1270
1271       /* Undefine subsidiary aliases,
1272          presumably created by a previous call to this function */
1273       if (! NILP (Fcoding_system_alias_p (subsidiary_unix)) &&
1274           ! NILP (Fcoding_system_alias_p (subsidiary_dos))  &&
1275           ! NILP (Fcoding_system_alias_p (subsidiary_mac)))
1276         {
1277           Fdefine_coding_system_alias (subsidiary_unix, Qnil);
1278           Fdefine_coding_system_alias (subsidiary_dos,  Qnil);
1279           Fdefine_coding_system_alias (subsidiary_mac,  Qnil);
1280         }
1281
1282       /* Undefine dangling coding system aliases. */
1283       {
1284         int dangling_aliases;
1285
1286         do {
1287           dangling_aliases = 0;
1288           elisp_map_remhash (dangling_coding_system_alias_p,
1289                              Vcoding_system_hash_table,
1290                              &dangling_aliases);
1291         } while (dangling_aliases > 0);
1292       }
1293
1294       return Qnil;
1295     }
1296
1297   if (CODING_SYSTEMP (aliasee))
1298     aliasee = XCODING_SYSTEM_NAME (aliasee);
1299
1300   /* Checks that aliasee names a coding-system */
1301   real_coding_system = Fget_coding_system (aliasee);
1302
1303   /* Check for coding system alias loops */
1304   if (EQ (alias, aliasee))
1305     alias_loop: signal_simple_error_2
1306       ("Attempt to create a coding system alias loop", alias, aliasee);
1307
1308   for (probe = aliasee;
1309        SYMBOLP (probe);
1310        probe = Fgethash (probe, Vcoding_system_hash_table, Qzero))
1311     {
1312       if (EQ (probe, alias))
1313         goto alias_loop;
1314     }
1315
1316   Fputhash (alias, aliasee, Vcoding_system_hash_table);
1317
1318   /* Set up aliases for subsidiaries.
1319      #### There must be a better way to handle subsidiary coding systems. */
1320   {
1321     static const char *suffixes[] = { "-unix", "-dos", "-mac" };
1322     int i;
1323     for (i = 0; i < countof (suffixes); i++)
1324       {
1325         Lisp_Object alias_subsidiary =
1326           append_suffix_to_symbol (alias, suffixes[i]);
1327         Lisp_Object aliasee_subsidiary =
1328           append_suffix_to_symbol (aliasee, suffixes[i]);
1329
1330         if (! NILP (Ffind_coding_system (aliasee_subsidiary)))
1331           Fdefine_coding_system_alias (alias_subsidiary, aliasee_subsidiary);
1332       }
1333   }
1334   /* FSF return value is a vector of [ALIAS-unix ALIAS-dos ALIAS-mac],
1335      but it doesn't look intentional, so I'd rather return something
1336      meaningful or nothing at all. */
1337   return Qnil;
1338 }
1339
1340 static Lisp_Object
1341 subsidiary_coding_system (Lisp_Object coding_system, eol_type_t type)
1342 {
1343   Lisp_Coding_System *cs = XCODING_SYSTEM (coding_system);
1344   Lisp_Object new_coding_system;
1345
1346   if (CODING_SYSTEM_EOL_TYPE (cs) != EOL_AUTODETECT)
1347     return coding_system;
1348
1349   switch (type)
1350     {
1351     case EOL_AUTODETECT: return coding_system;
1352     case EOL_LF:   new_coding_system = CODING_SYSTEM_EOL_LF   (cs); break;
1353     case EOL_CR:   new_coding_system = CODING_SYSTEM_EOL_CR   (cs); break;
1354     case EOL_CRLF: new_coding_system = CODING_SYSTEM_EOL_CRLF (cs); break;
1355     default:       abort (); return Qnil;
1356     }
1357
1358   return NILP (new_coding_system) ? coding_system : new_coding_system;
1359 }
1360
1361 DEFUN ("subsidiary-coding-system", Fsubsidiary_coding_system, 2, 2, 0, /*
1362 Return the subsidiary coding system of CODING-SYSTEM with eol type EOL-TYPE.
1363 */
1364        (coding_system, eol_type))
1365 {
1366   coding_system = Fget_coding_system (coding_system);
1367
1368   return subsidiary_coding_system (coding_system,
1369                                    symbol_to_eol_type (eol_type));
1370 }
1371
1372 \f
1373 /************************************************************************/
1374 /*                         Coding system accessors                      */
1375 /************************************************************************/
1376
1377 DEFUN ("coding-system-doc-string", Fcoding_system_doc_string, 1, 1, 0, /*
1378 Return the doc string for CODING-SYSTEM.
1379 */
1380        (coding_system))
1381 {
1382   coding_system = Fget_coding_system (coding_system);
1383   return XCODING_SYSTEM_DOC_STRING (coding_system);
1384 }
1385
1386 DEFUN ("coding-system-type", Fcoding_system_type, 1, 1, 0, /*
1387 Return the type of CODING-SYSTEM.
1388 */
1389        (coding_system))
1390 {
1391   switch (XCODING_SYSTEM_TYPE (Fget_coding_system (coding_system)))
1392     {
1393     default: abort ();
1394     case CODESYS_AUTODETECT:    return Qundecided;
1395 #ifdef MULE
1396     case CODESYS_SHIFT_JIS:     return Qshift_jis;
1397     case CODESYS_ISO2022:       return Qiso2022;
1398     case CODESYS_BIG5:          return Qbig5;
1399     case CODESYS_UCS4:          return Qucs4;
1400     case CODESYS_UTF16:         return Qutf16;
1401     case CODESYS_UTF8:          return Qutf8;
1402     case CODESYS_CCL:           return Qccl;
1403 #endif
1404     case CODESYS_NO_CONVERSION: return Qno_conversion;
1405 #ifdef DEBUG_XEMACS
1406     case CODESYS_INTERNAL:      return Qinternal;
1407 #endif
1408     }
1409 }
1410
1411 #ifdef MULE
1412 static
1413 Lisp_Object coding_system_charset (Lisp_Object coding_system, int gnum)
1414 {
1415   Lisp_Object cs
1416     = XCODING_SYSTEM_ISO2022_INITIAL_CHARSET (coding_system, gnum);
1417
1418   return CHARSETP (cs) ? XCHARSET_NAME (cs) : Qnil;
1419 }
1420
1421 DEFUN ("coding-system-charset", Fcoding_system_charset, 2, 2, 0, /*
1422 Return initial charset of CODING-SYSTEM designated to GNUM.
1423 GNUM allows 0 .. 3.
1424 */
1425        (coding_system, gnum))
1426 {
1427   coding_system = Fget_coding_system (coding_system);
1428   CHECK_INT (gnum);
1429
1430   return coding_system_charset (coding_system, XINT (gnum));
1431 }
1432 #endif /* MULE */
1433
1434 DEFUN ("coding-system-property", Fcoding_system_property, 2, 2, 0, /*
1435 Return the PROP property of CODING-SYSTEM.
1436 */
1437        (coding_system, prop))
1438 {
1439   int i, ok = 0;
1440   enum coding_system_type type;
1441
1442   coding_system = Fget_coding_system (coding_system);
1443   CHECK_SYMBOL (prop);
1444   type = XCODING_SYSTEM_TYPE (coding_system);
1445
1446   for (i = 0; !ok && i < Dynarr_length (the_codesys_prop_dynarr); i++)
1447     if (EQ (Dynarr_at (the_codesys_prop_dynarr, i).sym, prop))
1448       {
1449         ok = 1;
1450         switch (Dynarr_at (the_codesys_prop_dynarr, i).prop_type)
1451           {
1452           case CODESYS_PROP_ALL_OK:
1453             break;
1454 #ifdef MULE
1455           case CODESYS_PROP_ISO2022:
1456             if (type != CODESYS_ISO2022)
1457               signal_simple_error
1458                 ("Property only valid in ISO2022 coding systems",
1459                  prop);
1460             break;
1461
1462           case CODESYS_PROP_CCL:
1463             if (type != CODESYS_CCL)
1464               signal_simple_error
1465                 ("Property only valid in CCL coding systems",
1466                  prop);
1467             break;
1468 #endif /* MULE */
1469           default:
1470             abort ();
1471           }
1472       }
1473
1474   if (!ok)
1475     signal_simple_error ("Unrecognized property", prop);
1476
1477   if (EQ (prop, Qname))
1478     return XCODING_SYSTEM_NAME (coding_system);
1479   else if (EQ (prop, Qtype))
1480     return Fcoding_system_type (coding_system);
1481   else if (EQ (prop, Qdoc_string))
1482     return XCODING_SYSTEM_DOC_STRING (coding_system);
1483   else if (EQ (prop, Qmnemonic))
1484     return XCODING_SYSTEM_MNEMONIC (coding_system);
1485   else if (EQ (prop, Qeol_type))
1486     return eol_type_to_symbol (XCODING_SYSTEM_EOL_TYPE (coding_system));
1487   else if (EQ (prop, Qeol_lf))
1488     return XCODING_SYSTEM_EOL_LF (coding_system);
1489   else if (EQ (prop, Qeol_crlf))
1490     return XCODING_SYSTEM_EOL_CRLF (coding_system);
1491   else if (EQ (prop, Qeol_cr))
1492     return XCODING_SYSTEM_EOL_CR (coding_system);
1493   else if (EQ (prop, Qpost_read_conversion))
1494     return XCODING_SYSTEM_POST_READ_CONVERSION (coding_system);
1495   else if (EQ (prop, Qpre_write_conversion))
1496     return XCODING_SYSTEM_PRE_WRITE_CONVERSION (coding_system);
1497 #ifdef MULE
1498 #ifdef UTF2000
1499   else if (EQ (prop, Qdisable_composition))
1500     return XCODING_SYSTEM_DISABLE_COMPOSITION (coding_system) ? Qt : Qnil;
1501   else if (EQ (prop, Qenable_decomposition))
1502     return XCODING_SYSTEM_ENABLE_DECOMPOSITION (coding_system) ? Qt : Qnil;
1503   else if (EQ (prop, Quse_entity_reference))
1504     return XCODING_SYSTEM_USE_ENTITY_REFERENCE (coding_system) ? Qt : Qnil;
1505   else if (EQ (prop, Qccs_priority_list))
1506     return XCODING_SYSTEM_CCS_PRIORITY_LIST (coding_system);
1507 #endif
1508   else if (type == CODESYS_ISO2022)
1509     {
1510       if (EQ (prop, Qcharset_g0))
1511         return coding_system_charset (coding_system, 0);
1512       else if (EQ (prop, Qcharset_g1))
1513         return coding_system_charset (coding_system, 1);
1514       else if (EQ (prop, Qcharset_g2))
1515         return coding_system_charset (coding_system, 2);
1516       else if (EQ (prop, Qcharset_g3))
1517         return coding_system_charset (coding_system, 3);
1518
1519 #define FORCE_CHARSET(charset_num) \
1520   (XCODING_SYSTEM_ISO2022_FORCE_CHARSET_ON_OUTPUT \
1521    (coding_system, charset_num) ? Qt : Qnil)
1522
1523       else if (EQ (prop, Qforce_g0_on_output)) return FORCE_CHARSET (0);
1524       else if (EQ (prop, Qforce_g1_on_output)) return FORCE_CHARSET (1);
1525       else if (EQ (prop, Qforce_g2_on_output)) return FORCE_CHARSET (2);
1526       else if (EQ (prop, Qforce_g3_on_output)) return FORCE_CHARSET (3);
1527
1528 #define LISP_BOOLEAN(prop) \
1529   (XCODING_SYSTEM_ISO2022_##prop (coding_system) ? Qt : Qnil)
1530
1531       else if (EQ (prop, Qshort))         return LISP_BOOLEAN (SHORT);
1532       else if (EQ (prop, Qno_ascii_eol))  return LISP_BOOLEAN (NO_ASCII_EOL);
1533       else if (EQ (prop, Qno_ascii_cntl)) return LISP_BOOLEAN (NO_ASCII_CNTL);
1534       else if (EQ (prop, Qseven))         return LISP_BOOLEAN (SEVEN);
1535       else if (EQ (prop, Qlock_shift))    return LISP_BOOLEAN (LOCK_SHIFT);
1536       else if (EQ (prop, Qno_iso6429))    return LISP_BOOLEAN (NO_ISO6429);
1537       else if (EQ (prop, Qescape_quoted)) return LISP_BOOLEAN (ESCAPE_QUOTED);
1538
1539       else if (EQ (prop, Qinput_charset_conversion))
1540         return
1541           unparse_charset_conversion_specs
1542             (XCODING_SYSTEM (coding_system)->iso2022.input_conv);
1543       else if (EQ (prop, Qoutput_charset_conversion))
1544         return
1545           unparse_charset_conversion_specs
1546             (XCODING_SYSTEM (coding_system)->iso2022.output_conv);
1547       else
1548         abort ();
1549     }
1550   else if (type == CODESYS_CCL)
1551     {
1552       if (EQ (prop, Qdecode))
1553         return XCODING_SYSTEM_CCL_DECODE (coding_system);
1554       else if (EQ (prop, Qencode))
1555         return XCODING_SYSTEM_CCL_ENCODE (coding_system);
1556       else
1557         abort ();
1558     }
1559 #endif /* MULE */
1560   else
1561     abort ();
1562
1563   return Qnil; /* not reached */
1564 }
1565
1566 \f
1567 /************************************************************************/
1568 /*                       Coding category functions                      */
1569 /************************************************************************/
1570
1571 static int
1572 decode_coding_category (Lisp_Object symbol)
1573 {
1574   int i;
1575
1576   CHECK_SYMBOL (symbol);
1577   for (i = 0; i < CODING_CATEGORY_LAST; i++)
1578     if (EQ (coding_category_symbol[i], symbol))
1579       return i;
1580
1581   signal_simple_error ("Unrecognized coding category", symbol);
1582   return 0; /* not reached */
1583 }
1584
1585 DEFUN ("coding-category-list", Fcoding_category_list, 0, 0, 0, /*
1586 Return a list of all recognized coding categories.
1587 */
1588        ())
1589 {
1590   int i;
1591   Lisp_Object list = Qnil;
1592
1593   for (i = CODING_CATEGORY_LAST - 1; i >= 0; i--)
1594     list = Fcons (coding_category_symbol[i], list);
1595   return list;
1596 }
1597
1598 DEFUN ("set-coding-priority-list", Fset_coding_priority_list, 1, 1, 0, /*
1599 Change the priority order of the coding categories.
1600 LIST should be list of coding categories, in descending order of
1601 priority.  Unspecified coding categories will be lower in priority
1602 than all specified ones, in the same relative order they were in
1603 previously.
1604 */
1605        (list))
1606 {
1607   int category_to_priority[CODING_CATEGORY_LAST];
1608   int i, j;
1609   Lisp_Object rest;
1610
1611   /* First generate a list that maps coding categories to priorities. */
1612
1613   for (i = 0; i < CODING_CATEGORY_LAST; i++)
1614     category_to_priority[i] = -1;
1615
1616   /* Highest priority comes from the specified list. */
1617   i = 0;
1618   EXTERNAL_LIST_LOOP (rest, list)
1619     {
1620       int cat = decode_coding_category (XCAR (rest));
1621
1622       if (category_to_priority[cat] >= 0)
1623         signal_simple_error ("Duplicate coding category in list", XCAR (rest));
1624       category_to_priority[cat] = i++;
1625     }
1626
1627   /* Now go through the existing categories by priority to retrieve
1628      the categories not yet specified and preserve their priority
1629      order. */
1630   for (j = 0; j < CODING_CATEGORY_LAST; j++)
1631     {
1632       int cat = fcd->coding_category_by_priority[j];
1633       if (category_to_priority[cat] < 0)
1634         category_to_priority[cat] = i++;
1635     }
1636
1637   /* Now we need to construct the inverse of the mapping we just
1638      constructed. */
1639
1640   for (i = 0; i < CODING_CATEGORY_LAST; i++)
1641     fcd->coding_category_by_priority[category_to_priority[i]] = i;
1642
1643   /* Phew!  That was confusing. */
1644   return Qnil;
1645 }
1646
1647 DEFUN ("coding-priority-list", Fcoding_priority_list, 0, 0, 0, /*
1648 Return a list of coding categories in descending order of priority.
1649 */
1650        ())
1651 {
1652   int i;
1653   Lisp_Object list = Qnil;
1654
1655   for (i = CODING_CATEGORY_LAST - 1; i >= 0; i--)
1656     list = Fcons (coding_category_symbol[fcd->coding_category_by_priority[i]],
1657                   list);
1658   return list;
1659 }
1660
1661 DEFUN ("set-coding-category-system", Fset_coding_category_system, 2, 2, 0, /*
1662 Change the coding system associated with a coding category.
1663 */
1664        (coding_category, coding_system))
1665 {
1666   int cat = decode_coding_category (coding_category);
1667
1668   coding_system = Fget_coding_system (coding_system);
1669   fcd->coding_category_system[cat] = coding_system;
1670   return Qnil;
1671 }
1672
1673 DEFUN ("coding-category-system", Fcoding_category_system, 1, 1, 0, /*
1674 Return the coding system associated with a coding category.
1675 */
1676        (coding_category))
1677 {
1678   int cat = decode_coding_category (coding_category);
1679   Lisp_Object sys = fcd->coding_category_system[cat];
1680
1681   if (!NILP (sys))
1682     return XCODING_SYSTEM_NAME (sys);
1683   return Qnil;
1684 }
1685
1686 \f
1687 /************************************************************************/
1688 /*                     Detecting the encoding of data                   */
1689 /************************************************************************/
1690
1691 struct detection_state
1692 {
1693   eol_type_t eol_type;
1694   int seen_non_ascii;
1695   int mask;
1696 #ifdef MULE
1697   struct
1698     {
1699       int mask;
1700       int in_second_byte;
1701     }
1702   big5;
1703
1704   struct
1705     {
1706       int mask;
1707       int in_second_byte;
1708     }
1709   shift_jis;
1710
1711   struct
1712     {
1713       int mask;
1714       int in_byte;
1715   }
1716   ucs4;
1717
1718   struct
1719     {
1720       int mask;
1721       int in_byte;
1722     }
1723   utf16;
1724
1725   struct
1726     {
1727       int mask;
1728       int in_byte;
1729     }
1730   utf8;
1731
1732   struct
1733     {
1734       int mask;
1735       int initted;
1736       struct iso2022_decoder iso;
1737       unsigned int flags;
1738       int high_byte_count;
1739       unsigned int saw_single_shift:1;
1740     }
1741   iso2022;
1742 #endif
1743   struct
1744     {
1745       int seen_anything;
1746       int just_saw_cr;
1747     }
1748   eol;
1749 };
1750
1751 static int
1752 acceptable_control_char_p (int c)
1753 {
1754   switch (c)
1755     {
1756       /* Allow and ignore control characters that you might
1757          reasonably see in a text file */
1758     case '\r':
1759     case '\n':
1760     case '\t':
1761     case  7: /* bell */
1762     case  8: /* backspace */
1763     case 11: /* vertical tab */
1764     case 12: /* form feed */
1765     case 26: /* MS-DOS C-z junk */
1766     case 31: /* '^_' -- for info */
1767       return 1;
1768     default:
1769       return 0;
1770     }
1771 }
1772
1773 static int
1774 mask_has_at_most_one_bit_p (int mask)
1775 {
1776   /* Perhaps the only thing useful you learn from intensive Microsoft
1777      technical interviews */
1778   return (mask & (mask - 1)) == 0;
1779 }
1780
1781 static eol_type_t
1782 detect_eol_type (struct detection_state *st, const Extbyte *src,
1783                  Lstream_data_count n)
1784 {
1785   while (n--)
1786     {
1787       unsigned char c = *(unsigned char *)src++;
1788       if (c == '\n')
1789         {
1790           if (st->eol.just_saw_cr)
1791             return EOL_CRLF;
1792           else if (st->eol.seen_anything)
1793             return EOL_LF;
1794         }
1795       else if (st->eol.just_saw_cr)
1796         return EOL_CR;
1797       else if (c == '\r')
1798         st->eol.just_saw_cr = 1;
1799       else
1800         st->eol.just_saw_cr = 0;
1801       st->eol.seen_anything = 1;
1802     }
1803
1804   return EOL_AUTODETECT;
1805 }
1806
1807 /* Attempt to determine the encoding and EOL type of the given text.
1808    Before calling this function for the first type, you must initialize
1809    st->eol_type as appropriate and initialize st->mask to ~0.
1810
1811    st->eol_type holds the determined EOL type, or EOL_AUTODETECT if
1812    not yet known.
1813
1814    st->mask holds the determined coding category mask, or ~0 if only
1815    ASCII has been seen so far.
1816
1817    Returns:
1818
1819    0 == st->eol_type is EOL_AUTODETECT and/or more than coding category
1820         is present in st->mask
1821    1 == definitive answers are here for both st->eol_type and st->mask
1822 */
1823
1824 static int
1825 detect_coding_type (struct detection_state *st, const Extbyte *src,
1826                     Lstream_data_count n, int just_do_eol)
1827 {
1828   if (st->eol_type == EOL_AUTODETECT)
1829     st->eol_type = detect_eol_type (st, src, n);
1830
1831   if (just_do_eol)
1832     return st->eol_type != EOL_AUTODETECT;
1833
1834   if (!st->seen_non_ascii)
1835     {
1836       for (; n; n--, src++)
1837         {
1838           unsigned char c = *(unsigned char *) src;
1839           if ((c < 0x20 && !acceptable_control_char_p (c)) || c >= 0x80)
1840             {
1841               st->seen_non_ascii = 1;
1842 #ifdef MULE
1843               st->shift_jis.mask = ~0;
1844               st->big5.mask = ~0;
1845               st->ucs4.mask = ~0;
1846               st->utf16.mask = ~0;
1847               st->utf8.mask = ~0;
1848               st->iso2022.mask = ~0;
1849 #endif
1850               break;
1851             }
1852         }
1853     }
1854
1855   if (!n)
1856     return 0;
1857 #ifdef MULE
1858   if (!mask_has_at_most_one_bit_p (st->iso2022.mask))
1859     st->iso2022.mask = detect_coding_iso2022 (st, src, n);
1860   if (!mask_has_at_most_one_bit_p (st->shift_jis.mask))
1861     st->shift_jis.mask = detect_coding_sjis (st, src, n);
1862   if (!mask_has_at_most_one_bit_p (st->big5.mask))
1863     st->big5.mask = detect_coding_big5 (st, src, n);
1864   if (!mask_has_at_most_one_bit_p (st->utf8.mask))
1865     st->utf8.mask = detect_coding_utf8 (st, src, n);
1866   if (!mask_has_at_most_one_bit_p (st->utf16.mask))
1867     st->utf16.mask = detect_coding_utf16 (st, src, n);
1868   if (!mask_has_at_most_one_bit_p (st->ucs4.mask))
1869     st->ucs4.mask = detect_coding_ucs4 (st, src, n);
1870
1871   st->mask
1872     = st->iso2022.mask | st->shift_jis.mask | st->big5.mask
1873     | st->utf8.mask | st->ucs4.mask;
1874 #endif
1875   {
1876     int retval = mask_has_at_most_one_bit_p (st->mask);
1877     st->mask |= CODING_CATEGORY_NO_CONVERSION_MASK;
1878     return retval && st->eol_type != EOL_AUTODETECT;
1879   }
1880 }
1881
1882 static Lisp_Object
1883 coding_system_from_mask (int mask)
1884 {
1885   if (mask == ~0)
1886     {
1887       /* If the file was entirely or basically ASCII, use the
1888          default value of `buffer-file-coding-system'. */
1889       Lisp_Object retval =
1890         XBUFFER (Vbuffer_defaults)->buffer_file_coding_system;
1891       if (!NILP (retval))
1892         {
1893           retval = Ffind_coding_system (retval);
1894           if (NILP (retval))
1895             {
1896               warn_when_safe
1897                 (Qbad_variable, Qwarning,
1898                  "Invalid `default-buffer-file-coding-system', set to nil");
1899               XBUFFER (Vbuffer_defaults)->buffer_file_coding_system = Qnil;
1900             }
1901         }
1902       if (NILP (retval))
1903         retval = Fget_coding_system (Qraw_text);
1904       return retval;
1905     }
1906   else
1907     {
1908       int i;
1909       int cat = -1;
1910 #ifdef MULE
1911       mask = postprocess_iso2022_mask (mask);
1912 #endif
1913       /* Look through the coding categories by priority and find
1914          the first one that is allowed. */
1915       for (i = 0; i < CODING_CATEGORY_LAST; i++)
1916         {
1917           cat = fcd->coding_category_by_priority[i];
1918           if ((mask & (1 << cat)) &&
1919               !NILP (fcd->coding_category_system[cat]))
1920             break;
1921         }
1922       if (cat >= 0)
1923         return fcd->coding_category_system[cat];
1924       else
1925         return Fget_coding_system (Qraw_text);
1926     }
1927 }
1928
1929 /* Given a seekable read stream and potential coding system and EOL type
1930    as specified, do any autodetection that is called for.  If the
1931    coding system and/or EOL type are not `autodetect', they will be left
1932    alone; but this function will never return an autodetect coding system
1933    or EOL type.
1934
1935    This function does not automatically fetch subsidiary coding systems;
1936    that should be unnecessary with the explicit eol-type argument. */
1937
1938 #define LENGTH(string_constant) (sizeof (string_constant) - 1)
1939 /* number of leading lines to check for a coding cookie */
1940 #define LINES_TO_CHECK 2
1941
1942 void
1943 determine_real_coding_system (Lstream *stream, Lisp_Object *codesys_in_out,
1944                               eol_type_t *eol_type_in_out)
1945 {
1946   struct detection_state decst;
1947
1948   if (*eol_type_in_out == EOL_AUTODETECT)
1949     *eol_type_in_out = XCODING_SYSTEM_EOL_TYPE (*codesys_in_out);
1950
1951   xzero (decst);
1952   decst.eol_type = *eol_type_in_out;
1953   decst.mask = ~0;
1954
1955   /* If autodetection is called for, do it now. */
1956   if (XCODING_SYSTEM_TYPE (*codesys_in_out) == CODESYS_AUTODETECT
1957       || *eol_type_in_out == EOL_AUTODETECT)
1958     {
1959       Extbyte buf[4096];
1960       Lisp_Object coding_system = Qnil;
1961       Extbyte *p;
1962       Lstream_data_count nread = Lstream_read (stream, buf, sizeof (buf));
1963       Extbyte *scan_end;
1964       int lines_checked = 0;
1965
1966       /* Look for initial "-*-"; mode line prefix */
1967       for (p = buf,
1968              scan_end = buf + nread - LENGTH ("-*-coding:?-*-");
1969            p <= scan_end
1970              && lines_checked < LINES_TO_CHECK;
1971            p++)
1972         if (*p == '-' && *(p+1) == '*' && *(p+2) == '-')
1973           {
1974             Extbyte *local_vars_beg = p + 3;
1975             /* Look for final "-*-"; mode line suffix */
1976             for (p = local_vars_beg,
1977                    scan_end = buf + nread - LENGTH ("-*-");
1978                  p <= scan_end
1979                    && lines_checked < LINES_TO_CHECK;
1980                  p++)
1981               if (*p == '-' && *(p+1) == '*' && *(p+2) == '-')
1982                 {
1983                   Extbyte *suffix = p;
1984                   /* Look for "coding:" */
1985                   for (p = local_vars_beg,
1986                          scan_end = suffix - LENGTH ("coding:?");
1987                        p <= scan_end;
1988                        p++)
1989                     if (memcmp ("coding:", p, LENGTH ("coding:")) == 0
1990                         && (p == local_vars_beg
1991                             || (*(p-1) == ' '  ||
1992                                 *(p-1) == '\t' ||
1993                                 *(p-1) == ';')))
1994                       {
1995                         Extbyte save;
1996                         int n;
1997                         p += LENGTH ("coding:");
1998                         while (*p == ' ' || *p == '\t') p++;
1999
2000                         /* Get coding system name */
2001                         save = *suffix; *suffix = '\0';
2002                         /* Characters valid in a MIME charset name (rfc 1521),
2003                            and in a Lisp symbol name. */
2004                         n = strspn ( (char *) p,
2005                                     "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
2006                                     "abcdefghijklmnopqrstuvwxyz"
2007                                     "0123456789"
2008                                     "!$%&*+-.^_{|}~");
2009                         *suffix = save;
2010                         if (n > 0)
2011                           {
2012                             save = p[n]; p[n] = '\0';
2013                             coding_system =
2014                               Ffind_coding_system (intern ((char *) p));
2015                             p[n] = save;
2016                           }
2017                         break;
2018                       }
2019                   break;
2020                 }
2021               /* #### file must use standard EOLs or we miss 2d line */
2022               /* #### not to mention this is broken for UTF-16 DOS files */
2023               else if (*p == '\n' || *p == '\r')
2024                 {
2025                   lines_checked++;
2026                   /* skip past multibyte (DOS) newline */
2027                   if (*p == '\r' && *(p+1) == '\n') p++;
2028                 }
2029             break;
2030           }
2031         /* #### file must use standard EOLs or we miss 2d line */
2032         /* #### not to mention this is broken for UTF-16 DOS files */
2033         else if (*p == '\n' || *p == '\r')
2034           {
2035             lines_checked++;
2036             /* skip past multibyte (DOS) newline */
2037             if (*p == '\r' && *(p+1) == '\n') p++;
2038           }
2039
2040       if (NILP (coding_system))
2041         do
2042           {
2043             if (detect_coding_type (&decst, buf, nread,
2044                                     XCODING_SYSTEM_TYPE (*codesys_in_out)
2045                                     != CODESYS_AUTODETECT))
2046               break;
2047             nread = Lstream_read (stream, buf, sizeof (buf));
2048             if (nread == 0)
2049               break;
2050           }
2051         while (1);
2052
2053       else if (XCODING_SYSTEM_TYPE (*codesys_in_out) == CODESYS_AUTODETECT
2054                && XCODING_SYSTEM_EOL_TYPE (coding_system) == EOL_AUTODETECT)
2055         do
2056           {
2057             if (detect_coding_type (&decst, buf, nread, 1))
2058               break;
2059             nread = Lstream_read (stream, buf, sizeof (buf));
2060             if (!nread)
2061               break;
2062           }
2063         while (1);
2064
2065       *eol_type_in_out = decst.eol_type;
2066       if (XCODING_SYSTEM_TYPE (*codesys_in_out) == CODESYS_AUTODETECT)
2067         {
2068           if (NILP (coding_system))
2069             *codesys_in_out = coding_system_from_mask (decst.mask);
2070           else
2071             *codesys_in_out = coding_system;
2072         }
2073     }
2074
2075   /* If we absolutely can't determine the EOL type, just assume LF. */
2076   if (*eol_type_in_out == EOL_AUTODETECT)
2077     *eol_type_in_out = EOL_LF;
2078
2079   Lstream_rewind (stream);
2080 }
2081
2082 DEFUN ("detect-coding-region", Fdetect_coding_region, 2, 3, 0, /*
2083 Detect coding system of the text in the region between START and END.
2084 Return a list of possible coding systems ordered by priority.
2085 If only ASCII characters are found, return 'undecided or one of
2086 its subsidiary coding systems according to a detected end-of-line
2087 type.  Optional arg BUFFER defaults to the current buffer.
2088 */
2089        (start, end, buffer))
2090 {
2091   Lisp_Object val = Qnil;
2092   struct buffer *buf = decode_buffer (buffer, 0);
2093   Bufpos b, e;
2094   Lisp_Object instream, lb_instream;
2095   Lstream *istr, *lb_istr;
2096   struct detection_state decst;
2097   struct gcpro gcpro1, gcpro2;
2098
2099   get_buffer_range_char (buf, start, end, &b, &e, 0);
2100   lb_instream = make_lisp_buffer_input_stream (buf, b, e, 0);
2101   lb_istr = XLSTREAM (lb_instream);
2102   instream = make_encoding_input_stream (lb_istr, Fget_coding_system (Qbinary));
2103   istr = XLSTREAM (instream);
2104   GCPRO2 (instream, lb_instream);
2105   xzero (decst);
2106   decst.eol_type = EOL_AUTODETECT;
2107   decst.mask = ~0;
2108   while (1)
2109     {
2110       Extbyte random_buffer[4096];
2111       Lstream_data_count nread = Lstream_read (istr, random_buffer, sizeof (random_buffer));
2112
2113       if (!nread)
2114         break;
2115       if (detect_coding_type (&decst, random_buffer, nread, 0))
2116         break;
2117     }
2118
2119   if (decst.mask == ~0)
2120     val = subsidiary_coding_system (Fget_coding_system (Qundecided),
2121                                     decst.eol_type);
2122   else
2123     {
2124       int i;
2125
2126       val = Qnil;
2127 #ifdef MULE
2128       decst.mask = postprocess_iso2022_mask (decst.mask);
2129 #endif
2130       for (i = CODING_CATEGORY_LAST - 1; i >= 0; i--)
2131         {
2132           int sys = fcd->coding_category_by_priority[i];
2133           if (decst.mask & (1 << sys))
2134             {
2135               Lisp_Object codesys = fcd->coding_category_system[sys];
2136               if (!NILP (codesys))
2137                 codesys = subsidiary_coding_system (codesys, decst.eol_type);
2138               val = Fcons (codesys, val);
2139             }
2140         }
2141     }
2142   Lstream_close (istr);
2143   UNGCPRO;
2144   Lstream_delete (istr);
2145   Lstream_delete (lb_istr);
2146   return val;
2147 }
2148
2149 \f
2150 /************************************************************************/
2151 /*           Converting to internal Mule format ("decoding")            */
2152 /************************************************************************/
2153
2154 /* A decoding stream is a stream used for decoding text (i.e.
2155    converting from some external format to internal format).
2156    The decoding-stream object keeps track of the actual coding
2157    stream, the stream that is at the other end, and data that
2158    needs to be persistent across the lifetime of the stream. */
2159
2160 /* Handle the EOL stuff related to just-read-in character C.
2161    EOL_TYPE is the EOL type of the coding stream.
2162    FLAGS is the current value of FLAGS in the coding stream, and may
2163    be modified by this macro.  (The macro only looks at the
2164    CODING_STATE_CR flag.)  DST is the Dynarr to which the decoded
2165    bytes are to be written.  You need to also define a local goto
2166    label "label_continue_loop" that is at the end of the main
2167    character-reading loop.
2168
2169    If C is a CR character, then this macro handles it entirely and
2170    jumps to label_continue_loop.  Otherwise, this macro does not add
2171    anything to DST, and continues normally.  You should continue
2172    processing C normally after this macro. */
2173
2174 #define DECODE_HANDLE_EOL_TYPE(eol_type, c, flags, dst)         \
2175 do {                                                            \
2176   if (c == '\r')                                                \
2177     {                                                           \
2178       if (eol_type == EOL_CR)                                   \
2179         Dynarr_add (dst, '\n');                                 \
2180       else if (eol_type != EOL_CRLF || flags & CODING_STATE_CR) \
2181         Dynarr_add (dst, c);                                    \
2182       else                                                      \
2183         flags |= CODING_STATE_CR;                               \
2184       goto label_continue_loop;                                 \
2185     }                                                           \
2186   else if (flags & CODING_STATE_CR)                             \
2187     {   /* eol_type == CODING_SYSTEM_EOL_CRLF */                \
2188       if (c != '\n')                                            \
2189         Dynarr_add (dst, '\r');                                 \
2190       flags &= ~CODING_STATE_CR;                                \
2191     }                                                           \
2192 } while (0)
2193
2194 /* C should be a binary character in the range 0 - 255; convert
2195    to internal format and add to Dynarr DST. */
2196
2197 #ifdef UTF2000
2198 #define DECODE_ADD_BINARY_CHAR(c, dst) \
2199 do {                                            \
2200   if (BYTE_ASCII_P (c))                         \
2201     Dynarr_add (dst, c);                        \
2202   else                                          \
2203     {                                           \
2204       Dynarr_add (dst, (c >> 6) | 0xc0);        \
2205       Dynarr_add (dst, (c & 0x3f) | 0x80);      \
2206     }                                           \
2207 } while (0)
2208
2209 static void DECODE_ADD_UCS_CHAR(Emchar c, unsigned_char_dynarr* dst);
2210 static void
2211 DECODE_ADD_UCS_CHAR(Emchar c, unsigned_char_dynarr* dst)
2212 {
2213   if ( c <= 0x7f )
2214     {
2215       Dynarr_add (dst, c);
2216     }
2217   else if ( c <= 0x7ff )
2218     {
2219       Dynarr_add (dst, (c >> 6) | 0xc0);
2220       Dynarr_add (dst, (c & 0x3f) | 0x80);
2221     }
2222   else if ( c <= 0xffff )
2223     {
2224       Dynarr_add (dst,  (c >> 12) | 0xe0);
2225       Dynarr_add (dst, ((c >>  6) & 0x3f) | 0x80);
2226       Dynarr_add (dst,  (c        & 0x3f) | 0x80);
2227     }
2228   else if ( c <= 0x1fffff )
2229     {
2230       Dynarr_add (dst,  (c >> 18) | 0xf0);
2231       Dynarr_add (dst, ((c >> 12) & 0x3f) | 0x80);
2232       Dynarr_add (dst, ((c >>  6) & 0x3f) | 0x80);
2233       Dynarr_add (dst,  (c        & 0x3f) | 0x80);
2234     }
2235   else if ( c <= 0x3ffffff )
2236     {
2237       Dynarr_add (dst,  (c >> 24) | 0xf8);
2238       Dynarr_add (dst, ((c >> 18) & 0x3f) | 0x80);
2239       Dynarr_add (dst, ((c >> 12) & 0x3f) | 0x80);
2240       Dynarr_add (dst, ((c >>  6) & 0x3f) | 0x80);
2241       Dynarr_add (dst,  (c        & 0x3f) | 0x80);
2242     }
2243   else
2244     {
2245       Dynarr_add (dst,  (c >> 30) | 0xfc);
2246       Dynarr_add (dst, ((c >> 24) & 0x3f) | 0x80);
2247       Dynarr_add (dst, ((c >> 18) & 0x3f) | 0x80);
2248       Dynarr_add (dst, ((c >> 12) & 0x3f) | 0x80);
2249       Dynarr_add (dst, ((c >>  6) & 0x3f) | 0x80);
2250       Dynarr_add (dst,  (c        & 0x3f) | 0x80);
2251     }
2252 }
2253 #else
2254 #define DECODE_ADD_BINARY_CHAR(c, dst)          \
2255 do {                                            \
2256   if (BYTE_ASCII_P (c))                         \
2257     Dynarr_add (dst, c);                        \
2258   else if (BYTE_C1_P (c))                       \
2259     {                                           \
2260       Dynarr_add (dst, LEADING_BYTE_CONTROL_1); \
2261       Dynarr_add (dst, c + 0x20);               \
2262     }                                           \
2263   else                                          \
2264     {                                           \
2265       Dynarr_add (dst, LEADING_BYTE_LATIN_ISO8859_1); \
2266       Dynarr_add (dst, c);                      \
2267     }                                           \
2268 } while (0)
2269 #endif
2270
2271 #define DECODE_OUTPUT_PARTIAL_CHAR(ch)  \
2272 do {                                    \
2273   if (ch)                               \
2274     {                                   \
2275       DECODE_ADD_BINARY_CHAR (ch, dst); \
2276       ch = 0;                           \
2277     }                                   \
2278 } while (0)
2279
2280 #define DECODE_HANDLE_END_OF_CONVERSION(flags, ch, dst) \
2281 do {                                    \
2282   if (flags & CODING_STATE_END)         \
2283     {                                   \
2284       DECODE_OUTPUT_PARTIAL_CHAR (ch);  \
2285       if (flags & CODING_STATE_CR)      \
2286         Dynarr_add (dst, '\r');         \
2287     }                                   \
2288 } while (0)
2289
2290 #define DECODING_STREAM_DATA(stream) LSTREAM_TYPE_DATA (stream, decoding)
2291
2292 #define ER_BUF_SIZE 24
2293
2294 struct decoding_stream
2295 {
2296   /* Coding system that governs the conversion. */
2297   Lisp_Coding_System *codesys;
2298
2299   /* Stream that we read the encoded data from or
2300      write the decoded data to. */
2301   Lstream *other_end;
2302
2303   /* If we are reading, then we can return only a fixed amount of
2304      data, so if the conversion resulted in too much data, we store it
2305      here for retrieval the next time around. */
2306   unsigned_char_dynarr *runoff;
2307
2308   /* FLAGS holds flags indicating the current state of the decoding.
2309      Some of these flags are dependent on the coding system. */
2310   unsigned int flags;
2311
2312   /* CPOS holds a partially built-up code-point of character. */
2313   unsigned int cpos;
2314
2315   /* EOL_TYPE specifies the type of end-of-line conversion that
2316      currently applies.  We need to keep this separate from the
2317      EOL type stored in CODESYS because the latter might indicate
2318      automatic EOL-type detection while the former will always
2319      indicate a particular EOL type. */
2320   eol_type_t eol_type;
2321 #ifdef MULE
2322   /* Additional ISO2022 information.  We define the structure above
2323      because it's also needed by the detection routines. */
2324   struct iso2022_decoder iso2022;
2325
2326   /* Additional information (the state of the running CCL program)
2327      used by the CCL decoder. */
2328   struct ccl_program ccl;
2329
2330   /* counter for UTF-8 or UCS-4 */
2331   unsigned char counter;
2332 #endif
2333 #ifdef UTF2000
2334   char bom_flag;
2335   unsigned char er_counter;
2336   unsigned char er_buf[ER_BUF_SIZE];
2337
2338   unsigned combined_char_count;
2339   Emchar combined_chars[16];
2340 #ifdef HAVE_LIBCHISE
2341   COS_object combining_table;
2342 #else
2343   Lisp_Object combining_table;
2344 #endif /* HAVE_LIBCHISE */
2345 #endif
2346   struct detection_state decst;
2347 };
2348
2349 static Lstream_data_count decoding_reader (Lstream *stream,
2350                                 unsigned char *data, Lstream_data_count size);
2351 static Lstream_data_count decoding_writer (Lstream *stream,
2352                                 const unsigned char *data, Lstream_data_count size);
2353 static int decoding_rewinder   (Lstream *stream);
2354 static int decoding_seekable_p (Lstream *stream);
2355 static int decoding_flusher    (Lstream *stream);
2356 static int decoding_closer     (Lstream *stream);
2357
2358 static Lisp_Object decoding_marker (Lisp_Object stream);
2359
2360 DEFINE_LSTREAM_IMPLEMENTATION ("decoding", lstream_decoding,
2361                                sizeof (struct decoding_stream));
2362
2363 static Lisp_Object
2364 decoding_marker (Lisp_Object stream)
2365 {
2366   Lstream *str = DECODING_STREAM_DATA (XLSTREAM (stream))->other_end;
2367   Lisp_Object str_obj;
2368
2369   /* We do not need to mark the coding systems or charsets stored
2370      within the stream because they are stored in a global list
2371      and automatically marked. */
2372
2373   XSETLSTREAM (str_obj, str);
2374   mark_object (str_obj);
2375   if (str->imp->marker)
2376     return (str->imp->marker) (str_obj);
2377   else
2378     return Qnil;
2379 }
2380
2381 /* Read SIZE bytes of data and store it into DATA.  We are a decoding stream
2382    so we read data from the other end, decode it, and store it into DATA. */
2383
2384 static Lstream_data_count
2385 decoding_reader (Lstream *stream, unsigned char *data, Lstream_data_count size)
2386 {
2387   struct decoding_stream *str = DECODING_STREAM_DATA (stream);
2388   unsigned char *orig_data = data;
2389   Lstream_data_count read_size;
2390   int error_occurred = 0;
2391
2392   /* We need to interface to mule_decode(), which expects to take some
2393      amount of data and store the result into a Dynarr.  We have
2394      mule_decode() store into str->runoff, and take data from there
2395      as necessary. */
2396
2397   /* We loop until we have enough data, reading chunks from the other
2398      end and decoding it. */
2399   while (1)
2400     {
2401       /* Take data from the runoff if we can.  Make sure to take at
2402          most SIZE bytes, and delete the data from the runoff. */
2403       if (Dynarr_length (str->runoff) > 0)
2404         {
2405           Lstream_data_count chunk = min (size, (Lstream_data_count) Dynarr_length (str->runoff));
2406           memcpy (data, Dynarr_atp (str->runoff, 0), chunk);
2407           Dynarr_delete_many (str->runoff, 0, chunk);
2408           data += chunk;
2409           size -= chunk;
2410         }
2411
2412       if (size == 0)
2413         break; /* No more room for data */
2414
2415       if (str->flags & CODING_STATE_END)
2416         /* This means that on the previous iteration, we hit the EOF on
2417            the other end.  We loop once more so that mule_decode() can
2418            output any final stuff it may be holding, or any "go back
2419            to a sane state" escape sequences. (This latter makes sense
2420            during encoding.) */
2421         break;
2422
2423       /* Exhausted the runoff, so get some more.  DATA has at least
2424          SIZE bytes left of storage in it, so it's OK to read directly
2425          into it.  (We'll be overwriting above, after we've decoded it
2426          into the runoff.) */
2427       read_size = Lstream_read (str->other_end, data, size);
2428       if (read_size < 0)
2429         {
2430           error_occurred = 1;
2431           break;
2432         }
2433       if (read_size == 0)
2434         /* There might be some more end data produced in the translation.
2435            See the comment above. */
2436         str->flags |= CODING_STATE_END;
2437       mule_decode (stream, (Extbyte *) data, str->runoff, read_size);
2438     }
2439
2440   if (data - orig_data == 0)
2441     return error_occurred ? -1 : 0;
2442   else
2443     return data - orig_data;
2444 }
2445
2446 static Lstream_data_count
2447 decoding_writer (Lstream *stream, const unsigned char *data, Lstream_data_count size)
2448 {
2449   struct decoding_stream *str = DECODING_STREAM_DATA (stream);
2450   Lstream_data_count retval;
2451
2452   /* Decode all our data into the runoff, and then attempt to write
2453      it all out to the other end.  Remove whatever chunk we succeeded
2454      in writing. */
2455   mule_decode (stream, (Extbyte *) data, str->runoff, size);
2456   retval = Lstream_write (str->other_end, Dynarr_atp (str->runoff, 0),
2457                           Dynarr_length (str->runoff));
2458   if (retval > 0)
2459     Dynarr_delete_many (str->runoff, 0, retval);
2460   /* Do NOT return retval.  The return value indicates how much
2461      of the incoming data was written, not how many bytes were
2462      written. */
2463   return size;
2464 }
2465
2466 static void
2467 reset_decoding_stream (struct decoding_stream *str)
2468 {
2469 #ifdef MULE
2470   if (CODING_SYSTEM_TYPE (str->codesys) == CODESYS_ISO2022)
2471     {
2472       Lisp_Object coding_system;
2473       XSETCODING_SYSTEM (coding_system, str->codesys);
2474       reset_iso2022 (coding_system, &str->iso2022);
2475     }
2476   else if (CODING_SYSTEM_TYPE (str->codesys) == CODESYS_CCL)
2477     {
2478       setup_ccl_program (&str->ccl, CODING_SYSTEM_CCL_DECODE (str->codesys));
2479     }
2480   str->counter = 0;
2481 #endif /* MULE */
2482 #ifdef UTF2000
2483   str->bom_flag = 0;
2484   str->er_counter = 0;
2485   str->combined_char_count = 0;
2486 #ifdef HAVE_LIBCHISE
2487   str->combining_table = COS_NIL;
2488 #else
2489   str->combining_table = Qnil;
2490 #endif /* HAVE_LIBCHISE */
2491 #endif
2492   if (CODING_SYSTEM_TYPE (str->codesys) == CODESYS_AUTODETECT
2493       || CODING_SYSTEM_EOL_TYPE (str->codesys) == EOL_AUTODETECT)
2494     {
2495       xzero (str->decst);
2496       str->decst.eol_type = EOL_AUTODETECT;
2497       str->decst.mask = ~0;
2498     }
2499   str->flags = str->cpos = 0;
2500 }
2501
2502 static int
2503 decoding_rewinder (Lstream *stream)
2504 {
2505   struct decoding_stream *str = DECODING_STREAM_DATA (stream);
2506   reset_decoding_stream (str);
2507   Dynarr_reset (str->runoff);
2508   return Lstream_rewind (str->other_end);
2509 }
2510
2511 static int
2512 decoding_seekable_p (Lstream *stream)
2513 {
2514   struct decoding_stream *str = DECODING_STREAM_DATA (stream);
2515   return Lstream_seekable_p (str->other_end);
2516 }
2517
2518 static int
2519 decoding_flusher (Lstream *stream)
2520 {
2521   struct decoding_stream *str = DECODING_STREAM_DATA (stream);
2522   return Lstream_flush (str->other_end);
2523 }
2524
2525 static int
2526 decoding_closer (Lstream *stream)
2527 {
2528   struct decoding_stream *str = DECODING_STREAM_DATA (stream);
2529   if (stream->flags & LSTREAM_FL_WRITE)
2530     {
2531       str->flags |= CODING_STATE_END;
2532       decoding_writer (stream, 0, 0);
2533     }
2534   Dynarr_free (str->runoff);
2535 #ifdef MULE
2536 #ifdef ENABLE_COMPOSITE_CHARS
2537   if (str->iso2022.composite_chars)
2538     Dynarr_free (str->iso2022.composite_chars);
2539 #endif
2540 #endif
2541   return Lstream_close (str->other_end);
2542 }
2543
2544 Lisp_Object
2545 decoding_stream_coding_system (Lstream *stream)
2546 {
2547   Lisp_Object coding_system;
2548   struct decoding_stream *str = DECODING_STREAM_DATA (stream);
2549
2550   XSETCODING_SYSTEM (coding_system, str->codesys);
2551   return subsidiary_coding_system (coding_system, str->eol_type);
2552 }
2553
2554 void
2555 set_decoding_stream_coding_system (Lstream *lstr, Lisp_Object codesys)
2556 {
2557   Lisp_Coding_System *cs = XCODING_SYSTEM (codesys);
2558   struct decoding_stream *str = DECODING_STREAM_DATA (lstr);
2559   str->codesys = cs;
2560   if (CODING_SYSTEM_EOL_TYPE (cs) != EOL_AUTODETECT)
2561     str->eol_type = CODING_SYSTEM_EOL_TYPE (cs);
2562   reset_decoding_stream (str);
2563 }
2564
2565 /* WARNING WARNING WARNING WARNING!!!!!  If you open up a decoding
2566    stream for writing, no automatic code detection will be performed.
2567    The reason for this is that automatic code detection requires a
2568    seekable input.  Things will also fail if you open a decoding
2569    stream for reading using a non-fully-specified coding system and
2570    a non-seekable input stream. */
2571
2572 static Lisp_Object
2573 make_decoding_stream_1 (Lstream *stream, Lisp_Object codesys,
2574                         const char *mode)
2575 {
2576   Lstream *lstr = Lstream_new (lstream_decoding, mode);
2577   struct decoding_stream *str = DECODING_STREAM_DATA (lstr);
2578   Lisp_Object obj;
2579
2580   xzero (*str);
2581   str->other_end = stream;
2582   str->runoff = (unsigned_char_dynarr *) Dynarr_new (unsigned_char);
2583   str->eol_type = EOL_AUTODETECT;
2584   if (!strcmp (mode, "r")
2585       && Lstream_seekable_p (stream))
2586     /* We can determine the coding system now. */
2587     determine_real_coding_system (stream, &codesys, &str->eol_type);
2588   set_decoding_stream_coding_system (lstr, codesys);
2589   str->decst.eol_type = str->eol_type;
2590   str->decst.mask = ~0;
2591   XSETLSTREAM (obj, lstr);
2592   return obj;
2593 }
2594
2595 Lisp_Object
2596 make_decoding_input_stream (Lstream *stream, Lisp_Object codesys)
2597 {
2598   return make_decoding_stream_1 (stream, codesys, "r");
2599 }
2600
2601 Lisp_Object
2602 make_decoding_output_stream (Lstream *stream, Lisp_Object codesys)
2603 {
2604   return make_decoding_stream_1 (stream, codesys, "w");
2605 }
2606
2607 /* Note: the decode_coding_* functions all take the same
2608    arguments as mule_decode(), which is to say some SRC data of
2609    size N, which is to be stored into dynamic array DST.
2610    DECODING is the stream within which the decoding is
2611    taking place, but no data is actually read from or
2612    written to that stream; that is handled in decoding_reader()
2613    or decoding_writer().  This allows the same functions to
2614    be used for both reading and writing. */
2615
2616 static void
2617 mule_decode (Lstream *decoding, const Extbyte *src,
2618              unsigned_char_dynarr *dst, Lstream_data_count n)
2619 {
2620   struct decoding_stream *str = DECODING_STREAM_DATA (decoding);
2621
2622   /* If necessary, do encoding-detection now.  We do this when
2623      we're a writing stream or a non-seekable reading stream,
2624      meaning that we can't just process the whole input,
2625      rewind, and start over. */
2626
2627   if (CODING_SYSTEM_TYPE (str->codesys) == CODESYS_AUTODETECT ||
2628       str->eol_type == EOL_AUTODETECT)
2629     {
2630       Lisp_Object codesys;
2631
2632       XSETCODING_SYSTEM (codesys, str->codesys);
2633       detect_coding_type (&str->decst, src, n,
2634                           CODING_SYSTEM_TYPE (str->codesys) !=
2635                           CODESYS_AUTODETECT);
2636       if (CODING_SYSTEM_TYPE (str->codesys) == CODESYS_AUTODETECT &&
2637           str->decst.mask != ~0)
2638         /* #### This is cheesy.  What we really ought to do is
2639            buffer up a certain amount of data so as to get a
2640            less random result. */
2641         codesys = coding_system_from_mask (str->decst.mask);
2642       str->eol_type = str->decst.eol_type;
2643       if (XCODING_SYSTEM (codesys) != str->codesys)
2644         {
2645           /* Preserve the CODING_STATE_END flag in case it was set.
2646              If we erase it, bad things might happen. */
2647           int was_end = str->flags & CODING_STATE_END;
2648           set_decoding_stream_coding_system (decoding, codesys);
2649           if (was_end)
2650             str->flags |= CODING_STATE_END;
2651         }
2652     }
2653
2654   switch (CODING_SYSTEM_TYPE (str->codesys))
2655     {
2656 #ifdef DEBUG_XEMACS
2657     case CODESYS_INTERNAL:
2658       Dynarr_add_many (dst, src, n);
2659       break;
2660 #endif
2661     case CODESYS_AUTODETECT:
2662       /* If we got this far and still haven't decided on the coding
2663          system, then do no conversion. */
2664     case CODESYS_NO_CONVERSION:
2665       decode_coding_no_conversion (decoding, src, dst, n);
2666       break;
2667 #ifdef MULE
2668     case CODESYS_SHIFT_JIS:
2669       decode_coding_sjis (decoding, src, dst, n);
2670       break;
2671     case CODESYS_BIG5:
2672       decode_coding_big5 (decoding, src, dst, n);
2673       break;
2674     case CODESYS_UCS4:
2675       decode_coding_ucs4 (decoding, src, dst, n);
2676       break;
2677     case CODESYS_UTF16:
2678       decode_coding_utf16 (decoding, src, dst, n);
2679       break;
2680     case CODESYS_UTF8:
2681       decode_coding_utf8 (decoding, src, dst, n);
2682       break;
2683     case CODESYS_CCL:
2684       str->ccl.last_block = str->flags & CODING_STATE_END;
2685       /* When applying ccl program to stream, MUST NOT set NULL
2686          pointer to src.  */
2687       ccl_driver (&str->ccl, (src ? (unsigned char *)src : (unsigned char*)""),
2688                   dst, n, 0, CCL_MODE_DECODING);
2689       break;
2690     case CODESYS_ISO2022:
2691       decode_coding_iso2022 (decoding, src, dst, n);
2692       break;
2693 #endif /* MULE */
2694     default:
2695       abort ();
2696     }
2697 }
2698
2699 DEFUN ("decode-coding-region", Fdecode_coding_region, 3, 4, 0, /*
2700 Decode the text between START and END which is encoded in CODING-SYSTEM.
2701 This is useful if you've read in encoded text from a file without decoding
2702 it (e.g. you read in a JIS-formatted file but used the `binary' or
2703 `no-conversion' coding system, so that it shows up as "^[$B!<!+^[(B").
2704 Return length of decoded text.
2705 BUFFER defaults to the current buffer if unspecified.
2706 */
2707        (start, end, coding_system, buffer))
2708 {
2709   Bufpos b, e;
2710   struct buffer *buf = decode_buffer (buffer, 0);
2711   Lisp_Object instream, lb_outstream, de_outstream, outstream;
2712   Lstream *istr, *ostr;
2713   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
2714
2715   get_buffer_range_char (buf, start, end, &b, &e, 0);
2716
2717   barf_if_buffer_read_only (buf, b, e);
2718
2719   coding_system = Fget_coding_system (coding_system);
2720   instream = make_lisp_buffer_input_stream  (buf, b, e, 0);
2721   lb_outstream = make_lisp_buffer_output_stream (buf, b, 0);
2722   de_outstream = make_decoding_output_stream (XLSTREAM (lb_outstream),
2723                                               coding_system);
2724   outstream = make_encoding_output_stream (XLSTREAM (de_outstream),
2725                                            Fget_coding_system (Qbinary));
2726   istr = XLSTREAM (instream);
2727   ostr = XLSTREAM (outstream);
2728   GCPRO4 (instream, lb_outstream, de_outstream, outstream);
2729
2730   /* The chain of streams looks like this:
2731
2732      [BUFFER] <----- send through
2733                      ------> [ENCODE AS BINARY]
2734                              ------> [DECODE AS SPECIFIED]
2735                                      ------> [BUFFER]
2736    */
2737
2738   while (1)
2739     {
2740       char tempbuf[1024]; /* some random amount */
2741       Bufpos newpos, even_newer_pos;
2742       Bufpos oldpos = lisp_buffer_stream_startpos (istr);
2743       Lstream_data_count size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf));
2744
2745       if (!size_in_bytes)
2746         break;
2747       newpos = lisp_buffer_stream_startpos (istr);
2748       Lstream_write (ostr, tempbuf, size_in_bytes);
2749       even_newer_pos = lisp_buffer_stream_startpos (istr);
2750       buffer_delete_range (buf, even_newer_pos - (newpos - oldpos),
2751                            even_newer_pos, 0);
2752     }
2753   Lstream_close (istr);
2754   Lstream_close (ostr);
2755   UNGCPRO;
2756   Lstream_delete (istr);
2757   Lstream_delete (ostr);
2758   Lstream_delete (XLSTREAM (de_outstream));
2759   Lstream_delete (XLSTREAM (lb_outstream));
2760   return Qnil;
2761 }
2762
2763 \f
2764 /************************************************************************/
2765 /*           Converting to an external encoding ("encoding")            */
2766 /************************************************************************/
2767
2768 /* An encoding stream is an output stream.  When you create the
2769    stream, you specify the coding system that governs the encoding
2770    and another stream that the resulting encoded data is to be
2771    sent to, and then start sending data to it. */
2772
2773 #define ENCODING_STREAM_DATA(stream) LSTREAM_TYPE_DATA (stream, encoding)
2774
2775 struct encoding_stream
2776 {
2777   /* Coding system that governs the conversion. */
2778   Lisp_Coding_System *codesys;
2779
2780   /* Stream that we read the encoded data from or
2781      write the decoded data to. */
2782   Lstream *other_end;
2783
2784   /* If we are reading, then we can return only a fixed amount of
2785      data, so if the conversion resulted in too much data, we store it
2786      here for retrieval the next time around. */
2787   unsigned_char_dynarr *runoff;
2788
2789   /* FLAGS holds flags indicating the current state of the encoding.
2790      Some of these flags are dependent on the coding system. */
2791   unsigned int flags;
2792
2793   /* CH holds a partially built-up character.  Since we only deal
2794      with one- and two-byte characters at the moment, we only use
2795      this to store the first byte of a two-byte character. */
2796   unsigned int ch;
2797 #ifdef MULE
2798   /* Additional information used by the ISO2022 encoder. */
2799   struct
2800     {
2801       /* CHARSET holds the character sets currently assigned to the G0
2802          through G3 registers.  It is initialized from the array
2803          INITIAL_CHARSET in CODESYS. */
2804       Lisp_Object charset[4];
2805
2806       /* Which registers are currently invoked into the left (GL) and
2807          right (GR) halves of the 8-bit encoding space? */
2808       int register_left, register_right;
2809
2810       /* Whether we need to explicitly designate the charset in the
2811          G? register before using it.  It is initialized from the
2812          array FORCE_CHARSET_ON_OUTPUT in CODESYS. */
2813       unsigned char force_charset_on_output[4];
2814
2815       /* Other state variables that need to be preserved across
2816          invocations. */
2817       Lisp_Object current_charset;
2818       int current_half;
2819       int current_char_boundary;
2820     } iso2022;
2821
2822   void (*encode_char) (struct encoding_stream *str, Emchar c,
2823                        unsigned_char_dynarr *dst, unsigned int *flags);
2824   void (*finish) (struct encoding_stream *str,
2825                   unsigned_char_dynarr *dst, unsigned int *flags);
2826
2827   /* Additional information (the state of the running CCL program)
2828      used by the CCL encoder. */
2829   struct ccl_program ccl;
2830 #endif /* MULE */
2831 };
2832
2833 static Lstream_data_count encoding_reader (Lstream *stream, unsigned char *data, Lstream_data_count size);
2834 static Lstream_data_count encoding_writer (Lstream *stream, const unsigned char *data,
2835                                 Lstream_data_count size);
2836 static int encoding_rewinder   (Lstream *stream);
2837 static int encoding_seekable_p (Lstream *stream);
2838 static int encoding_flusher    (Lstream *stream);
2839 static int encoding_closer     (Lstream *stream);
2840
2841 static Lisp_Object encoding_marker (Lisp_Object stream);
2842
2843 DEFINE_LSTREAM_IMPLEMENTATION ("encoding", lstream_encoding,
2844                                sizeof (struct encoding_stream));
2845
2846 static Lisp_Object
2847 encoding_marker (Lisp_Object stream)
2848 {
2849   Lstream *str = ENCODING_STREAM_DATA (XLSTREAM (stream))->other_end;
2850   Lisp_Object str_obj;
2851
2852   /* We do not need to mark the coding systems or charsets stored
2853      within the stream because they are stored in a global list
2854      and automatically marked. */
2855
2856   XSETLSTREAM (str_obj, str);
2857   mark_object (str_obj);
2858   if (str->imp->marker)
2859     return (str->imp->marker) (str_obj);
2860   else
2861     return Qnil;
2862 }
2863
2864 /* Read SIZE bytes of data and store it into DATA.  We are a encoding stream
2865    so we read data from the other end, encode it, and store it into DATA. */
2866
2867 static Lstream_data_count
2868 encoding_reader (Lstream *stream, unsigned char *data, Lstream_data_count size)
2869 {
2870   struct encoding_stream *str = ENCODING_STREAM_DATA (stream);
2871   unsigned char *orig_data = data;
2872   Lstream_data_count read_size;
2873   int error_occurred = 0;
2874
2875   /* We need to interface to mule_encode(), which expects to take some
2876      amount of data and store the result into a Dynarr.  We have
2877      mule_encode() store into str->runoff, and take data from there
2878      as necessary. */
2879
2880   /* We loop until we have enough data, reading chunks from the other
2881      end and encoding it. */
2882   while (1)
2883     {
2884       /* Take data from the runoff if we can.  Make sure to take at
2885          most SIZE bytes, and delete the data from the runoff. */
2886       if (Dynarr_length (str->runoff) > 0)
2887         {
2888           int chunk = min ((int) size, Dynarr_length (str->runoff));
2889           memcpy (data, Dynarr_atp (str->runoff, 0), chunk);
2890           Dynarr_delete_many (str->runoff, 0, chunk);
2891           data += chunk;
2892           size -= chunk;
2893         }
2894
2895       if (size == 0)
2896         break; /* No more room for data */
2897
2898       if (str->flags & CODING_STATE_END)
2899         /* This means that on the previous iteration, we hit the EOF on
2900            the other end.  We loop once more so that mule_encode() can
2901            output any final stuff it may be holding, or any "go back
2902            to a sane state" escape sequences. (This latter makes sense
2903            during encoding.) */
2904         break;
2905
2906       /* Exhausted the runoff, so get some more.  DATA at least SIZE bytes
2907          left of storage in it, so it's OK to read directly into it.
2908          (We'll be overwriting above, after we've encoded it into the
2909          runoff.) */
2910       read_size = Lstream_read (str->other_end, data, size);
2911       if (read_size < 0)
2912         {
2913           error_occurred = 1;
2914           break;
2915         }
2916       if (read_size == 0)
2917         /* There might be some more end data produced in the translation.
2918            See the comment above. */
2919         str->flags |= CODING_STATE_END;
2920       mule_encode (stream, data, str->runoff, read_size);
2921     }
2922
2923   if (data == orig_data)
2924     return error_occurred ? -1 : 0;
2925   else
2926     return data - orig_data;
2927 }
2928
2929 static Lstream_data_count
2930 encoding_writer (Lstream *stream, const unsigned char *data, Lstream_data_count size)
2931 {
2932   struct encoding_stream *str = ENCODING_STREAM_DATA (stream);
2933   Lstream_data_count retval;
2934
2935   /* Encode all our data into the runoff, and then attempt to write
2936      it all out to the other end.  Remove whatever chunk we succeeded
2937      in writing. */
2938   mule_encode (stream, data, str->runoff, size);
2939   retval = Lstream_write (str->other_end, Dynarr_atp (str->runoff, 0),
2940                           Dynarr_length (str->runoff));
2941   if (retval > 0)
2942     Dynarr_delete_many (str->runoff, 0, retval);
2943   /* Do NOT return retval.  The return value indicates how much
2944      of the incoming data was written, not how many bytes were
2945      written. */
2946   return size;
2947 }
2948
2949 static void
2950 reset_encoding_stream (struct encoding_stream *str)
2951 {
2952 #ifdef MULE
2953   switch (CODING_SYSTEM_TYPE (str->codesys))
2954     {
2955     case CODESYS_ISO2022:
2956       {
2957         int i;
2958
2959         str->encode_char = &char_encode_iso2022;
2960         str->finish = &char_finish_iso2022;
2961         for (i = 0; i < 4; i++)
2962           {
2963             str->iso2022.charset[i] =
2964               CODING_SYSTEM_ISO2022_INITIAL_CHARSET (str->codesys, i);
2965             str->iso2022.force_charset_on_output[i] =
2966               CODING_SYSTEM_ISO2022_FORCE_CHARSET_ON_OUTPUT (str->codesys, i);
2967           }
2968         str->iso2022.register_left = 0;
2969         str->iso2022.register_right = 1;
2970         str->iso2022.current_charset = Qnil;
2971         str->iso2022.current_half = 0;
2972         break;
2973       }
2974     case CODESYS_CCL:
2975       setup_ccl_program (&str->ccl, CODING_SYSTEM_CCL_ENCODE (str->codesys));
2976       break;
2977     case CODESYS_UTF8:
2978       str->encode_char = &char_encode_utf8;
2979       str->finish = &char_finish_utf8;
2980       break;
2981     case CODESYS_UTF16:
2982       str->encode_char = &char_encode_utf16;
2983       str->finish = &char_finish_utf16;
2984       break;
2985     case CODESYS_UCS4:
2986       str->encode_char = &char_encode_ucs4;
2987       str->finish = &char_finish_ucs4;
2988       break;
2989     case CODESYS_SHIFT_JIS:
2990       str->encode_char = &char_encode_shift_jis;
2991       str->finish = &char_finish_shift_jis;
2992       break;
2993     case CODESYS_BIG5:
2994       str->encode_char = &char_encode_big5;
2995       str->finish = &char_finish_big5;
2996       break;
2997     default:
2998       break;
2999     }
3000 #endif /* MULE */
3001   str->iso2022.current_char_boundary = 0;
3002   str->flags = str->ch = 0;
3003 }
3004
3005 static int
3006 encoding_rewinder (Lstream *stream)
3007 {
3008   struct encoding_stream *str = ENCODING_STREAM_DATA (stream);
3009   reset_encoding_stream (str);
3010   Dynarr_reset (str->runoff);
3011   return Lstream_rewind (str->other_end);
3012 }
3013
3014 static int
3015 encoding_seekable_p (Lstream *stream)
3016 {
3017   struct encoding_stream *str = ENCODING_STREAM_DATA (stream);
3018   return Lstream_seekable_p (str->other_end);
3019 }
3020
3021 static int
3022 encoding_flusher (Lstream *stream)
3023 {
3024   struct encoding_stream *str = ENCODING_STREAM_DATA (stream);
3025   return Lstream_flush (str->other_end);
3026 }
3027
3028 static int
3029 encoding_closer (Lstream *stream)
3030 {
3031   struct encoding_stream *str = ENCODING_STREAM_DATA (stream);
3032   if (stream->flags & LSTREAM_FL_WRITE)
3033     {
3034       str->flags |= CODING_STATE_END;
3035       encoding_writer (stream, 0, 0);
3036     }
3037   Dynarr_free (str->runoff);
3038   return Lstream_close (str->other_end);
3039 }
3040
3041 Lisp_Object
3042 encoding_stream_coding_system (Lstream *stream)
3043 {
3044   Lisp_Object coding_system;
3045   struct encoding_stream *str = ENCODING_STREAM_DATA (stream);
3046
3047   XSETCODING_SYSTEM (coding_system, str->codesys);
3048   return coding_system;
3049 }
3050
3051 void
3052 set_encoding_stream_coding_system (Lstream *lstr, Lisp_Object codesys)
3053 {
3054   Lisp_Coding_System *cs = XCODING_SYSTEM (codesys);
3055   struct encoding_stream *str = ENCODING_STREAM_DATA (lstr);
3056   str->codesys = cs;
3057   reset_encoding_stream (str);
3058 }
3059
3060 static Lisp_Object
3061 make_encoding_stream_1 (Lstream *stream, Lisp_Object codesys,
3062                         const char *mode)
3063 {
3064   Lstream *lstr = Lstream_new (lstream_encoding, mode);
3065   struct encoding_stream *str = ENCODING_STREAM_DATA (lstr);
3066   Lisp_Object obj;
3067
3068   xzero (*str);
3069   str->runoff = Dynarr_new (unsigned_char);
3070   str->other_end = stream;
3071   set_encoding_stream_coding_system (lstr, codesys);
3072   XSETLSTREAM (obj, lstr);
3073   return obj;
3074 }
3075
3076 Lisp_Object
3077 make_encoding_input_stream (Lstream *stream, Lisp_Object codesys)
3078 {
3079   return make_encoding_stream_1 (stream, codesys, "r");
3080 }
3081
3082 Lisp_Object
3083 make_encoding_output_stream (Lstream *stream, Lisp_Object codesys)
3084 {
3085   return make_encoding_stream_1 (stream, codesys, "w");
3086 }
3087
3088 /* Convert N bytes of internally-formatted data stored in SRC to an
3089    external format, according to the encoding stream ENCODING.
3090    Store the encoded data into DST. */
3091
3092 static void
3093 mule_encode (Lstream *encoding, const Bufbyte *src,
3094              unsigned_char_dynarr *dst, Lstream_data_count n)
3095 {
3096   struct encoding_stream *str = ENCODING_STREAM_DATA (encoding);
3097
3098   switch (CODING_SYSTEM_TYPE (str->codesys))
3099     {
3100 #ifdef DEBUG_XEMACS
3101     case CODESYS_INTERNAL:
3102       Dynarr_add_many (dst, src, n);
3103       break;
3104 #endif
3105     case CODESYS_AUTODETECT:
3106       /* If we got this far and still haven't decided on the coding
3107          system, then do no conversion. */
3108     case CODESYS_NO_CONVERSION:
3109       encode_coding_no_conversion (encoding, src, dst, n);
3110       break;
3111 #ifdef MULE
3112     case CODESYS_CCL:
3113       str->ccl.last_block = str->flags & CODING_STATE_END;
3114       /* When applying ccl program to stream, MUST NOT set NULL
3115          pointer to src.  */
3116       ccl_driver (&str->ccl, ((src) ? src : (unsigned char*)""),
3117                   dst, n, 0, CCL_MODE_ENCODING);
3118       break;
3119 #endif /* MULE */
3120     default:
3121       text_encode_generic (encoding, src, dst, n);
3122     }
3123 }
3124
3125 DEFUN ("encode-coding-region", Fencode_coding_region, 3, 4, 0, /*
3126 Encode the text between START and END using CODING-SYSTEM.
3127 This will, for example, convert Japanese characters into stuff such as
3128 "^[$B!<!+^[(B" if you use the JIS encoding.  Return length of encoded
3129 text.  BUFFER defaults to the current buffer if unspecified.
3130 */
3131        (start, end, coding_system, buffer))
3132 {
3133   Bufpos b, e;
3134   struct buffer *buf = decode_buffer (buffer, 0);
3135   Lisp_Object instream, lb_outstream, de_outstream, outstream;
3136   Lstream *istr, *ostr;
3137   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3138
3139   get_buffer_range_char (buf, start, end, &b, &e, 0);
3140
3141   barf_if_buffer_read_only (buf, b, e);
3142
3143   coding_system = Fget_coding_system (coding_system);
3144   instream  = make_lisp_buffer_input_stream  (buf, b, e, 0);
3145   lb_outstream = make_lisp_buffer_output_stream (buf, b, 0);
3146   de_outstream = make_decoding_output_stream (XLSTREAM (lb_outstream),
3147                                               Fget_coding_system (Qbinary));
3148   outstream = make_encoding_output_stream (XLSTREAM (de_outstream),
3149                                            coding_system);
3150   istr = XLSTREAM (instream);
3151   ostr = XLSTREAM (outstream);
3152   GCPRO4 (instream, outstream, de_outstream, lb_outstream);
3153   /* The chain of streams looks like this:
3154
3155      [BUFFER] <----- send through
3156                      ------> [ENCODE AS SPECIFIED]
3157                              ------> [DECODE AS BINARY]
3158                                      ------> [BUFFER]
3159    */
3160   while (1)
3161     {
3162       char tempbuf[1024]; /* some random amount */
3163       Bufpos newpos, even_newer_pos;
3164       Bufpos oldpos = lisp_buffer_stream_startpos (istr);
3165       Lstream_data_count size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf));
3166
3167       if (!size_in_bytes)
3168         break;
3169       newpos = lisp_buffer_stream_startpos (istr);
3170       Lstream_write (ostr, tempbuf, size_in_bytes);
3171       even_newer_pos = lisp_buffer_stream_startpos (istr);
3172       buffer_delete_range (buf, even_newer_pos - (newpos - oldpos),
3173                            even_newer_pos, 0);
3174     }
3175
3176   {
3177     Charcount retlen =
3178       lisp_buffer_stream_startpos (XLSTREAM (instream)) - b;
3179     Lstream_close (istr);
3180     Lstream_close (ostr);
3181     UNGCPRO;
3182     Lstream_delete (istr);
3183     Lstream_delete (ostr);
3184     Lstream_delete (XLSTREAM (de_outstream));
3185     Lstream_delete (XLSTREAM (lb_outstream));
3186     return make_int (retlen);
3187   }
3188 }
3189
3190 #ifdef MULE
3191 \f
3192 static void
3193 text_encode_generic (Lstream *encoding, const Bufbyte *src,
3194                      unsigned_char_dynarr *dst, Lstream_data_count n)
3195 {
3196   unsigned char c;
3197   unsigned char char_boundary;
3198   struct encoding_stream *str = ENCODING_STREAM_DATA (encoding);
3199   unsigned int flags          = str->flags;
3200   Emchar ch                   = str->ch;
3201
3202   char_boundary = str->iso2022.current_char_boundary;
3203
3204   while (n--)
3205     {
3206       c = *src++;
3207
3208       if (char_boundary == 0)
3209         {
3210           if (c >= 0xfc)
3211             {
3212               ch = c & 0x01;
3213               char_boundary = 5;
3214             }
3215           else if (c >= 0xf8)
3216             {
3217               ch = c & 0x03;
3218               char_boundary = 4;
3219             }
3220           else if (c >= 0xf0)
3221             {
3222               ch = c & 0x07;
3223               char_boundary = 3;
3224             }
3225           else if (c >= 0xe0)
3226             {
3227               ch = c & 0x0f;
3228               char_boundary = 2;
3229             }
3230           else if (c >= 0xc0)
3231             {
3232               ch = c & 0x1f;
3233               char_boundary = 1;
3234             }
3235           else
3236             (*str->encode_char) (str, c, dst, &flags);
3237         }
3238       else if (char_boundary == 1)
3239         {
3240           (*str->encode_char) (str, (ch << 6) | (c & 0x3f), dst, &flags);
3241           ch =0;
3242           char_boundary = 0;
3243         }
3244       else
3245         {
3246           ch = (ch << 6) | (c & 0x3f);
3247           char_boundary--;
3248         }
3249     }
3250
3251   if ((char_boundary == 0) && (flags & CODING_STATE_END))
3252     {
3253       (*str->finish) (str, dst, &flags);
3254     }
3255
3256   str->flags = flags;
3257   str->ch    = ch;
3258   str->iso2022.current_char_boundary = char_boundary;
3259 }
3260
3261 \f
3262 #ifdef UTF2000
3263 /************************************************************************/
3264 /*                          entity reference                            */
3265 /************************************************************************/
3266
3267 INLINE_HEADER void
3268 decode_flush_er_chars (struct decoding_stream *str, unsigned_char_dynarr* dst);
3269 INLINE_HEADER void
3270 decode_flush_er_chars (struct decoding_stream *str, unsigned_char_dynarr* dst)
3271 {
3272   if ( str->er_counter > 0)
3273     {
3274       Dynarr_add_many (dst, str->er_buf, str->er_counter);
3275       str->er_counter = 0;
3276     }
3277 }
3278
3279 EXFUN (Fregexp_quote, 1);
3280
3281 void decode_add_er_char (struct decoding_stream *str, Emchar character,
3282                          unsigned_char_dynarr* dst);
3283 void
3284 decode_add_er_char (struct decoding_stream *str, Emchar c,
3285                     unsigned_char_dynarr* dst)
3286 {
3287   if (str->er_counter == 0)
3288     {
3289       if (CODING_SYSTEM_USE_ENTITY_REFERENCE (str->codesys)
3290           && (c == '&') )
3291         {
3292           str->er_buf[0] = '&';
3293           str->er_counter++;
3294         }
3295       else
3296         DECODE_ADD_UCS_CHAR (c, dst);
3297     }
3298   else if (c == ';')
3299     {
3300       Lisp_Object string = make_string (str->er_buf,
3301                                         str->er_counter);
3302       Lisp_Object rest;
3303       Lisp_Object cell;
3304       Lisp_Object ret;
3305       Lisp_Object pat;
3306       Lisp_Object ccs;
3307       Lisp_Object char_type;
3308       int base;
3309
3310       for ( rest = Vcoded_charset_entity_reference_alist;
3311             !NILP (rest); rest = Fcdr (rest) )
3312         {                     
3313           cell = Fcar (rest);
3314           ccs = Fcar (cell);
3315           if (CONSP (ccs))
3316             {
3317               char_type = XCDR (ccs);
3318               ccs = XCAR (ccs);
3319             }
3320           else
3321             char_type = Qnil;
3322           if (NILP (ccs = Ffind_charset (ccs)))
3323             continue;
3324
3325           cell = Fcdr (cell);
3326           ret = Fcar (cell);
3327           if (STRINGP (ret))
3328             pat = ret;
3329           else
3330             continue;
3331           pat = Fregexp_quote (pat);
3332
3333           cell = Fcdr (cell);
3334           cell = Fcdr (cell);
3335           ret = Fcar (cell);
3336           if (EQ (ret, Qd))
3337             {
3338               pat = concat3 (build_string ("^&"),
3339                              pat, build_string ("\\([0-9]+\\)$"));
3340               base = 10;
3341             }
3342           else if (EQ (ret, Qx))
3343             {
3344               pat = concat3 (build_string ("^&"),
3345                              pat, build_string ("\\([0-9a-f]+\\)$"));
3346               base = 16;
3347             }
3348           else if (EQ (ret, QX))
3349             {
3350               pat = concat3 (build_string ("^&"),
3351                              pat, build_string ("\\([0-9A-F]+\\)$"));
3352               base = 16;
3353             }
3354           else
3355             continue;
3356
3357           if (!NILP (Fstring_match (pat, string, Qnil, Qnil)))
3358             {
3359               int code
3360                 = XINT (Fstring_to_number
3361                         (Fsubstring (string,
3362                                      Fmatch_beginning (make_int (1)),
3363                                      Fmatch_end (make_int (1))),
3364                          make_int (base)));
3365               Emchar chr
3366                 = NILP (char_type)
3367                 ? DECODE_CHAR (ccs, code, 0)
3368                 : decode_builtin_char (ccs, code);
3369
3370               if ( chr >= 0 )
3371                 DECODE_ADD_UCS_CHAR (chr, dst);
3372               else
3373                 {
3374                   Dynarr_add_many (dst, str->er_buf, str->er_counter);
3375                   Dynarr_add (dst, ';');
3376                 }
3377
3378               goto decoded;
3379             }
3380         }
3381       if (!NILP (Fstring_match (build_string ("^&MCS-\\([0-9A-F]+\\)$"),
3382                                 string, Qnil, Qnil)))
3383         {
3384           int code
3385             = XUINT (Fstring_to_number
3386                      (Fsubstring (string,
3387                                   Fmatch_beginning (make_int (1)),
3388                                   Fmatch_end (make_int (1))),
3389                       make_int (16)));
3390
3391           DECODE_ADD_UCS_CHAR (code, dst);
3392         }
3393       else
3394         {
3395           Dynarr_add_many (dst, str->er_buf, str->er_counter);
3396           Dynarr_add (dst, ';');
3397         }
3398     decoded:
3399       str->er_counter = 0;
3400     }
3401   else if ( (str->er_counter >= ER_BUF_SIZE) || (c >= 0x7F) )
3402     {
3403       Dynarr_add_many (dst, str->er_buf, str->er_counter);
3404       str->er_counter = 0;
3405       DECODE_ADD_UCS_CHAR (c, dst);
3406     }
3407   else
3408     str->er_buf[str->er_counter++] = c;
3409 }
3410
3411 void char_encode_as_entity_reference (Emchar ch, char* buf);
3412 void
3413 char_encode_as_entity_reference (Emchar ch, char* buf)
3414 {
3415   Lisp_Object rest = Vcoded_charset_entity_reference_alist;
3416   Lisp_Object cell;
3417   Lisp_Object ccs;
3418   Lisp_Object char_type;
3419   int format_columns, idx;
3420   char format[ER_BUF_SIZE];
3421
3422   while (!NILP (rest))
3423     {
3424       cell = Fcar (rest);
3425       ccs = Fcar (cell);
3426       if (CONSP (ccs))
3427         {
3428           char_type = XCDR (ccs);
3429           ccs = XCAR (ccs);
3430         }
3431       else
3432         char_type = Qnil;
3433       if (!NILP (ccs = Ffind_charset (ccs)))
3434         {
3435           int code_point
3436             = charset_code_point (ccs, ch,
3437                                   NILP (char_type) ?
3438                                   CHAR_ALL : CHAR_ISOLATED_ONLY );
3439
3440           if ( (code_point >= 0)
3441                && ( NILP (char_type)
3442 #if 1
3443                     || ( charset_code_point (ccs, ch, CHAR_DEFINED_ONLY)
3444                          == -1 )
3445 #endif
3446 #if 0
3447                     || ( DECODE_CHAR (ccs, code_point, 0) != ch )
3448 #endif
3449                     )
3450                )
3451             {
3452               Lisp_Object ret;
3453
3454               cell = Fcdr (cell);
3455               ret = Fcar (cell);
3456               if ( STRINGP (ret) &&
3457                    ( (idx = XSTRING_LENGTH (ret)) <= (ER_BUF_SIZE - 4) ) )
3458                 {
3459                   format[0] = '&';
3460                   strncpy (&format[1], XSTRING_DATA (ret), idx);
3461                   idx++;
3462                 }
3463               else
3464                 goto try_next;
3465
3466               cell = Fcdr (cell);
3467               ret = Fcar (cell);
3468               if (INTP (ret))
3469                 {
3470                   format[idx++] = '%';
3471                   format_columns = XINT (ret);
3472                   if ( (2 <= format_columns) && (format_columns <= 8)
3473                        && (idx + format_columns <= ER_BUF_SIZE - 1) )
3474                     {
3475                       format [idx++] = '0';
3476                       format [idx++] = '0' + format_columns;
3477                     }
3478                 }
3479               else
3480                 goto try_next;
3481
3482               cell = Fcdr (cell);
3483               ret = Fcar (cell);
3484               if (EQ (ret, Qd))
3485                 format [idx++] = 'd';
3486               else if (EQ (ret, Qx))
3487                 format [idx++] = 'x';
3488               else if (EQ (ret, QX))
3489                 format [idx++] = 'X';
3490               else
3491                 goto try_next;
3492               format [idx++] = ';';
3493               format [idx++] = 0;
3494
3495               sprintf (buf, format, code_point);
3496               return;
3497             }
3498         }
3499     try_next:
3500       rest = Fcdr (rest);
3501     }
3502   sprintf (buf, "&MCS-%08X;", ch);
3503 }
3504
3505 \f
3506 /************************************************************************/
3507 /*                          character composition                       */
3508 /************************************************************************/
3509 extern Lisp_Object Qcomposition, Qrep_decomposition;
3510
3511 INLINE_HEADER void
3512 COMPOSE_FLUSH_CHARS (struct decoding_stream *str, unsigned_char_dynarr* dst);
3513 INLINE_HEADER void
3514 COMPOSE_FLUSH_CHARS (struct decoding_stream *str, unsigned_char_dynarr* dst)
3515 {
3516   unsigned i;
3517
3518   for (i = 0; i < str->combined_char_count; i++)
3519     decode_add_er_char (str, str->combined_chars[i], dst);
3520   str->combined_char_count = 0;
3521 #ifdef HAVE_LIBCHISE
3522   str->combining_table = COS_NIL;
3523 #else
3524   str->combining_table = Qnil;
3525 #endif /* HAVE_LIBCHISE */
3526 }
3527
3528 extern CONCORD_DS concord_current_env;
3529
3530 #if 0
3531 static int
3532 concord_setup_env_maybe ()
3533 {
3534   if (concord_current_env == NULL)
3535     {
3536       concord_open_env ("/usr/local/share/chise/1.0/db/");
3537     }
3538   return 0;
3539 }
3540 #endif
3541
3542 void COMPOSE_ADD_CHAR (struct decoding_stream *str, Emchar character,
3543                        unsigned_char_dynarr* dst);
3544 void
3545 COMPOSE_ADD_CHAR (struct decoding_stream *str,
3546                   Emchar character, unsigned_char_dynarr* dst)
3547 {
3548   if (CODING_SYSTEM_DISABLE_COMPOSITION (str->codesys))
3549     decode_add_er_char (str, character, dst);
3550 #ifdef HAVE_LIBCHISE
3551   else if (!cos_cons_p (str->combining_table))
3552     {
3553       COS_object ret;
3554
3555       /* concord_setup_env_maybe (); */
3556       open_chise_data_source_maybe ();
3557       ret = concord_object_get_attribute (cos_make_char (character),
3558                                               COS_COMPOSITION);
3559
3560       if (!cos_cons_p (ret))
3561         decode_add_er_char (str, character, dst);
3562       else
3563         {
3564           str->combined_chars[0] = character;
3565           str->combined_char_count = 1;
3566           str->combining_table = ret;
3567         }
3568     }
3569   else
3570     {
3571       COS_object ret
3572         = cos_cdr (cos_assoc (cos_make_char (character),
3573                               str->combining_table));
3574
3575       if (cos_char_p (ret))
3576         {
3577           Emchar char2 = cos_char_id (ret);
3578           COS_object ret2;
3579
3580           /* concord_setup_env_maybe (); */
3581           open_chise_data_source_maybe ();
3582           ret2 = concord_object_get_attribute (ret, COS_COMPOSITION);
3583
3584           if (!cos_cons_p (ret2))
3585             {
3586               decode_add_er_char (str, char2, dst);
3587               str->combined_char_count = 0;
3588               str->combining_table = COS_NIL;
3589             }
3590           else
3591             {
3592               str->combined_chars[0] = char2;
3593               str->combined_char_count = 1;
3594               str->combining_table = ret2;
3595             }
3596         }
3597       else
3598         {
3599           /* concord_setup_env_maybe (); */
3600           open_chise_data_source_maybe ();
3601           ret = concord_object_get_attribute (cos_make_char (character),
3602                                                   COS_COMPOSITION);
3603
3604           COMPOSE_FLUSH_CHARS (str, dst);
3605           if (!cos_cons_p (ret))
3606             decode_add_er_char (str, character, dst);
3607           else
3608             {
3609               str->combined_chars[0] = character;
3610               str->combined_char_count = 1;
3611               str->combining_table = ret;
3612             }
3613         }
3614     }
3615 #else
3616   else if (!CONSP (str->combining_table))
3617     {
3618       Lisp_Object ret
3619         = Fchar_feature (make_char (character), Qcomposition, Qnil,
3620                          Qnil, Qnil);
3621
3622       if (NILP (ret))
3623         decode_add_er_char (str, character, dst);
3624       else
3625         {
3626           str->combined_chars[0] = character;
3627           str->combined_char_count = 1;
3628           str->combining_table = ret;
3629         }
3630     }
3631   else
3632     {
3633       Lisp_Object ret
3634         = Fcdr (Fassq (make_char (character), str->combining_table));
3635
3636       if (CHARP (ret))
3637         {
3638           Emchar char2 = XCHARVAL (ret);
3639           Lisp_Object ret2 = Fchar_feature (ret, Qcomposition, Qnil,
3640                                             Qnil, Qnil);
3641
3642           if (NILP (ret2))
3643             {
3644               decode_add_er_char (str, char2, dst);
3645               str->combined_char_count = 0;
3646               str->combining_table = Qnil;
3647             }
3648           else
3649             {
3650               str->combined_chars[0] = char2;
3651               str->combined_char_count = 1;
3652               str->combining_table = ret2;
3653             }
3654         }
3655       else
3656         {
3657           ret = Fchar_feature (make_char (character), Qcomposition, Qnil,
3658                                Qnil, Qnil);
3659
3660           COMPOSE_FLUSH_CHARS (str, dst);
3661           if (NILP (ret))
3662             decode_add_er_char (str, character, dst);
3663           else
3664             {
3665               str->combined_chars[0] = character;
3666               str->combined_char_count = 1;
3667               str->combining_table = ret;
3668             }
3669         }
3670     }
3671 #endif /* HAVE_LIBCHISE */
3672 }
3673 #else /* not UTF2000 */
3674 #define COMPOSE_FLUSH_CHARS(str, dst)
3675 #define COMPOSE_ADD_CHAR(str, ch, dst) DECODE_ADD_UCS_CHAR (ch, dst)
3676 #endif /* UTF2000 */
3677
3678 \f
3679 /************************************************************************/
3680 /*                          Shift-JIS methods                           */
3681 /************************************************************************/
3682
3683 /* Shift-JIS is a coding system encoding three character sets: ASCII, right
3684    half of JISX0201-Kana, and JISX0208.  An ASCII character is encoded
3685    as is.  A character of JISX0201-Kana (DIMENSION1_CHARS94 character set) is
3686    encoded by "position-code + 0x80".  A character of JISX0208
3687    (DIMENSION2_CHARS94 character set) is encoded in 2-byte but two
3688    position-codes are divided and shifted so that it fit in the range
3689    below.
3690
3691    --- CODE RANGE of Shift-JIS ---
3692    (character set)      (range)
3693    ASCII                0x00 .. 0x7F
3694    JISX0201-Kana        0xA0 .. 0xDF
3695    JISX0208 (1st byte)  0x80 .. 0x9F and 0xE0 .. 0xEF
3696             (2nd byte)  0x40 .. 0x7E and 0x80 .. 0xFC
3697    -------------------------------
3698
3699 */
3700
3701 /* Is this the first byte of a Shift-JIS two-byte char? */
3702
3703 #define BYTE_SJIS_TWO_BYTE_1_P(c) \
3704   (((c) >= 0x81 && (c) <= 0x9F) || ((c) >= 0xE0 && (c) <= 0xEF))
3705
3706 /* Is this the second byte of a Shift-JIS two-byte char? */
3707
3708 #define BYTE_SJIS_TWO_BYTE_2_P(c) \
3709   (((c) >= 0x40 && (c) <= 0x7E) || ((c) >= 0x80 && (c) <= 0xFC))
3710
3711 #define BYTE_SJIS_KATAKANA_P(c) \
3712   ((c) >= 0xA1 && (c) <= 0xDF)
3713
3714 static int
3715 detect_coding_sjis (struct detection_state *st, const Extbyte *src, Lstream_data_count n)
3716 {
3717   while (n--)
3718     {
3719       unsigned char c = *(unsigned char *)src++;
3720       if (c == ISO_CODE_ESC || c == ISO_CODE_SI || c == ISO_CODE_SO)
3721         return 0;
3722       if (st->shift_jis.in_second_byte)
3723         {
3724           st->shift_jis.in_second_byte = 0;
3725           if (c < 0x40)
3726             return 0;
3727         }
3728       else if ((c >= 0x80 && c < 0xA0) || c >= 0xE0)
3729         st->shift_jis.in_second_byte = 1;
3730     }
3731   return CODING_CATEGORY_SHIFT_JIS_MASK;
3732 }
3733
3734 /* Convert Shift-JIS data to internal format. */
3735
3736 static void
3737 decode_coding_sjis (Lstream *decoding, const Extbyte *src,
3738                     unsigned_char_dynarr *dst, Lstream_data_count n)
3739 {
3740   struct decoding_stream *str = DECODING_STREAM_DATA (decoding);
3741   unsigned int flags  = str->flags;
3742   unsigned int cpos   = str->cpos;
3743   eol_type_t eol_type = str->eol_type;
3744
3745   while (n--)
3746     {
3747       unsigned char c = *(unsigned char *)src++;
3748
3749       if (cpos)
3750         {
3751           /* Previous character was first byte of Shift-JIS Kanji char. */
3752           if (BYTE_SJIS_TWO_BYTE_2_P (c))
3753             {
3754               unsigned char e1, e2;
3755
3756               DECODE_SJIS (cpos, c, e1, e2);
3757 #ifdef UTF2000
3758               DECODE_ADD_UCS_CHAR(MAKE_CHAR(Vcharset_japanese_jisx0208,
3759                                             e1 & 0x7F,
3760                                             e2 & 0x7F), dst);
3761 #else
3762               Dynarr_add (dst, LEADING_BYTE_JAPANESE_JISX0208);
3763               Dynarr_add (dst, e1);
3764               Dynarr_add (dst, e2);
3765 #endif
3766             }
3767           else
3768             {
3769               DECODE_ADD_BINARY_CHAR (cpos, dst);
3770               DECODE_ADD_BINARY_CHAR (c, dst);
3771             }
3772           cpos = 0;
3773         }
3774       else
3775         {
3776           DECODE_HANDLE_EOL_TYPE (eol_type, c, flags, dst);
3777           if (BYTE_SJIS_TWO_BYTE_1_P (c))
3778             cpos = c;
3779           else if (BYTE_SJIS_KATAKANA_P (c))
3780             {
3781 #ifdef UTF2000
3782               DECODE_ADD_UCS_CHAR(MAKE_CHAR(Vcharset_katakana_jisx0201,
3783                                             c & 0x7F, 0), dst);
3784 #else
3785               Dynarr_add (dst, LEADING_BYTE_KATAKANA_JISX0201);
3786               Dynarr_add (dst, c);
3787 #endif
3788             }
3789 #ifdef UTF2000
3790           else if (c > 32)
3791             DECODE_ADD_UCS_CHAR(MAKE_CHAR(Vcharset_latin_jisx0201,
3792                                           c, 0), dst);
3793 #endif
3794           else
3795             DECODE_ADD_BINARY_CHAR (c, dst);
3796         }
3797     label_continue_loop:;
3798     }
3799
3800   DECODE_HANDLE_END_OF_CONVERSION (flags, cpos, dst);
3801
3802   str->flags = flags;
3803   str->cpos  = cpos;
3804 }
3805
3806 /* Convert internal character representation to Shift_JIS. */
3807
3808 void
3809 char_encode_shift_jis (struct encoding_stream *str, Emchar ch,
3810                        unsigned_char_dynarr *dst, unsigned int *flags)
3811 {
3812   eol_type_t eol_type = CODING_SYSTEM_EOL_TYPE (str->codesys);
3813
3814   if (ch == '\n')
3815     {
3816       if (eol_type != EOL_LF && eol_type != EOL_AUTODETECT)
3817         Dynarr_add (dst, '\r');
3818       if (eol_type != EOL_CR)
3819         Dynarr_add (dst, ch);
3820     }
3821   else
3822     {
3823       unsigned int s1, s2;
3824 #ifdef UTF2000
3825       int code_point = charset_code_point (Vcharset_latin_jisx0201, ch, 0);
3826
3827       if (code_point >= 0)
3828         Dynarr_add (dst, code_point);
3829       else if ((code_point
3830                 = charset_code_point (Vcharset_japanese_jisx0208_1990, ch, 0))
3831                >= 0)
3832         {
3833           ENCODE_SJIS ((code_point >> 8) | 0x80,
3834                        (code_point & 0xFF) | 0x80, s1, s2);
3835           Dynarr_add (dst, s1);
3836           Dynarr_add (dst, s2);
3837         }
3838       else if ((code_point
3839                 = charset_code_point (Vcharset_katakana_jisx0201, ch, 0))
3840                >= 0)
3841         Dynarr_add (dst, code_point | 0x80);
3842       else if ((code_point
3843                 = charset_code_point (Vcharset_japanese_jisx0208, ch, 0))
3844                >= 0)
3845         {
3846           ENCODE_SJIS ((code_point >> 8) | 0x80,
3847                        (code_point & 0xFF) | 0x80, s1, s2);
3848           Dynarr_add (dst, s1);
3849           Dynarr_add (dst, s2);
3850         }
3851       else if ((code_point = charset_code_point (Vcharset_ascii, ch, 0))
3852                >= 0)
3853         Dynarr_add (dst, code_point);
3854       else
3855         Dynarr_add (dst, '?');
3856 #else
3857       Lisp_Object charset;
3858       unsigned int c1, c2;
3859
3860       BREAKUP_CHAR (ch, charset, c1, c2);
3861           
3862       if (EQ(charset, Vcharset_katakana_jisx0201))
3863         {
3864           Dynarr_add (dst, c1 | 0x80);
3865         }
3866       else if (c2 == 0)
3867         {
3868           Dynarr_add (dst, c1);
3869         }
3870       else if (EQ(charset, Vcharset_japanese_jisx0208))
3871         {
3872           ENCODE_SJIS (c1 | 0x80, c2 | 0x80, s1, s2);
3873           Dynarr_add (dst, s1);
3874           Dynarr_add (dst, s2);
3875         }
3876       else
3877         Dynarr_add (dst, '?');
3878 #endif
3879     }
3880 }
3881
3882 void
3883 char_finish_shift_jis (struct encoding_stream *str, unsigned_char_dynarr *dst,
3884                        unsigned int *flags)
3885 {
3886 }
3887
3888 DEFUN ("decode-shift-jis-char", Fdecode_shift_jis_char, 1, 1, 0, /*
3889 Decode a JISX0208 character of Shift-JIS coding-system.
3890 CODE is the character code in Shift-JIS as a cons of type bytes.
3891 Return the corresponding character.
3892 */
3893        (code))
3894 {
3895   unsigned char c1, c2, s1, s2;
3896
3897   CHECK_CONS (code);
3898   CHECK_INT (XCAR (code));
3899   CHECK_INT (XCDR (code));
3900   s1 = XINT (XCAR (code));
3901   s2 = XINT (XCDR (code));
3902   if (BYTE_SJIS_TWO_BYTE_1_P (s1) &&
3903       BYTE_SJIS_TWO_BYTE_2_P (s2))
3904     {
3905       DECODE_SJIS (s1, s2, c1, c2);
3906       return make_char (MAKE_CHAR (Vcharset_japanese_jisx0208,
3907                                    c1 & 0x7F, c2 & 0x7F));
3908     }
3909   else
3910     return Qnil;
3911 }
3912
3913 DEFUN ("encode-shift-jis-char", Fencode_shift_jis_char, 1, 1, 0, /*
3914 Encode a JISX0208 character CHARACTER to SHIFT-JIS coding-system.
3915 Return the corresponding character code in SHIFT-JIS as a cons of two bytes.
3916 */
3917        (character))
3918 {
3919   Lisp_Object charset;
3920   int c1, c2, s1, s2;
3921
3922   CHECK_CHAR_COERCE_INT (character);
3923   BREAKUP_CHAR (XCHAR (character), charset, c1, c2);
3924   if (EQ (charset, Vcharset_japanese_jisx0208))
3925     {
3926       ENCODE_SJIS (c1 | 0x80, c2 | 0x80, s1, s2);
3927       return Fcons (make_int (s1), make_int (s2));
3928     }
3929   else
3930     return Qnil;
3931 }
3932
3933 \f
3934 /************************************************************************/
3935 /*                            Big5 methods                              */
3936 /************************************************************************/
3937
3938 /* BIG5 is a coding system encoding two character sets: ASCII and
3939    Big5.  An ASCII character is encoded as is.  Big5 is a two-byte
3940    character set and is encoded in two-byte.
3941
3942    --- CODE RANGE of BIG5 ---
3943    (character set)      (range)
3944    ASCII                0x00 .. 0x7F
3945    Big5 (1st byte)      0xA1 .. 0xFE
3946         (2nd byte)      0x40 .. 0x7E and 0xA1 .. 0xFE
3947    --------------------------
3948
3949    Since the number of characters in Big5 is larger than maximum
3950    characters in Emacs' charset (96x96), it can't be handled as one
3951    charset.  So, in Emacs, Big5 is divided into two: `charset-big5-1'
3952    and `charset-big5-2'.  Both <type>s are DIMENSION2_CHARS94.  The former
3953    contains frequently used characters and the latter contains less
3954    frequently used characters.  */
3955
3956 #ifdef UTF2000
3957 #define BYTE_BIG5_TWO_BYTE_1_P(c) \
3958   ((c) >= 0x81 && (c) <= 0xFE)
3959 #else
3960 #define BYTE_BIG5_TWO_BYTE_1_P(c) \
3961   ((c) >= 0xA1 && (c) <= 0xFE)
3962 #endif
3963
3964 /* Is this the second byte of a Shift-JIS two-byte char? */
3965
3966 #define BYTE_BIG5_TWO_BYTE_2_P(c) \
3967   (((c) >= 0x40 && (c) <= 0x7E) || ((c) >= 0xA1 && (c) <= 0xFE))
3968
3969 /* Number of Big5 characters which have the same code in 1st byte.  */
3970
3971 #define BIG5_SAME_ROW (0xFF - 0xA1 + 0x7F - 0x40)
3972
3973 /* Code conversion macros.  These are macros because they are used in
3974    inner loops during code conversion.
3975
3976    Note that temporary variables in macros introduce the classic
3977    dynamic-scoping problems with variable names.  We use capital-
3978    lettered variables in the assumption that XEmacs does not use
3979    capital letters in variables except in a very formalized way
3980    (e.g. Qstring). */
3981
3982 /* Convert Big5 code (b1, b2) into its internal string representation
3983    (lb, c1, c2). */
3984
3985 /* There is a much simpler way to split the Big5 charset into two.
3986    For the moment I'm going to leave the algorithm as-is because it
3987    claims to separate out the most-used characters into a single
3988    charset, which perhaps will lead to optimizations in various
3989    places.
3990
3991    The way the algorithm works is something like this:
3992
3993    Big5 can be viewed as a 94x157 charset, where the row is
3994    encoded into the bytes 0xA1 .. 0xFE and the column is encoded
3995    into the bytes 0x40 .. 0x7E and 0xA1 .. 0xFE.  As for frequency,
3996    the split between low and high column numbers is apparently
3997    meaningless; ascending rows produce less and less frequent chars.
3998    Therefore, we assign the lower half of rows (0xA1 .. 0xC8) to
3999    the first charset, and the upper half (0xC9 .. 0xFE) to the
4000    second.  To do the conversion, we convert the character into
4001    a single number where 0 .. 156 is the first row, 157 .. 313
4002    is the second, etc.  That way, the characters are ordered by
4003    decreasing frequency.  Then we just chop the space in two
4004    and coerce the result into a 94x94 space.
4005    */
4006
4007 #define DECODE_BIG5(b1, b2, lb, c1, c2) do                              \
4008 {                                                                       \
4009   int B1 = b1, B2 = b2;                                                 \
4010   unsigned int I                                                        \
4011     = (B1 - 0xA1) * BIG5_SAME_ROW + B2 - (B2 < 0x7F ? 0x40 : 0x62);     \
4012                                                                         \
4013   if (B1 < 0xC9)                                                        \
4014     {                                                                   \
4015       lb = LEADING_BYTE_CHINESE_BIG5_1;                                 \
4016     }                                                                   \
4017   else                                                                  \
4018     {                                                                   \
4019       lb = LEADING_BYTE_CHINESE_BIG5_2;                                 \
4020       I -= (BIG5_SAME_ROW) * (0xC9 - 0xA1);                             \
4021     }                                                                   \
4022   c1 = I / (0xFF - 0xA1) + 0xA1;                                        \
4023   c2 = I % (0xFF - 0xA1) + 0xA1;                                        \
4024 } while (0)
4025
4026 /* Convert the internal string representation of a Big5 character
4027    (lb, c1, c2) into Big5 code (b1, b2). */
4028
4029 #define ENCODE_BIG5(lb, c1, c2, b1, b2) do                              \
4030 {                                                                       \
4031   unsigned int I = ((c1) - 0xA1) * (0xFF - 0xA1) + ((c2) - 0xA1);       \
4032                                                                         \
4033   if (lb == LEADING_BYTE_CHINESE_BIG5_2)                                \
4034     {                                                                   \
4035       I += BIG5_SAME_ROW * (0xC9 - 0xA1);                               \
4036     }                                                                   \
4037   b1 = I / BIG5_SAME_ROW + 0xA1;                                        \
4038   b2 = I % BIG5_SAME_ROW;                                               \
4039   b2 += b2 < 0x3F ? 0x40 : 0x62;                                        \
4040 } while (0)
4041
4042 static int
4043 detect_coding_big5 (struct detection_state *st, const Extbyte *src, Lstream_data_count n)
4044 {
4045   while (n--)
4046     {
4047       unsigned char c = *(unsigned char *)src++;
4048       if (c == ISO_CODE_ESC || c == ISO_CODE_SI || c == ISO_CODE_SO
4049 #ifndef UTF2000
4050           || (c >= 0x80 && c <= 0xA0)
4051 #endif
4052           )
4053         return 0;
4054       if (st->big5.in_second_byte)
4055         {
4056           st->big5.in_second_byte = 0;
4057           if (c < 0x40 || (c >= 0x80 && c <= 0xA0))
4058             return 0;
4059         }
4060       else if (
4061 #ifdef UTF2000
4062                c >= 0x81
4063 #else
4064                c >= 0xA1
4065 #endif
4066                )
4067         st->big5.in_second_byte = 1;
4068     }
4069   return CODING_CATEGORY_BIG5_MASK;
4070 }
4071
4072 /* Convert Big5 data to internal format. */
4073
4074 static void
4075 decode_coding_big5 (Lstream *decoding, const Extbyte *src,
4076                     unsigned_char_dynarr *dst, Lstream_data_count n)
4077 {
4078   struct decoding_stream *str = DECODING_STREAM_DATA (decoding);
4079   unsigned int flags  = str->flags;
4080   unsigned int cpos   = str->cpos;
4081   eol_type_t eol_type = str->eol_type;
4082 #ifdef UTF2000
4083   Lisp_Object ccs
4084     = CODING_SYSTEM_ISO2022_INITIAL_CHARSET (DECODING_STREAM_DATA
4085                                              (decoding)->codesys, 1);
4086 #endif
4087
4088   while (n--)
4089     {
4090       unsigned char c = *(unsigned char *)src++;
4091       if (cpos)
4092         {
4093           /* Previous character was first byte of Big5 char. */
4094           if (BYTE_BIG5_TWO_BYTE_2_P (c))
4095             {
4096 #ifdef UTF2000
4097               int code_point = (cpos << 8) | c;
4098               Emchar char_id = decode_defined_char (ccs, code_point, 0);
4099
4100               if (char_id < 0)
4101                 char_id
4102                   = DECODE_CHAR (Vcharset_chinese_big5, code_point, 0);
4103               DECODE_ADD_UCS_CHAR (char_id, dst);
4104 #else
4105               unsigned char b1, b2, b3;
4106               DECODE_BIG5 (cpos, c, b1, b2, b3);
4107               Dynarr_add (dst, b1);
4108               Dynarr_add (dst, b2);
4109               Dynarr_add (dst, b3);
4110 #endif
4111             }
4112           else
4113             {
4114               DECODE_ADD_BINARY_CHAR (cpos, dst);
4115               DECODE_ADD_BINARY_CHAR (c, dst);
4116             }
4117           cpos = 0;
4118         }
4119       else
4120         {
4121           DECODE_HANDLE_EOL_TYPE (eol_type, c, flags, dst);
4122           if (BYTE_BIG5_TWO_BYTE_1_P (c))
4123             {
4124               decode_flush_er_chars (str, dst);
4125               cpos = c;
4126             }
4127           else if ( c < ' ' )
4128             {
4129               decode_flush_er_chars (str, dst);
4130               DECODE_HANDLE_EOL_TYPE (eol_type, c, flags, dst);
4131               DECODE_ADD_BINARY_CHAR (c, dst);
4132             }
4133           else
4134             {
4135               /* DECODE_ADD_BINARY_CHAR (c, dst); */
4136               decode_add_er_char (str, c, dst);
4137             }
4138         }
4139     label_continue_loop:;
4140     }
4141
4142   /* DECODE_HANDLE_END_OF_CONVERSION (flags, cpos, dst); */
4143   if (flags & CODING_STATE_END)
4144     {
4145       decode_flush_er_chars (str, dst);
4146       DECODE_OUTPUT_PARTIAL_CHAR (cpos);
4147       if (flags & CODING_STATE_CR)
4148         Dynarr_add (dst, '\r');
4149     }
4150
4151   str->flags = flags;
4152   str->cpos  = cpos;
4153 }
4154
4155 /* Convert internally-formatted data to Big5. */
4156
4157 void
4158 char_encode_big5 (struct encoding_stream *str, Emchar ch,
4159                   unsigned_char_dynarr *dst, unsigned int *flags)
4160 {
4161   eol_type_t eol_type = CODING_SYSTEM_EOL_TYPE (str->codesys);
4162
4163   if (ch == '\n')
4164     {
4165       if (eol_type != EOL_LF && eol_type != EOL_AUTODETECT)
4166         Dynarr_add (dst, '\r');
4167       if (eol_type != EOL_CR)
4168         Dynarr_add (dst, ch);
4169     }
4170   else
4171     {
4172 #ifdef UTF2000
4173       int code_point;
4174       Lisp_Object ccs
4175         = CODING_SYSTEM_ISO2022_INITIAL_CHARSET (str->codesys, 1);
4176
4177       if ((code_point = charset_code_point (Vcharset_ascii, ch, 0)) >= 0)
4178         Dynarr_add (dst, code_point);
4179       else if ((code_point = charset_code_point (ccs, ch, 0)) >= 0)
4180         {
4181           Dynarr_add (dst, code_point >> 8);
4182           Dynarr_add (dst, code_point & 0xFF);
4183         }
4184       else if ((code_point
4185                 = charset_code_point (Vcharset_chinese_big5, ch, 0)) >= 0)
4186         {
4187           Dynarr_add (dst, code_point >> 8);
4188           Dynarr_add (dst, code_point & 0xFF);
4189         }
4190       else if ((code_point
4191                 = charset_code_point (Vcharset_chinese_big5_1, ch, 0)) >= 0)
4192         {
4193           unsigned int I
4194             = ((code_point >> 8) - 33) * (0xFF - 0xA1)
4195             + ((code_point & 0xFF) - 33);
4196           unsigned char b1 = I / BIG5_SAME_ROW + 0xA1;
4197           unsigned char b2 = I % BIG5_SAME_ROW;
4198
4199           b2 += b2 < 0x3F ? 0x40 : 0x62;
4200           Dynarr_add (dst, b1);
4201           Dynarr_add (dst, b2);
4202         }
4203       else if ((code_point
4204                 = charset_code_point (Vcharset_chinese_big5_2, ch, 0)) >= 0)
4205         {
4206           unsigned int I
4207             = ((code_point >> 8) - 33) * (0xFF - 0xA1)
4208             + ((code_point & 0xFF) - 33);
4209           unsigned char b1, b2;
4210
4211           I += BIG5_SAME_ROW * (0xC9 - 0xA1);
4212           b1 = I / BIG5_SAME_ROW + 0xA1;
4213           b2 = I % BIG5_SAME_ROW;
4214           b2 += b2 < 0x3F ? 0x40 : 0x62;
4215           Dynarr_add (dst, b1);
4216           Dynarr_add (dst, b2);
4217         }
4218       else if (CODING_SYSTEM_USE_ENTITY_REFERENCE (str->codesys))
4219         {
4220           char buf[18];
4221
4222           char_encode_as_entity_reference (ch, buf);
4223           Dynarr_add_many (dst, buf, strlen (buf));
4224         }
4225       else
4226         Dynarr_add (dst, '?');
4227 #else
4228 #endif
4229     }
4230 }
4231
4232 void
4233 char_finish_big5 (struct encoding_stream *str, unsigned_char_dynarr *dst,
4234                   unsigned int *flags)
4235 {
4236 }
4237
4238
4239 DEFUN ("decode-big5-char", Fdecode_big5_char, 1, 1, 0, /*
4240 Decode a Big5 character CODE of BIG5 coding-system.
4241 CODE is the character code in BIG5, a cons of two integers.
4242 Return the corresponding character.
4243 */
4244        (code))
4245 {
4246   unsigned char c1, c2, b1, b2;
4247
4248   CHECK_CONS (code);
4249   CHECK_INT (XCAR (code));
4250   CHECK_INT (XCDR (code));
4251   b1 = XINT (XCAR (code));
4252   b2 = XINT (XCDR (code));
4253   if (BYTE_BIG5_TWO_BYTE_1_P (b1) &&
4254       BYTE_BIG5_TWO_BYTE_2_P (b2))
4255     {
4256       Charset_ID leading_byte;
4257       Lisp_Object charset;
4258       DECODE_BIG5 (b1, b2, leading_byte, c1, c2);
4259       charset = CHARSET_BY_LEADING_BYTE (leading_byte);
4260       return make_char (MAKE_CHAR (charset, c1 & 0x7F, c2 & 0x7F));
4261     }
4262   else
4263     return Qnil;
4264 }
4265
4266 DEFUN ("encode-big5-char", Fencode_big5_char, 1, 1, 0, /*
4267 Encode the Big5 character CHARACTER in the BIG5 coding-system.
4268 Return the corresponding character code in Big5.
4269 */
4270        (character))
4271 {
4272   Lisp_Object charset;
4273   int c1, c2, b1, b2;
4274
4275   CHECK_CHAR_COERCE_INT (character);
4276   BREAKUP_CHAR (XCHAR (character), charset, c1, c2);
4277   if (EQ (charset, Vcharset_chinese_big5_1) ||
4278       EQ (charset, Vcharset_chinese_big5_2))
4279     {
4280       ENCODE_BIG5 (XCHARSET_LEADING_BYTE (charset), c1 | 0x80, c2 | 0x80,
4281                    b1, b2);
4282       return Fcons (make_int (b1), make_int (b2));
4283     }
4284   else
4285     return Qnil;
4286 }
4287
4288 \f
4289 /************************************************************************/
4290 /*                           UCS-4 methods                              */
4291 /************************************************************************/
4292
4293 static int
4294 detect_coding_ucs4 (struct detection_state *st, const Extbyte *src, Lstream_data_count n)
4295 {
4296   while (n--)
4297     {
4298       unsigned char c = *(unsigned char *)src++;
4299       switch (st->ucs4.in_byte)
4300         {
4301         case 0:
4302           if (c >= 128)
4303             return 0;
4304           else
4305             st->ucs4.in_byte++;
4306           break;
4307         case 3:
4308           st->ucs4.in_byte = 0;
4309           break;
4310         default:
4311           st->ucs4.in_byte++;
4312         }
4313     }
4314   return CODING_CATEGORY_UCS4_MASK;
4315 }
4316
4317 static void
4318 decode_coding_ucs4 (Lstream *decoding, const Extbyte *src,
4319                     unsigned_char_dynarr *dst, Lstream_data_count n)
4320 {
4321   struct decoding_stream *str = DECODING_STREAM_DATA (decoding);
4322   unsigned int flags = str->flags;
4323   unsigned int cpos  = str->cpos;
4324   unsigned char counter = str->counter;
4325
4326   while (n--)
4327     {
4328       unsigned char c = *(unsigned char *)src++;
4329       switch (counter)
4330         {
4331         case 0:
4332           cpos = c;
4333           counter = 3;
4334           break;
4335         case 1:
4336           DECODE_ADD_UCS_CHAR ((cpos << 8) | c, dst);
4337           cpos = 0;
4338           counter = 0;
4339           break;
4340         default:
4341           cpos = ( cpos << 8 ) | c;
4342           counter--;
4343         }
4344     }
4345   if (counter & CODING_STATE_END)
4346     DECODE_OUTPUT_PARTIAL_CHAR (cpos);
4347
4348   str->flags    = flags;
4349   str->cpos     = cpos;
4350   str->counter  = counter;
4351 }
4352
4353 void
4354 char_encode_ucs4 (struct encoding_stream *str, Emchar ch,
4355                   unsigned_char_dynarr *dst, unsigned int *flags)
4356 {
4357   Dynarr_add (dst, ch >> 24);
4358   Dynarr_add (dst, ch >> 16);
4359   Dynarr_add (dst, ch >>  8);
4360   Dynarr_add (dst, ch      );
4361 }
4362
4363 void
4364 char_finish_ucs4 (struct encoding_stream *str, unsigned_char_dynarr *dst,
4365                   unsigned int *flags)
4366 {
4367 }
4368
4369 \f
4370 /************************************************************************/
4371 /*                           UTF-16 methods                             */
4372 /************************************************************************/
4373
4374 static int
4375 detect_coding_utf16 (struct detection_state *st, const Extbyte *src, Lstream_data_count n)
4376 {
4377   return CODING_CATEGORY_UTF16_MASK;
4378 }
4379
4380 static void
4381 decode_coding_utf16 (Lstream *decoding, const Extbyte *src,
4382                     unsigned_char_dynarr *dst, Lstream_data_count n)
4383 {
4384   struct decoding_stream *str = DECODING_STREAM_DATA (decoding);
4385   unsigned int flags = str->flags;
4386   unsigned int cpos  = str->cpos;
4387   unsigned char counter = str->counter & 3;
4388   unsigned char byte_order = str->counter >> 2;
4389   eol_type_t eol_type = str->eol_type;
4390
4391   while (n--)
4392     {
4393       unsigned char c = *(unsigned char *)src++;
4394       if (counter == 0)
4395         {
4396           cpos = c;
4397           counter = 1;
4398         }
4399       else if (counter == 1)
4400         {
4401           int code;
4402
4403           if (byte_order == 0)
4404             code = (c << 8) | cpos;
4405           else
4406             code = (cpos << 8) | c;
4407           if (code == 0xFFFE)
4408             {
4409               code = ((code & 0xFF) << 8) | (code >> 8);
4410               if ( byte_order == 0 )
4411                 byte_order = 1;
4412               else
4413                 byte_order = 0;
4414             }
4415           if ( (0xD800 <= code) && (code <= 0xDBFF) )
4416             {
4417               counter = 2;
4418               cpos = code;
4419             }
4420           else
4421             {
4422               counter = 0;
4423               cpos = 0;
4424               if (code != 0xFEFF)
4425                 {
4426                   DECODE_HANDLE_EOL_TYPE (eol_type, code, flags, dst);
4427                   DECODE_ADD_UCS_CHAR (code, dst);
4428                 }
4429             }
4430         }
4431       else if (counter == 2)
4432         {
4433           cpos = (cpos << 8) | c;
4434           counter++;
4435         }
4436       else
4437         {
4438           int x = cpos >> 8;
4439           int y
4440             = (byte_order == 0)
4441             ? (c << 8) | (cpos & 0xFF)
4442             : ((cpos & 0xFF) << 8) | c;
4443
4444           DECODE_ADD_UCS_CHAR ((x - 0xD800) * 0x400 + (y - 0xDC00)
4445                                + 0x10000, dst);
4446           counter = 0;
4447           cpos = 0;
4448         }
4449     label_continue_loop:;
4450     }
4451   if (counter & CODING_STATE_END)
4452     DECODE_OUTPUT_PARTIAL_CHAR (cpos);
4453
4454   str->flags    = flags;
4455   str->cpos     = cpos;
4456   str->counter  = (byte_order << 2) | counter;
4457 }
4458
4459 void
4460 char_encode_utf16 (struct encoding_stream *str, Emchar ch,
4461                   unsigned_char_dynarr *dst, unsigned int *flags)
4462 {
4463   if (ch <= 0xFFFF)
4464     {
4465       Dynarr_add (dst, ch);
4466       Dynarr_add (dst, ch >> 8);
4467     }
4468   else
4469     {
4470       int y = ((ch - 0x10000) / 0x400) + 0xD800;
4471       int z = ((ch - 0x10000) % 0x400) + 0xDC00;
4472       
4473       Dynarr_add (dst, y);
4474       Dynarr_add (dst, y >> 8);
4475       Dynarr_add (dst, z);
4476       Dynarr_add (dst, z >> 8);
4477     }
4478 }
4479
4480 void
4481 char_finish_utf16 (struct encoding_stream *str, unsigned_char_dynarr *dst,
4482                   unsigned int *flags)
4483 {
4484 }
4485
4486 \f
4487 /************************************************************************/
4488 /*                           UTF-8 methods                              */
4489 /************************************************************************/
4490
4491 static int
4492 detect_coding_utf8 (struct detection_state *st, const Extbyte *src, Lstream_data_count n)
4493 {
4494   while (n--)
4495     {
4496       unsigned char c = *(unsigned char *)src++;
4497       switch (st->utf8.in_byte)
4498         {
4499         case 0:
4500           if (c == ISO_CODE_ESC || c == ISO_CODE_SI || c == ISO_CODE_SO)
4501             return 0;
4502           else if (c >= 0xfc)
4503             st->utf8.in_byte = 5;
4504           else if (c >= 0xf8)
4505             st->utf8.in_byte = 4;
4506           else if (c >= 0xf0)
4507             st->utf8.in_byte = 3;
4508           else if (c >= 0xe0)
4509             st->utf8.in_byte = 2;
4510           else if (c >= 0xc0)
4511             st->utf8.in_byte = 1;
4512           else if (c >= 0x80)
4513             return 0;
4514           break;
4515         default:
4516           if ((c & 0xc0) != 0x80)
4517             return 0;
4518           else
4519             st->utf8.in_byte--;
4520         }
4521     }
4522   return CODING_CATEGORY_UTF8_MASK;
4523 }
4524
4525 static void
4526 decode_output_utf8_partial_char (unsigned char counter,
4527                                  unsigned int cpos,
4528                                  unsigned_char_dynarr *dst)
4529 {
4530   if (counter == 5)
4531     DECODE_ADD_BINARY_CHAR ( (cpos|0xFC), dst);
4532   else if (counter == 4)
4533     {
4534       if (cpos < (1 << 6))
4535         DECODE_ADD_BINARY_CHAR ( (cpos|0xF8), dst);
4536       else
4537         {
4538           DECODE_ADD_BINARY_CHAR ( ((cpos >> 6)|0xFC), dst);
4539           DECODE_ADD_BINARY_CHAR ( ((cpos&0x3F)|0x80), dst);
4540         }
4541     }
4542   else if (counter == 3)
4543     {
4544       if (cpos < (1 << 6))
4545         DECODE_ADD_BINARY_CHAR ( (cpos|0xF0), dst);
4546       else if (cpos < (1 << 12))
4547         {
4548           DECODE_ADD_BINARY_CHAR ( ((cpos >> 6)|0xF8), dst);
4549           DECODE_ADD_BINARY_CHAR ( ((cpos&0x3F)|0x80), dst);
4550         }
4551       else
4552         {
4553           DECODE_ADD_BINARY_CHAR ( ( (cpos >> 12)|0xFC), dst);
4554           DECODE_ADD_BINARY_CHAR ( (((cpos >>  6)&0x3F)|0x80), dst);
4555           DECODE_ADD_BINARY_CHAR ( ( (cpos       &0x3F)|0x80), dst);
4556         }
4557     }
4558   else if (counter == 2)
4559     {
4560       if (cpos < (1 << 6))
4561         DECODE_ADD_BINARY_CHAR ( (cpos|0xE0), dst);
4562       else if (cpos < (1 << 12))
4563         {
4564           DECODE_ADD_BINARY_CHAR ( ((cpos >> 6)|0xF0), dst);
4565           DECODE_ADD_BINARY_CHAR ( ((cpos&0x3F)|0x80), dst);
4566         }
4567       else if (cpos < (1 << 18))
4568         {
4569           DECODE_ADD_BINARY_CHAR ( ( (cpos >> 12)|0xF8), dst);
4570           DECODE_ADD_BINARY_CHAR ( (((cpos >> 6)&0x3F)|0x80), dst);
4571           DECODE_ADD_BINARY_CHAR ( ( (cpos      &0x3F)|0x80), dst);
4572         }
4573       else
4574         {
4575           DECODE_ADD_BINARY_CHAR ( ( (cpos >> 18)|0xFC), dst);
4576           DECODE_ADD_BINARY_CHAR ( (((cpos >> 12)&0x3F)|0x80), dst);
4577           DECODE_ADD_BINARY_CHAR ( (((cpos >>  6)&0x3F)|0x80), dst);
4578           DECODE_ADD_BINARY_CHAR ( ( (cpos       &0x3F)|0x80), dst);
4579         }
4580     }
4581   else
4582     {
4583       if (cpos < (1 << 6))
4584         DECODE_ADD_BINARY_CHAR ( (cpos|0xC0), dst);
4585       else if (cpos < (1 << 12))
4586         {
4587           DECODE_ADD_BINARY_CHAR ( ((cpos >> 6)|0xE0), dst);
4588           DECODE_ADD_BINARY_CHAR ( ((cpos&0x3F)|0x80), dst);
4589         }
4590       else if (cpos < (1 << 18))
4591         {
4592           DECODE_ADD_BINARY_CHAR ( ( (cpos >> 12)|0xF0), dst);
4593           DECODE_ADD_BINARY_CHAR ( (((cpos >>  6)&0x3F)|0x80), dst);
4594           DECODE_ADD_BINARY_CHAR ( ( (cpos       &0x3F)|0x80), dst);
4595         }
4596       else if (cpos < (1 << 24))
4597         {
4598           DECODE_ADD_BINARY_CHAR ( ( (cpos >> 18)|0xF8), dst);
4599           DECODE_ADD_BINARY_CHAR ( (((cpos >> 12)&0x3F)|0x80), dst);
4600           DECODE_ADD_BINARY_CHAR ( (((cpos >>  6)&0x3F)|0x80), dst);
4601           DECODE_ADD_BINARY_CHAR ( ( (cpos       &0x3F)|0x80), dst);
4602         }
4603       else
4604         {
4605           DECODE_ADD_BINARY_CHAR ( ( (cpos >> 24)|0xFC), dst);
4606           DECODE_ADD_BINARY_CHAR ( (((cpos >> 18)&0x3F)|0x80), dst);
4607           DECODE_ADD_BINARY_CHAR ( (((cpos >> 12)&0x3F)|0x80), dst);
4608           DECODE_ADD_BINARY_CHAR ( (((cpos >>  6)&0x3F)|0x80), dst);
4609           DECODE_ADD_BINARY_CHAR ( ( (cpos       &0x3F)|0x80), dst);
4610         }
4611     }
4612 }
4613
4614 static void
4615 decode_coding_utf8 (Lstream *decoding, const Extbyte *src,
4616                     unsigned_char_dynarr *dst, Lstream_data_count n)
4617 {
4618   struct decoding_stream *str = DECODING_STREAM_DATA (decoding);
4619   unsigned int flags    = str->flags;
4620   unsigned int cpos     = str->cpos;
4621   eol_type_t eol_type   = str->eol_type;
4622   unsigned char counter = str->counter;
4623 #ifdef UTF2000
4624   int bom_flag = str->bom_flag;
4625   Lisp_Object ccs
4626     = CODING_SYSTEM_ISO2022_INITIAL_CHARSET (DECODING_STREAM_DATA
4627                                              (decoding)->codesys, 0);
4628 #endif
4629
4630   while (n--)
4631     {
4632       unsigned char c = *(unsigned char *)src++;
4633       if (counter == 0)
4634         {
4635           if ( c < ' ' )
4636             {
4637               COMPOSE_FLUSH_CHARS (str, dst);
4638               decode_flush_er_chars (str, dst);
4639               DECODE_HANDLE_EOL_TYPE (eol_type, c, flags, dst);
4640
4641               if ( bom_flag == 0 )
4642                 bom_flag = -1;
4643
4644               DECODE_ADD_UCS_CHAR (c, dst);
4645             }
4646           else if ( c < 0xC0 )
4647             {         
4648               if ( bom_flag == 0 )
4649                 bom_flag = -1;
4650
4651               /* decode_add_er_char (str, c, dst); */
4652               COMPOSE_ADD_CHAR (str, c, dst);
4653             }
4654           else
4655             {
4656               /* decode_flush_er_chars (str, dst); */
4657               if ( c < 0xE0 )
4658                 {
4659                   cpos = c & 0x1f;
4660                   counter = 1;
4661                 }
4662               else if ( c < 0xF0 )
4663                 {
4664                   cpos = c & 0x0f;
4665                   counter = 2;
4666                 }
4667               else if ( c < 0xF8 )
4668                 {
4669                   cpos = c & 0x07;
4670                   counter = 3;
4671                 }
4672               else if ( c < 0xFC )
4673                 {
4674                   cpos = c & 0x03;
4675                   counter = 4;
4676                 }
4677               else
4678                 {
4679                   cpos = c & 0x01;
4680                   counter = 5;
4681                 }
4682             }
4683         }
4684       else if ( (c & 0xC0) == 0x80 )
4685         {
4686           cpos = ( cpos << 6 ) | ( c & 0x3f );
4687           if (counter == 1)
4688             {
4689               Emchar char_id;
4690
4691               if ( bom_flag == 0 )
4692                 {
4693                   if ( cpos == 0xFEFF )
4694                     {
4695                       bom_flag = 1;
4696                       goto decoded;
4697                     }
4698                   else
4699                     bom_flag = -1;
4700                 }
4701
4702               if (!NILP (ccs))
4703                 {
4704                   char_id = decode_defined_char (ccs, cpos, 0);
4705
4706                   if (char_id < 0)
4707                     char_id = cpos;
4708                 }
4709               else
4710                 char_id = cpos;
4711               COMPOSE_ADD_CHAR (str, char_id, dst);
4712             decoded:
4713               cpos = 0;
4714               counter = 0;
4715             }
4716           else
4717             counter--;
4718         }
4719       else
4720         {
4721           COMPOSE_FLUSH_CHARS (str, dst);
4722           decode_flush_er_chars (str, dst);
4723           decode_output_utf8_partial_char (counter, cpos, dst);
4724           DECODE_ADD_BINARY_CHAR (c, dst);
4725           cpos = 0;
4726           counter = 0;
4727         }
4728     label_continue_loop:;
4729     }
4730
4731   if (flags & CODING_STATE_END)
4732     {
4733       COMPOSE_FLUSH_CHARS (str, dst);
4734       decode_flush_er_chars (str, dst);
4735       if (counter > 0)
4736         {
4737           decode_output_utf8_partial_char (counter, cpos, dst);
4738           cpos = 0;
4739           counter = 0;
4740         }
4741     }
4742   str->flags    = flags;
4743   str->cpos     = cpos;
4744   str->counter  = counter;
4745 #ifdef UTF2000
4746   str->bom_flag = bom_flag;
4747 #endif
4748 }
4749
4750 void
4751 char_encode_utf8 (struct encoding_stream *str, Emchar ch,
4752                   unsigned_char_dynarr *dst, unsigned int *flags)
4753 {
4754   eol_type_t eol_type = CODING_SYSTEM_EOL_TYPE (str->codesys);
4755
4756   if (ch == '\n')
4757     {
4758       if (eol_type != EOL_LF && eol_type != EOL_AUTODETECT)
4759         Dynarr_add (dst, '\r');
4760       if (eol_type != EOL_CR)
4761         Dynarr_add (dst, ch);
4762     }
4763   else if (ch <= 0x7f)
4764     {
4765       Dynarr_add (dst, ch);
4766     }
4767   else
4768     {
4769       Lisp_Object ucs_ccs
4770         = CODING_SYSTEM_ISO2022_INITIAL_CHARSET (str->codesys, 0);
4771       int code_point = charset_code_point (ucs_ccs, ch, 0);
4772
4773       if ( (code_point < 0) || (code_point > 0xEFFFF) )
4774         {
4775           Lisp_Object map, ret;
4776
4777           if ( CODING_SYSTEM_ENABLE_DECOMPOSITION (str->codesys) )
4778             {
4779               Lisp_Object rest = Vdecomposition_feature_list;
4780               Lisp_Object decomp_f;
4781               Lisp_Object seq = Qnil;
4782               struct gcpro gcpro1;
4783
4784               while ( CONSP (rest) )
4785                 {
4786                   decomp_f = XCAR (rest);
4787                   GCPRO1 (rest);
4788                   seq = Fchar_feature (make_char (ch), decomp_f, Qnil,
4789                                        Qnil, Qnil);
4790                   UNGCPRO;
4791                   if ( !NILP (seq) )
4792                     break;
4793                   rest = XCDR (rest);
4794                 }
4795
4796               if ( CONSP (seq) )
4797                 {
4798                   Lisp_Object base = Fcar (seq);
4799
4800                   seq = Fcdr (seq);
4801                   if ( CHARP (base) && CONSP (seq) )
4802                     {
4803                       Lisp_Object comb = Fcar (seq);
4804
4805                       if ( CHARP (comb) )
4806                         {
4807                           char_encode_utf8 (str, XCHAR (base), dst, flags);
4808                           char_encode_utf8 (str, XCHAR (comb), dst, flags);
4809                           return;
4810                         }
4811                     }
4812                 }
4813             }
4814
4815           map = CODING_SYSTEM_ISO2022_INITIAL_CHARSET (str->codesys, 1);
4816           if ( !NILP (map)
4817                && INTP (ret = Fchar_feature (make_char (ch),
4818                                              map, Qnil,
4819                                              Qnil, Qnil)) )
4820             code_point = XINT (ret);
4821           else if ( !NILP (map =
4822                            CODING_SYSTEM_ISO2022_INITIAL_CHARSET
4823                            (str->codesys, 2))
4824                     && INTP (ret = Fchar_feature (make_char (ch),
4825                                                   map, Qnil,
4826                                                   Qnil, Qnil)) )
4827             code_point = XINT (ret);
4828           else if (CODING_SYSTEM_USE_ENTITY_REFERENCE (str->codesys))
4829             {
4830               char buf[18];
4831
4832               char_encode_as_entity_reference (ch, buf);
4833               Dynarr_add_many (dst, buf, strlen (buf));
4834               return;
4835             }
4836           else
4837             code_point = ch;
4838         }
4839       if (code_point <= 0x7ff)
4840         {
4841           Dynarr_add (dst, (code_point >> 6) | 0xc0);
4842           Dynarr_add (dst, (code_point & 0x3f) | 0x80);
4843         }
4844       else if (code_point <= 0xffff)
4845         {
4846           Dynarr_add (dst,  (code_point >> 12) | 0xe0);
4847           Dynarr_add (dst, ((code_point >>  6) & 0x3f) | 0x80);
4848           Dynarr_add (dst,  (code_point        & 0x3f) | 0x80);
4849         }
4850       else if (code_point <= 0x1fffff)
4851         {
4852           Dynarr_add (dst,  (code_point >> 18) | 0xf0);
4853           Dynarr_add (dst, ((code_point >> 12) & 0x3f) | 0x80);
4854           Dynarr_add (dst, ((code_point >>  6) & 0x3f) | 0x80);
4855           Dynarr_add (dst,  (code_point        & 0x3f) | 0x80);
4856         }
4857       else if (code_point <= 0x3ffffff)
4858         {
4859           Dynarr_add (dst,  (code_point >> 24) | 0xf8);
4860           Dynarr_add (dst, ((code_point >> 18) & 0x3f) | 0x80);
4861           Dynarr_add (dst, ((code_point >> 12) & 0x3f) | 0x80);
4862           Dynarr_add (dst, ((code_point >>  6) & 0x3f) | 0x80);
4863           Dynarr_add (dst,  (code_point        & 0x3f) | 0x80);
4864         }
4865       else
4866         {
4867           Dynarr_add (dst,  (code_point >> 30) | 0xfc);
4868           Dynarr_add (dst, ((code_point >> 24) & 0x3f) | 0x80);
4869           Dynarr_add (dst, ((code_point >> 18) & 0x3f) | 0x80);
4870           Dynarr_add (dst, ((code_point >> 12) & 0x3f) | 0x80);
4871           Dynarr_add (dst, ((code_point >>  6) & 0x3f) | 0x80);
4872           Dynarr_add (dst,  (code_point        & 0x3f) | 0x80);
4873         }
4874     }
4875 }
4876
4877 void
4878 char_finish_utf8 (struct encoding_stream *str, unsigned_char_dynarr *dst,
4879                   unsigned int *flags)
4880 {
4881 }
4882
4883 \f
4884 /************************************************************************/
4885 /*                           ISO2022 methods                            */
4886 /************************************************************************/
4887
4888 /* The following note describes the coding system ISO2022 briefly.
4889    Since the intention of this note is to help understand the
4890    functions in this file, some parts are NOT ACCURATE or OVERLY
4891    SIMPLIFIED.  For thorough understanding, please refer to the
4892    original document of ISO2022.
4893
4894    ISO2022 provides many mechanisms to encode several character sets
4895    in 7-bit and 8-bit environments.  For 7-bit environments, all text
4896    is encoded using bytes less than 128.  This may make the encoded
4897    text a little bit longer, but the text passes more easily through
4898    several gateways, some of which strip off MSB (Most Signigant Bit).
4899
4900    There are two kinds of character sets: control character set and
4901    graphic character set.  The former contains control characters such
4902    as `newline' and `escape' to provide control functions (control
4903    functions are also provided by escape sequences).  The latter
4904    contains graphic characters such as 'A' and '-'.  Emacs recognizes
4905    two control character sets and many graphic character sets.
4906
4907    Graphic character sets are classified into one of the following
4908    four classes, according to the number of bytes (DIMENSION) and
4909    number of characters in one dimension (CHARS) of the set:
4910    - DIMENSION1_CHARS94
4911    - DIMENSION1_CHARS96
4912    - DIMENSION2_CHARS94
4913    - DIMENSION2_CHARS96
4914
4915    In addition, each character set is assigned an identification tag,
4916    unique for each set, called "final character" (denoted as <F>
4917    hereafter).  The <F> of each character set is decided by ECMA(*)
4918    when it is registered in ISO.  The code range of <F> is 0x30..0x7F
4919    (0x30..0x3F are for private use only).
4920
4921    Note (*): ECMA = European Computer Manufacturers Association
4922
4923    Here are examples of graphic character set [NAME(<F>)]:
4924         o DIMENSION1_CHARS94 -- ASCII('B'), right-half-of-JISX0201('I'), ...
4925         o DIMENSION1_CHARS96 -- right-half-of-ISO8859-1('A'), ...
4926         o DIMENSION2_CHARS94 -- GB2312('A'), JISX0208('B'), ...
4927         o DIMENSION2_CHARS96 -- none for the moment
4928
4929    A code area (1 byte = 8 bits) is divided into 4 areas, C0, GL, C1, and GR.
4930         C0 [0x00..0x1F] -- control character plane 0
4931         GL [0x20..0x7F] -- graphic character plane 0
4932         C1 [0x80..0x9F] -- control character plane 1
4933         GR [0xA0..0xFF] -- graphic character plane 1
4934
4935    A control character set is directly designated and invoked to C0 or
4936    C1 by an escape sequence.  The most common case is that:
4937    - ISO646's  control character set is designated/invoked to C0, and
4938    - ISO6429's control character set is designated/invoked to C1,
4939    and usually these designations/invocations are omitted in encoded
4940    text.  In a 7-bit environment, only C0 can be used, and a control
4941    character for C1 is encoded by an appropriate escape sequence to
4942    fit into the environment.  All control characters for C1 are
4943    defined to have corresponding escape sequences.
4944
4945    A graphic character set is at first designated to one of four
4946    graphic registers (G0 through G3), then these graphic registers are
4947    invoked to GL or GR.  These designations and invocations can be
4948    done independently.  The most common case is that G0 is invoked to
4949    GL, G1 is invoked to GR, and ASCII is designated to G0.  Usually
4950    these invocations and designations are omitted in encoded text.
4951    In a 7-bit environment, only GL can be used.
4952
4953    When a graphic character set of CHARS94 is invoked to GL, codes
4954    0x20 and 0x7F of the GL area work as control characters SPACE and
4955    DEL respectively, and codes 0xA0 and 0xFF of the GR area should not
4956    be used.
4957
4958    There are two ways of invocation: locking-shift and single-shift.
4959    With locking-shift, the invocation lasts until the next different
4960    invocation, whereas with single-shift, the invocation affects the
4961    following character only and doesn't affect the locking-shift
4962    state.  Invocations are done by the following control characters or
4963    escape sequences:
4964
4965    ----------------------------------------------------------------------
4966    abbrev  function                  cntrl escape seq   description
4967    ----------------------------------------------------------------------
4968    SI/LS0  (shift-in)                0x0F  none         invoke G0 into GL
4969    SO/LS1  (shift-out)               0x0E  none         invoke G1 into GL
4970    LS2     (locking-shift-2)         none  ESC 'n'      invoke G2 into GL
4971    LS3     (locking-shift-3)         none  ESC 'o'      invoke G3 into GL
4972    LS1R    (locking-shift-1 right)   none  ESC '~'      invoke G1 into GR (*)
4973    LS2R    (locking-shift-2 right)   none  ESC '}'      invoke G2 into GR (*)
4974    LS3R    (locking-shift 3 right)   none  ESC '|'      invoke G3 into GR (*)
4975    SS2     (single-shift-2)          0x8E  ESC 'N'      invoke G2 for one char
4976    SS3     (single-shift-3)          0x8F  ESC 'O'      invoke G3 for one char
4977    ----------------------------------------------------------------------
4978    (*) These are not used by any known coding system.
4979
4980    Control characters for these functions are defined by macros
4981    ISO_CODE_XXX in `coding.h'.
4982
4983    Designations are done by the following escape sequences:
4984    ----------------------------------------------------------------------
4985    escape sequence      description
4986    ----------------------------------------------------------------------
4987    ESC '(' <F>          designate DIMENSION1_CHARS94<F> to G0
4988    ESC ')' <F>          designate DIMENSION1_CHARS94<F> to G1
4989    ESC '*' <F>          designate DIMENSION1_CHARS94<F> to G2
4990    ESC '+' <F>          designate DIMENSION1_CHARS94<F> to G3
4991    ESC ',' <F>          designate DIMENSION1_CHARS96<F> to G0 (*)
4992    ESC '-' <F>          designate DIMENSION1_CHARS96<F> to G1
4993    ESC '.' <F>          designate DIMENSION1_CHARS96<F> to G2
4994    ESC '/' <F>          designate DIMENSION1_CHARS96<F> to G3
4995    ESC '$' '(' <F>      designate DIMENSION2_CHARS94<F> to G0 (**)
4996    ESC '$' ')' <F>      designate DIMENSION2_CHARS94<F> to G1
4997    ESC '$' '*' <F>      designate DIMENSION2_CHARS94<F> to G2
4998    ESC '$' '+' <F>      designate DIMENSION2_CHARS94<F> to G3
4999    ESC '$' ',' <F>      designate DIMENSION2_CHARS96<F> to G0 (*)
5000    ESC '$' '-' <F>      designate DIMENSION2_CHARS96<F> to G1
5001    ESC '$' '.' <F>      designate DIMENSION2_CHARS96<F> to G2
5002    ESC '$' '/' <F>      designate DIMENSION2_CHARS96<F> to G3
5003    ----------------------------------------------------------------------
5004
5005    In this list, "DIMENSION1_CHARS94<F>" means a graphic character set
5006    of dimension 1, chars 94, and final character <F>, etc...
5007
5008    Note (*): Although these designations are not allowed in ISO2022,
5009    Emacs accepts them on decoding, and produces them on encoding
5010    CHARS96 character sets in a coding system which is characterized as
5011    7-bit environment, non-locking-shift, and non-single-shift.
5012
5013    Note (**): If <F> is '@', 'A', or 'B', the intermediate character
5014    '(' can be omitted.  We refer to this as "short-form" hereafter.
5015
5016    Now you may notice that there are a lot of ways for encoding the
5017    same multilingual text in ISO2022.  Actually, there exist many
5018    coding systems such as Compound Text (used in X11's inter client
5019    communication, ISO-2022-JP (used in Japanese internet), ISO-2022-KR
5020    (used in Korean internet), EUC (Extended UNIX Code, used in Asian
5021    localized platforms), and all of these are variants of ISO2022.
5022
5023    In addition to the above, Emacs handles two more kinds of escape
5024    sequences: ISO6429's direction specification and Emacs' private
5025    sequence for specifying character composition.
5026
5027    ISO6429's direction specification takes the following form:
5028         o CSI ']'      -- end of the current direction
5029         o CSI '0' ']'  -- end of the current direction
5030         o CSI '1' ']'  -- start of left-to-right text
5031         o CSI '2' ']'  -- start of right-to-left text
5032    The control character CSI (0x9B: control sequence introducer) is
5033    abbreviated to the escape sequence ESC '[' in a 7-bit environment.
5034
5035    Character composition specification takes the following form:
5036         o ESC '0' -- start character composition
5037         o ESC '1' -- end character composition
5038    Since these are not standard escape sequences of any ISO standard,
5039    their use with these meanings is restricted to Emacs only.  */
5040
5041 static void
5042 reset_iso2022 (Lisp_Object coding_system, struct iso2022_decoder *iso)
5043 {
5044   int i;
5045
5046   for (i = 0; i < 4; i++)
5047     {
5048       if (!NILP (coding_system))
5049         iso->charset[i] =
5050           XCODING_SYSTEM_ISO2022_INITIAL_CHARSET (coding_system, i);
5051       else
5052         iso->charset[i] = Qt;
5053       iso->invalid_designated[i] = 0;
5054     }
5055   iso->esc = ISO_ESC_NOTHING;
5056   iso->esc_bytes_index = 0;
5057   iso->register_left = 0;
5058   iso->register_right = 1;
5059   iso->switched_dir_and_no_valid_charset_yet = 0;
5060   iso->invalid_switch_dir = 0;
5061   iso->output_direction_sequence = 0;
5062   iso->output_literally = 0;
5063 #ifdef ENABLE_COMPOSITE_CHARS
5064   if (iso->composite_chars)
5065     Dynarr_reset (iso->composite_chars);
5066 #endif
5067 }
5068
5069 static int
5070 fit_to_be_escape_quoted (unsigned char c)
5071 {
5072   switch (c)
5073     {
5074     case ISO_CODE_ESC:
5075     case ISO_CODE_CSI:
5076     case ISO_CODE_SS2:
5077     case ISO_CODE_SS3:
5078     case ISO_CODE_SO:
5079     case ISO_CODE_SI:
5080       return 1;
5081
5082     default:
5083       return 0;
5084     }
5085 }
5086
5087 /* Parse one byte of an ISO2022 escape sequence.
5088    If the result is an invalid escape sequence, return 0 and
5089    do not change anything in STR.  Otherwise, if the result is
5090    an incomplete escape sequence, update ISO2022.ESC and
5091    ISO2022.ESC_BYTES and return -1.  Otherwise, update
5092    all the state variables (but not ISO2022.ESC_BYTES) and
5093    return 1.
5094
5095    If CHECK_INVALID_CHARSETS is non-zero, check for designation
5096    or invocation of an invalid character set and treat that as
5097    an unrecognized escape sequence. */
5098
5099 static int
5100 parse_iso2022_esc (Lisp_Object codesys, struct iso2022_decoder *iso,
5101                    unsigned char c, unsigned int *flags,
5102                    int check_invalid_charsets)
5103 {
5104   /* (1) If we're at the end of a designation sequence, CS is the
5105      charset being designated and REG is the register to designate
5106      it to.
5107
5108      (2) If we're at the end of a locking-shift sequence, REG is
5109      the register to invoke and HALF (0 == left, 1 == right) is
5110      the half to invoke it into.
5111
5112      (3) If we're at the end of a single-shift sequence, REG is
5113      the register to invoke. */
5114   Lisp_Object cs = Qnil;
5115   int reg, half;
5116
5117   /* NOTE: This code does goto's all over the fucking place.
5118      The reason for this is that we're basically implementing
5119      a state machine here, and hierarchical languages like C
5120      don't really provide a clean way of doing this. */
5121
5122   if (! (*flags & CODING_STATE_ESCAPE))
5123     /* At beginning of escape sequence; we need to reset our
5124        escape-state variables. */
5125     iso->esc = ISO_ESC_NOTHING;
5126
5127   iso->output_literally = 0;
5128   iso->output_direction_sequence = 0;
5129
5130   switch (iso->esc)
5131     {
5132     case ISO_ESC_NOTHING:
5133       iso->esc_bytes_index = 0;
5134       switch (c)
5135         {
5136         case ISO_CODE_ESC:      /* Start escape sequence */
5137           *flags |= CODING_STATE_ESCAPE;
5138           iso->esc = ISO_ESC;
5139           goto not_done;
5140
5141         case ISO_CODE_CSI:      /* ISO6429 (specifying directionality) */
5142           *flags |= CODING_STATE_ESCAPE;
5143           iso->esc = ISO_ESC_5_11;
5144           goto not_done;
5145
5146         case ISO_CODE_SO:       /* locking shift 1 */
5147           reg = 1; half = 0;
5148           goto locking_shift;
5149         case ISO_CODE_SI:       /* locking shift 0 */
5150           reg = 0; half = 0;
5151           goto locking_shift;
5152
5153         case ISO_CODE_SS2:      /* single shift */
5154           reg = 2;
5155           goto single_shift;
5156         case ISO_CODE_SS3:      /* single shift */
5157           reg = 3;
5158           goto single_shift;
5159
5160         default:                        /* Other control characters */
5161           return 0;
5162         }
5163
5164     case ISO_ESC:
5165       switch (c)
5166         {
5167           /**** single shift ****/
5168
5169         case 'N':       /* single shift 2 */
5170           reg = 2;
5171           goto single_shift;
5172         case 'O':       /* single shift 3 */
5173           reg = 3;
5174           goto single_shift;
5175
5176           /**** locking shift ****/
5177
5178         case '~':       /* locking shift 1 right */
5179           reg = 1; half = 1;
5180           goto locking_shift;
5181         case 'n':       /* locking shift 2 */
5182           reg = 2; half = 0;
5183           goto locking_shift;
5184         case '}':       /* locking shift 2 right */
5185           reg = 2; half = 1;
5186           goto locking_shift;
5187         case 'o':       /* locking shift 3 */
5188           reg = 3; half = 0;
5189           goto locking_shift;
5190         case '|':       /* locking shift 3 right */
5191           reg = 3; half = 1;
5192           goto locking_shift;
5193
5194 #ifdef ENABLE_COMPOSITE_CHARS
5195           /**** composite ****/
5196
5197         case '0':
5198           iso->esc = ISO_ESC_START_COMPOSITE;
5199           *flags = (*flags & CODING_STATE_ISO2022_LOCK) |
5200             CODING_STATE_COMPOSITE;
5201           return 1;
5202
5203         case '1':
5204           iso->esc = ISO_ESC_END_COMPOSITE;
5205           *flags = (*flags & CODING_STATE_ISO2022_LOCK) &
5206             ~CODING_STATE_COMPOSITE;
5207           return 1;
5208 #endif /* ENABLE_COMPOSITE_CHARS */
5209
5210           /**** directionality ****/
5211
5212         case '[':
5213           iso->esc = ISO_ESC_5_11;
5214           goto not_done;
5215
5216           /**** designation ****/
5217
5218         case '$':       /* multibyte charset prefix */
5219           iso->esc = ISO_ESC_2_4;
5220           goto not_done;
5221
5222         default:
5223           if (0x28 <= c && c <= 0x2F)
5224             {
5225               iso->esc = (enum iso_esc_flag) (c - 0x28 + ISO_ESC_2_8);
5226               goto not_done;
5227             }
5228
5229           /* This function is called with CODESYS equal to nil when
5230              doing coding-system detection. */
5231           if (!NILP (codesys)
5232               && XCODING_SYSTEM_ISO2022_ESCAPE_QUOTED (codesys)
5233               && fit_to_be_escape_quoted (c))
5234             {
5235               iso->esc = ISO_ESC_LITERAL;
5236               *flags &= CODING_STATE_ISO2022_LOCK;
5237               return 1;
5238             }
5239
5240           /* bzzzt! */
5241           return 0;
5242         }
5243
5244
5245
5246       /**** directionality ****/
5247
5248     case ISO_ESC_5_11:          /* ISO6429 direction control */
5249       if (c == ']')
5250         {
5251           *flags &= (CODING_STATE_ISO2022_LOCK & ~CODING_STATE_R2L);
5252           goto directionality;
5253         }
5254       if      (c == '0') iso->esc = ISO_ESC_5_11_0;
5255       else if (c == '1') iso->esc = ISO_ESC_5_11_1;
5256       else if (c == '2') iso->esc = ISO_ESC_5_11_2;
5257       else               return 0;
5258       goto not_done;
5259
5260     case ISO_ESC_5_11_0:
5261       if (c == ']')
5262         {
5263           *flags &= (CODING_STATE_ISO2022_LOCK & ~CODING_STATE_R2L);
5264           goto directionality;
5265         }
5266       return 0;
5267
5268     case ISO_ESC_5_11_1:
5269       if (c == ']')
5270         {
5271           *flags = (CODING_STATE_ISO2022_LOCK & ~CODING_STATE_R2L);
5272           goto directionality;
5273         }
5274       return 0;
5275
5276     case ISO_ESC_5_11_2:
5277       if (c == ']')
5278         {
5279           *flags = (*flags & CODING_STATE_ISO2022_LOCK) | CODING_STATE_R2L;
5280           goto directionality;
5281         }
5282       return 0;
5283
5284     directionality:
5285       iso->esc = ISO_ESC_DIRECTIONALITY;
5286       /* Various junk here to attempt to preserve the direction sequences
5287          literally in the text if they would otherwise be swallowed due
5288          to invalid designations that don't show up as actual charset
5289          changes in the text. */
5290       if (iso->invalid_switch_dir)
5291         {
5292           /* We already inserted a direction switch literally into the
5293              text.  We assume (#### this may not be right) that the
5294              next direction switch is the one going the other way,
5295              and we need to output that literally as well. */
5296           iso->output_literally = 1;
5297           iso->invalid_switch_dir = 0;
5298         }
5299       else
5300         {
5301           int jj;
5302
5303           /* If we are in the thrall of an invalid designation,
5304            then stick the directionality sequence literally into the
5305            output stream so it ends up in the original text again. */
5306           for (jj = 0; jj < 4; jj++)
5307             if (iso->invalid_designated[jj])
5308               break;
5309           if (jj < 4)
5310             {
5311               iso->output_literally = 1;
5312               iso->invalid_switch_dir = 1;
5313             }
5314           else
5315             /* Indicate that we haven't yet seen a valid designation,
5316                so that if a switch-dir is directly followed by an
5317                invalid designation, both get inserted literally. */
5318             iso->switched_dir_and_no_valid_charset_yet = 1;
5319         }
5320       return 1;
5321
5322
5323       /**** designation ****/
5324
5325     case ISO_ESC_2_4:
5326       if (0x28 <= c && c <= 0x2F)
5327         {
5328           iso->esc = (enum iso_esc_flag) (c - 0x28 + ISO_ESC_2_4_8);
5329           goto not_done;
5330         }
5331       if (0x40 <= c && c <= 0x42)
5332         {
5333           /* 94^n-set */
5334           cs = CHARSET_BY_ATTRIBUTES (94, -1, c,
5335                                       *flags & CODING_STATE_R2L ?
5336                                       CHARSET_RIGHT_TO_LEFT :
5337                                       CHARSET_LEFT_TO_RIGHT);
5338           reg = 0;
5339           goto designated;
5340         }
5341       return 0;
5342
5343     default:
5344       {
5345         int chars = 0;
5346         int single = 0;
5347
5348         if (c < '0' || c > '~')
5349           return 0; /* bad final byte */
5350
5351         if (iso->esc >= ISO_ESC_2_8 &&
5352             iso->esc <= ISO_ESC_2_15)
5353           {
5354             chars = (iso->esc >= ISO_ESC_2_12) ? 96 : 94;
5355             single = 1; /* single-byte */
5356             reg = (iso->esc - ISO_ESC_2_8) & 3;
5357           }
5358         else if (iso->esc >= ISO_ESC_2_4_8 &&
5359                  iso->esc <= ISO_ESC_2_4_15)
5360           {
5361             chars = (iso->esc >= ISO_ESC_2_4_12) ? 96 : 94;
5362             single = -1; /* multi-byte */
5363             reg = (iso->esc - ISO_ESC_2_4_8) & 3;
5364           }
5365         else
5366           {
5367             /* Can this ever be reached? -slb */
5368             abort();
5369           }
5370
5371         cs = CHARSET_BY_ATTRIBUTES (chars, single, c,
5372                                     *flags & CODING_STATE_R2L ?
5373                                     CHARSET_RIGHT_TO_LEFT :
5374                                     CHARSET_LEFT_TO_RIGHT);
5375         goto designated;
5376       }
5377     }
5378
5379  not_done:
5380   iso->esc_bytes[iso->esc_bytes_index++] = (unsigned char) c;
5381   return -1;
5382
5383  single_shift:
5384   if (check_invalid_charsets && !CHARSETP (iso->charset[reg]))
5385     /* can't invoke something that ain't there. */
5386     return 0;
5387   iso->esc = ISO_ESC_SINGLE_SHIFT;
5388   *flags &= CODING_STATE_ISO2022_LOCK;
5389   if (reg == 2)
5390     *flags |= CODING_STATE_SS2;
5391   else
5392     *flags |= CODING_STATE_SS3;
5393   return 1;
5394
5395  locking_shift:
5396   if (check_invalid_charsets &&
5397       !CHARSETP (iso->charset[reg]))
5398     /* can't invoke something that ain't there. */
5399     return 0;
5400   if (half)
5401     iso->register_right = reg;
5402   else
5403     iso->register_left = reg;
5404   *flags &= CODING_STATE_ISO2022_LOCK;
5405   iso->esc = ISO_ESC_LOCKING_SHIFT;
5406   return 1;
5407
5408  designated:
5409   if (NILP (cs) && check_invalid_charsets)
5410     {
5411       iso->invalid_designated[reg] = 1;
5412       iso->charset[reg] = Vcharset_ascii;
5413       iso->esc = ISO_ESC_DESIGNATE;
5414       *flags &= CODING_STATE_ISO2022_LOCK;
5415       iso->output_literally = 1;
5416       if (iso->switched_dir_and_no_valid_charset_yet)
5417         {
5418           /* We encountered a switch-direction followed by an
5419              invalid designation.  Ensure that the switch-direction
5420              gets outputted; otherwise it will probably get eaten
5421              when the text is written out again. */
5422           iso->switched_dir_and_no_valid_charset_yet = 0;
5423           iso->output_direction_sequence = 1;
5424           /* And make sure that the switch-dir going the other
5425              way gets outputted, as well. */
5426           iso->invalid_switch_dir = 1;
5427         }
5428       return 1;
5429     }
5430   /* This function is called with CODESYS equal to nil when
5431      doing coding-system detection. */
5432   if (!NILP (codesys))
5433     {
5434       charset_conversion_spec_dynarr *dyn =
5435         XCODING_SYSTEM (codesys)->iso2022.input_conv;
5436
5437       if (dyn)
5438         {
5439           int i;
5440
5441           for (i = 0; i < Dynarr_length (dyn); i++)
5442             {
5443               struct charset_conversion_spec *spec = Dynarr_atp (dyn, i);
5444               if (EQ (cs, spec->from_charset))
5445                 cs = spec->to_charset;
5446             }
5447         }
5448     }
5449
5450   iso->charset[reg] = cs;
5451   iso->esc = ISO_ESC_DESIGNATE;
5452   *flags &= CODING_STATE_ISO2022_LOCK;
5453   if (iso->invalid_designated[reg])
5454     {
5455       iso->invalid_designated[reg] = 0;
5456       iso->output_literally = 1;
5457     }
5458   if (iso->switched_dir_and_no_valid_charset_yet)
5459     iso->switched_dir_and_no_valid_charset_yet = 0;
5460   return 1;
5461 }
5462
5463 static int
5464 detect_coding_iso2022 (struct detection_state *st, const Extbyte *src, Lstream_data_count n)
5465 {
5466   int mask;
5467
5468   /* #### There are serious deficiencies in the recognition mechanism
5469      here.  This needs to be much smarter if it's going to cut it.
5470      The sequence "\xff\x0f" is currently detected as LOCK_SHIFT while
5471      it should be detected as Latin-1.
5472      All the ISO2022 stuff in this file should be synced up with the
5473      code from FSF Emacs-20.4, in which Mule should be more or less stable.
5474      Perhaps we should wait till R2L works in FSF Emacs? */
5475
5476   if (!st->iso2022.initted)
5477     {
5478       reset_iso2022 (Qnil, &st->iso2022.iso);
5479       st->iso2022.mask = (CODING_CATEGORY_ISO_7_MASK |
5480                           CODING_CATEGORY_ISO_8_DESIGNATE_MASK |
5481                           CODING_CATEGORY_ISO_8_1_MASK |
5482                           CODING_CATEGORY_ISO_8_2_MASK |
5483                           CODING_CATEGORY_ISO_LOCK_SHIFT_MASK);
5484       st->iso2022.flags = 0;
5485       st->iso2022.high_byte_count = 0;
5486       st->iso2022.saw_single_shift = 0;
5487       st->iso2022.initted = 1;
5488     }
5489
5490   mask = st->iso2022.mask;
5491
5492   while (n--)
5493     {
5494       unsigned char c = *(unsigned char *)src++;
5495       if (c >= 0xA0)
5496         {
5497           mask &= ~CODING_CATEGORY_ISO_7_MASK;
5498           st->iso2022.high_byte_count++;
5499         }
5500       else
5501         {
5502           if (st->iso2022.high_byte_count && !st->iso2022.saw_single_shift)
5503             {
5504               if (st->iso2022.high_byte_count & 1)
5505                 /* odd number of high bytes; assume not iso-8-2 */
5506                 mask &= ~CODING_CATEGORY_ISO_8_2_MASK;
5507             }
5508           st->iso2022.high_byte_count = 0;
5509           st->iso2022.saw_single_shift = 0;
5510           if (c > 0x80)
5511             mask &= ~CODING_CATEGORY_ISO_7_MASK;
5512         }
5513       if (!(st->iso2022.flags & CODING_STATE_ESCAPE)
5514           && (BYTE_C0_P (c) || BYTE_C1_P (c)))
5515         { /* control chars */
5516           switch (c)
5517             {
5518               /* Allow and ignore control characters that you might
5519                  reasonably see in a text file */
5520             case '\r':
5521             case '\n':
5522             case '\t':
5523             case  7: /* bell */
5524             case  8: /* backspace */
5525             case 11: /* vertical tab */
5526             case 12: /* form feed */
5527             case 26: /* MS-DOS C-z junk */
5528             case 31: /* '^_' -- for info */
5529               goto label_continue_loop;
5530
5531             default:
5532               break;
5533             }
5534         }
5535
5536       if ((st->iso2022.flags & CODING_STATE_ESCAPE) || BYTE_C0_P (c)
5537           || BYTE_C1_P (c))
5538         {
5539           if (parse_iso2022_esc (Qnil, &st->iso2022.iso, c,
5540                                  &st->iso2022.flags, 0))
5541             {
5542               switch (st->iso2022.iso.esc)
5543                 {
5544                 case ISO_ESC_DESIGNATE:
5545                   mask &= ~CODING_CATEGORY_ISO_8_1_MASK;
5546                   mask &= ~CODING_CATEGORY_ISO_8_2_MASK;
5547                   break;
5548                 case ISO_ESC_LOCKING_SHIFT:
5549                   mask = CODING_CATEGORY_ISO_LOCK_SHIFT_MASK;
5550                   goto ran_out_of_chars;
5551                 case ISO_ESC_SINGLE_SHIFT:
5552                   mask &= ~CODING_CATEGORY_ISO_8_DESIGNATE_MASK;
5553                   st->iso2022.saw_single_shift = 1;
5554                   break;
5555                 default:
5556                   break;
5557                 }
5558             }
5559           else
5560             {
5561               mask = 0;
5562               goto ran_out_of_chars;
5563             }
5564         }
5565     label_continue_loop:;
5566     }
5567
5568  ran_out_of_chars:
5569
5570   return mask;
5571 }
5572
5573 static int
5574 postprocess_iso2022_mask (int mask)
5575 {
5576   /* #### kind of cheesy */
5577   /* If seven-bit ISO is allowed, then assume that the encoding is
5578      entirely seven-bit and turn off the eight-bit ones. */
5579   if (mask & CODING_CATEGORY_ISO_7_MASK)
5580     mask &= ~ (CODING_CATEGORY_ISO_8_DESIGNATE_MASK |
5581                CODING_CATEGORY_ISO_8_1_MASK |
5582                CODING_CATEGORY_ISO_8_2_MASK);
5583   return mask;
5584 }
5585
5586 /* If FLAGS is a null pointer or specifies right-to-left motion,
5587    output a switch-dir-to-left-to-right sequence to DST.
5588    Also update FLAGS if it is not a null pointer.
5589    If INTERNAL_P is set, we are outputting in internal format and
5590    need to handle the CSI differently. */
5591
5592 static void
5593 restore_left_to_right_direction (Lisp_Coding_System *codesys,
5594                                  unsigned_char_dynarr *dst,
5595                                  unsigned int *flags,
5596                                  int internal_p)
5597 {
5598   if (!flags || (*flags & CODING_STATE_R2L))
5599     {
5600       if (CODING_SYSTEM_ISO2022_SEVEN (codesys))
5601         {
5602           Dynarr_add (dst, ISO_CODE_ESC);
5603           Dynarr_add (dst, '[');
5604         }
5605       else if (internal_p)
5606         DECODE_ADD_BINARY_CHAR (ISO_CODE_CSI, dst);
5607       else
5608         Dynarr_add (dst, ISO_CODE_CSI);
5609       Dynarr_add (dst, '0');
5610       Dynarr_add (dst, ']');
5611       if (flags)
5612         *flags &= ~CODING_STATE_R2L;
5613     }
5614 }
5615
5616 /* If FLAGS is a null pointer or specifies a direction different from
5617    DIRECTION (which should be either CHARSET_RIGHT_TO_LEFT or
5618    CHARSET_LEFT_TO_RIGHT), output the appropriate switch-dir escape
5619    sequence to DST.  Also update FLAGS if it is not a null pointer.
5620    If INTERNAL_P is set, we are outputting in internal format and
5621    need to handle the CSI differently. */
5622
5623 static void
5624 ensure_correct_direction (int direction, Lisp_Coding_System *codesys,
5625                           unsigned_char_dynarr *dst, unsigned int *flags,
5626                           int internal_p)
5627 {
5628   if ((!flags || (*flags & CODING_STATE_R2L)) &&
5629       direction == CHARSET_LEFT_TO_RIGHT)
5630     restore_left_to_right_direction (codesys, dst, flags, internal_p);
5631   else if (!CODING_SYSTEM_ISO2022_NO_ISO6429 (codesys)
5632            && (!flags || !(*flags & CODING_STATE_R2L)) &&
5633            direction == CHARSET_RIGHT_TO_LEFT)
5634     {
5635       if (CODING_SYSTEM_ISO2022_SEVEN (codesys))
5636         {
5637           Dynarr_add (dst, ISO_CODE_ESC);
5638           Dynarr_add (dst, '[');
5639         }
5640       else if (internal_p)
5641         DECODE_ADD_BINARY_CHAR (ISO_CODE_CSI, dst);
5642       else
5643         Dynarr_add (dst, ISO_CODE_CSI);
5644       Dynarr_add (dst, '2');
5645       Dynarr_add (dst, ']');
5646       if (flags)
5647         *flags |= CODING_STATE_R2L;
5648     }
5649 }
5650
5651 /* Convert ISO2022-format data to internal format. */
5652
5653 static void
5654 decode_coding_iso2022 (Lstream *decoding, const Extbyte *src,
5655                        unsigned_char_dynarr *dst, Lstream_data_count n)
5656 {
5657   struct decoding_stream *str = DECODING_STREAM_DATA (decoding);
5658   unsigned int flags    = str->flags;
5659   unsigned int cpos     = str->cpos;
5660   unsigned char counter = str->counter;
5661   eol_type_t eol_type   = str->eol_type;
5662 #ifdef ENABLE_COMPOSITE_CHARS
5663   unsigned_char_dynarr *real_dst = dst;
5664 #endif
5665   Lisp_Object coding_system;
5666
5667   XSETCODING_SYSTEM (coding_system, str->codesys);
5668
5669 #ifdef ENABLE_COMPOSITE_CHARS
5670   if (flags & CODING_STATE_COMPOSITE)
5671     dst = str->iso2022.composite_chars;
5672 #endif /* ENABLE_COMPOSITE_CHARS */
5673
5674   while (n--)
5675     {
5676       unsigned char c = *(unsigned char *)src++;
5677       if (flags & CODING_STATE_ESCAPE)
5678         {       /* Within ESC sequence */
5679           int retval = parse_iso2022_esc (coding_system, &str->iso2022,
5680                                           c, &flags, 1);
5681
5682           if (retval)
5683             {
5684               switch (str->iso2022.esc)
5685                 {
5686 #ifdef ENABLE_COMPOSITE_CHARS
5687                 case ISO_ESC_START_COMPOSITE:
5688                   if (str->iso2022.composite_chars)
5689                     Dynarr_reset (str->iso2022.composite_chars);
5690                   else
5691                     str->iso2022.composite_chars = Dynarr_new (unsigned_char);
5692                   dst = str->iso2022.composite_chars;
5693                   break;
5694                 case ISO_ESC_END_COMPOSITE:
5695                   {
5696                     Bufbyte comstr[MAX_EMCHAR_LEN];
5697                     Bytecount len;
5698                     Emchar emch = lookup_composite_char (Dynarr_atp (dst, 0),
5699                                                          Dynarr_length (dst));
5700                     dst = real_dst;
5701                     len = set_charptr_emchar (comstr, emch);
5702                     Dynarr_add_many (dst, comstr, len);
5703                     break;
5704                   }
5705 #endif /* ENABLE_COMPOSITE_CHARS */
5706
5707                 case ISO_ESC_LITERAL:
5708                   COMPOSE_FLUSH_CHARS (str, dst);
5709                   decode_flush_er_chars (str, dst);
5710                   DECODE_ADD_BINARY_CHAR (c, dst);
5711                   break;
5712
5713                 default:
5714                   /* Everything else handled already */
5715                   break;
5716                 }
5717             }
5718
5719           /* Attempted error recovery. */
5720           if (str->iso2022.output_direction_sequence)
5721             ensure_correct_direction (flags & CODING_STATE_R2L ?
5722                                       CHARSET_RIGHT_TO_LEFT :
5723                                       CHARSET_LEFT_TO_RIGHT,
5724                                       str->codesys, dst, 0, 1);
5725           /* More error recovery. */
5726           if (!retval || str->iso2022.output_literally)
5727             {
5728               /* Output the (possibly invalid) sequence */
5729               int i;
5730               COMPOSE_FLUSH_CHARS (str, dst);
5731               decode_flush_er_chars (str, dst);
5732               for (i = 0; i < str->iso2022.esc_bytes_index; i++)
5733                 DECODE_ADD_BINARY_CHAR (str->iso2022.esc_bytes[i], dst);
5734               flags &= CODING_STATE_ISO2022_LOCK;
5735               if (!retval)
5736                 n++, src--;/* Repeat the loop with the same character. */
5737               else
5738                 {
5739                   /* No sense in reprocessing the final byte of the
5740                      escape sequence; it could mess things up anyway.
5741                      Just add it now. */
5742                   COMPOSE_FLUSH_CHARS (str, dst);
5743                   decode_flush_er_chars (str, dst);
5744                   DECODE_ADD_BINARY_CHAR (c, dst);
5745                 }
5746             }
5747           cpos = 0;
5748           counter = 0;
5749         }
5750       else if (BYTE_C0_P (c) || BYTE_C1_P (c))
5751         { /* Control characters */
5752
5753           /***** Error-handling *****/
5754
5755           /* If we were in the middle of a character, dump out the
5756              partial character. */
5757           if (counter)
5758             {
5759               COMPOSE_FLUSH_CHARS (str, dst);
5760               decode_flush_er_chars (str, dst);
5761               while (counter > 0)
5762                 {
5763                   counter--;
5764                   DECODE_ADD_BINARY_CHAR
5765                     ((unsigned char)(cpos >> (counter * 8)), dst);
5766                 }
5767               cpos = 0;
5768             }
5769
5770           /* If we just saw a single-shift character, dump it out.
5771              This may dump out the wrong sort of single-shift character,
5772              but least it will give an indication that something went
5773              wrong. */
5774           if (flags & CODING_STATE_SS2)
5775             {
5776               COMPOSE_FLUSH_CHARS (str, dst);
5777               decode_flush_er_chars (str, dst);
5778               DECODE_ADD_BINARY_CHAR (ISO_CODE_SS2, dst);
5779               flags &= ~CODING_STATE_SS2;
5780             }
5781           if (flags & CODING_STATE_SS3)
5782             {
5783               COMPOSE_FLUSH_CHARS (str, dst);
5784               decode_flush_er_chars (str, dst);
5785               DECODE_ADD_BINARY_CHAR (ISO_CODE_SS3, dst);
5786               flags &= ~CODING_STATE_SS3;
5787             }
5788
5789           /***** Now handle the control characters. *****/
5790
5791           /* Handle CR/LF */
5792 #ifdef UTF2000
5793           if (c == '\r')
5794             {
5795               COMPOSE_FLUSH_CHARS (str, dst);
5796               decode_flush_er_chars (str, dst);
5797               if (eol_type == EOL_CR)
5798                 Dynarr_add (dst, '\n');
5799               else if (eol_type != EOL_CRLF || flags & CODING_STATE_CR)
5800                 Dynarr_add (dst, c);
5801               else
5802                 flags |= CODING_STATE_CR;
5803               goto label_continue_loop;
5804             }
5805           else if (flags & CODING_STATE_CR)
5806             {   /* eol_type == CODING_SYSTEM_EOL_CRLF */
5807               if (c != '\n')
5808                 Dynarr_add (dst, '\r');
5809               flags &= ~CODING_STATE_CR;
5810             }
5811 #else
5812           DECODE_HANDLE_EOL_TYPE (eol_type, c, flags, dst);
5813 #endif
5814
5815           flags &= CODING_STATE_ISO2022_LOCK;
5816
5817           if (!parse_iso2022_esc (coding_system, &str->iso2022, c, &flags, 1))
5818             {
5819               COMPOSE_FLUSH_CHARS (str, dst);
5820               decode_flush_er_chars (str, dst);
5821               DECODE_ADD_BINARY_CHAR (c, dst);
5822             }
5823         }
5824       else
5825         {                       /* Graphic characters */
5826           Lisp_Object charset;
5827 #ifndef UTF2000
5828           Charset_ID lb;
5829 #endif
5830           int reg;
5831
5832 #ifdef UTF2000
5833           if (c == '\r')
5834             {
5835               COMPOSE_FLUSH_CHARS (str, dst);
5836               decode_flush_er_chars (str, dst);
5837               if (eol_type == EOL_CR)
5838                 Dynarr_add (dst, '\n');
5839               else if (eol_type != EOL_CRLF || flags & CODING_STATE_CR)
5840                 Dynarr_add (dst, c);
5841               else
5842                 flags |= CODING_STATE_CR;
5843               goto label_continue_loop;
5844             }
5845           else if (flags & CODING_STATE_CR)
5846             {   /* eol_type == CODING_SYSTEM_EOL_CRLF */
5847               if (c != '\n')
5848                 Dynarr_add (dst, '\r');
5849               flags &= ~CODING_STATE_CR;
5850             }
5851 #else
5852           DECODE_HANDLE_EOL_TYPE (eol_type, c, flags, dst);
5853 #endif
5854
5855           /* Now determine the charset. */
5856           reg = ((flags & CODING_STATE_SS2) ? 2
5857                  : (flags & CODING_STATE_SS3) ? 3
5858                  : !BYTE_ASCII_P (c) ? str->iso2022.register_right
5859                  : str->iso2022.register_left);
5860           charset = str->iso2022.charset[reg];
5861
5862           /* Error checking: */
5863           if (! CHARSETP (charset)
5864               || str->iso2022.invalid_designated[reg]
5865               || (((c & 0x7F) == ' ' || (c & 0x7F) == ISO_CODE_DEL)
5866                   && XCHARSET_CHARS (charset) == 94))
5867             /* Mrmph.  We are trying to invoke a register that has no
5868                or an invalid charset in it, or trying to add a character
5869                outside the range of the charset.  Insert that char literally
5870                to preserve it for the output. */
5871             {
5872               COMPOSE_FLUSH_CHARS (str, dst);
5873               decode_flush_er_chars (str, dst);
5874               while (counter > 0)
5875                 {
5876                   counter--;
5877                   DECODE_ADD_BINARY_CHAR
5878                     ((unsigned char)(cpos >> (counter * 8)), dst);
5879                 }
5880               cpos = 0;
5881               DECODE_ADD_BINARY_CHAR (c, dst);
5882             }
5883
5884           else
5885             {
5886               /* Things are probably hunky-dorey. */
5887
5888               /* Fetch reverse charset, maybe. */
5889               if (((flags & CODING_STATE_R2L) &&
5890                    XCHARSET_DIRECTION (charset) == CHARSET_LEFT_TO_RIGHT)
5891                   ||
5892                   (!(flags & CODING_STATE_R2L) &&
5893                    XCHARSET_DIRECTION (charset) == CHARSET_RIGHT_TO_LEFT))
5894                 {
5895                   Lisp_Object new_charset =
5896                     XCHARSET_REVERSE_DIRECTION_CHARSET (charset);
5897                   if (!NILP (new_charset))
5898                     charset = new_charset;
5899                 }
5900
5901 #ifdef UTF2000
5902               counter++;
5903               if (XCHARSET_DIMENSION (charset) == counter)
5904                 {
5905                   COMPOSE_ADD_CHAR (str,
5906                                     DECODE_CHAR (charset,
5907                                                  ((cpos & 0x7F7F7F) << 8)
5908                                                  | (c & 0x7F), 0),
5909                                     dst);
5910                   cpos = 0;
5911                   counter = 0;
5912                 }
5913               else
5914                 cpos = (cpos << 8) | c;
5915 #else
5916               lb = XCHARSET_LEADING_BYTE (charset);
5917               switch (XCHARSET_REP_BYTES (charset))
5918                 {
5919                 case 1: /* ASCII */
5920                   DECODE_OUTPUT_PARTIAL_CHAR (ch);
5921                   Dynarr_add (dst, c & 0x7F);
5922                   break;
5923
5924                 case 2: /* one-byte official */
5925                   DECODE_OUTPUT_PARTIAL_CHAR (ch);
5926                   Dynarr_add (dst, lb);
5927                   Dynarr_add (dst, c | 0x80);
5928                   break;
5929
5930                 case 3: /* one-byte private or two-byte official */
5931                   if (XCHARSET_PRIVATE_P (charset))
5932                     {
5933                       DECODE_OUTPUT_PARTIAL_CHAR (ch);
5934                       Dynarr_add (dst, PRE_LEADING_BYTE_PRIVATE_1);
5935                       Dynarr_add (dst, lb);
5936                       Dynarr_add (dst, c | 0x80);
5937                     }
5938                   else
5939                     {
5940                       if (ch)
5941                         {
5942                           Dynarr_add (dst, lb);
5943                           Dynarr_add (dst, ch | 0x80);
5944                           Dynarr_add (dst, c | 0x80);
5945                           ch = 0;
5946                         }
5947                       else
5948                         ch = c;
5949                     }
5950                   break;
5951
5952                 default:        /* two-byte private */
5953                   if (ch)
5954                     {
5955                       Dynarr_add (dst, PRE_LEADING_BYTE_PRIVATE_2);
5956                       Dynarr_add (dst, lb);
5957                       Dynarr_add (dst, ch | 0x80);
5958                       Dynarr_add (dst, c | 0x80);
5959                       ch = 0;
5960                     }
5961                   else
5962                     ch = c;
5963                 }
5964 #endif
5965             }
5966
5967           if (!cpos)
5968             flags &= CODING_STATE_ISO2022_LOCK;
5969         }
5970
5971     label_continue_loop:;
5972     }
5973
5974   if (flags & CODING_STATE_END)
5975     {
5976       COMPOSE_FLUSH_CHARS (str, dst);
5977       decode_flush_er_chars (str, dst);
5978       DECODE_OUTPUT_PARTIAL_CHAR (cpos);
5979     }
5980   str->flags   = flags;
5981   str->cpos    = cpos;
5982   str->counter = counter;
5983 }
5984
5985
5986 /***** ISO2022 encoder *****/
5987
5988 /* Designate CHARSET into register REG. */
5989
5990 static void
5991 iso2022_designate (Lisp_Object charset, unsigned char reg,
5992                    struct encoding_stream *str, unsigned_char_dynarr *dst)
5993 {
5994   static const char inter94[] = "()*+";
5995   static const char inter96[] = ",-./";
5996   unsigned short chars;
5997   unsigned char dimension;
5998   unsigned char final;
5999   Lisp_Object old_charset = str->iso2022.charset[reg];
6000
6001   str->iso2022.charset[reg] = charset;
6002   if (!CHARSETP (charset))
6003     /* charset might be an initial nil or t. */
6004     return;
6005   chars = XCHARSET_CHARS (charset);
6006   dimension = XCHARSET_DIMENSION (charset);
6007   final = XCHARSET_FINAL (charset);
6008   if (!str->iso2022.force_charset_on_output[reg] &&
6009       CHARSETP (old_charset) &&
6010       XCHARSET_CHARS (old_charset) == chars &&
6011       XCHARSET_DIMENSION (old_charset) == dimension &&
6012       XCHARSET_FINAL (old_charset) == final)
6013     return;
6014
6015   str->iso2022.force_charset_on_output[reg] = 0;
6016
6017   {
6018     charset_conversion_spec_dynarr *dyn =
6019       str->codesys->iso2022.output_conv;
6020
6021     if (dyn)
6022       {
6023         int i;
6024
6025         for (i = 0; i < Dynarr_length (dyn); i++)
6026           {
6027             struct charset_conversion_spec *spec = Dynarr_atp (dyn, i);
6028             if (EQ (charset, spec->from_charset))
6029                 charset = spec->to_charset;
6030           }
6031       }
6032   }
6033
6034   Dynarr_add (dst, ISO_CODE_ESC);
6035   switch (chars)
6036     {
6037     case 94:
6038       if (dimension == 1)
6039         Dynarr_add (dst, inter94[reg]);
6040       else
6041         {
6042           Dynarr_add (dst, '$');
6043           if (reg != 0
6044               || !(CODING_SYSTEM_ISO2022_SHORT (str->codesys))
6045               || final < '@'
6046               || final > 'B')
6047             Dynarr_add (dst, inter94[reg]);
6048         }
6049       break;
6050     case 96:
6051       if (dimension == 1)
6052         Dynarr_add (dst, inter96[reg]);
6053       else
6054         {
6055           Dynarr_add (dst, '$');
6056           Dynarr_add (dst, inter96[reg]);
6057         }
6058       break;
6059     }
6060   Dynarr_add (dst, final);
6061 }
6062
6063 static void
6064 ensure_normal_shift (struct encoding_stream *str, unsigned_char_dynarr *dst)
6065 {
6066   if (str->iso2022.register_left != 0)
6067     {
6068       Dynarr_add (dst, ISO_CODE_SI);
6069       str->iso2022.register_left = 0;
6070     }
6071 }
6072
6073 static void
6074 ensure_shift_out (struct encoding_stream *str, unsigned_char_dynarr *dst)
6075 {
6076   if (str->iso2022.register_left != 1)
6077     {
6078       Dynarr_add (dst, ISO_CODE_SO);
6079       str->iso2022.register_left = 1;
6080     }
6081 }
6082
6083 void
6084 char_encode_iso2022 (struct encoding_stream *str, Emchar ch,
6085                      unsigned_char_dynarr *dst, unsigned int *flags)
6086 {
6087   unsigned char charmask;
6088   Lisp_Coding_System* codesys = str->codesys;
6089   eol_type_t eol_type         = CODING_SYSTEM_EOL_TYPE (str->codesys);
6090   int i;
6091   Lisp_Object charset = str->iso2022.current_charset;
6092   int half = str->iso2022.current_half;
6093   int code_point = -1;
6094
6095   if (ch <= 0x7F)
6096     {
6097       restore_left_to_right_direction (codesys, dst, flags, 0);
6098               
6099       /* Make sure G0 contains ASCII */
6100       if ((ch > ' ' && ch < ISO_CODE_DEL)
6101           || !CODING_SYSTEM_ISO2022_NO_ASCII_CNTL (codesys))
6102         {
6103           ensure_normal_shift (str, dst);
6104           iso2022_designate (Vcharset_ascii, 0, str, dst);
6105         }
6106               
6107       /* If necessary, restore everything to the default state
6108          at end-of-line */
6109       if (ch == '\n' && !(CODING_SYSTEM_ISO2022_NO_ASCII_EOL (codesys)))
6110         {
6111           restore_left_to_right_direction (codesys, dst, flags, 0);
6112
6113           ensure_normal_shift (str, dst);
6114
6115           for (i = 0; i < 4; i++)
6116             {
6117               Lisp_Object initial_charset =
6118                 CODING_SYSTEM_ISO2022_INITIAL_CHARSET (codesys, i);
6119               iso2022_designate (initial_charset, i, str, dst);
6120             }
6121         }
6122       if (ch == '\n')
6123         {
6124           if (eol_type != EOL_LF && eol_type != EOL_AUTODETECT)
6125             Dynarr_add (dst, '\r');
6126           if (eol_type != EOL_CR)
6127             Dynarr_add (dst, ch);
6128         }
6129       else
6130         {
6131           if (CODING_SYSTEM_ISO2022_ESCAPE_QUOTED (codesys)
6132               && fit_to_be_escape_quoted (ch))
6133             Dynarr_add (dst, ISO_CODE_ESC);
6134           Dynarr_add (dst, ch);
6135         }
6136     }
6137   else if ( (0x80 <= ch) && (ch <= 0x9f) )
6138     {
6139       charmask = (half == 0 ? 0x00 : 0x80);
6140           
6141       if (CODING_SYSTEM_ISO2022_ESCAPE_QUOTED (codesys)
6142           && fit_to_be_escape_quoted (ch))
6143         Dynarr_add (dst, ISO_CODE_ESC);
6144       /* you asked for it ... */
6145       Dynarr_add (dst, ch);
6146     }
6147   else
6148     {
6149       int reg;
6150
6151       /* Now determine which register to use. */
6152       reg = -1;
6153       for (i = 0; i < 4; i++)
6154         {
6155           if ((CHARSETP (charset = str->iso2022.charset[i])
6156                && ((code_point = charset_code_point (charset, ch, 0)) >= 0))
6157               ||
6158               (CHARSETP
6159                (charset
6160                 = CODING_SYSTEM_ISO2022_INITIAL_CHARSET (codesys, i))
6161                && ((code_point = charset_code_point (charset, ch, 0)) >= 0)))
6162             {
6163               reg = i;
6164               break;
6165             }
6166         }
6167       if (reg == -1)
6168         {
6169           Lisp_Object original_default_coded_charset_priority_list
6170             = Vdefault_coded_charset_priority_list;
6171           Vdefault_coded_charset_priority_list
6172             = CODING_SYSTEM_CCS_PRIORITY_LIST (codesys);
6173           while (!EQ (Vdefault_coded_charset_priority_list, Qnil))
6174             {
6175               code_point = ENCODE_CHAR (ch, charset);
6176               if (XCHARSET_FINAL (charset))
6177                 goto found;
6178               Vdefault_coded_charset_priority_list
6179                 = Fcdr (Fmemq (XCHARSET_NAME (charset),
6180                                Vdefault_coded_charset_priority_list));
6181             }
6182           Vdefault_coded_charset_priority_list
6183             = original_default_coded_charset_priority_list;
6184           while (!EQ (Vdefault_coded_charset_priority_list, Qnil))
6185             {
6186               code_point = ENCODE_CHAR (ch, charset);
6187               if (XCHARSET_FINAL (charset))
6188                 goto found;
6189               Vdefault_coded_charset_priority_list
6190                 = Fcdr (Fmemq (XCHARSET_NAME (charset),
6191                                Vdefault_coded_charset_priority_list));
6192             }
6193           code_point = ENCODE_CHAR (ch, charset);
6194           if (!XCHARSET_FINAL (charset))
6195             {
6196               charset = Vcharset_ascii;
6197               code_point = '~';
6198             }
6199         found:
6200           Vdefault_coded_charset_priority_list
6201             = original_default_coded_charset_priority_list;
6202         }
6203       ensure_correct_direction (XCHARSET_DIRECTION (charset),
6204                                 codesys, dst, flags, 0);
6205       
6206       if (reg == -1)
6207         {
6208           if (XCHARSET_GRAPHIC (charset) != 0)
6209             {
6210               if (!NILP (str->iso2022.charset[1]) &&
6211                   (!CODING_SYSTEM_ISO2022_SEVEN (codesys)
6212                    || CODING_SYSTEM_ISO2022_LOCK_SHIFT (codesys)))
6213                 reg = 1;
6214               else if (!NILP (str->iso2022.charset[2]))
6215                 reg = 2;
6216               else if (!NILP (str->iso2022.charset[3]))
6217                 reg = 3;
6218               else
6219                 reg = 0;
6220             }
6221           else
6222             reg = 0;
6223         }
6224
6225       iso2022_designate (charset, reg, str, dst);
6226               
6227       /* Now invoke that register. */
6228       switch (reg)
6229         {
6230         case 0:
6231           ensure_normal_shift (str, dst);
6232           half = 0;
6233           break;
6234         case 1:
6235           if (CODING_SYSTEM_ISO2022_SEVEN (codesys))
6236             {
6237               ensure_shift_out (str, dst);
6238               half = 0;
6239             }
6240           else
6241             half = 1;
6242           break;
6243         case 2:
6244           if (CODING_SYSTEM_ISO2022_SEVEN (str->codesys))
6245             {
6246               Dynarr_add (dst, ISO_CODE_ESC);
6247               Dynarr_add (dst, 'N');
6248               half = 0;
6249             }
6250           else
6251             {
6252               Dynarr_add (dst, ISO_CODE_SS2);
6253               half = 1;
6254             }
6255           break;
6256         case 3:
6257           if (CODING_SYSTEM_ISO2022_SEVEN (str->codesys))
6258             {
6259               Dynarr_add (dst, ISO_CODE_ESC);
6260               Dynarr_add (dst, 'O');
6261               half = 0;
6262             }
6263           else
6264             {
6265               Dynarr_add (dst, ISO_CODE_SS3);
6266               half = 1;
6267             }
6268           break;
6269         default:
6270           abort ();
6271         }
6272       
6273       charmask = (half == 0 ? 0x00 : 0x80);
6274       
6275       switch (XCHARSET_DIMENSION (charset))
6276         {
6277         case 1:
6278           Dynarr_add (dst, (code_point & 0xFF) | charmask);
6279           break;
6280         case 2:
6281           Dynarr_add (dst, ((code_point >> 8) & 0xFF) | charmask);
6282           Dynarr_add (dst, ( code_point       & 0xFF) | charmask);
6283           break;
6284         case 3:
6285           Dynarr_add (dst, ((code_point >> 16) & 0xFF) | charmask);
6286           Dynarr_add (dst, ((code_point >>  8) & 0xFF) | charmask);
6287           Dynarr_add (dst, ( code_point        & 0xFF) | charmask);
6288           break;
6289         case 4:
6290           Dynarr_add (dst, ((code_point >> 24) & 0xFF) | charmask);
6291           Dynarr_add (dst, ((code_point >> 16) & 0xFF) | charmask);
6292           Dynarr_add (dst, ((code_point >>  8) & 0xFF) | charmask);
6293           Dynarr_add (dst, ( code_point        & 0xFF) | charmask);
6294           break;
6295         default:
6296           abort ();
6297         }
6298     }
6299   str->iso2022.current_charset = charset;
6300   str->iso2022.current_half = half;
6301 }
6302
6303 void
6304 char_finish_iso2022 (struct encoding_stream *str, unsigned_char_dynarr *dst,
6305                      unsigned int *flags)
6306 {
6307   Lisp_Coding_System* codesys = str->codesys;
6308   int i;
6309
6310   restore_left_to_right_direction (codesys, dst, flags, 0);
6311   ensure_normal_shift (str, dst);
6312   for (i = 0; i < 4; i++)
6313     {
6314       Lisp_Object initial_charset
6315         = CODING_SYSTEM_ISO2022_INITIAL_CHARSET (codesys, i);
6316       iso2022_designate (initial_charset, i, str, dst);
6317     }
6318 }
6319 #endif /* MULE */
6320 \f
6321 /************************************************************************/
6322 /*                     No-conversion methods                            */
6323 /************************************************************************/
6324
6325 /* This is used when reading in "binary" files -- i.e. files that may
6326    contain all 256 possible byte values and that are not to be
6327    interpreted as being in any particular decoding. */
6328 static void
6329 decode_coding_no_conversion (Lstream *decoding, const Extbyte *src,
6330                              unsigned_char_dynarr *dst, Lstream_data_count n)
6331 {
6332   struct decoding_stream *str = DECODING_STREAM_DATA (decoding);
6333   unsigned int flags  = str->flags;
6334   unsigned int cpos   = str->cpos;
6335   eol_type_t eol_type = str->eol_type;
6336
6337   while (n--)
6338     {
6339       unsigned char c = *(unsigned char *)src++;
6340
6341       DECODE_HANDLE_EOL_TYPE (eol_type, c, flags, dst);
6342       DECODE_ADD_BINARY_CHAR (c, dst);
6343     label_continue_loop:;
6344     }
6345
6346   DECODE_HANDLE_END_OF_CONVERSION (flags, cpos, dst);
6347
6348   str->flags = flags;
6349   str->cpos  = cpos;
6350 }
6351
6352 static void
6353 encode_coding_no_conversion (Lstream *encoding, const Bufbyte *src,
6354                              unsigned_char_dynarr *dst, Lstream_data_count n)
6355 {
6356   unsigned char c;
6357   struct encoding_stream *str = ENCODING_STREAM_DATA (encoding);
6358   unsigned int flags  = str->flags;
6359   unsigned int ch     = str->ch;
6360   eol_type_t eol_type = CODING_SYSTEM_EOL_TYPE (str->codesys);
6361 #ifdef UTF2000
6362   unsigned char char_boundary = str->iso2022.current_char_boundary;
6363 #endif
6364
6365   while (n--)
6366     {
6367       c = *src++;         
6368 #ifdef UTF2000
6369       if (char_boundary == 0)
6370         if ( c >= 0xfc )
6371           {
6372             ch = c & 0x01;
6373             char_boundary = 5;
6374           }
6375         else if ( c >= 0xf8 )
6376           {
6377             ch = c & 0x03;
6378             char_boundary = 4;
6379           }
6380         else if ( c >= 0xf0 )
6381           {
6382             ch = c & 0x07;
6383             char_boundary = 3;
6384           }
6385         else if ( c >= 0xe0 )
6386           {
6387             ch = c & 0x0f;
6388             char_boundary = 2;
6389           }
6390         else if ( c >= 0xc0 )
6391           {
6392             ch = c & 0x1f;
6393             char_boundary = 1;
6394           }
6395         else
6396           {
6397             ch = 0;
6398             if (c == '\n')
6399               {
6400                 if (eol_type != EOL_LF && eol_type != EOL_AUTODETECT)
6401                   Dynarr_add (dst, '\r');
6402                 if (eol_type != EOL_CR)
6403                   Dynarr_add (dst, c);
6404               }
6405             else
6406               Dynarr_add (dst, c);
6407             char_boundary = 0;
6408           }
6409       else if (char_boundary == 1)
6410         {
6411           ch = ( ch << 6 ) | ( c & 0x3f );
6412           Dynarr_add (dst, ch & 0xff);
6413           char_boundary = 0;
6414         }
6415       else
6416         {
6417           ch = ( ch << 6 ) | ( c & 0x3f );
6418           char_boundary--;
6419         }
6420 #else /* not UTF2000 */
6421       if (c == '\n')
6422         {
6423           if (eol_type != EOL_LF && eol_type != EOL_AUTODETECT)
6424             Dynarr_add (dst, '\r');
6425           if (eol_type != EOL_CR)
6426             Dynarr_add (dst, '\n');
6427           ch = 0;
6428         }
6429       else if (BYTE_ASCII_P (c))
6430         {
6431           assert (ch == 0);
6432           Dynarr_add (dst, c);
6433         }
6434       else if (BUFBYTE_LEADING_BYTE_P (c))
6435         {
6436           assert (ch == 0);
6437           if (c == LEADING_BYTE_LATIN_ISO8859_1 ||
6438               c == LEADING_BYTE_CONTROL_1)
6439             ch = c;
6440           else
6441             Dynarr_add (dst, '~'); /* untranslatable character */
6442         }
6443       else
6444         {
6445           if (ch == LEADING_BYTE_LATIN_ISO8859_1)
6446             Dynarr_add (dst, c);
6447           else if (ch == LEADING_BYTE_CONTROL_1)
6448             {
6449               assert (c < 0xC0);
6450               Dynarr_add (dst, c - 0x20);
6451             }
6452           /* else it should be the second or third byte of an
6453              untranslatable character, so ignore it */
6454           ch = 0;
6455         }
6456 #endif /* not UTF2000 */
6457     }
6458
6459   str->flags = flags;
6460   str->ch    = ch;
6461 #ifdef UTF2000
6462   str->iso2022.current_char_boundary = char_boundary;
6463 #endif
6464 }
6465
6466 \f
6467
6468 /************************************************************************/
6469 /*                             Initialization                           */
6470 /************************************************************************/
6471
6472 void
6473 syms_of_file_coding (void)
6474 {
6475   INIT_LRECORD_IMPLEMENTATION (coding_system);
6476
6477   DEFERROR_STANDARD (Qcoding_system_error, Qio_error);
6478
6479   DEFSUBR (Fcoding_system_p);
6480   DEFSUBR (Ffind_coding_system);
6481   DEFSUBR (Fget_coding_system);
6482   DEFSUBR (Fcoding_system_list);
6483   DEFSUBR (Fcoding_system_name);
6484   DEFSUBR (Fmake_coding_system);
6485   DEFSUBR (Fcopy_coding_system);
6486   DEFSUBR (Fcoding_system_canonical_name_p);
6487   DEFSUBR (Fcoding_system_alias_p);
6488   DEFSUBR (Fcoding_system_aliasee);
6489   DEFSUBR (Fdefine_coding_system_alias);
6490   DEFSUBR (Fsubsidiary_coding_system);
6491
6492   DEFSUBR (Fcoding_system_type);
6493   DEFSUBR (Fcoding_system_doc_string);
6494 #ifdef MULE
6495   DEFSUBR (Fcoding_system_charset);
6496 #endif
6497   DEFSUBR (Fcoding_system_property);
6498
6499   DEFSUBR (Fcoding_category_list);
6500   DEFSUBR (Fset_coding_priority_list);
6501   DEFSUBR (Fcoding_priority_list);
6502   DEFSUBR (Fset_coding_category_system);
6503   DEFSUBR (Fcoding_category_system);
6504
6505   DEFSUBR (Fdetect_coding_region);
6506   DEFSUBR (Fdecode_coding_region);
6507   DEFSUBR (Fencode_coding_region);
6508 #ifdef MULE
6509   DEFSUBR (Fdecode_shift_jis_char);
6510   DEFSUBR (Fencode_shift_jis_char);
6511   DEFSUBR (Fdecode_big5_char);
6512   DEFSUBR (Fencode_big5_char);
6513 #endif /* MULE */
6514   defsymbol (&Qcoding_systemp, "coding-system-p");
6515   defsymbol (&Qno_conversion, "no-conversion");
6516   defsymbol (&Qraw_text, "raw-text");
6517 #ifdef MULE
6518   defsymbol (&Qbig5, "big5");
6519   defsymbol (&Qshift_jis, "shift-jis");
6520   defsymbol (&Qucs4, "ucs-4");
6521   defsymbol (&Qutf8, "utf-8");
6522   defsymbol (&Qutf16, "utf-16");
6523   defsymbol (&Qccl, "ccl");
6524   defsymbol (&Qiso2022, "iso2022");
6525 #endif /* MULE */
6526   defsymbol (&Qmnemonic, "mnemonic");
6527   defsymbol (&Qeol_type, "eol-type");
6528   defsymbol (&Qpost_read_conversion, "post-read-conversion");
6529   defsymbol (&Qpre_write_conversion, "pre-write-conversion");
6530
6531   defsymbol (&Qcr, "cr");
6532   defsymbol (&Qlf, "lf");
6533   defsymbol (&Qcrlf, "crlf");
6534   defsymbol (&Qeol_cr, "eol-cr");
6535   defsymbol (&Qeol_lf, "eol-lf");
6536   defsymbol (&Qeol_crlf, "eol-crlf");
6537 #ifdef MULE
6538   defsymbol (&Qcharset_g0, "charset-g0");
6539   defsymbol (&Qcharset_g1, "charset-g1");
6540   defsymbol (&Qcharset_g2, "charset-g2");
6541   defsymbol (&Qcharset_g3, "charset-g3");
6542   defsymbol (&Qforce_g0_on_output, "force-g0-on-output");
6543   defsymbol (&Qforce_g1_on_output, "force-g1-on-output");
6544   defsymbol (&Qforce_g2_on_output, "force-g2-on-output");
6545   defsymbol (&Qforce_g3_on_output, "force-g3-on-output");
6546   defsymbol (&Qno_iso6429, "no-iso6429");
6547   defsymbol (&Qinput_charset_conversion, "input-charset-conversion");
6548   defsymbol (&Qoutput_charset_conversion, "output-charset-conversion");
6549
6550   defsymbol (&Qshort, "short");
6551   defsymbol (&Qno_ascii_eol, "no-ascii-eol");
6552   defsymbol (&Qno_ascii_cntl, "no-ascii-cntl");
6553   defsymbol (&Qseven, "seven");
6554   defsymbol (&Qlock_shift, "lock-shift");
6555   defsymbol (&Qescape_quoted, "escape-quoted");
6556 #endif /* MULE */
6557 #ifdef UTF2000
6558   defsymbol (&Qutf_8_mcs, "utf-8-mcs");
6559   defsymbol (&Qdisable_composition, "disable-composition");
6560   defsymbol (&Qenable_decomposition, "enable-decomposition");
6561   defsymbol (&Qccs_priority_list, "ccs-priority-list");
6562   defsymbol (&Quse_entity_reference, "use-entity-reference");
6563   defsymbol (&Qd, "d");
6564   defsymbol (&Qx, "x");
6565   defsymbol (&QX, "X");
6566 #endif
6567   defsymbol (&Qencode, "encode");
6568   defsymbol (&Qdecode, "decode");
6569
6570 #ifdef MULE
6571   defsymbol (&coding_category_symbol[CODING_CATEGORY_SHIFT_JIS],
6572              "shift-jis");
6573   defsymbol (&coding_category_symbol[CODING_CATEGORY_BIG5],
6574              "big5");
6575   defsymbol (&coding_category_symbol[CODING_CATEGORY_UCS4],
6576              "ucs-4");
6577   defsymbol (&coding_category_symbol[CODING_CATEGORY_UTF16],
6578              "utf-16");
6579   defsymbol (&coding_category_symbol[CODING_CATEGORY_UTF8],
6580              "utf-8");
6581   defsymbol (&coding_category_symbol[CODING_CATEGORY_ISO_7],
6582              "iso-7");
6583   defsymbol (&coding_category_symbol[CODING_CATEGORY_ISO_8_DESIGNATE],
6584              "iso-8-designate");
6585   defsymbol (&coding_category_symbol[CODING_CATEGORY_ISO_8_1],
6586              "iso-8-1");
6587   defsymbol (&coding_category_symbol[CODING_CATEGORY_ISO_8_2],
6588              "iso-8-2");
6589   defsymbol (&coding_category_symbol[CODING_CATEGORY_ISO_LOCK_SHIFT],
6590              "iso-lock-shift");
6591 #endif /* MULE */
6592   defsymbol (&coding_category_symbol[CODING_CATEGORY_NO_CONVERSION],
6593              "no-conversion");
6594 }
6595
6596 void
6597 lstream_type_create_file_coding (void)
6598 {
6599   LSTREAM_HAS_METHOD (decoding, reader);
6600   LSTREAM_HAS_METHOD (decoding, writer);
6601   LSTREAM_HAS_METHOD (decoding, rewinder);
6602   LSTREAM_HAS_METHOD (decoding, seekable_p);
6603   LSTREAM_HAS_METHOD (decoding, flusher);
6604   LSTREAM_HAS_METHOD (decoding, closer);
6605   LSTREAM_HAS_METHOD (decoding, marker);
6606
6607   LSTREAM_HAS_METHOD (encoding, reader);
6608   LSTREAM_HAS_METHOD (encoding, writer);
6609   LSTREAM_HAS_METHOD (encoding, rewinder);
6610   LSTREAM_HAS_METHOD (encoding, seekable_p);
6611   LSTREAM_HAS_METHOD (encoding, flusher);
6612   LSTREAM_HAS_METHOD (encoding, closer);
6613   LSTREAM_HAS_METHOD (encoding, marker);
6614 }
6615
6616 void
6617 vars_of_file_coding (void)
6618 {
6619   int i;
6620
6621   fcd = xnew (struct file_coding_dump);
6622   dump_add_root_struct_ptr (&fcd, &fcd_description);
6623
6624   /* Initialize to something reasonable ... */
6625   for (i = 0; i < CODING_CATEGORY_LAST; i++)
6626     {
6627       fcd->coding_category_system[i] = Qnil;
6628       fcd->coding_category_by_priority[i] = i;
6629     }
6630
6631   Fprovide (intern ("file-coding"));
6632
6633   DEFVAR_LISP ("keyboard-coding-system", &Vkeyboard_coding_system /*
6634 Coding system used for TTY keyboard input.
6635 Not used under a windowing system.
6636 */ );
6637   Vkeyboard_coding_system = Qnil;
6638
6639   DEFVAR_LISP ("terminal-coding-system", &Vterminal_coding_system /*
6640 Coding system used for TTY display output.
6641 Not used under a windowing system.
6642 */ );
6643   Vterminal_coding_system = Qnil;
6644
6645   DEFVAR_LISP ("coding-system-for-read", &Vcoding_system_for_read /*
6646 Overriding coding system used when reading from a file or process.
6647 You should bind this variable with `let', but do not set it globally.
6648 If this is non-nil, it specifies the coding system that will be used
6649 to decode input on read operations, such as from a file or process.
6650 It overrides `buffer-file-coding-system-for-read',
6651 `insert-file-contents-pre-hook', etc.  Use those variables instead of
6652 this one for permanent changes to the environment.  */ );
6653   Vcoding_system_for_read = Qnil;
6654
6655   DEFVAR_LISP ("coding-system-for-write",
6656                &Vcoding_system_for_write /*
6657 Overriding coding system used when writing to a file or process.
6658 You should bind this variable with `let', but do not set it globally.
6659 If this is non-nil, it specifies the coding system that will be used
6660 to encode output for write operations, such as to a file or process.
6661 It overrides `buffer-file-coding-system', `write-region-pre-hook', etc.
6662 Use those variables instead of this one for permanent changes to the
6663 environment.  */ );
6664   Vcoding_system_for_write = Qnil;
6665
6666   DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system /*
6667 Coding system used to convert pathnames when accessing files.
6668 */ );
6669   Vfile_name_coding_system = Qnil;
6670
6671   DEFVAR_LISP ("coded-charset-entity-reference-alist",
6672                &Vcoded_charset_entity_reference_alist /*
6673 Alist of coded-charset vs corresponding entity-reference.
6674 Each element looks like (CCS PREFIX CODE-COLUMNS CODE-TYPE).
6675 CCS is coded-charset.
6676 CODE-COLUMNS is columns of code-point of entity-reference.
6677 CODE-TYPE is format type of code-point of entity-reference.
6678 `d' means decimal value and `x' means hexadecimal value.
6679 */ );
6680   Vcoded_charset_entity_reference_alist = Qnil;
6681
6682   DEFVAR_BOOL ("enable-multibyte-characters", &enable_multibyte_characters /*
6683 Non-nil means the buffer contents are regarded as multi-byte form
6684 of characters, not a binary code.  This affects the display, file I/O,
6685 and behaviors of various editing commands.
6686
6687 Setting this to nil does not do anything.
6688 */ );
6689   enable_multibyte_characters = 1;
6690
6691 #ifdef UTF2000
6692   DEFVAR_LISP ("decomposition-feature-list",
6693                &Vdecomposition_feature_list /*
6694 List of `=decomposition@FOO' feature to encode characters as IVS.
6695 */ );
6696   Vdecomposition_feature_list = Qnil;
6697 #endif
6698 }
6699
6700 void
6701 complex_vars_of_file_coding (void)
6702 {
6703   staticpro (&Vcoding_system_hash_table);
6704   Vcoding_system_hash_table =
6705     make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
6706
6707   the_codesys_prop_dynarr = Dynarr_new (codesys_prop);
6708   dump_add_root_struct_ptr (&the_codesys_prop_dynarr, &codesys_prop_dynarr_description);
6709
6710 #define DEFINE_CODESYS_PROP(Prop_Type, Sym) do  \
6711 {                                               \
6712   struct codesys_prop csp;                      \
6713   csp.sym = (Sym);                              \
6714   csp.prop_type = (Prop_Type);                  \
6715   Dynarr_add (the_codesys_prop_dynarr, csp);    \
6716 } while (0)
6717
6718   DEFINE_CODESYS_PROP (CODESYS_PROP_ALL_OK,  Qmnemonic);
6719   DEFINE_CODESYS_PROP (CODESYS_PROP_ALL_OK,  Qeol_type);
6720   DEFINE_CODESYS_PROP (CODESYS_PROP_ALL_OK,  Qeol_cr);
6721   DEFINE_CODESYS_PROP (CODESYS_PROP_ALL_OK,  Qeol_crlf);
6722   DEFINE_CODESYS_PROP (CODESYS_PROP_ALL_OK,  Qeol_lf);
6723   DEFINE_CODESYS_PROP (CODESYS_PROP_ALL_OK,  Qpost_read_conversion);
6724   DEFINE_CODESYS_PROP (CODESYS_PROP_ALL_OK,  Qpre_write_conversion);
6725 #ifdef MULE
6726   DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qcharset_g0);
6727   DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qcharset_g1);
6728   DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qcharset_g2);
6729   DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qcharset_g3);
6730   DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qforce_g0_on_output);
6731   DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qforce_g1_on_output);
6732   DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qforce_g2_on_output);
6733   DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qforce_g3_on_output);
6734   DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qshort);
6735   DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qno_ascii_eol);
6736   DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qno_ascii_cntl);
6737   DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qseven);
6738   DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qlock_shift);
6739   DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qno_iso6429);
6740   DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qescape_quoted);
6741   DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qinput_charset_conversion);
6742   DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qoutput_charset_conversion);
6743 #ifdef UTF2000
6744   DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qccs_priority_list);
6745 #endif
6746
6747   DEFINE_CODESYS_PROP (CODESYS_PROP_CCL,     Qencode);
6748   DEFINE_CODESYS_PROP (CODESYS_PROP_CCL,     Qdecode);
6749 #ifdef UTF2000
6750   DEFINE_CODESYS_PROP (CODESYS_PROP_ALL_OK,  Qdisable_composition);
6751   DEFINE_CODESYS_PROP (CODESYS_PROP_ALL_OK,  Qenable_decomposition);
6752   DEFINE_CODESYS_PROP (CODESYS_PROP_ALL_OK,  Quse_entity_reference);
6753 #endif
6754 #endif /* MULE */
6755   /* Need to create this here or we're really screwed. */
6756   Fmake_coding_system
6757     (Qraw_text, Qno_conversion,
6758      build_string ("Raw text, which means it converts only line-break-codes."),
6759      list2 (Qmnemonic, build_string ("Raw")));
6760
6761   Fmake_coding_system
6762     (Qbinary, Qno_conversion,
6763      build_string ("Binary, which means it does not convert anything."),
6764      list4 (Qeol_type, Qlf,
6765             Qmnemonic, build_string ("Binary")));
6766
6767 #ifdef UTF2000
6768   Fmake_coding_system
6769     (Qutf_8_mcs, Qutf8,
6770      build_string
6771      ("Coding-system of UTF-8 with Multiple Coded-character-Sets extension."),
6772      list2 (Qmnemonic, build_string ("MTF8")));
6773 #endif
6774
6775   Fdefine_coding_system_alias (Qno_conversion, Qraw_text);
6776
6777   Fdefine_coding_system_alias (Qfile_name, Qbinary);
6778
6779   Fdefine_coding_system_alias (Qterminal, Qbinary);
6780   Fdefine_coding_system_alias (Qkeyboard, Qbinary);
6781
6782   /* Need this for bootstrapping */
6783   fcd->coding_category_system[CODING_CATEGORY_NO_CONVERSION] =
6784     Fget_coding_system (Qraw_text);
6785
6786 #ifdef UTF2000
6787   fcd->coding_category_system[CODING_CATEGORY_UTF8]
6788    = Fget_coding_system (Qutf_8_mcs);
6789 #endif
6790
6791 #if defined(MULE) && !defined(UTF2000)
6792   {
6793     size_t i;
6794
6795     for (i = 0; i < countof (fcd->ucs_to_mule_table); i++)
6796       fcd->ucs_to_mule_table[i] = Qnil;
6797   }
6798   staticpro (&mule_to_ucs_table);
6799   mule_to_ucs_table = Fmake_char_table(Qgeneric);
6800 #endif /* defined(MULE) && !defined(UTF2000) */
6801 }