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