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