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