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