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