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