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