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