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