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