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