Contents in 1999-06-04-13 of release-21-2.
[chise/xemacs-chise.git.1] / src / file-coding.c
1 /* Code conversion functions.
2    Copyright (C) 1991, 1995 Free Software Foundation, Inc.
3    Copyright (C) 1995 Sun Microsystems, Inc.
4
5 This file is part of XEmacs.
6
7 XEmacs is free software; you can redistribute it and/or modify it
8 under the terms of the GNU General Public License as published by the
9 Free Software Foundation; either version 2, or (at your option) any
10 later version.
11
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
15 for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with XEmacs; see the file COPYING.  If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA.  */
21
22 /* Synched up with: Mule 2.3.   Not in FSF. */
23
24 /* Rewritten by Ben Wing <ben@xemacs.org>. */
25
26 #include <config.h>
27 #include "lisp.h"
28 #include "buffer.h"
29 #include "elhash.h"
30 #include "insdel.h"
31 #include "lstream.h"
32 #ifdef MULE
33 #include "mule-ccl.h"
34 #include "chartab.h"
35 #endif
36 #include "file-coding.h"
37
38 Lisp_Object Qbuffer_file_coding_system, Qcoding_system_error;
39
40 Lisp_Object Vkeyboard_coding_system;
41 Lisp_Object Vterminal_coding_system;
42 Lisp_Object Vcoding_system_for_read;
43 Lisp_Object Vcoding_system_for_write;
44 Lisp_Object Vfile_name_coding_system;
45
46 /* Table of symbols identifying each coding category. */
47 Lisp_Object coding_category_symbol[CODING_CATEGORY_LAST + 1];
48
49 /* Coding system currently associated with each coding category. */
50 Lisp_Object coding_category_system[CODING_CATEGORY_LAST + 1];
51
52 /* Table of all coding categories in decreasing order of priority.
53    This describes a permutation of the possible coding categories. */
54 int coding_category_by_priority[CODING_CATEGORY_LAST + 1];
55
56 Lisp_Object Qcoding_system_p;
57
58 Lisp_Object Qno_conversion, Qccl, Qiso2022;
59 /* Qinternal in general.c */
60
61 Lisp_Object Qmnemonic, Qeol_type;
62 Lisp_Object Qcr, Qcrlf, Qlf;
63 Lisp_Object Qeol_cr, Qeol_crlf, Qeol_lf;
64 Lisp_Object Qpost_read_conversion;
65 Lisp_Object Qpre_write_conversion;
66
67 #ifdef MULE
68 Lisp_Object Qucs4, Qutf8;
69 Lisp_Object Qbig5, Qshift_jis;
70 Lisp_Object Qcharset_g0, Qcharset_g1, Qcharset_g2, Qcharset_g3;
71 Lisp_Object Qforce_g0_on_output, Qforce_g1_on_output;
72 Lisp_Object Qforce_g2_on_output, Qforce_g3_on_output;
73 Lisp_Object Qno_iso6429;
74 Lisp_Object Qinput_charset_conversion, Qoutput_charset_conversion;
75 Lisp_Object Qctext, Qescape_quoted;
76 Lisp_Object Qshort, Qno_ascii_eol, Qno_ascii_cntl, Qseven, Qlock_shift;
77 #endif
78 Lisp_Object Qencode, Qdecode;
79
80 Lisp_Object Vcoding_system_hash_table;
81
82 int enable_multibyte_characters;
83
84 #ifdef MULE
85 /* Additional information used by the ISO2022 decoder and detector. */
86 struct iso2022_decoder
87 {
88   /* CHARSET holds the character sets currently assigned to the G0
89      through G3 variables.  It is initialized from the array
90      INITIAL_CHARSET in CODESYS. */
91   Lisp_Object charset[4];
92
93   /* Which registers are currently invoked into the left (GL) and
94      right (GR) halves of the 8-bit encoding space? */
95   int register_left, register_right;
96
97   /* ISO_ESC holds a value indicating part of an escape sequence
98      that has already been seen. */
99   enum iso_esc_flag esc;
100
101   /* This records the bytes we've seen so far in an escape sequence,
102      in case the sequence is invalid (we spit out the bytes unchanged). */
103   unsigned char esc_bytes[8];
104
105   /* Index for next byte to store in ISO escape sequence. */
106   int esc_bytes_index;
107
108 #ifdef ENABLE_COMPOSITE_CHARS
109   /* Stuff seen so far when composing a string. */
110   unsigned_char_dynarr *composite_chars;
111 #endif
112
113   /* If we saw an invalid designation sequence for a particular
114      register, we flag it here and switch to ASCII.  The next time we
115      see a valid designation for this register, we turn off the flag
116      and do the designation normally, but pretend the sequence was
117      invalid.  The effect of all this is that (most of the time) the
118      escape sequences for both the switch to the unknown charset, and
119      the switch back to the known charset, get inserted literally into
120      the buffer and saved out as such.  The hope is that we can
121      preserve the escape sequences so that the resulting written out
122      file makes sense.  If we don't do any of this, the designation
123      to the invalid charset will be preserved but that switch back
124      to the known charset will probably get eaten because it was
125      the same charset that was already present in the register. */
126   unsigned char invalid_designated[4];
127
128   /* We try to do similar things as above for direction-switching
129      sequences.  If we encountered a direction switch while an
130      invalid designation was present, or an invalid designation
131      just after a direction switch (i.e. no valid designation
132      encountered yet), we insert the direction-switch escape
133      sequence literally into the output stream, and later on
134      insert the corresponding direction-restoring escape sequence
135      literally also. */
136   unsigned int switched_dir_and_no_valid_charset_yet :1;
137   unsigned int invalid_switch_dir :1;
138
139   /* Tells the decoder to output the escape sequence literally
140      even though it was valid.  Used in the games we play to
141      avoid lossage when we encounter invalid designations. */
142   unsigned int output_literally :1;
143   /* We encountered a direction switch followed by an invalid
144      designation.  We didn't output the direction switch
145      literally because we didn't know about the invalid designation;
146      but we have to do so now. */
147   unsigned int output_direction_sequence :1;
148 };
149 #endif /* MULE */
150 EXFUN (Fcopy_coding_system, 2);
151 #ifdef MULE
152 struct detection_state;
153 static int detect_coding_sjis (struct detection_state *st,
154                                CONST unsigned char *src,
155                                unsigned int n);
156 static void decode_coding_sjis (Lstream *decoding,
157                                 CONST unsigned char *src,
158                                 unsigned_char_dynarr *dst,
159                                 unsigned int n);
160 static void encode_coding_sjis (Lstream *encoding,
161                                 CONST unsigned char *src,
162                                 unsigned_char_dynarr *dst,
163                                 unsigned int n);
164 static int detect_coding_big5 (struct detection_state *st,
165                                CONST unsigned char *src,
166                                unsigned int n);
167 static void decode_coding_big5 (Lstream *decoding,
168                                 CONST unsigned char *src,
169                                 unsigned_char_dynarr *dst, unsigned int n);
170 static void encode_coding_big5 (Lstream *encoding,
171                                 CONST unsigned char *src,
172                                 unsigned_char_dynarr *dst, unsigned int n);
173 static int detect_coding_ucs4 (struct detection_state *st,
174                                CONST unsigned char *src,
175                                unsigned int n);
176 static void decode_coding_ucs4 (Lstream *decoding,
177                                 CONST unsigned char *src,
178                                 unsigned_char_dynarr *dst, unsigned int n);
179 static void encode_coding_ucs4 (Lstream *encoding,
180                                 CONST unsigned char *src,
181                                 unsigned_char_dynarr *dst, unsigned int n);
182 static int detect_coding_utf8 (struct detection_state *st,
183                                CONST unsigned char *src,
184                                unsigned int n);
185 static void decode_coding_utf8 (Lstream *decoding,
186                                 CONST unsigned char *src,
187                                 unsigned_char_dynarr *dst, unsigned int n);
188 static void encode_coding_utf8 (Lstream *encoding,
189                                 CONST unsigned char *src,
190                                 unsigned_char_dynarr *dst, unsigned int n);
191 static int postprocess_iso2022_mask (int mask);
192 static void reset_iso2022 (Lisp_Object coding_system,
193                            struct iso2022_decoder *iso);
194 static int detect_coding_iso2022 (struct detection_state *st,
195                                   CONST unsigned char *src,
196                                   unsigned int n);
197 static void decode_coding_iso2022 (Lstream *decoding,
198                                    CONST unsigned char *src,
199                                    unsigned_char_dynarr *dst, unsigned int n);
200 static void encode_coding_iso2022 (Lstream *encoding,
201                                    CONST unsigned char *src,
202                                    unsigned_char_dynarr *dst, unsigned int n);
203 #endif /* MULE */
204 static void decode_coding_no_conversion (Lstream *decoding,
205                                          CONST unsigned char *src,
206                                          unsigned_char_dynarr *dst,
207                                          unsigned int n);
208 static void encode_coding_no_conversion (Lstream *encoding,
209                                          CONST unsigned char *src,
210                                          unsigned_char_dynarr *dst,
211                                          unsigned int n);
212 static void mule_decode (Lstream *decoding, CONST unsigned char *src,
213                          unsigned_char_dynarr *dst, unsigned int n);
214 static void mule_encode (Lstream *encoding, CONST unsigned char *src,
215                          unsigned_char_dynarr *dst, unsigned int n);
216
217 typedef struct codesys_prop codesys_prop;
218 struct codesys_prop
219 {
220   Lisp_Object sym;
221   int prop_type;
222 };
223
224 typedef struct
225 {
226   Dynarr_declare (codesys_prop);
227 } codesys_prop_dynarr;
228
229 codesys_prop_dynarr *the_codesys_prop_dynarr;
230
231 enum codesys_prop_enum
232 {
233   CODESYS_PROP_ALL_OK,
234   CODESYS_PROP_ISO2022,
235   CODESYS_PROP_CCL
236 };
237
238 \f
239 /************************************************************************/
240 /*                       Coding system functions                        */
241 /************************************************************************/
242
243 static Lisp_Object mark_coding_system (Lisp_Object, void (*) (Lisp_Object));
244 static void print_coding_system (Lisp_Object, Lisp_Object, int);
245 static void finalize_coding_system (void *header, int for_disksave);
246
247 DEFINE_LRECORD_IMPLEMENTATION ("coding-system", coding_system,
248                                mark_coding_system, print_coding_system,
249                                finalize_coding_system,
250                                0, 0, struct Lisp_Coding_System);
251
252 static Lisp_Object
253 mark_coding_system (Lisp_Object obj, void (*markobj) (Lisp_Object))
254 {
255   Lisp_Coding_System *codesys = XCODING_SYSTEM (obj);
256
257   markobj (CODING_SYSTEM_NAME (codesys));
258   markobj (CODING_SYSTEM_DOC_STRING (codesys));
259   markobj (CODING_SYSTEM_MNEMONIC (codesys));
260   markobj (CODING_SYSTEM_EOL_LF (codesys));
261   markobj (CODING_SYSTEM_EOL_CRLF (codesys));
262   markobj (CODING_SYSTEM_EOL_CR (codesys));
263
264   switch (CODING_SYSTEM_TYPE (codesys))
265     {
266 #ifdef MULE
267       int i;
268     case CODESYS_ISO2022:
269       for (i = 0; i < 4; i++)
270         markobj (CODING_SYSTEM_ISO2022_INITIAL_CHARSET (codesys, i));
271       if (codesys->iso2022.input_conv)
272         {
273           for (i = 0; i < Dynarr_length (codesys->iso2022.input_conv); i++)
274             {
275               struct charset_conversion_spec *ccs =
276                 Dynarr_atp (codesys->iso2022.input_conv, i);
277               markobj (ccs->from_charset);
278               markobj (ccs->to_charset);
279             }
280         }
281       if (codesys->iso2022.output_conv)
282         {
283           for (i = 0; i < Dynarr_length (codesys->iso2022.output_conv); i++)
284             {
285               struct charset_conversion_spec *ccs =
286                 Dynarr_atp (codesys->iso2022.output_conv, i);
287               markobj (ccs->from_charset);
288               markobj (ccs->to_charset);
289             }
290         }
291       break;
292
293     case CODESYS_CCL:
294       markobj (CODING_SYSTEM_CCL_DECODE (codesys));
295       markobj (CODING_SYSTEM_CCL_ENCODE (codesys));
296       break;
297 #endif /* MULE */
298     default:
299       break;
300     }
301
302   markobj (CODING_SYSTEM_PRE_WRITE_CONVERSION (codesys));
303   return CODING_SYSTEM_POST_READ_CONVERSION (codesys);
304 }
305
306 static void
307 print_coding_system (Lisp_Object obj, Lisp_Object printcharfun,
308                      int escapeflag)
309 {
310   Lisp_Coding_System *c = XCODING_SYSTEM (obj);
311   if (print_readably)
312     error ("printing unreadable object #<coding_system 0x%x>",
313            c->header.uid);
314
315   write_c_string ("#<coding_system ", printcharfun);
316   print_internal (c->name, printcharfun, 1);
317   write_c_string (">", printcharfun);
318 }
319
320 static void
321 finalize_coding_system (void *header, int for_disksave)
322 {
323   Lisp_Coding_System *c = (Lisp_Coding_System *) header;
324   /* Since coding systems never go away, this function is not
325      necessary.  But it would be necessary if we changed things
326      so that coding systems could go away. */
327   if (!for_disksave) /* see comment in lstream.c */
328     {
329       switch (CODING_SYSTEM_TYPE (c))
330         {
331 #ifdef MULE
332         case CODESYS_ISO2022:
333           if (c->iso2022.input_conv)
334             {
335               Dynarr_free (c->iso2022.input_conv);
336               c->iso2022.input_conv = 0;
337             }
338           if (c->iso2022.output_conv)
339             {
340               Dynarr_free (c->iso2022.output_conv);
341               c->iso2022.output_conv = 0;
342             }
343           break;
344 #endif /* MULE */
345         default:
346           break;
347         }
348     }
349 }
350
351 static enum eol_type
352 symbol_to_eol_type (Lisp_Object symbol)
353 {
354   CHECK_SYMBOL (symbol);
355   if (NILP (symbol))      return EOL_AUTODETECT;
356   if (EQ (symbol, Qlf))   return EOL_LF;
357   if (EQ (symbol, Qcrlf)) return EOL_CRLF;
358   if (EQ (symbol, Qcr))   return EOL_CR;
359
360   signal_simple_error ("Unrecognized eol type", symbol);
361   return EOL_AUTODETECT; /* not reached */
362 }
363
364 static Lisp_Object
365 eol_type_to_symbol (enum eol_type type)
366 {
367   switch (type)
368     {
369     default: abort ();
370     case EOL_LF:         return Qlf;
371     case EOL_CRLF:       return Qcrlf;
372     case EOL_CR:         return Qcr;
373     case EOL_AUTODETECT: return Qnil;
374     }
375 }
376
377 static void
378 setup_eol_coding_systems (Lisp_Coding_System *codesys)
379 {
380   Lisp_Object codesys_obj;
381   int len = string_length (XSYMBOL (CODING_SYSTEM_NAME (codesys))->name);
382   char *codesys_name = (char *) alloca (len + 7);
383   int mlen = -1;
384   char *codesys_mnemonic=0;
385
386   Lisp_Object codesys_name_sym, sub_codesys_obj;
387
388   /* kludge */
389
390   XSETCODING_SYSTEM (codesys_obj, codesys);
391
392   memcpy (codesys_name,
393           string_data (XSYMBOL (CODING_SYSTEM_NAME (codesys))->name), len);
394
395   if (STRINGP (CODING_SYSTEM_MNEMONIC (codesys)))
396     {
397       mlen = XSTRING_LENGTH (CODING_SYSTEM_MNEMONIC (codesys));
398       codesys_mnemonic = (char *) alloca (mlen + 7);
399       memcpy (codesys_mnemonic,
400               XSTRING_DATA (CODING_SYSTEM_MNEMONIC (codesys)), mlen);
401     }
402
403 #define DEFINE_SUB_CODESYS(op_sys, op_sys_abbr, Type) do {                      \
404   strcpy (codesys_name + len, "-" op_sys);                                      \
405   if (mlen != -1)                                                               \
406     strcpy (codesys_mnemonic + mlen, op_sys_abbr);                              \
407   codesys_name_sym = intern (codesys_name);                                     \
408   sub_codesys_obj = Fcopy_coding_system (codesys_obj, codesys_name_sym);        \
409   XCODING_SYSTEM_EOL_TYPE (sub_codesys_obj) = Type;                             \
410   if (mlen != -1)                                                               \
411     XCODING_SYSTEM_MNEMONIC(sub_codesys_obj) =                                  \
412       build_string (codesys_mnemonic);                                          \
413   CODING_SYSTEM_##Type (codesys) = sub_codesys_obj;                             \
414 } while (0)
415
416   DEFINE_SUB_CODESYS("unix", "", EOL_LF);
417   DEFINE_SUB_CODESYS("dos",  ":T", EOL_CRLF);
418   DEFINE_SUB_CODESYS("mac",  ":t", EOL_CR);
419 }
420
421 DEFUN ("coding-system-p", Fcoding_system_p, 1, 1, 0, /*
422 Return t if OBJECT is a coding system.
423 A coding system is an object that defines how text containing multiple
424 character sets is encoded into a stream of (typically 8-bit) bytes.
425 The coding system is used to decode the stream into a series of
426 characters (which may be from multiple charsets) when the text is read
427 from a file or process, and is used to encode the text back into the
428 same format when it is written out to a file or process.
429
430 For example, many ISO2022-compliant coding systems (such as Compound
431 Text, which is used for inter-client data under the X Window System)
432 use escape sequences to switch between different charsets -- Japanese
433 Kanji, for example, is invoked with "ESC $ ( B"; ASCII is invoked
434 with "ESC ( B"; and Cyrillic is invoked with "ESC - L".  See
435 `make-coding-system' for more information.
436
437 Coding systems are normally identified using a symbol, and the
438 symbol is accepted in place of the actual coding system object whenever
439 a coding system is called for. (This is similar to how faces work.)
440 */
441        (object))
442 {
443   return CODING_SYSTEMP (object) ? Qt : Qnil;
444 }
445
446 DEFUN ("find-coding-system", Ffind_coding_system, 1, 1, 0, /*
447 Retrieve the coding system of the given name.
448
449 If CODING-SYSTEM-OR-NAME is a coding-system object, it is simply
450 returned.  Otherwise, CODING-SYSTEM-OR-NAME should be a symbol.
451 If there is no such coding system, nil is returned.  Otherwise the
452 associated coding system object is returned.
453 */
454        (coding_system_or_name))
455 {
456   if (CODING_SYSTEMP (coding_system_or_name))
457     return coding_system_or_name;
458
459   if (NILP (coding_system_or_name))
460     coding_system_or_name = Qbinary;
461   else
462     CHECK_SYMBOL (coding_system_or_name);
463
464   return Fgethash (coding_system_or_name, Vcoding_system_hash_table, Qnil);
465 }
466
467 DEFUN ("get-coding-system", Fget_coding_system, 1, 1, 0, /*
468 Retrieve the coding system of the given name.
469 Same as `find-coding-system' except that if there is no such
470 coding system, an error is signaled instead of returning nil.
471 */
472        (name))
473 {
474   Lisp_Object coding_system = Ffind_coding_system (name);
475
476   if (NILP (coding_system))
477     signal_simple_error ("No such coding system", name);
478   return coding_system;
479 }
480
481 /* We store the coding systems in hash tables with the names as the key and the
482    actual coding system object as the value.  Occasionally we need to use them
483    in a list format.  These routines provide us with that. */
484 struct coding_system_list_closure
485 {
486   Lisp_Object *coding_system_list;
487 };
488
489 static int
490 add_coding_system_to_list_mapper (Lisp_Object key, Lisp_Object value,
491                                   void *coding_system_list_closure)
492 {
493   /* This function can GC */
494   struct coding_system_list_closure *cscl =
495     (struct coding_system_list_closure *) coding_system_list_closure;
496   Lisp_Object *coding_system_list = cscl->coding_system_list;
497
498   *coding_system_list = Fcons (XCODING_SYSTEM (value)->name,
499                                *coding_system_list);
500   return 0;
501 }
502
503 DEFUN ("coding-system-list", Fcoding_system_list, 0, 0, 0, /*
504 Return a list of the names of all defined coding systems.
505 */
506        ())
507 {
508   Lisp_Object coding_system_list = Qnil;
509   struct gcpro gcpro1;
510   struct coding_system_list_closure coding_system_list_closure;
511
512   GCPRO1 (coding_system_list);
513   coding_system_list_closure.coding_system_list = &coding_system_list;
514   elisp_maphash (add_coding_system_to_list_mapper, Vcoding_system_hash_table,
515                  &coding_system_list_closure);
516   UNGCPRO;
517
518   return coding_system_list;
519 }
520
521 DEFUN ("coding-system-name", Fcoding_system_name, 1, 1, 0, /*
522 Return the name of the given coding system.
523 */
524        (coding_system))
525 {
526   coding_system = Fget_coding_system (coding_system);
527   return XCODING_SYSTEM_NAME (coding_system);
528 }
529
530 static Lisp_Coding_System *
531 allocate_coding_system (enum coding_system_type type, Lisp_Object name)
532 {
533   Lisp_Coding_System *codesys =
534     alloc_lcrecord_type (Lisp_Coding_System, &lrecord_coding_system);
535
536   zero_lcrecord (codesys);
537   CODING_SYSTEM_PRE_WRITE_CONVERSION (codesys) = Qnil;
538   CODING_SYSTEM_POST_READ_CONVERSION (codesys) = Qnil;
539   CODING_SYSTEM_EOL_TYPE (codesys) = EOL_AUTODETECT;
540   CODING_SYSTEM_EOL_CRLF (codesys) = Qnil;
541   CODING_SYSTEM_EOL_CR   (codesys) = Qnil;
542   CODING_SYSTEM_EOL_LF   (codesys) = Qnil;
543   CODING_SYSTEM_TYPE     (codesys) = type;
544   CODING_SYSTEM_MNEMONIC (codesys) = Qnil;
545 #ifdef MULE
546   if (type == CODESYS_ISO2022)
547     {
548       int i;
549       for (i = 0; i < 4; i++)
550         CODING_SYSTEM_ISO2022_INITIAL_CHARSET (codesys, i) = Qnil;
551     }
552   else if (type == CODESYS_CCL)
553     {
554       CODING_SYSTEM_CCL_DECODE (codesys) = Qnil;
555       CODING_SYSTEM_CCL_ENCODE (codesys) = Qnil;
556     }
557 #endif /* MULE */
558   CODING_SYSTEM_NAME (codesys) = name;
559
560   return codesys;
561 }
562
563 #ifdef MULE
564 /* Given a list of charset conversion specs as specified in a Lisp
565    program, parse it into STORE_HERE. */
566
567 static void
568 parse_charset_conversion_specs (charset_conversion_spec_dynarr *store_here,
569                                 Lisp_Object spec_list)
570 {
571   Lisp_Object rest;
572
573   EXTERNAL_LIST_LOOP (rest, spec_list)
574     {
575       Lisp_Object car = XCAR (rest);
576       Lisp_Object from, to;
577       struct charset_conversion_spec spec;
578
579       if (!CONSP (car) || !CONSP (XCDR (car)) || !NILP (XCDR (XCDR (car))))
580         signal_simple_error ("Invalid charset conversion spec", car);
581       from = Fget_charset (XCAR (car));
582       to = Fget_charset (XCAR (XCDR (car)));
583       if (XCHARSET_TYPE (from) != XCHARSET_TYPE (to))
584         signal_simple_error_2
585           ("Attempted conversion between different charset types",
586            from, to);
587       spec.from_charset = from;
588       spec.to_charset = to;
589
590       Dynarr_add (store_here, spec);
591     }
592 }
593
594 /* Given a dynarr LOAD_HERE of internally-stored charset conversion
595    specs, return the equivalent as the Lisp programmer would see it.
596
597    If LOAD_HERE is 0, return Qnil. */
598
599 static Lisp_Object
600 unparse_charset_conversion_specs (charset_conversion_spec_dynarr *load_here)
601 {
602   int i;
603   Lisp_Object result;
604
605   if (!load_here)
606     return Qnil;
607   for (i = 0, result = Qnil; i < Dynarr_length (load_here); i++)
608     {
609       struct charset_conversion_spec *ccs = Dynarr_atp (load_here, i);
610       result = Fcons (list2 (ccs->from_charset, ccs->to_charset), result);
611     }
612
613   return Fnreverse (result);
614 }
615
616 #endif /* MULE */
617
618 DEFUN ("make-coding-system", Fmake_coding_system, 2, 4, 0, /*
619 Register symbol NAME as a coding system.
620
621 TYPE describes the conversion method used and should be one of
622
623 nil or 'undecided
624      Automatic conversion.  XEmacs attempts to detect the coding system
625      used in the file.
626 'no-conversion
627      No conversion.  Use this for binary files and such.  On output,
628      graphic characters that are not in ASCII or Latin-1 will be
629      replaced by a ?. (For a no-conversion-encoded buffer, these
630      characters will only be present if you explicitly insert them.)
631 'shift-jis
632      Shift-JIS (a Japanese encoding commonly used in PC operating systems).
633 'ucs-4
634      ISO 10646 UCS-4 encoding.
635 'utf-8
636      ISO 10646 UTF-8 encoding.
637 'iso2022
638      Any ISO2022-compliant encoding.  Among other things, this includes
639      JIS (the Japanese encoding commonly used for e-mail), EUC (the
640      standard Unix encoding for Japanese and other languages), and
641      Compound Text (the encoding used in X11).  You can specify more
642      specific information about the conversion with the FLAGS argument.
643 'big5
644      Big5 (the encoding commonly used for Taiwanese).
645 'ccl
646      The conversion is performed using a user-written pseudo-code
647      program.  CCL (Code Conversion Language) is the name of this
648      pseudo-code.
649 'internal
650      Write out or read in the raw contents of the memory representing
651      the buffer's text.  This is primarily useful for debugging
652      purposes, and is only enabled when XEmacs has been compiled with
653      DEBUG_XEMACS defined (via the --debug configure option).
654      WARNING: Reading in a file using 'internal conversion can result
655      in an internal inconsistency in the memory representing a
656      buffer's text, which will produce unpredictable results and may
657      cause XEmacs to crash.  Under normal circumstances you should
658      never use 'internal conversion.
659
660 DOC-STRING is a string describing the coding system.
661
662 PROPS is a property list, describing the specific nature of the
663 character set.  Recognized properties are:
664
665 'mnemonic
666      String to be displayed in the modeline when this coding system is
667      active.
668
669 'eol-type
670      End-of-line conversion to be used.  It should be one of
671
672         nil
673                 Automatically detect the end-of-line type (LF, CRLF,
674                 or CR).  Also generate subsidiary coding systems named
675                 `NAME-unix', `NAME-dos', and `NAME-mac', that are
676                 identical to this coding system but have an EOL-TYPE
677                 value of 'lf, 'crlf, and 'cr, respectively.
678         'lf
679                 The end of a line is marked externally using ASCII LF.
680                 Since this is also the way that XEmacs represents an
681                 end-of-line internally, specifying this option results
682                 in no end-of-line conversion.  This is the standard
683                 format for Unix text files.
684         'crlf
685                 The end of a line is marked externally using ASCII
686                 CRLF.  This is the standard format for MS-DOS text
687                 files.
688         'cr
689                 The end of a line is marked externally using ASCII CR.
690                 This is the standard format for Macintosh text files.
691         t
692                 Automatically detect the end-of-line type but do not
693                 generate subsidiary coding systems.  (This value is
694                 converted to nil when stored internally, and
695                 `coding-system-property' will return nil.)
696
697 'post-read-conversion
698      Function called after a file has been read in, to perform the
699      decoding.  Called with two arguments, BEG and END, denoting
700      a region of the current buffer to be decoded.
701
702 'pre-write-conversion
703      Function called before a file is written out, to perform the
704      encoding.  Called with two arguments, BEG and END, denoting
705      a region of the current buffer to be encoded.
706
707
708 The following additional properties are recognized if TYPE is 'iso2022:
709
710 'charset-g0
711 'charset-g1
712 'charset-g2
713 'charset-g3
714      The character set initially designated to the G0 - G3 registers.
715      The value should be one of
716
717           -- A charset object (designate that character set)
718           -- nil (do not ever use this register)
719           -- t (no character set is initially designated to
720                 the register, but may be later on; this automatically
721                 sets the corresponding `force-g*-on-output' property)
722
723 'force-g0-on-output
724 'force-g1-on-output
725 'force-g2-on-output
726 'force-g2-on-output
727      If non-nil, send an explicit designation sequence on output before
728      using the specified register.
729
730 'short
731      If non-nil, use the short forms "ESC $ @", "ESC $ A", and
732      "ESC $ B" on output in place of the full designation sequences
733      "ESC $ ( @", "ESC $ ( A", and "ESC $ ( B".
734
735 'no-ascii-eol
736      If non-nil, don't designate ASCII to G0 at each end of line on output.
737      Setting this to non-nil also suppresses other state-resetting that
738      normally happens at the end of a line.
739
740 'no-ascii-cntl
741      If non-nil, don't designate ASCII to G0 before control chars on output.
742
743 'seven
744      If non-nil, use 7-bit environment on output.  Otherwise, use 8-bit
745      environment.
746
747 'lock-shift
748      If non-nil, use locking-shift (SO/SI) instead of single-shift
749      or designation by escape sequence.
750
751 'no-iso6429
752      If non-nil, don't use ISO6429's direction specification.
753
754 'escape-quoted
755      If non-nil, literal control characters that are the same as
756      the beginning of a recognized ISO2022 or ISO6429 escape sequence
757      (in particular, ESC (0x1B), SO (0x0E), SI (0x0F), SS2 (0x8E),
758      SS3 (0x8F), and CSI (0x9B)) are "quoted" with an escape character
759      so that they can be properly distinguished from an escape sequence.
760      (Note that doing this results in a non-portable encoding.) This
761      encoding flag is used for byte-compiled files.  Note that ESC
762      is a good choice for a quoting character because there are no
763      escape sequences whose second byte is a character from the Control-0
764      or Control-1 character sets; this is explicitly disallowed by the
765      ISO2022 standard.
766
767 'input-charset-conversion
768      A list of conversion specifications, specifying conversion of
769      characters in one charset to another when decoding is performed.
770      Each specification is a list of two elements: the source charset,
771      and the destination charset.
772
773 'output-charset-conversion
774      A list of conversion specifications, specifying conversion of
775      characters in one charset to another when encoding is performed.
776      The form of each specification is the same as for
777      'input-charset-conversion.
778
779
780 The following additional properties are recognized (and required)
781 if TYPE is 'ccl:
782
783 'decode
784      CCL program used for decoding (converting to internal format).
785
786 'encode
787      CCL program used for encoding (converting to external format).
788 */
789        (name, type, doc_string, props))
790 {
791   Lisp_Coding_System *codesys;
792   Lisp_Object rest, key, value;
793   enum coding_system_type ty;
794   int need_to_setup_eol_systems = 1;
795
796   /* Convert type to constant */
797   if (NILP (type) || EQ (type, Qundecided))
798                                       { ty = CODESYS_AUTODETECT; }
799 #ifdef MULE
800   else if (EQ (type, Qshift_jis))     { ty = CODESYS_SHIFT_JIS; }
801   else if (EQ (type, Qiso2022))       { ty = CODESYS_ISO2022; }
802   else if (EQ (type, Qbig5))          { ty = CODESYS_BIG5; }
803   else if (EQ (type, Qucs4))          { ty = CODESYS_UCS4; }
804   else if (EQ (type, Qutf8))          { ty = CODESYS_UTF8; }
805   else if (EQ (type, Qccl))           { ty = CODESYS_CCL; }
806 #endif
807   else if (EQ (type, Qno_conversion)) { ty = CODESYS_NO_CONVERSION; }
808 #ifdef DEBUG_XEMACS
809   else if (EQ (type, Qinternal))      { ty = CODESYS_INTERNAL; }
810 #endif
811   else
812     signal_simple_error ("Invalid coding system type", type);
813
814   CHECK_SYMBOL (name);
815
816   codesys = allocate_coding_system (ty, name);
817
818   if (NILP (doc_string))
819     doc_string = build_string ("");
820   else
821     CHECK_STRING (doc_string);
822   CODING_SYSTEM_DOC_STRING (codesys) = doc_string;
823
824   EXTERNAL_PROPERTY_LIST_LOOP (rest, key, value, props)
825     {
826       if (EQ (key, Qmnemonic))
827         {
828           if (!NILP (value))
829             CHECK_STRING (value);
830           CODING_SYSTEM_MNEMONIC (codesys) = value;
831         }
832
833       else if (EQ (key, Qeol_type))
834         {
835           need_to_setup_eol_systems = NILP (value);
836           if (EQ (value, Qt))
837             value = Qnil;
838           CODING_SYSTEM_EOL_TYPE (codesys) = symbol_to_eol_type (value);
839         }
840
841       else if (EQ (key, Qpost_read_conversion)) CODING_SYSTEM_POST_READ_CONVERSION (codesys) = value;
842       else if (EQ (key, Qpre_write_conversion)) CODING_SYSTEM_PRE_WRITE_CONVERSION (codesys) = value;
843 #ifdef MULE
844       else if (ty == CODESYS_ISO2022)
845         {
846 #define FROB_INITIAL_CHARSET(charset_num) \
847   CODING_SYSTEM_ISO2022_INITIAL_CHARSET (codesys, charset_num) = \
848     ((EQ (value, Qt) || EQ (value, Qnil)) ? value : Fget_charset (value))
849
850           if      (EQ (key, Qcharset_g0)) FROB_INITIAL_CHARSET (0);
851           else if (EQ (key, Qcharset_g1)) FROB_INITIAL_CHARSET (1);
852           else if (EQ (key, Qcharset_g2)) FROB_INITIAL_CHARSET (2);
853           else if (EQ (key, Qcharset_g3)) FROB_INITIAL_CHARSET (3);
854
855 #define FROB_FORCE_CHARSET(charset_num) \
856   CODING_SYSTEM_ISO2022_FORCE_CHARSET_ON_OUTPUT (codesys, charset_num) = !NILP (value)
857
858           else if (EQ (key, Qforce_g0_on_output)) FROB_FORCE_CHARSET (0);
859           else if (EQ (key, Qforce_g1_on_output)) FROB_FORCE_CHARSET (1);
860           else if (EQ (key, Qforce_g2_on_output)) FROB_FORCE_CHARSET (2);
861           else if (EQ (key, Qforce_g3_on_output)) FROB_FORCE_CHARSET (3);
862
863 #define FROB_BOOLEAN_PROPERTY(prop) \
864   CODING_SYSTEM_ISO2022_##prop (codesys) = !NILP (value)
865
866           else if (EQ (key, Qshort))         FROB_BOOLEAN_PROPERTY (SHORT);
867           else if (EQ (key, Qno_ascii_eol))  FROB_BOOLEAN_PROPERTY (NO_ASCII_EOL);
868           else if (EQ (key, Qno_ascii_cntl)) FROB_BOOLEAN_PROPERTY (NO_ASCII_CNTL);
869           else if (EQ (key, Qseven))         FROB_BOOLEAN_PROPERTY (SEVEN);
870           else if (EQ (key, Qlock_shift))    FROB_BOOLEAN_PROPERTY (LOCK_SHIFT);
871           else if (EQ (key, Qno_iso6429))    FROB_BOOLEAN_PROPERTY (NO_ISO6429);
872           else if (EQ (key, Qescape_quoted)) FROB_BOOLEAN_PROPERTY (ESCAPE_QUOTED);
873
874           else if (EQ (key, Qinput_charset_conversion))
875             {
876               codesys->iso2022.input_conv =
877                 Dynarr_new (charset_conversion_spec);
878               parse_charset_conversion_specs (codesys->iso2022.input_conv,
879                                               value);
880             }
881           else if (EQ (key, Qoutput_charset_conversion))
882             {
883               codesys->iso2022.output_conv =
884                 Dynarr_new (charset_conversion_spec);
885               parse_charset_conversion_specs (codesys->iso2022.output_conv,
886                                               value);
887             }
888           else
889             signal_simple_error ("Unrecognized property", key);
890         }
891       else if (EQ (type, Qccl))
892         {
893           if (EQ (key, Qdecode))
894             {
895               CHECK_VECTOR (value);
896               CODING_SYSTEM_CCL_DECODE (codesys) = value;
897             }
898           else if (EQ (key, Qencode))
899             {
900               CHECK_VECTOR (value);
901               CODING_SYSTEM_CCL_ENCODE (codesys) = value;
902             }
903           else
904             signal_simple_error ("Unrecognized property", key);
905         }
906 #endif /* MULE */
907       else
908         signal_simple_error ("Unrecognized property", key);
909     }
910
911   if (need_to_setup_eol_systems)
912     setup_eol_coding_systems (codesys);
913
914   {
915     Lisp_Object codesys_obj;
916     XSETCODING_SYSTEM (codesys_obj, codesys);
917     Fputhash (name, codesys_obj, Vcoding_system_hash_table);
918     return codesys_obj;
919   }
920 }
921
922 DEFUN ("copy-coding-system", Fcopy_coding_system, 2, 2, 0, /*
923 Copy OLD-CODING-SYSTEM to NEW-NAME.
924 If NEW-NAME does not name an existing coding system, a new one will
925 be created.
926 */
927        (old_coding_system, new_name))
928 {
929   Lisp_Object new_coding_system;
930   old_coding_system = Fget_coding_system (old_coding_system);
931   new_coding_system = Ffind_coding_system (new_name);
932   if (NILP (new_coding_system))
933     {
934       XSETCODING_SYSTEM (new_coding_system,
935                          allocate_coding_system
936                          (XCODING_SYSTEM_TYPE (old_coding_system),
937                           new_name));
938       Fputhash (new_name, new_coding_system, Vcoding_system_hash_table);
939     }
940
941   {
942     Lisp_Coding_System *to = XCODING_SYSTEM (new_coding_system);
943     Lisp_Coding_System *from = XCODING_SYSTEM (old_coding_system);
944     memcpy (((char *) to  ) + sizeof (to->header),
945             ((char *) from) + sizeof (from->header),
946             sizeof (*from) - sizeof (from->header));
947     to->name = new_name;
948   }
949   return new_coding_system;
950 }
951
952 DEFUN ("define-coding-system-alias", Fdefine_coding_system_alias, 2, 2, 0, /*
953 Define symbol ALIAS as an alias for coding system CODING-SYSTEM.
954 */
955        (alias, coding_system))
956 {
957   CHECK_SYMBOL (alias);
958   if (!NILP (Ffind_coding_system (alias)))
959     signal_simple_error ("Symbol already names a coding system", alias);
960   coding_system = Fget_coding_system (coding_system);
961   Fputhash (alias, coding_system, Vcoding_system_hash_table);
962
963   /* Set up aliases for subsidiaries. */
964   if (XCODING_SYSTEM_EOL_TYPE (coding_system) == EOL_AUTODETECT)
965     {
966       Lisp_Object str;
967       XSETSTRING (str, symbol_name (XSYMBOL (alias)));
968 #define FROB(type, name)                                                        \
969       do {                                                                      \
970         Lisp_Object subsidiary = XCODING_SYSTEM_EOL_##type (coding_system);     \
971         if (!NILP (subsidiary))                                                 \
972           Fdefine_coding_system_alias                                           \
973             (Fintern (concat2 (str, build_string (name)), Qnil), subsidiary);   \
974       } while (0)
975       FROB (LF,   "-unix");
976       FROB (CRLF, "-dos");
977       FROB (CR,   "-mac");
978 #undef FROB
979     }
980   /* FSF return value is a vector of [ALIAS-unix ALIAS-doc ALIAS-mac],
981      but it doesn't look intentional, so I'd rather return something
982      meaningful or nothing at all. */
983   return Qnil;
984 }
985
986 static Lisp_Object
987 subsidiary_coding_system (Lisp_Object coding_system, enum eol_type type)
988 {
989   Lisp_Coding_System *cs = XCODING_SYSTEM (coding_system);
990   Lisp_Object new_coding_system;
991
992   if (CODING_SYSTEM_EOL_TYPE (cs) != EOL_AUTODETECT)
993     return coding_system;
994
995   switch (type)
996     {
997     case EOL_AUTODETECT: return coding_system;
998     case EOL_LF:   new_coding_system = CODING_SYSTEM_EOL_LF   (cs); break;
999     case EOL_CR:   new_coding_system = CODING_SYSTEM_EOL_CR   (cs); break;
1000     case EOL_CRLF: new_coding_system = CODING_SYSTEM_EOL_CRLF (cs); break;
1001     default:       abort ();
1002     }
1003
1004   return NILP (new_coding_system) ? coding_system : new_coding_system;
1005 }
1006
1007 DEFUN ("subsidiary-coding-system", Fsubsidiary_coding_system, 2, 2, 0, /*
1008 Return the subsidiary coding system of CODING-SYSTEM with eol type EOL-TYPE.
1009 */
1010        (coding_system, eol_type))
1011 {
1012   coding_system = Fget_coding_system (coding_system);
1013
1014   return subsidiary_coding_system (coding_system,
1015                                    symbol_to_eol_type (eol_type));
1016 }
1017
1018 \f
1019 /************************************************************************/
1020 /*                         Coding system accessors                      */
1021 /************************************************************************/
1022
1023 DEFUN ("coding-system-doc-string", Fcoding_system_doc_string, 1, 1, 0, /*
1024 Return the doc string for CODING-SYSTEM.
1025 */
1026        (coding_system))
1027 {
1028   coding_system = Fget_coding_system (coding_system);
1029   return XCODING_SYSTEM_DOC_STRING (coding_system);
1030 }
1031
1032 DEFUN ("coding-system-type", Fcoding_system_type, 1, 1, 0, /*
1033 Return the type of CODING-SYSTEM.
1034 */
1035        (coding_system))
1036 {
1037   switch (XCODING_SYSTEM_TYPE (Fget_coding_system (coding_system)))
1038     {
1039     default: abort ();
1040     case CODESYS_AUTODETECT:    return Qundecided;
1041 #ifdef MULE
1042     case CODESYS_SHIFT_JIS:     return Qshift_jis;
1043     case CODESYS_ISO2022:       return Qiso2022;
1044     case CODESYS_BIG5:          return Qbig5;
1045     case CODESYS_UCS4:          return Qucs4;
1046     case CODESYS_UTF8:          return Qutf8;
1047     case CODESYS_CCL:           return Qccl;
1048 #endif
1049     case CODESYS_NO_CONVERSION: return Qno_conversion;
1050 #ifdef DEBUG_XEMACS
1051     case CODESYS_INTERNAL:      return Qinternal;
1052 #endif
1053     }
1054 }
1055
1056 #ifdef MULE
1057 static
1058 Lisp_Object coding_system_charset (Lisp_Object coding_system, int gnum)
1059 {
1060   Lisp_Object cs
1061     = XCODING_SYSTEM_ISO2022_INITIAL_CHARSET (coding_system, gnum);
1062
1063   return CHARSETP (cs) ? XCHARSET_NAME (cs) : Qnil;
1064 }
1065
1066 DEFUN ("coding-system-charset", Fcoding_system_charset, 2, 2, 0, /*
1067 Return initial charset of CODING-SYSTEM designated to GNUM.
1068 GNUM allows 0 .. 3.
1069 */
1070        (coding_system, gnum))
1071 {
1072   coding_system = Fget_coding_system (coding_system);
1073   CHECK_INT (gnum);
1074
1075   return coding_system_charset (coding_system, XINT (gnum));
1076 }
1077 #endif /* MULE */
1078
1079 DEFUN ("coding-system-property", Fcoding_system_property, 2, 2, 0, /*
1080 Return the PROP property of CODING-SYSTEM.
1081 */
1082        (coding_system, prop))
1083 {
1084   int i, ok = 0;
1085   enum coding_system_type type;
1086
1087   coding_system = Fget_coding_system (coding_system);
1088   CHECK_SYMBOL (prop);
1089   type = XCODING_SYSTEM_TYPE (coding_system);
1090
1091   for (i = 0; !ok && i < Dynarr_length (the_codesys_prop_dynarr); i++)
1092     if (EQ (Dynarr_at (the_codesys_prop_dynarr, i).sym, prop))
1093       {
1094         ok = 1;
1095         switch (Dynarr_at (the_codesys_prop_dynarr, i).prop_type)
1096           {
1097           case CODESYS_PROP_ALL_OK:
1098             break;
1099 #ifdef MULE
1100           case CODESYS_PROP_ISO2022:
1101             if (type != CODESYS_ISO2022)
1102               signal_simple_error
1103                 ("Property only valid in ISO2022 coding systems",
1104                  prop);
1105             break;
1106
1107           case CODESYS_PROP_CCL:
1108             if (type != CODESYS_CCL)
1109               signal_simple_error
1110                 ("Property only valid in CCL coding systems",
1111                  prop);
1112             break;
1113 #endif /* MULE */
1114           default:
1115             abort ();
1116           }
1117       }
1118
1119   if (!ok)
1120     signal_simple_error ("Unrecognized property", prop);
1121
1122   if (EQ (prop, Qname))
1123     return XCODING_SYSTEM_NAME (coding_system);
1124   else if (EQ (prop, Qtype))
1125     return Fcoding_system_type (coding_system);
1126   else if (EQ (prop, Qdoc_string))
1127     return XCODING_SYSTEM_DOC_STRING (coding_system);
1128   else if (EQ (prop, Qmnemonic))
1129     return XCODING_SYSTEM_MNEMONIC (coding_system);
1130   else if (EQ (prop, Qeol_type))
1131     return eol_type_to_symbol (XCODING_SYSTEM_EOL_TYPE (coding_system));
1132   else if (EQ (prop, Qeol_lf))
1133     return XCODING_SYSTEM_EOL_LF (coding_system);
1134   else if (EQ (prop, Qeol_crlf))
1135     return XCODING_SYSTEM_EOL_CRLF (coding_system);
1136   else if (EQ (prop, Qeol_cr))
1137     return XCODING_SYSTEM_EOL_CR (coding_system);
1138   else if (EQ (prop, Qpost_read_conversion))
1139     return XCODING_SYSTEM_POST_READ_CONVERSION (coding_system);
1140   else if (EQ (prop, Qpre_write_conversion))
1141     return XCODING_SYSTEM_PRE_WRITE_CONVERSION (coding_system);
1142 #ifdef MULE
1143   else if (type == CODESYS_ISO2022)
1144     {
1145       if (EQ (prop, Qcharset_g0))
1146         return coding_system_charset (coding_system, 0);
1147       else if (EQ (prop, Qcharset_g1))
1148         return coding_system_charset (coding_system, 1);
1149       else if (EQ (prop, Qcharset_g2))
1150         return coding_system_charset (coding_system, 2);
1151       else if (EQ (prop, Qcharset_g3))
1152         return coding_system_charset (coding_system, 3);
1153
1154 #define FORCE_CHARSET(charset_num) \
1155   (XCODING_SYSTEM_ISO2022_FORCE_CHARSET_ON_OUTPUT \
1156    (coding_system, charset_num) ? Qt : Qnil)
1157
1158       else if (EQ (prop, Qforce_g0_on_output)) return FORCE_CHARSET (0);
1159       else if (EQ (prop, Qforce_g1_on_output)) return FORCE_CHARSET (1);
1160       else if (EQ (prop, Qforce_g2_on_output)) return FORCE_CHARSET (2);
1161       else if (EQ (prop, Qforce_g3_on_output)) return FORCE_CHARSET (3);
1162
1163 #define LISP_BOOLEAN(prop) \
1164   (XCODING_SYSTEM_ISO2022_##prop (coding_system) ? Qt : Qnil)
1165
1166       else if (EQ (prop, Qshort))         return LISP_BOOLEAN (SHORT);
1167       else if (EQ (prop, Qno_ascii_eol))  return LISP_BOOLEAN (NO_ASCII_EOL);
1168       else if (EQ (prop, Qno_ascii_cntl)) return LISP_BOOLEAN (NO_ASCII_CNTL);
1169       else if (EQ (prop, Qseven))         return LISP_BOOLEAN (SEVEN);
1170       else if (EQ (prop, Qlock_shift))    return LISP_BOOLEAN (LOCK_SHIFT);
1171       else if (EQ (prop, Qno_iso6429))    return LISP_BOOLEAN (NO_ISO6429);
1172       else if (EQ (prop, Qescape_quoted)) return LISP_BOOLEAN (ESCAPE_QUOTED);
1173
1174       else if (EQ (prop, Qinput_charset_conversion))
1175         return
1176           unparse_charset_conversion_specs
1177             (XCODING_SYSTEM (coding_system)->iso2022.input_conv);
1178       else if (EQ (prop, Qoutput_charset_conversion))
1179         return
1180           unparse_charset_conversion_specs
1181             (XCODING_SYSTEM (coding_system)->iso2022.output_conv);
1182       else
1183         abort ();
1184     }
1185   else if (type == CODESYS_CCL)
1186     {
1187       if (EQ (prop, Qdecode))
1188         return XCODING_SYSTEM_CCL_DECODE (coding_system);
1189       else if (EQ (prop, Qencode))
1190         return XCODING_SYSTEM_CCL_ENCODE (coding_system);
1191       else
1192         abort ();
1193     }
1194 #endif /* MULE */
1195   else
1196     abort ();
1197
1198   return Qnil; /* not reached */
1199 }
1200
1201 \f
1202 /************************************************************************/
1203 /*                       Coding category functions                      */
1204 /************************************************************************/
1205
1206 static int
1207 decode_coding_category (Lisp_Object symbol)
1208 {
1209   int i;
1210
1211   CHECK_SYMBOL (symbol);
1212   for (i = 0; i <= CODING_CATEGORY_LAST; i++)
1213     if (EQ (coding_category_symbol[i], symbol))
1214       return i;
1215
1216   signal_simple_error ("Unrecognized coding category", symbol);
1217   return 0; /* not reached */
1218 }
1219
1220 DEFUN ("coding-category-list", Fcoding_category_list, 0, 0, 0, /*
1221 Return a list of all recognized coding categories.
1222 */
1223        ())
1224 {
1225   int i;
1226   Lisp_Object list = Qnil;
1227
1228   for (i = CODING_CATEGORY_LAST; i >= 0; i--)
1229     list = Fcons (coding_category_symbol[i], list);
1230   return list;
1231 }
1232
1233 DEFUN ("set-coding-priority-list", Fset_coding_priority_list, 1, 1, 0, /*
1234 Change the priority order of the coding categories.
1235 LIST should be list of coding categories, in descending order of
1236 priority.  Unspecified coding categories will be lower in priority
1237 than all specified ones, in the same relative order they were in
1238 previously.
1239 */
1240        (list))
1241 {
1242   int category_to_priority[CODING_CATEGORY_LAST + 1];
1243   int i, j;
1244   Lisp_Object rest;
1245
1246   /* First generate a list that maps coding categories to priorities. */
1247
1248   for (i = 0; i <= CODING_CATEGORY_LAST; i++)
1249     category_to_priority[i] = -1;
1250
1251   /* Highest priority comes from the specified list. */
1252   i = 0;
1253   EXTERNAL_LIST_LOOP (rest, list)
1254     {
1255       int cat = decode_coding_category (XCAR (rest));
1256
1257       if (category_to_priority[cat] >= 0)
1258         signal_simple_error ("Duplicate coding category in list", XCAR (rest));
1259       category_to_priority[cat] = i++;
1260     }
1261
1262   /* Now go through the existing categories by priority to retrieve
1263      the categories not yet specified and preserve their priority
1264      order. */
1265   for (j = 0; j <= CODING_CATEGORY_LAST; j++)
1266     {
1267       int cat = coding_category_by_priority[j];
1268       if (category_to_priority[cat] < 0)
1269         category_to_priority[cat] = i++;
1270     }
1271
1272   /* Now we need to construct the inverse of the mapping we just
1273      constructed. */
1274
1275   for (i = 0; i <= CODING_CATEGORY_LAST; i++)
1276     coding_category_by_priority[category_to_priority[i]] = i;
1277
1278   /* Phew!  That was confusing. */
1279   return Qnil;
1280 }
1281
1282 DEFUN ("coding-priority-list", Fcoding_priority_list, 0, 0, 0, /*
1283 Return a list of coding categories in descending order of priority.
1284 */
1285        ())
1286 {
1287   int i;
1288   Lisp_Object list = Qnil;
1289
1290   for (i = CODING_CATEGORY_LAST; i >= 0; i--)
1291     list = Fcons (coding_category_symbol[coding_category_by_priority[i]],
1292                   list);
1293   return list;
1294 }
1295
1296 DEFUN ("set-coding-category-system", Fset_coding_category_system, 2, 2, 0, /*
1297 Change the coding system associated with a coding category.
1298 */
1299        (coding_category, coding_system))
1300 {
1301   int cat = decode_coding_category (coding_category);
1302
1303   coding_system = Fget_coding_system (coding_system);
1304   coding_category_system[cat] = coding_system;
1305   return Qnil;
1306 }
1307
1308 DEFUN ("coding-category-system", Fcoding_category_system, 1, 1, 0, /*
1309 Return the coding system associated with a coding category.
1310 */
1311        (coding_category))
1312 {
1313   int cat = decode_coding_category (coding_category);
1314   Lisp_Object sys = coding_category_system[cat];
1315
1316   if (!NILP (sys))
1317     return XCODING_SYSTEM_NAME (sys);
1318   return Qnil;
1319 }
1320
1321 \f
1322 /************************************************************************/
1323 /*                     Detecting the encoding of data                   */
1324 /************************************************************************/
1325
1326 struct detection_state
1327 {
1328   enum eol_type eol_type;
1329   int seen_non_ascii;
1330   int mask;
1331 #ifdef MULE
1332   struct
1333     {
1334       int mask;
1335       int in_second_byte;
1336     }
1337   big5;
1338
1339   struct
1340     {
1341       int mask;
1342       int in_second_byte;
1343     }
1344   shift_jis;
1345
1346   struct
1347     {
1348       int mask;
1349       int in_byte;
1350   }
1351   ucs4;
1352
1353   struct
1354     {
1355       int mask;
1356       int in_byte;
1357     }
1358   utf8;
1359
1360   struct
1361     {
1362       int mask;
1363       int initted;
1364       struct iso2022_decoder iso;
1365       unsigned int flags;
1366       int high_byte_count;
1367       unsigned int saw_single_shift:1;
1368     }
1369   iso2022;
1370 #endif
1371   struct
1372     {
1373       int seen_anything;
1374       int just_saw_cr;
1375     }
1376   eol;
1377 };
1378
1379 static int
1380 acceptable_control_char_p (int c)
1381 {
1382   switch (c)
1383     {
1384       /* Allow and ignore control characters that you might
1385          reasonably see in a text file */
1386     case '\r':
1387     case '\n':
1388     case '\t':
1389     case  7: /* bell */
1390     case  8: /* backspace */
1391     case 11: /* vertical tab */
1392     case 12: /* form feed */
1393     case 26: /* MS-DOS C-z junk */
1394     case 31: /* '^_' -- for info */
1395       return 1;
1396     default:
1397       return 0;
1398     }
1399 }
1400
1401 static int
1402 mask_has_at_most_one_bit_p (int mask)
1403 {
1404   /* Perhaps the only thing useful you learn from intensive Microsoft
1405      technical interviews */
1406   return (mask & (mask - 1)) == 0;
1407 }
1408
1409 static enum eol_type
1410 detect_eol_type (struct detection_state *st, CONST unsigned char *src,
1411                  unsigned int n)
1412 {
1413   int c;
1414
1415   while (n--)
1416     {
1417       c = *src++;
1418       if (c == '\r')
1419         st->eol.just_saw_cr = 1;
1420       else
1421         {
1422           if (c == '\n')
1423             {
1424               if (st->eol.just_saw_cr)
1425                 return EOL_CRLF;
1426               else if (st->eol.seen_anything)
1427                 return EOL_LF;
1428             }
1429           else if (st->eol.just_saw_cr)
1430             return EOL_CR;
1431           st->eol.just_saw_cr = 0;
1432         }
1433       st->eol.seen_anything = 1;
1434     }
1435
1436   return EOL_AUTODETECT;
1437 }
1438
1439 /* Attempt to determine the encoding and EOL type of the given text.
1440    Before calling this function for the first type, you must initialize
1441    st->eol_type as appropriate and initialize st->mask to ~0.
1442
1443    st->eol_type holds the determined EOL type, or EOL_AUTODETECT if
1444    not yet known.
1445
1446    st->mask holds the determined coding category mask, or ~0 if only
1447    ASCII has been seen so far.
1448
1449    Returns:
1450
1451    0 == st->eol_type is EOL_AUTODETECT and/or more than coding category
1452         is present in st->mask
1453    1 == definitive answers are here for both st->eol_type and st->mask
1454 */
1455
1456 static int
1457 detect_coding_type (struct detection_state *st, CONST unsigned char *src,
1458                     unsigned int n, int just_do_eol)
1459 {
1460   int c;
1461
1462   if (st->eol_type == EOL_AUTODETECT)
1463     st->eol_type = detect_eol_type (st, src, n);
1464
1465   if (just_do_eol)
1466     return st->eol_type != EOL_AUTODETECT;
1467
1468   if (!st->seen_non_ascii)
1469     {
1470       for (; n; n--, src++)
1471         {
1472           c = *src;
1473           if ((c < 0x20 && !acceptable_control_char_p (c)) || c >= 0x80)
1474             {
1475               st->seen_non_ascii = 1;
1476 #ifdef MULE
1477               st->shift_jis.mask = ~0;
1478               st->big5.mask = ~0;
1479               st->ucs4.mask = ~0;
1480               st->utf8.mask = ~0;
1481               st->iso2022.mask = ~0;
1482 #endif
1483               break;
1484             }
1485         }
1486     }
1487
1488   if (!n)
1489     return 0;
1490 #ifdef MULE
1491   if (!mask_has_at_most_one_bit_p (st->iso2022.mask))
1492     st->iso2022.mask = detect_coding_iso2022 (st, src, n);
1493   if (!mask_has_at_most_one_bit_p (st->shift_jis.mask))
1494     st->shift_jis.mask = detect_coding_sjis (st, src, n);
1495   if (!mask_has_at_most_one_bit_p (st->big5.mask))
1496     st->big5.mask = detect_coding_big5 (st, src, n);
1497   if (!mask_has_at_most_one_bit_p (st->utf8.mask))
1498     st->utf8.mask = detect_coding_utf8 (st, src, n);
1499   if (!mask_has_at_most_one_bit_p (st->ucs4.mask))
1500     st->ucs4.mask = detect_coding_ucs4 (st, src, n);
1501
1502   st->mask
1503     = st->iso2022.mask | st->shift_jis.mask | st->big5.mask
1504     | st->utf8.mask | st->ucs4.mask;
1505 #endif
1506   {
1507     int retval = mask_has_at_most_one_bit_p (st->mask);
1508     st->mask |= CODING_CATEGORY_NO_CONVERSION_MASK;
1509     return retval && st->eol_type != EOL_AUTODETECT;
1510   }
1511 }
1512
1513 static Lisp_Object
1514 coding_system_from_mask (int mask)
1515 {
1516   if (mask == ~0)
1517     {
1518       /* If the file was entirely or basically ASCII, use the
1519          default value of `buffer-file-coding-system'. */
1520       Lisp_Object retval =
1521         XBUFFER (Vbuffer_defaults)->buffer_file_coding_system;
1522       if (!NILP (retval))
1523         {
1524           retval = Ffind_coding_system (retval);
1525           if (NILP (retval))
1526             {
1527               warn_when_safe
1528                 (Qbad_variable, Qwarning,
1529                  "Invalid `default-buffer-file-coding-system', set to nil");
1530               XBUFFER (Vbuffer_defaults)->buffer_file_coding_system = Qnil;
1531             }
1532         }
1533       if (NILP (retval))
1534         retval = Fget_coding_system (Qno_conversion);
1535       return retval;
1536     }
1537   else
1538     {
1539       int i;
1540       int cat = -1;
1541 #ifdef MULE
1542       mask = postprocess_iso2022_mask (mask);
1543 #endif
1544       /* Look through the coding categories by priority and find
1545          the first one that is allowed. */
1546       for (i = 0; i <= CODING_CATEGORY_LAST; i++)
1547         {
1548           cat = coding_category_by_priority[i];
1549           if ((mask & (1 << cat)) &&
1550               !NILP (coding_category_system[cat]))
1551             break;
1552         }
1553       if (cat >= 0)
1554         return coding_category_system[cat];
1555       else
1556         return Fget_coding_system (Qno_conversion);
1557     }
1558 }
1559
1560 /* Given a seekable read stream and potential coding system and EOL type
1561    as specified, do any autodetection that is called for.  If the
1562    coding system and/or EOL type are not autodetect, they will be left
1563    alone; but this function will never return an autodetect coding system
1564    or EOL type.
1565
1566    This function does not automatically fetch subsidiary coding systems;
1567    that should be unnecessary with the explicit eol-type argument. */
1568
1569 void
1570 determine_real_coding_system (Lstream *stream, Lisp_Object *codesys_in_out,
1571                               enum eol_type *eol_type_in_out)
1572 {
1573   struct detection_state decst;
1574
1575   if (*eol_type_in_out == EOL_AUTODETECT)
1576     *eol_type_in_out = XCODING_SYSTEM_EOL_TYPE (*codesys_in_out);
1577
1578   xzero (decst);
1579   decst.eol_type = *eol_type_in_out;
1580   decst.mask = ~0;
1581
1582   /* If autodetection is called for, do it now. */
1583   if (XCODING_SYSTEM_TYPE (*codesys_in_out) == CODESYS_AUTODETECT ||
1584       *eol_type_in_out == EOL_AUTODETECT)
1585     {
1586
1587       while (1)
1588         {
1589           unsigned char random_buffer[4096];
1590           int nread;
1591
1592           nread = Lstream_read (stream, random_buffer, sizeof (random_buffer));
1593           if (!nread)
1594             break;
1595           if (detect_coding_type (&decst, random_buffer, nread,
1596                                   XCODING_SYSTEM_TYPE (*codesys_in_out) !=
1597                                   CODESYS_AUTODETECT))
1598             break;
1599         }
1600
1601       *eol_type_in_out = decst.eol_type;
1602       if (XCODING_SYSTEM_TYPE (*codesys_in_out) == CODESYS_AUTODETECT)
1603         *codesys_in_out = coding_system_from_mask (decst.mask);
1604     }
1605
1606   /* If we absolutely can't determine the EOL type, just assume LF. */
1607   if (*eol_type_in_out == EOL_AUTODETECT)
1608     *eol_type_in_out = EOL_LF;
1609
1610   Lstream_rewind (stream);
1611 }
1612
1613 DEFUN ("detect-coding-region", Fdetect_coding_region, 2, 3, 0, /*
1614 Detect coding system of the text in the region between START and END.
1615 Returned a list of possible coding systems ordered by priority.
1616 If only ASCII characters are found, it returns 'undecided or one of
1617 its subsidiary coding systems according to a detected end-of-line
1618 type.  Optional arg BUFFER defaults to the current buffer.
1619 */
1620        (start, end, buffer))
1621 {
1622   Lisp_Object val = Qnil;
1623   struct buffer *buf = decode_buffer (buffer, 0);
1624   Bufpos b, e;
1625   Lisp_Object instream, lb_instream;
1626   Lstream *istr, *lb_istr;
1627   struct detection_state decst;
1628   struct gcpro gcpro1, gcpro2;
1629
1630   get_buffer_range_char (buf, start, end, &b, &e, 0);
1631   lb_instream = make_lisp_buffer_input_stream (buf, b, e, 0);
1632   lb_istr = XLSTREAM (lb_instream);
1633   instream = make_encoding_input_stream (lb_istr, Fget_coding_system (Qbinary));
1634   istr = XLSTREAM (instream);
1635   GCPRO2 (instream, lb_instream);
1636   xzero (decst);
1637   decst.eol_type = EOL_AUTODETECT;
1638   decst.mask = ~0;
1639   while (1)
1640     {
1641       unsigned char random_buffer[4096];
1642       int nread = Lstream_read (istr, random_buffer, sizeof (random_buffer));
1643
1644       if (!nread)
1645         break;
1646       if (detect_coding_type (&decst, random_buffer, nread, 0))
1647         break;
1648     }
1649
1650   if (decst.mask == ~0)
1651     val = subsidiary_coding_system (Fget_coding_system (Qundecided),
1652                                     decst.eol_type);
1653   else
1654     {
1655       int i;
1656
1657       val = Qnil;
1658 #ifdef MULE
1659       decst.mask = postprocess_iso2022_mask (decst.mask);
1660 #endif
1661       for (i = CODING_CATEGORY_LAST; i >= 0; i--)
1662         {
1663           int sys = coding_category_by_priority[i];
1664           if (decst.mask & (1 << sys))
1665             {
1666               Lisp_Object codesys = coding_category_system[sys];
1667               if (!NILP (codesys))
1668                 codesys = subsidiary_coding_system (codesys, decst.eol_type);
1669               val = Fcons (codesys, val);
1670             }
1671         }
1672     }
1673   Lstream_close (istr);
1674   UNGCPRO;
1675   Lstream_delete (istr);
1676   Lstream_delete (lb_istr);
1677   return val;
1678 }
1679
1680 \f
1681 /************************************************************************/
1682 /*           Converting to internal Mule format ("decoding")            */
1683 /************************************************************************/
1684
1685 /* A decoding stream is a stream used for decoding text (i.e.
1686    converting from some external format to internal format).
1687    The decoding-stream object keeps track of the actual coding
1688    stream, the stream that is at the other end, and data that
1689    needs to be persistent across the lifetime of the stream. */
1690
1691 /* Handle the EOL stuff related to just-read-in character C.
1692    EOL_TYPE is the EOL type of the coding stream.
1693    FLAGS is the current value of FLAGS in the coding stream, and may
1694    be modified by this macro.  (The macro only looks at the
1695    CODING_STATE_CR flag.)  DST is the Dynarr to which the decoded
1696    bytes are to be written.  You need to also define a local goto
1697    label "label_continue_loop" that is at the end of the main
1698    character-reading loop.
1699
1700    If C is a CR character, then this macro handles it entirely and
1701    jumps to label_continue_loop.  Otherwise, this macro does not add
1702    anything to DST, and continues normally.  You should continue
1703    processing C normally after this macro. */
1704
1705 #define DECODE_HANDLE_EOL_TYPE(eol_type, c, flags, dst)         \
1706 do {                                                            \
1707   if (c == '\r')                                                \
1708     {                                                           \
1709       if (eol_type == EOL_CR)                                   \
1710         Dynarr_add (dst, '\n');                                 \
1711       else if (eol_type != EOL_CRLF || flags & CODING_STATE_CR) \
1712         Dynarr_add (dst, c);                                    \
1713       else                                                      \
1714         flags |= CODING_STATE_CR;                               \
1715       goto label_continue_loop;                                 \
1716     }                                                           \
1717   else if (flags & CODING_STATE_CR)                             \
1718     {   /* eol_type == CODING_SYSTEM_EOL_CRLF */                \
1719       if (c != '\n')                                            \
1720         Dynarr_add (dst, '\r');                                 \
1721       flags &= ~CODING_STATE_CR;                                \
1722     }                                                           \
1723 } while (0)
1724
1725 /* C should be a binary character in the range 0 - 255; convert
1726    to internal format and add to Dynarr DST. */
1727
1728 #define DECODE_ADD_BINARY_CHAR(c, dst)          \
1729 do {                                            \
1730   if (BYTE_ASCII_P (c))                         \
1731     Dynarr_add (dst, c);                        \
1732   else if (BYTE_C1_P (c))                       \
1733     {                                           \
1734       Dynarr_add (dst, LEADING_BYTE_CONTROL_1); \
1735       Dynarr_add (dst, c + 0x20);               \
1736     }                                           \
1737   else                                          \
1738     {                                           \
1739       Dynarr_add (dst, LEADING_BYTE_LATIN_ISO8859_1); \
1740       Dynarr_add (dst, c);                      \
1741     }                                           \
1742 } while (0)
1743
1744 #define DECODE_OUTPUT_PARTIAL_CHAR(ch)  \
1745 do {                                    \
1746   if (ch)                               \
1747     {                                   \
1748       DECODE_ADD_BINARY_CHAR (ch, dst); \
1749       ch = 0;                           \
1750     }                                   \
1751 } while (0)
1752
1753 #define DECODE_HANDLE_END_OF_CONVERSION(flags, ch, dst) \
1754 do {                                    \
1755   if (flags & CODING_STATE_END)         \
1756     {                                   \
1757       DECODE_OUTPUT_PARTIAL_CHAR (ch);  \
1758       if (flags & CODING_STATE_CR)      \
1759         Dynarr_add (dst, '\r');         \
1760     }                                   \
1761 } while (0)
1762
1763 #define DECODING_STREAM_DATA(stream) LSTREAM_TYPE_DATA (stream, decoding)
1764
1765 struct decoding_stream
1766 {
1767   /* Coding system that governs the conversion. */
1768   Lisp_Coding_System *codesys;
1769
1770   /* Stream that we read the encoded data from or
1771      write the decoded data to. */
1772   Lstream *other_end;
1773
1774   /* If we are reading, then we can return only a fixed amount of
1775      data, so if the conversion resulted in too much data, we store it
1776      here for retrieval the next time around. */
1777   unsigned_char_dynarr *runoff;
1778
1779   /* FLAGS holds flags indicating the current state of the decoding.
1780      Some of these flags are dependent on the coding system. */
1781   unsigned int flags;
1782
1783   /* CH holds a partially built-up character.  Since we only deal
1784      with one- and two-byte characters at the moment, we only use
1785      this to store the first byte of a two-byte character. */
1786   unsigned int ch;
1787
1788   /* EOL_TYPE specifies the type of end-of-line conversion that
1789      currently applies.  We need to keep this separate from the
1790      EOL type stored in CODESYS because the latter might indicate
1791      automatic EOL-type detection while the former will always
1792      indicate a particular EOL type. */
1793   enum eol_type eol_type;
1794 #ifdef MULE
1795   /* Additional ISO2022 information.  We define the structure above
1796      because it's also needed by the detection routines. */
1797   struct iso2022_decoder iso2022;
1798
1799   /* Additional information (the state of the running CCL program)
1800      used by the CCL decoder. */
1801   struct ccl_program ccl;
1802 #endif
1803   struct detection_state decst;
1804 };
1805
1806 static int decoding_reader     (Lstream *stream,       unsigned char *data, size_t size);
1807 static int decoding_writer     (Lstream *stream, CONST unsigned char *data, size_t size);
1808 static int decoding_rewinder   (Lstream *stream);
1809 static int decoding_seekable_p (Lstream *stream);
1810 static int decoding_flusher    (Lstream *stream);
1811 static int decoding_closer     (Lstream *stream);
1812
1813 static Lisp_Object decoding_marker (Lisp_Object stream,
1814                                     void (*markobj) (Lisp_Object));
1815
1816 DEFINE_LSTREAM_IMPLEMENTATION ("decoding", lstream_decoding,
1817                                sizeof (struct decoding_stream));
1818
1819 static Lisp_Object
1820 decoding_marker (Lisp_Object stream, void (*markobj) (Lisp_Object))
1821 {
1822   Lstream *str = DECODING_STREAM_DATA (XLSTREAM (stream))->other_end;
1823   Lisp_Object str_obj;
1824
1825   /* We do not need to mark the coding systems or charsets stored
1826      within the stream because they are stored in a global list
1827      and automatically marked. */
1828
1829   XSETLSTREAM (str_obj, str);
1830   markobj (str_obj);
1831   if (str->imp->marker)
1832     return (str->imp->marker) (str_obj, markobj);
1833   else
1834     return Qnil;
1835 }
1836
1837 /* Read SIZE bytes of data and store it into DATA.  We are a decoding stream
1838    so we read data from the other end, decode it, and store it into DATA. */
1839
1840 static int
1841 decoding_reader (Lstream *stream, unsigned char *data, size_t size)
1842 {
1843   struct decoding_stream *str = DECODING_STREAM_DATA (stream);
1844   unsigned char *orig_data = data;
1845   int read_size;
1846   int error_occurred = 0;
1847
1848   /* We need to interface to mule_decode(), which expects to take some
1849      amount of data and store the result into a Dynarr.  We have
1850      mule_decode() store into str->runoff, and take data from there
1851      as necessary. */
1852
1853   /* We loop until we have enough data, reading chunks from the other
1854      end and decoding it. */
1855   while (1)
1856     {
1857       /* Take data from the runoff if we can.  Make sure to take at
1858          most SIZE bytes, and delete the data from the runoff. */
1859       if (Dynarr_length (str->runoff) > 0)
1860         {
1861           size_t chunk = min (size, (size_t) Dynarr_length (str->runoff));
1862           memcpy (data, Dynarr_atp (str->runoff, 0), chunk);
1863           Dynarr_delete_many (str->runoff, 0, chunk);
1864           data += chunk;
1865           size -= chunk;
1866         }
1867
1868       if (size == 0)
1869         break; /* No more room for data */
1870
1871       if (str->flags & CODING_STATE_END)
1872         /* This means that on the previous iteration, we hit the EOF on
1873            the other end.  We loop once more so that mule_decode() can
1874            output any final stuff it may be holding, or any "go back
1875            to a sane state" escape sequences. (This latter makes sense
1876            during encoding.) */
1877         break;
1878
1879       /* Exhausted the runoff, so get some more.  DATA has at least
1880          SIZE bytes left of storage in it, so it's OK to read directly
1881          into it.  (We'll be overwriting above, after we've decoded it
1882          into the runoff.) */
1883       read_size = Lstream_read (str->other_end, data, size);
1884       if (read_size < 0)
1885         {
1886           error_occurred = 1;
1887           break;
1888         }
1889       if (read_size == 0)
1890         /* There might be some more end data produced in the translation.
1891            See the comment above. */
1892         str->flags |= CODING_STATE_END;
1893       mule_decode (stream, data, str->runoff, read_size);
1894     }
1895
1896   if (data - orig_data == 0)
1897     return error_occurred ? -1 : 0;
1898   else
1899     return data - orig_data;
1900 }
1901
1902 static int
1903 decoding_writer (Lstream *stream, CONST unsigned char *data, size_t size)
1904 {
1905   struct decoding_stream *str = DECODING_STREAM_DATA (stream);
1906   int retval;
1907
1908   /* Decode all our data into the runoff, and then attempt to write
1909      it all out to the other end.  Remove whatever chunk we succeeded
1910      in writing. */
1911   mule_decode (stream, data, str->runoff, size);
1912   retval = Lstream_write (str->other_end, Dynarr_atp (str->runoff, 0),
1913                           Dynarr_length (str->runoff));
1914   if (retval > 0)
1915     Dynarr_delete_many (str->runoff, 0, retval);
1916   /* Do NOT return retval.  The return value indicates how much
1917      of the incoming data was written, not how many bytes were
1918      written. */
1919   return size;
1920 }
1921
1922 static void
1923 reset_decoding_stream (struct decoding_stream *str)
1924 {
1925 #ifdef MULE
1926   if (CODING_SYSTEM_TYPE (str->codesys) == CODESYS_ISO2022)
1927     {
1928       Lisp_Object coding_system;
1929       XSETCODING_SYSTEM (coding_system, str->codesys);
1930       reset_iso2022 (coding_system, &str->iso2022);
1931     }
1932   else if (CODING_SYSTEM_TYPE (str->codesys) == CODESYS_CCL)
1933     {
1934       setup_ccl_program (&str->ccl, CODING_SYSTEM_CCL_DECODE (str->codesys));
1935     }
1936 #endif /* MULE */
1937   str->flags = str->ch = 0;
1938 }
1939
1940 static int
1941 decoding_rewinder (Lstream *stream)
1942 {
1943   struct decoding_stream *str = DECODING_STREAM_DATA (stream);
1944   reset_decoding_stream (str);
1945   Dynarr_reset (str->runoff);
1946   return Lstream_rewind (str->other_end);
1947 }
1948
1949 static int
1950 decoding_seekable_p (Lstream *stream)
1951 {
1952   struct decoding_stream *str = DECODING_STREAM_DATA (stream);
1953   return Lstream_seekable_p (str->other_end);
1954 }
1955
1956 static int
1957 decoding_flusher (Lstream *stream)
1958 {
1959   struct decoding_stream *str = DECODING_STREAM_DATA (stream);
1960   return Lstream_flush (str->other_end);
1961 }
1962
1963 static int
1964 decoding_closer (Lstream *stream)
1965 {
1966   struct decoding_stream *str = DECODING_STREAM_DATA (stream);
1967   if (stream->flags & LSTREAM_FL_WRITE)
1968     {
1969       str->flags |= CODING_STATE_END;
1970       decoding_writer (stream, 0, 0);
1971     }
1972   Dynarr_free (str->runoff);
1973 #ifdef MULE
1974 #ifdef ENABLE_COMPOSITE_CHARS
1975   if (str->iso2022.composite_chars)
1976     Dynarr_free (str->iso2022.composite_chars);
1977 #endif
1978 #endif
1979   return Lstream_close (str->other_end);
1980 }
1981
1982 Lisp_Object
1983 decoding_stream_coding_system (Lstream *stream)
1984 {
1985   Lisp_Object coding_system;
1986   struct decoding_stream *str = DECODING_STREAM_DATA (stream);
1987
1988   XSETCODING_SYSTEM (coding_system, str->codesys);
1989   return subsidiary_coding_system (coding_system, str->eol_type);
1990 }
1991
1992 void
1993 set_decoding_stream_coding_system (Lstream *lstr, Lisp_Object codesys)
1994 {
1995   Lisp_Coding_System *cs = XCODING_SYSTEM (codesys);
1996   struct decoding_stream *str = DECODING_STREAM_DATA (lstr);
1997   str->codesys = cs;
1998   if (CODING_SYSTEM_EOL_TYPE (cs) != EOL_AUTODETECT)
1999     str->eol_type = CODING_SYSTEM_EOL_TYPE (cs);
2000   reset_decoding_stream (str);
2001 }
2002
2003 /* WARNING WARNING WARNING WARNING!!!!!  If you open up a decoding
2004    stream for writing, no automatic code detection will be performed.
2005    The reason for this is that automatic code detection requires a
2006    seekable input.  Things will also fail if you open a decoding
2007    stream for reading using a non-fully-specified coding system and
2008    a non-seekable input stream. */
2009
2010 static Lisp_Object
2011 make_decoding_stream_1 (Lstream *stream, Lisp_Object codesys,
2012                         CONST char *mode)
2013 {
2014   Lstream *lstr = Lstream_new (lstream_decoding, mode);
2015   struct decoding_stream *str = DECODING_STREAM_DATA (lstr);
2016   Lisp_Object obj;
2017
2018   xzero (*str);
2019   str->other_end = stream;
2020   str->runoff = (unsigned_char_dynarr *) Dynarr_new (unsigned_char);
2021   str->eol_type = EOL_AUTODETECT;
2022   if (!strcmp (mode, "r")
2023       && Lstream_seekable_p (stream))
2024     /* We can determine the coding system now. */
2025     determine_real_coding_system (stream, &codesys, &str->eol_type);
2026   set_decoding_stream_coding_system (lstr, codesys);
2027   str->decst.eol_type = str->eol_type;
2028   str->decst.mask = ~0;
2029   XSETLSTREAM (obj, lstr);
2030   return obj;
2031 }
2032
2033 Lisp_Object
2034 make_decoding_input_stream (Lstream *stream, Lisp_Object codesys)
2035 {
2036   return make_decoding_stream_1 (stream, codesys, "r");
2037 }
2038
2039 Lisp_Object
2040 make_decoding_output_stream (Lstream *stream, Lisp_Object codesys)
2041 {
2042   return make_decoding_stream_1 (stream, codesys, "w");
2043 }
2044
2045 /* Note: the decode_coding_* functions all take the same
2046    arguments as mule_decode(), which is to say some SRC data of
2047    size N, which is to be stored into dynamic array DST.
2048    DECODING is the stream within which the decoding is
2049    taking place, but no data is actually read from or
2050    written to that stream; that is handled in decoding_reader()
2051    or decoding_writer().  This allows the same functions to
2052    be used for both reading and writing. */
2053
2054 static void
2055 mule_decode (Lstream *decoding, CONST unsigned char *src,
2056              unsigned_char_dynarr *dst, unsigned int n)
2057 {
2058   struct decoding_stream *str = DECODING_STREAM_DATA (decoding);
2059
2060   /* If necessary, do encoding-detection now.  We do this when
2061      we're a writing stream or a non-seekable reading stream,
2062      meaning that we can't just process the whole input,
2063      rewind, and start over. */
2064
2065   if (CODING_SYSTEM_TYPE (str->codesys) == CODESYS_AUTODETECT ||
2066       str->eol_type == EOL_AUTODETECT)
2067     {
2068       Lisp_Object codesys;
2069
2070       XSETCODING_SYSTEM (codesys, str->codesys);
2071       detect_coding_type (&str->decst, src, n,
2072                           CODING_SYSTEM_TYPE (str->codesys) !=
2073                           CODESYS_AUTODETECT);
2074       if (CODING_SYSTEM_TYPE (str->codesys) == CODESYS_AUTODETECT &&
2075           str->decst.mask != ~0)
2076         /* #### This is cheesy.  What we really ought to do is
2077            buffer up a certain amount of data so as to get a
2078            less random result. */
2079         codesys = coding_system_from_mask (str->decst.mask);
2080       str->eol_type = str->decst.eol_type;
2081       if (XCODING_SYSTEM (codesys) != str->codesys)
2082         {
2083           /* Preserve the CODING_STATE_END flag in case it was set.
2084              If we erase it, bad things might happen. */
2085           int was_end = str->flags & CODING_STATE_END;
2086           set_decoding_stream_coding_system (decoding, codesys);
2087           if (was_end)
2088             str->flags |= CODING_STATE_END;
2089         }
2090     }
2091
2092   switch (CODING_SYSTEM_TYPE (str->codesys))
2093     {
2094 #ifdef DEBUG_XEMACS
2095     case CODESYS_INTERNAL:
2096       Dynarr_add_many (dst, src, n);
2097       break;
2098 #endif
2099     case CODESYS_AUTODETECT:
2100       /* If we got this far and still haven't decided on the coding
2101          system, then do no conversion. */
2102     case CODESYS_NO_CONVERSION:
2103       decode_coding_no_conversion (decoding, src, dst, n);
2104       break;
2105 #ifdef MULE
2106     case CODESYS_SHIFT_JIS:
2107       decode_coding_sjis (decoding, src, dst, n);
2108       break;
2109     case CODESYS_BIG5:
2110       decode_coding_big5 (decoding, src, dst, n);
2111       break;
2112     case CODESYS_UCS4:
2113       decode_coding_ucs4 (decoding, src, dst, n);
2114       break;
2115     case CODESYS_UTF8:
2116       decode_coding_utf8 (decoding, src, dst, n);
2117       break;
2118     case CODESYS_CCL:
2119       ccl_driver (&str->ccl, src, dst, n, 0);
2120       break;
2121     case CODESYS_ISO2022:
2122       decode_coding_iso2022 (decoding, src, dst, n);
2123       break;
2124 #endif /* MULE */
2125     default:
2126       abort ();
2127     }
2128 }
2129
2130 DEFUN ("decode-coding-region", Fdecode_coding_region, 3, 4, 0, /*
2131 Decode the text between START and END which is encoded in CODING-SYSTEM.
2132 This is useful if you've read in encoded text from a file without decoding
2133 it (e.g. you read in a JIS-formatted file but used the `binary' or
2134 `no-conversion' coding system, so that it shows up as "^[$B!<!+^[(B").
2135 Return length of decoded text.
2136 BUFFER defaults to the current buffer if unspecified.
2137 */
2138        (start, end, coding_system, buffer))
2139 {
2140   Bufpos b, e;
2141   struct buffer *buf = decode_buffer (buffer, 0);
2142   Lisp_Object instream, lb_outstream, de_outstream, outstream;
2143   Lstream *istr, *ostr;
2144   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
2145
2146   get_buffer_range_char (buf, start, end, &b, &e, 0);
2147
2148   barf_if_buffer_read_only (buf, b, e);
2149
2150   coding_system = Fget_coding_system (coding_system);
2151   instream = make_lisp_buffer_input_stream  (buf, b, e, 0);
2152   lb_outstream = make_lisp_buffer_output_stream (buf, b, 0);
2153   de_outstream = make_decoding_output_stream (XLSTREAM (lb_outstream),
2154                                               coding_system);
2155   outstream = make_encoding_output_stream (XLSTREAM (de_outstream),
2156                                            Fget_coding_system (Qbinary));
2157   istr = XLSTREAM (instream);
2158   ostr = XLSTREAM (outstream);
2159   GCPRO4 (instream, lb_outstream, de_outstream, outstream);
2160
2161   /* The chain of streams looks like this:
2162
2163      [BUFFER] <----- send through
2164                      ------> [ENCODE AS BINARY]
2165                              ------> [DECODE AS SPECIFIED]
2166                                      ------> [BUFFER]
2167    */
2168
2169   while (1)
2170     {
2171       char tempbuf[1024]; /* some random amount */
2172       Bufpos newpos, even_newer_pos;
2173       Bufpos oldpos = lisp_buffer_stream_startpos (istr);
2174       int size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf));
2175
2176       if (!size_in_bytes)
2177         break;
2178       newpos = lisp_buffer_stream_startpos (istr);
2179       Lstream_write (ostr, tempbuf, size_in_bytes);
2180       even_newer_pos = lisp_buffer_stream_startpos (istr);
2181       buffer_delete_range (buf, even_newer_pos - (newpos - oldpos),
2182                            even_newer_pos, 0);
2183     }
2184   Lstream_close (istr);
2185   Lstream_close (ostr);
2186   UNGCPRO;
2187   Lstream_delete (istr);
2188   Lstream_delete (ostr);
2189   Lstream_delete (XLSTREAM (de_outstream));
2190   Lstream_delete (XLSTREAM (lb_outstream));
2191   return Qnil;
2192 }
2193
2194 \f
2195 /************************************************************************/
2196 /*           Converting to an external encoding ("encoding")            */
2197 /************************************************************************/
2198
2199 /* An encoding stream is an output stream.  When you create the
2200    stream, you specify the coding system that governs the encoding
2201    and another stream that the resulting encoded data is to be
2202    sent to, and then start sending data to it. */
2203
2204 #define ENCODING_STREAM_DATA(stream) LSTREAM_TYPE_DATA (stream, encoding)
2205
2206 struct encoding_stream
2207 {
2208   /* Coding system that governs the conversion. */
2209   Lisp_Coding_System *codesys;
2210
2211   /* Stream that we read the encoded data from or
2212      write the decoded data to. */
2213   Lstream *other_end;
2214
2215   /* If we are reading, then we can return only a fixed amount of
2216      data, so if the conversion resulted in too much data, we store it
2217      here for retrieval the next time around. */
2218   unsigned_char_dynarr *runoff;
2219
2220   /* FLAGS holds flags indicating the current state of the encoding.
2221      Some of these flags are dependent on the coding system. */
2222   unsigned int flags;
2223
2224   /* CH holds a partially built-up character.  Since we only deal
2225      with one- and two-byte characters at the moment, we only use
2226      this to store the first byte of a two-byte character. */
2227   unsigned int ch;
2228 #ifdef MULE
2229   /* Additional information used by the ISO2022 encoder. */
2230   struct
2231     {
2232       /* CHARSET holds the character sets currently assigned to the G0
2233          through G3 registers.  It is initialized from the array
2234          INITIAL_CHARSET in CODESYS. */
2235       Lisp_Object charset[4];
2236
2237       /* Which registers are currently invoked into the left (GL) and
2238          right (GR) halves of the 8-bit encoding space? */
2239       int register_left, register_right;
2240
2241       /* Whether we need to explicitly designate the charset in the
2242          G? register before using it.  It is initialized from the
2243          array FORCE_CHARSET_ON_OUTPUT in CODESYS. */
2244       unsigned char force_charset_on_output[4];
2245
2246       /* Other state variables that need to be preserved across
2247          invocations. */
2248       Lisp_Object current_charset;
2249       int current_half;
2250       int current_char_boundary;
2251     } iso2022;
2252
2253   /* Additional information (the state of the running CCL program)
2254      used by the CCL encoder. */
2255   struct ccl_program ccl;
2256 #endif /* MULE */
2257 };
2258
2259 static int encoding_reader (Lstream *stream, unsigned char *data, size_t size);
2260 static int encoding_writer (Lstream *stream, CONST unsigned char *data,
2261                             size_t size);
2262 static int encoding_rewinder   (Lstream *stream);
2263 static int encoding_seekable_p (Lstream *stream);
2264 static int encoding_flusher    (Lstream *stream);
2265 static int encoding_closer     (Lstream *stream);
2266
2267 static Lisp_Object encoding_marker (Lisp_Object stream,
2268                                     void (*markobj) (Lisp_Object));
2269
2270 DEFINE_LSTREAM_IMPLEMENTATION ("encoding", lstream_encoding,
2271                                sizeof (struct encoding_stream));
2272
2273 static Lisp_Object
2274 encoding_marker (Lisp_Object stream, void (*markobj) (Lisp_Object))
2275 {
2276   Lstream *str = ENCODING_STREAM_DATA (XLSTREAM (stream))->other_end;
2277   Lisp_Object str_obj;
2278
2279   /* We do not need to mark the coding systems or charsets stored
2280      within the stream because they are stored in a global list
2281      and automatically marked. */
2282
2283   XSETLSTREAM (str_obj, str);
2284   markobj (str_obj);
2285   if (str->imp->marker)
2286     return (str->imp->marker) (str_obj, markobj);
2287   else
2288     return Qnil;
2289 }
2290
2291 /* Read SIZE bytes of data and store it into DATA.  We are a encoding stream
2292    so we read data from the other end, encode it, and store it into DATA. */
2293
2294 static int
2295 encoding_reader (Lstream *stream, unsigned char *data, size_t size)
2296 {
2297   struct encoding_stream *str = ENCODING_STREAM_DATA (stream);
2298   unsigned char *orig_data = data;
2299   int read_size;
2300   int error_occurred = 0;
2301
2302   /* We need to interface to mule_encode(), which expects to take some
2303      amount of data and store the result into a Dynarr.  We have
2304      mule_encode() store into str->runoff, and take data from there
2305      as necessary. */
2306
2307   /* We loop until we have enough data, reading chunks from the other
2308      end and encoding it. */
2309   while (1)
2310     {
2311       /* Take data from the runoff if we can.  Make sure to take at
2312          most SIZE bytes, and delete the data from the runoff. */
2313       if (Dynarr_length (str->runoff) > 0)
2314         {
2315           int chunk = min ((int) size, Dynarr_length (str->runoff));
2316           memcpy (data, Dynarr_atp (str->runoff, 0), chunk);
2317           Dynarr_delete_many (str->runoff, 0, chunk);
2318           data += chunk;
2319           size -= chunk;
2320         }
2321
2322       if (size == 0)
2323         break; /* No more room for data */
2324
2325       if (str->flags & CODING_STATE_END)
2326         /* This means that on the previous iteration, we hit the EOF on
2327            the other end.  We loop once more so that mule_encode() can
2328            output any final stuff it may be holding, or any "go back
2329            to a sane state" escape sequences. (This latter makes sense
2330            during encoding.) */
2331         break;
2332
2333       /* Exhausted the runoff, so get some more.  DATA at least SIZE bytes
2334          left of storage in it, so it's OK to read directly into it.
2335          (We'll be overwriting above, after we've encoded it into the
2336          runoff.) */
2337       read_size = Lstream_read (str->other_end, data, size);
2338       if (read_size < 0)
2339         {
2340           error_occurred = 1;
2341           break;
2342         }
2343       if (read_size == 0)
2344         /* There might be some more end data produced in the translation.
2345            See the comment above. */
2346         str->flags |= CODING_STATE_END;
2347       mule_encode (stream, data, str->runoff, read_size);
2348     }
2349
2350   if (data == orig_data)
2351     return error_occurred ? -1 : 0;
2352   else
2353     return data - orig_data;
2354 }
2355
2356 static int
2357 encoding_writer (Lstream *stream, CONST unsigned char *data, size_t size)
2358 {
2359   struct encoding_stream *str = ENCODING_STREAM_DATA (stream);
2360   int retval;
2361
2362   /* Encode all our data into the runoff, and then attempt to write
2363      it all out to the other end.  Remove whatever chunk we succeeded
2364      in writing. */
2365   mule_encode (stream, data, str->runoff, size);
2366   retval = Lstream_write (str->other_end, Dynarr_atp (str->runoff, 0),
2367                           Dynarr_length (str->runoff));
2368   if (retval > 0)
2369     Dynarr_delete_many (str->runoff, 0, retval);
2370   /* Do NOT return retval.  The return value indicates how much
2371      of the incoming data was written, not how many bytes were
2372      written. */
2373   return size;
2374 }
2375
2376 static void
2377 reset_encoding_stream (struct encoding_stream *str)
2378 {
2379 #ifdef MULE
2380   switch (CODING_SYSTEM_TYPE (str->codesys))
2381     {
2382     case CODESYS_ISO2022:
2383       {
2384         int i;
2385
2386         for (i = 0; i < 4; i++)
2387           {
2388             str->iso2022.charset[i] =
2389               CODING_SYSTEM_ISO2022_INITIAL_CHARSET (str->codesys, i);
2390             str->iso2022.force_charset_on_output[i] =
2391               CODING_SYSTEM_ISO2022_FORCE_CHARSET_ON_OUTPUT (str->codesys, i);
2392           }
2393         str->iso2022.register_left = 0;
2394         str->iso2022.register_right = 1;
2395         str->iso2022.current_charset = Qnil;
2396         str->iso2022.current_half = 0;
2397         str->iso2022.current_char_boundary = 1;
2398         break;
2399       }
2400     case CODESYS_CCL:
2401       setup_ccl_program (&str->ccl, CODING_SYSTEM_CCL_ENCODE (str->codesys));
2402       break;
2403     default:
2404       break;
2405     }
2406 #endif /* MULE */
2407
2408   str->flags = str->ch = 0;
2409 }
2410
2411 static int
2412 encoding_rewinder (Lstream *stream)
2413 {
2414   struct encoding_stream *str = ENCODING_STREAM_DATA (stream);
2415   reset_encoding_stream (str);
2416   Dynarr_reset (str->runoff);
2417   return Lstream_rewind (str->other_end);
2418 }
2419
2420 static int
2421 encoding_seekable_p (Lstream *stream)
2422 {
2423   struct encoding_stream *str = ENCODING_STREAM_DATA (stream);
2424   return Lstream_seekable_p (str->other_end);
2425 }
2426
2427 static int
2428 encoding_flusher (Lstream *stream)
2429 {
2430   struct encoding_stream *str = ENCODING_STREAM_DATA (stream);
2431   return Lstream_flush (str->other_end);
2432 }
2433
2434 static int
2435 encoding_closer (Lstream *stream)
2436 {
2437   struct encoding_stream *str = ENCODING_STREAM_DATA (stream);
2438   if (stream->flags & LSTREAM_FL_WRITE)
2439     {
2440       str->flags |= CODING_STATE_END;
2441       encoding_writer (stream, 0, 0);
2442     }
2443   Dynarr_free (str->runoff);
2444   return Lstream_close (str->other_end);
2445 }
2446
2447 Lisp_Object
2448 encoding_stream_coding_system (Lstream *stream)
2449 {
2450   Lisp_Object coding_system;
2451   struct encoding_stream *str = ENCODING_STREAM_DATA (stream);
2452
2453   XSETCODING_SYSTEM (coding_system, str->codesys);
2454   return coding_system;
2455 }
2456
2457 void
2458 set_encoding_stream_coding_system (Lstream *lstr, Lisp_Object codesys)
2459 {
2460   Lisp_Coding_System *cs = XCODING_SYSTEM (codesys);
2461   struct encoding_stream *str = ENCODING_STREAM_DATA (lstr);
2462   str->codesys = cs;
2463   reset_encoding_stream (str);
2464 }
2465
2466 static Lisp_Object
2467 make_encoding_stream_1 (Lstream *stream, Lisp_Object codesys,
2468                         CONST char *mode)
2469 {
2470   Lstream *lstr = Lstream_new (lstream_encoding, mode);
2471   struct encoding_stream *str = ENCODING_STREAM_DATA (lstr);
2472   Lisp_Object obj;
2473
2474   xzero (*str);
2475   str->runoff = Dynarr_new (unsigned_char);
2476   str->other_end = stream;
2477   set_encoding_stream_coding_system (lstr, codesys);
2478   XSETLSTREAM (obj, lstr);
2479   return obj;
2480 }
2481
2482 Lisp_Object
2483 make_encoding_input_stream (Lstream *stream, Lisp_Object codesys)
2484 {
2485   return make_encoding_stream_1 (stream, codesys, "r");
2486 }
2487
2488 Lisp_Object
2489 make_encoding_output_stream (Lstream *stream, Lisp_Object codesys)
2490 {
2491   return make_encoding_stream_1 (stream, codesys, "w");
2492 }
2493
2494 /* Convert N bytes of internally-formatted data stored in SRC to an
2495    external format, according to the encoding stream ENCODING.
2496    Store the encoded data into DST. */
2497
2498 static void
2499 mule_encode (Lstream *encoding, CONST unsigned char *src,
2500              unsigned_char_dynarr *dst, unsigned int n)
2501 {
2502   struct encoding_stream *str = ENCODING_STREAM_DATA (encoding);
2503
2504   switch (CODING_SYSTEM_TYPE (str->codesys))
2505     {
2506 #ifdef DEBUG_XEMACS
2507     case CODESYS_INTERNAL:
2508       Dynarr_add_many (dst, src, n);
2509       break;
2510 #endif
2511     case CODESYS_AUTODETECT:
2512       /* If we got this far and still haven't decided on the coding
2513          system, then do no conversion. */
2514     case CODESYS_NO_CONVERSION:
2515       encode_coding_no_conversion (encoding, src, dst, n);
2516       break;
2517 #ifdef MULE
2518     case CODESYS_SHIFT_JIS:
2519       encode_coding_sjis (encoding, src, dst, n);
2520       break;
2521     case CODESYS_BIG5:
2522       encode_coding_big5 (encoding, src, dst, n);
2523       break;
2524     case CODESYS_UCS4:
2525       encode_coding_ucs4 (encoding, src, dst, n);
2526       break;
2527     case CODESYS_UTF8:
2528       encode_coding_utf8 (encoding, src, dst, n);
2529       break;
2530     case CODESYS_CCL:
2531       ccl_driver (&str->ccl, src, dst, n, 0);
2532       break;
2533     case CODESYS_ISO2022:
2534       encode_coding_iso2022 (encoding, src, dst, n);
2535       break;
2536 #endif /* MULE */
2537     default:
2538       abort ();
2539     }
2540 }
2541
2542 DEFUN ("encode-coding-region", Fencode_coding_region, 3, 4, 0, /*
2543 Encode the text between START and END using CODING-SYSTEM.
2544 This will, for example, convert Japanese characters into stuff such as
2545 "^[$B!<!+^[(B" if you use the JIS encoding.  Return length of encoded
2546 text.  BUFFER defaults to the current buffer if unspecified.
2547 */
2548        (start, end, coding_system, buffer))
2549 {
2550   Bufpos b, e;
2551   struct buffer *buf = decode_buffer (buffer, 0);
2552   Lisp_Object instream, lb_outstream, de_outstream, outstream;
2553   Lstream *istr, *ostr;
2554   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
2555
2556   get_buffer_range_char (buf, start, end, &b, &e, 0);
2557
2558   barf_if_buffer_read_only (buf, b, e);
2559
2560   coding_system = Fget_coding_system (coding_system);
2561   instream  = make_lisp_buffer_input_stream  (buf, b, e, 0);
2562   lb_outstream = make_lisp_buffer_output_stream (buf, b, 0);
2563   de_outstream = make_decoding_output_stream (XLSTREAM (lb_outstream),
2564                                               Fget_coding_system (Qbinary));
2565   outstream = make_encoding_output_stream (XLSTREAM (de_outstream),
2566                                            coding_system);
2567   istr = XLSTREAM (instream);
2568   ostr = XLSTREAM (outstream);
2569   GCPRO4 (instream, outstream, de_outstream, lb_outstream);
2570   /* The chain of streams looks like this:
2571
2572      [BUFFER] <----- send through
2573                      ------> [ENCODE AS SPECIFIED]
2574                              ------> [DECODE AS BINARY]
2575                                      ------> [BUFFER]
2576    */
2577   while (1)
2578     {
2579       char tempbuf[1024]; /* some random amount */
2580       Bufpos newpos, even_newer_pos;
2581       Bufpos oldpos = lisp_buffer_stream_startpos (istr);
2582       int size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf));
2583
2584       if (!size_in_bytes)
2585         break;
2586       newpos = lisp_buffer_stream_startpos (istr);
2587       Lstream_write (ostr, tempbuf, size_in_bytes);
2588       even_newer_pos = lisp_buffer_stream_startpos (istr);
2589       buffer_delete_range (buf, even_newer_pos - (newpos - oldpos),
2590                            even_newer_pos, 0);
2591     }
2592
2593   {
2594     Charcount retlen =
2595       lisp_buffer_stream_startpos (XLSTREAM (instream)) - b;
2596     Lstream_close (istr);
2597     Lstream_close (ostr);
2598     UNGCPRO;
2599     Lstream_delete (istr);
2600     Lstream_delete (ostr);
2601     Lstream_delete (XLSTREAM (de_outstream));
2602     Lstream_delete (XLSTREAM (lb_outstream));
2603     return make_int (retlen);
2604   }
2605 }
2606
2607 #ifdef MULE
2608 \f
2609 /************************************************************************/
2610 /*                          Shift-JIS methods                           */
2611 /************************************************************************/
2612
2613 /* Shift-JIS is a coding system encoding three character sets: ASCII, right
2614    half of JISX0201-Kana, and JISX0208.  An ASCII character is encoded
2615    as is.  A character of JISX0201-Kana (DIMENSION1_CHARS94 character set) is
2616    encoded by "position-code + 0x80".  A character of JISX0208
2617    (DIMENSION2_CHARS94 character set) is encoded in 2-byte but two
2618    position-codes are divided and shifted so that it fit in the range
2619    below.
2620
2621    --- CODE RANGE of Shift-JIS ---
2622    (character set)      (range)
2623    ASCII                0x00 .. 0x7F
2624    JISX0201-Kana        0xA0 .. 0xDF
2625    JISX0208 (1st byte)  0x80 .. 0x9F and 0xE0 .. 0xEF
2626             (2nd byte)  0x40 .. 0x7E and 0x80 .. 0xFC
2627    -------------------------------
2628
2629 */
2630
2631 /* Is this the first byte of a Shift-JIS two-byte char? */
2632
2633 #define BYTE_SJIS_TWO_BYTE_1_P(c) \
2634   (((c) >= 0x81 && (c) <= 0x9F) || ((c) >= 0xE0 && (c) <= 0xEF))
2635
2636 /* Is this the second byte of a Shift-JIS two-byte char? */
2637
2638 #define BYTE_SJIS_TWO_BYTE_2_P(c) \
2639   (((c) >= 0x40 && (c) <= 0x7E) || ((c) >= 0x80 && (c) <= 0xFC))
2640
2641 #define BYTE_SJIS_KATAKANA_P(c) \
2642   ((c) >= 0xA1 && (c) <= 0xDF)
2643
2644 static int
2645 detect_coding_sjis (struct detection_state *st, CONST unsigned char *src,
2646                     unsigned int n)
2647 {
2648   int c;
2649
2650   while (n--)
2651     {
2652       c = *src++;
2653       if (c == ISO_CODE_ESC || c == ISO_CODE_SI || c == ISO_CODE_SO)
2654         return 0;
2655       if (st->shift_jis.in_second_byte)
2656         {
2657           st->shift_jis.in_second_byte = 0;
2658           if (c < 0x40)
2659             return 0;
2660         }
2661       else if ((c >= 0x80 && c < 0xA0) || c >= 0xE0)
2662         st->shift_jis.in_second_byte = 1;
2663     }
2664   return CODING_CATEGORY_SHIFT_JIS_MASK;
2665 }
2666
2667 /* Convert Shift-JIS data to internal format. */
2668
2669 static void
2670 decode_coding_sjis (Lstream *decoding, CONST unsigned char *src,
2671                     unsigned_char_dynarr *dst, unsigned int n)
2672 {
2673   unsigned char c;
2674   struct decoding_stream *str = DECODING_STREAM_DATA (decoding);
2675   unsigned int flags  = str->flags;
2676   unsigned int ch     = str->ch;
2677   eol_type_t eol_type = str->eol_type;
2678
2679   while (n--)
2680     {
2681       c = *src++;
2682
2683       if (ch)
2684         {
2685           /* Previous character was first byte of Shift-JIS Kanji char. */
2686           if (BYTE_SJIS_TWO_BYTE_2_P (c))
2687             {
2688               unsigned char e1, e2;
2689
2690               Dynarr_add (dst, LEADING_BYTE_JAPANESE_JISX0208);
2691               DECODE_SJIS (ch, c, e1, e2);
2692               Dynarr_add (dst, e1);
2693               Dynarr_add (dst, e2);
2694             }
2695           else
2696             {
2697               DECODE_ADD_BINARY_CHAR (ch, dst);
2698               DECODE_ADD_BINARY_CHAR (c, dst);
2699             }
2700           ch = 0;
2701         }
2702       else
2703         {
2704           DECODE_HANDLE_EOL_TYPE (eol_type, c, flags, dst);
2705           if (BYTE_SJIS_TWO_BYTE_1_P (c))
2706             ch = c;
2707           else if (BYTE_SJIS_KATAKANA_P (c))
2708             {
2709               Dynarr_add (dst, LEADING_BYTE_KATAKANA_JISX0201);
2710               Dynarr_add (dst, c);
2711             }
2712           else
2713             DECODE_ADD_BINARY_CHAR (c, dst);
2714         }
2715     label_continue_loop:;
2716     }
2717
2718   DECODE_HANDLE_END_OF_CONVERSION (flags, ch, dst);
2719
2720   str->flags = flags;
2721   str->ch    = ch;
2722 }
2723
2724 /* Convert internally-formatted data to Shift-JIS. */
2725
2726 static void
2727 encode_coding_sjis (Lstream *encoding, CONST unsigned char *src,
2728                     unsigned_char_dynarr *dst, unsigned int n)
2729 {
2730   unsigned char c;
2731   struct encoding_stream *str = ENCODING_STREAM_DATA (encoding);
2732   unsigned int flags  = str->flags;
2733   unsigned int ch     = str->ch;
2734   eol_type_t eol_type = CODING_SYSTEM_EOL_TYPE (str->codesys);
2735
2736   while (n--)
2737     {
2738       c = *src++;
2739       if (c == '\n')
2740         {
2741           if (eol_type != EOL_LF && eol_type != EOL_AUTODETECT)
2742             Dynarr_add (dst, '\r');
2743           if (eol_type != EOL_CR)
2744             Dynarr_add (dst, '\n');
2745           ch = 0;
2746         }
2747       else if (BYTE_ASCII_P (c))
2748         {
2749           Dynarr_add (dst, c);
2750           ch = 0;
2751         }
2752       else if (BUFBYTE_LEADING_BYTE_P (c))
2753         ch = (c == LEADING_BYTE_KATAKANA_JISX0201 ||
2754               c == LEADING_BYTE_JAPANESE_JISX0208_1978 ||
2755               c == LEADING_BYTE_JAPANESE_JISX0208) ? c : 0;
2756       else if (ch)
2757         {
2758           if (ch == LEADING_BYTE_KATAKANA_JISX0201)
2759             {
2760               Dynarr_add (dst, c);
2761               ch = 0;
2762             }
2763           else if (ch == LEADING_BYTE_JAPANESE_JISX0208_1978 ||
2764                    ch == LEADING_BYTE_JAPANESE_JISX0208)
2765             ch = c;
2766           else
2767             {
2768               unsigned char j1, j2;
2769               ENCODE_SJIS (ch, c, j1, j2);
2770               Dynarr_add (dst, j1);
2771               Dynarr_add (dst, j2);
2772               ch = 0;
2773             }
2774         }
2775     }
2776
2777   str->flags = flags;
2778   str->ch    = ch;
2779 }
2780
2781 DEFUN ("decode-shift-jis-char", Fdecode_shift_jis_char, 1, 1, 0, /*
2782 Decode a JISX0208 character of Shift-JIS coding-system.
2783 CODE is the character code in Shift-JIS as a cons of type bytes.
2784 Return the corresponding character.
2785 */
2786        (code))
2787 {
2788   unsigned char c1, c2, s1, s2;
2789
2790   CHECK_CONS (code);
2791   CHECK_INT (XCAR (code));
2792   CHECK_INT (XCDR (code));
2793   s1 = XINT (XCAR (code));
2794   s2 = XINT (XCDR (code));
2795   if (BYTE_SJIS_TWO_BYTE_1_P (s1) &&
2796       BYTE_SJIS_TWO_BYTE_2_P (s2))
2797     {
2798       DECODE_SJIS (s1, s2, c1, c2);
2799       return make_char (MAKE_CHAR (Vcharset_japanese_jisx0208,
2800                                    c1 & 0x7F, c2 & 0x7F));
2801     }
2802   else
2803     return Qnil;
2804 }
2805
2806 DEFUN ("encode-shift-jis-char", Fencode_shift_jis_char, 1, 1, 0, /*
2807 Encode a JISX0208 character CHAR to SHIFT-JIS coding-system.
2808 Return the corresponding character code in SHIFT-JIS as a cons of two bytes.
2809 */
2810        (ch))
2811 {
2812   Lisp_Object charset;
2813   int c1, c2, s1, s2;
2814
2815   CHECK_CHAR_COERCE_INT (ch);
2816   BREAKUP_CHAR (XCHAR (ch), charset, c1, c2);
2817   if (EQ (charset, Vcharset_japanese_jisx0208))
2818     {
2819       ENCODE_SJIS (c1 | 0x80, c2 | 0x80, s1, s2);
2820       return Fcons (make_int (s1), make_int (s2));
2821     }
2822   else
2823     return Qnil;
2824 }
2825
2826 \f
2827 /************************************************************************/
2828 /*                            Big5 methods                              */
2829 /************************************************************************/
2830
2831 /* BIG5 is a coding system encoding two character sets: ASCII and
2832    Big5.  An ASCII character is encoded as is.  Big5 is a two-byte
2833    character set and is encoded in two-byte.
2834
2835    --- CODE RANGE of BIG5 ---
2836    (character set)      (range)
2837    ASCII                0x00 .. 0x7F
2838    Big5 (1st byte)      0xA1 .. 0xFE
2839         (2nd byte)      0x40 .. 0x7E and 0xA1 .. 0xFE
2840    --------------------------
2841
2842    Since the number of characters in Big5 is larger than maximum
2843    characters in Emacs' charset (96x96), it can't be handled as one
2844    charset.  So, in Emacs, Big5 is divided into two: `charset-big5-1'
2845    and `charset-big5-2'.  Both <type>s are DIMENSION2_CHARS94.  The former
2846    contains frequently used characters and the latter contains less
2847    frequently used characters.  */
2848
2849 #define BYTE_BIG5_TWO_BYTE_1_P(c) \
2850   ((c) >= 0xA1 && (c) <= 0xFE)
2851
2852 /* Is this the second byte of a Shift-JIS two-byte char? */
2853
2854 #define BYTE_BIG5_TWO_BYTE_2_P(c) \
2855   (((c) >= 0x40 && (c) <= 0x7E) || ((c) >= 0xA1 && (c) <= 0xFE))
2856
2857 /* Number of Big5 characters which have the same code in 1st byte.  */
2858
2859 #define BIG5_SAME_ROW (0xFF - 0xA1 + 0x7F - 0x40)
2860
2861 /* Code conversion macros.  These are macros because they are used in
2862    inner loops during code conversion.
2863
2864    Note that temporary variables in macros introduce the classic
2865    dynamic-scoping problems with variable names.  We use capital-
2866    lettered variables in the assumption that XEmacs does not use
2867    capital letters in variables except in a very formalized way
2868    (e.g. Qstring). */
2869
2870 /* Convert Big5 code (b1, b2) into its internal string representation
2871    (lb, c1, c2). */
2872
2873 /* There is a much simpler way to split the Big5 charset into two.
2874    For the moment I'm going to leave the algorithm as-is because it
2875    claims to separate out the most-used characters into a single
2876    charset, which perhaps will lead to optimizations in various
2877    places.
2878
2879    The way the algorithm works is something like this:
2880
2881    Big5 can be viewed as a 94x157 charset, where the row is
2882    encoded into the bytes 0xA1 .. 0xFE and the column is encoded
2883    into the bytes 0x40 .. 0x7E and 0xA1 .. 0xFE.  As for frequency,
2884    the split between low and high column numbers is apparently
2885    meaningless; ascending rows produce less and less frequent chars.
2886    Therefore, we assign the lower half of rows (0xA1 .. 0xC8) to
2887    the first charset, and the upper half (0xC9 .. 0xFE) to the
2888    second.  To do the conversion, we convert the character into
2889    a single number where 0 .. 156 is the first row, 157 .. 313
2890    is the second, etc.  That way, the characters are ordered by
2891    decreasing frequency.  Then we just chop the space in two
2892    and coerce the result into a 94x94 space.
2893    */
2894
2895 #define DECODE_BIG5(b1, b2, lb, c1, c2) do                              \
2896 {                                                                       \
2897   int B1 = b1, B2 = b2;                                                 \
2898   unsigned int I                                                        \
2899     = (B1 - 0xA1) * BIG5_SAME_ROW + B2 - (B2 < 0x7F ? 0x40 : 0x62);     \
2900                                                                         \
2901   if (B1 < 0xC9)                                                        \
2902     {                                                                   \
2903       lb = LEADING_BYTE_CHINESE_BIG5_1;                                 \
2904     }                                                                   \
2905   else                                                                  \
2906     {                                                                   \
2907       lb = LEADING_BYTE_CHINESE_BIG5_2;                                 \
2908       I -= (BIG5_SAME_ROW) * (0xC9 - 0xA1);                             \
2909     }                                                                   \
2910   c1 = I / (0xFF - 0xA1) + 0xA1;                                        \
2911   c2 = I % (0xFF - 0xA1) + 0xA1;                                        \
2912 } while (0)
2913
2914 /* Convert the internal string representation of a Big5 character
2915    (lb, c1, c2) into Big5 code (b1, b2). */
2916
2917 #define ENCODE_BIG5(lb, c1, c2, b1, b2) do                              \
2918 {                                                                       \
2919   unsigned int I = ((c1) - 0xA1) * (0xFF - 0xA1) + ((c2) - 0xA1);       \
2920                                                                         \
2921   if (lb == LEADING_BYTE_CHINESE_BIG5_2)                                \
2922     {                                                                   \
2923       I += BIG5_SAME_ROW * (0xC9 - 0xA1);                               \
2924     }                                                                   \
2925   b1 = I / BIG5_SAME_ROW + 0xA1;                                        \
2926   b2 = I % BIG5_SAME_ROW;                                               \
2927   b2 += b2 < 0x3F ? 0x40 : 0x62;                                        \
2928 } while (0)
2929
2930 static int
2931 detect_coding_big5 (struct detection_state *st, CONST unsigned char *src,
2932                     unsigned int n)
2933 {
2934   int c;
2935
2936   while (n--)
2937     {
2938       c = *src++;
2939       if (c == ISO_CODE_ESC || c == ISO_CODE_SI || c == ISO_CODE_SO ||
2940           (c >= 0x80 && c <= 0xA0))
2941         return 0;
2942       if (st->big5.in_second_byte)
2943         {
2944           st->big5.in_second_byte = 0;
2945           if (c < 0x40 || (c >= 0x80 && c <= 0xA0))
2946             return 0;
2947         }
2948       else if (c >= 0xA1)
2949         st->big5.in_second_byte = 1;
2950     }
2951   return CODING_CATEGORY_BIG5_MASK;
2952 }
2953
2954 /* Convert Big5 data to internal format. */
2955
2956 static void
2957 decode_coding_big5 (Lstream *decoding, CONST unsigned char *src,
2958                     unsigned_char_dynarr *dst, unsigned int n)
2959 {
2960   unsigned char c;
2961   struct decoding_stream *str = DECODING_STREAM_DATA (decoding);
2962   unsigned int flags  = str->flags;
2963   unsigned int ch     = str->ch;
2964   eol_type_t eol_type = str->eol_type;
2965
2966   while (n--)
2967     {
2968       c = *src++;
2969       if (ch)
2970         {
2971           /* Previous character was first byte of Big5 char. */
2972           if (BYTE_BIG5_TWO_BYTE_2_P (c))
2973             {
2974               unsigned char b1, b2, b3;
2975               DECODE_BIG5 (ch, c, b1, b2, b3);
2976               Dynarr_add (dst, b1);
2977               Dynarr_add (dst, b2);
2978               Dynarr_add (dst, b3);
2979             }
2980           else
2981             {
2982               DECODE_ADD_BINARY_CHAR (ch, dst);
2983               DECODE_ADD_BINARY_CHAR (c, dst);
2984             }
2985           ch = 0;
2986         }
2987       else
2988         {
2989           DECODE_HANDLE_EOL_TYPE (eol_type, c, flags, dst);
2990           if (BYTE_BIG5_TWO_BYTE_1_P (c))
2991             ch = c;
2992           else
2993             DECODE_ADD_BINARY_CHAR (c, dst);
2994         }
2995     label_continue_loop:;
2996     }
2997
2998   DECODE_HANDLE_END_OF_CONVERSION (flags, ch, dst);
2999
3000   str->flags = flags;
3001   str->ch    = ch;
3002 }
3003
3004 /* Convert internally-formatted data to Big5. */
3005
3006 static void
3007 encode_coding_big5 (Lstream *encoding, CONST unsigned char *src,
3008                     unsigned_char_dynarr *dst, unsigned int n)
3009 {
3010   unsigned char c;
3011   struct encoding_stream *str = ENCODING_STREAM_DATA (encoding);
3012   unsigned int flags  = str->flags;
3013   unsigned int ch     = str->ch;
3014   eol_type_t eol_type = CODING_SYSTEM_EOL_TYPE (str->codesys);
3015
3016   while (n--)
3017     {
3018       c = *src++;
3019       if (c == '\n')
3020         {
3021           if (eol_type != EOL_LF && eol_type != EOL_AUTODETECT)
3022             Dynarr_add (dst, '\r');
3023           if (eol_type != EOL_CR)
3024             Dynarr_add (dst, '\n');
3025         }
3026       else if (BYTE_ASCII_P (c))
3027         {
3028           /* ASCII. */
3029           Dynarr_add (dst, c);
3030         }
3031       else if (BUFBYTE_LEADING_BYTE_P (c))
3032         {
3033           if (c == LEADING_BYTE_CHINESE_BIG5_1 ||
3034               c == LEADING_BYTE_CHINESE_BIG5_2)
3035             {
3036               /* A recognized leading byte. */
3037               ch = c;
3038               continue; /* not done with this character. */
3039             }
3040           /* otherwise just ignore this character. */
3041         }
3042       else if (ch == LEADING_BYTE_CHINESE_BIG5_1 ||
3043                ch == LEADING_BYTE_CHINESE_BIG5_2)
3044         {
3045           /* Previous char was a recognized leading byte. */
3046           ch = (ch << 8) | c;
3047           continue; /* not done with this character. */
3048         }
3049       else if (ch)
3050         {
3051           /* Encountering second byte of a Big5 character. */
3052           unsigned char b1, b2;
3053
3054           ENCODE_BIG5 (ch >> 8, ch & 0xFF, c, b1, b2);
3055           Dynarr_add (dst, b1);
3056           Dynarr_add (dst, b2);
3057         }
3058
3059       ch = 0;
3060     }
3061
3062   str->flags = flags;
3063   str->ch    = ch;
3064 }
3065
3066
3067 DEFUN ("decode-big5-char", Fdecode_big5_char, 1, 1, 0, /*
3068 Decode a Big5 character CODE of BIG5 coding-system.
3069 CODE is the character code in BIG5, a cons of two integers.
3070 Return the corresponding character.
3071 */
3072        (code))
3073 {
3074   unsigned char c1, c2, b1, b2;
3075
3076   CHECK_CONS (code);
3077   CHECK_INT (XCAR (code));
3078   CHECK_INT (XCDR (code));
3079   b1 = XINT (XCAR (code));
3080   b2 = XINT (XCDR (code));
3081   if (BYTE_BIG5_TWO_BYTE_1_P (b1) &&
3082       BYTE_BIG5_TWO_BYTE_2_P (b2))
3083     {
3084       int leading_byte;
3085       Lisp_Object charset;
3086       DECODE_BIG5 (b1, b2, leading_byte, c1, c2);
3087       charset = CHARSET_BY_LEADING_BYTE (leading_byte);
3088       return make_char (MAKE_CHAR (charset, c1 & 0x7F, c2 & 0x7F));
3089     }
3090   else
3091     return Qnil;
3092 }
3093
3094 DEFUN ("encode-big5-char", Fencode_big5_char, 1, 1, 0, /*
3095 Encode the Big5 character CH to BIG5 coding-system.
3096 Return the corresponding character code in Big5.
3097 */
3098        (ch))
3099 {
3100   Lisp_Object charset;
3101   int c1, c2, b1, b2;
3102
3103   CHECK_CHAR_COERCE_INT (ch);
3104   BREAKUP_CHAR (XCHAR (ch), charset, c1, c2);
3105   if (EQ (charset, Vcharset_chinese_big5_1) ||
3106       EQ (charset, Vcharset_chinese_big5_2))
3107     {
3108       ENCODE_BIG5 (XCHARSET_LEADING_BYTE (charset), c1 | 0x80, c2 | 0x80,
3109                    b1, b2);
3110       return Fcons (make_int (b1), make_int (b2));
3111     }
3112   else
3113     return Qnil;
3114 }
3115
3116 \f
3117 /************************************************************************/
3118 /*                           UCS-4 methods                              */
3119 /*                                                                      */
3120 /*  UCS-4 character codes are implemented as nonnegative integers.      */
3121 /*                                                                      */
3122 /************************************************************************/
3123
3124 Lisp_Object ucs_to_mule_table[65536];
3125 Lisp_Object mule_to_ucs_table;
3126
3127 DEFUN ("set-ucs-char", Fset_ucs_char, 2, 2, 0, /*
3128 Map UCS-4 code CODE to Mule character CHARACTER.
3129
3130 Return T on success, NIL on failure.
3131 */
3132        (code, character))
3133 {
3134   unsigned int c;
3135
3136   CHECK_CHAR (character);
3137   CHECK_INT (code);
3138   c = XINT (code);
3139
3140   if (c < sizeof (ucs_to_mule_table))
3141     {
3142       ucs_to_mule_table[c] = character;
3143       return Qt;
3144     }
3145   else
3146     return Qnil;
3147 }
3148
3149 static Lisp_Object
3150 ucs_to_char (unsigned long code)
3151 {
3152   if (code < sizeof (ucs_to_mule_table))
3153     {
3154       return ucs_to_mule_table[code];
3155     }
3156   else if ((0xe00000 <= code) && (code <= 0xe00000 + 94 * 94 * 14))
3157     {
3158       unsigned int c;
3159
3160       code -= 0xe00000;
3161       c = code % (94 * 94);
3162       return make_char
3163         (MAKE_CHAR (CHARSET_BY_ATTRIBUTES
3164                     (CHARSET_TYPE_94X94, code / (94 * 94) + '@',
3165                      CHARSET_LEFT_TO_RIGHT),
3166                     c / 94 + 33, c % 94 + 33));
3167     }
3168   else
3169     return Qnil;
3170 }
3171
3172 DEFUN ("ucs-char", Fucs_char, 1, 1, 0, /*
3173 Return Mule character corresponding to UCS code CODE (a positive integer).
3174 */
3175        (code))
3176 {
3177   CHECK_NATNUM (code);
3178   return ucs_to_char (XINT (code));
3179 }
3180
3181 DEFUN ("set-char-ucs", Fset_char_ucs, 2, 2, 0, /*
3182 Map Mule character CHARACTER to UCS code CODE (a positive integer).
3183 */
3184        (character, code))
3185 {
3186   /* #### Isn't this gilding the lily?  Fput_char_table checks its args.
3187           Fset_char_ucs is more restrictive on index arg, but should
3188           check code arg in a char_table method. */
3189   CHECK_CHAR (character);
3190   CHECK_NATNUM (code);
3191   return Fput_char_table (character, code, mule_to_ucs_table);
3192 }
3193
3194 DEFUN ("char-ucs", Fchar_ucs, 1, 1, 0, /*
3195 Return the UCS code (a positive integer) corresponding to CHARACTER.
3196 */
3197        (character))
3198 {
3199   return Fget_char_table (character, mule_to_ucs_table);
3200 }
3201
3202 /* Decode a UCS-4 character into a buffer.  If the lookup fails, use
3203    <GETA MARK> (U+3013) of JIS X 0208, which means correct character
3204    is not found, instead.
3205    #### do something more appropriate (use blob?)
3206         Danger, Will Robinson!  Data loss.  Should we signal user? */
3207 static void
3208 decode_ucs4 (unsigned long ch, unsigned_char_dynarr *dst)
3209 {
3210   Lisp_Object chr = ucs_to_char (ch);
3211
3212   if (! NILP (chr))
3213     {
3214       Bufbyte work[MAX_EMCHAR_LEN];
3215       int len;
3216
3217       ch = XCHAR (chr);
3218       len = (ch < 128) ?
3219         simple_set_charptr_emchar (work, ch) :
3220         non_ascii_set_charptr_emchar (work, ch);
3221       Dynarr_add_many (dst, work, len);
3222     }
3223   else
3224     {
3225       Dynarr_add (dst, LEADING_BYTE_JAPANESE_JISX0208);
3226       Dynarr_add (dst, 34 + 128);
3227       Dynarr_add (dst, 46 + 128);
3228     }
3229 }
3230
3231 static unsigned long
3232 mule_char_to_ucs4 (Lisp_Object charset,
3233                    unsigned char h, unsigned char l)
3234 {
3235   Lisp_Object code
3236     = Fget_char_table (make_char (MAKE_CHAR (charset, h & 127, l & 127)),
3237                        mule_to_ucs_table);
3238
3239   if (INTP (code))
3240     {
3241       return XINT (code);
3242     }
3243   else if ( (XCHARSET_DIMENSION (charset) == 2) &&
3244             (XCHARSET_CHARS (charset) == 94) )
3245     {
3246       unsigned char final = XCHARSET_FINAL (charset);
3247
3248       if ( ('@' <= final) && (final < 0x7f) )
3249         {
3250           return 0xe00000 + (final - '@') * 94 * 94
3251             + ((h & 127) - 33) * 94 + (l & 127) - 33;
3252         }
3253       else
3254         {
3255           return '?';
3256         }
3257     }
3258   else
3259     {
3260       return '?';
3261     }
3262 }
3263
3264 static void
3265 encode_ucs4 (Lisp_Object charset,
3266              unsigned char h, unsigned char l, unsigned_char_dynarr *dst)
3267 {
3268   unsigned long code = mule_char_to_ucs4 (charset, h, l);
3269   Dynarr_add (dst,  code >> 24);
3270   Dynarr_add (dst, (code >> 16) & 255);
3271   Dynarr_add (dst, (code >>  8) & 255);
3272   Dynarr_add (dst,  code        & 255);
3273 }
3274
3275 static int
3276 detect_coding_ucs4 (struct detection_state *st, CONST unsigned char *src,
3277                     unsigned int n)
3278 {
3279   while (n--)
3280     {
3281       int c = *src++;
3282       switch (st->ucs4.in_byte)
3283         {
3284         case 0:
3285           if (c >= 128)
3286             return 0;
3287           else
3288             st->ucs4.in_byte++;
3289           break;
3290         case 3:
3291           st->ucs4.in_byte = 0;
3292           break;
3293         default:
3294           st->ucs4.in_byte++;
3295         }
3296     }
3297   return CODING_CATEGORY_UCS4_MASK;
3298 }
3299
3300 static void
3301 decode_coding_ucs4 (Lstream *decoding, CONST unsigned char *src,
3302                     unsigned_char_dynarr *dst, unsigned int n)
3303 {
3304   struct decoding_stream *str = DECODING_STREAM_DATA (decoding);
3305   unsigned int flags = str->flags;
3306   unsigned int ch    = str->ch;
3307
3308   while (n--)
3309     {
3310       unsigned char c = *src++;
3311       switch (flags)
3312         {
3313         case 0:
3314           ch = c;
3315           flags = 3;
3316           break;
3317         case 1:
3318           decode_ucs4 ( ( ch << 8 ) | c, dst);
3319           ch = 0;
3320           flags = 0;
3321           break;
3322         default:
3323           ch = ( ch << 8 ) | c;
3324           flags--;
3325         }
3326     }
3327   if (flags & CODING_STATE_END)
3328     DECODE_OUTPUT_PARTIAL_CHAR (ch);
3329
3330   str->flags = flags;
3331   str->ch    = ch;
3332 }
3333
3334 static void
3335 encode_coding_ucs4 (Lstream *encoding, CONST unsigned char *src,
3336                     unsigned_char_dynarr *dst, unsigned int n)
3337 {
3338   struct encoding_stream *str = ENCODING_STREAM_DATA (encoding);
3339   unsigned int flags = str->flags;
3340   unsigned int ch = str->ch;
3341   unsigned char char_boundary = str->iso2022.current_char_boundary;
3342   Lisp_Object charset = str->iso2022.current_charset;
3343
3344 #ifdef ENABLE_COMPOSITE_CHARS
3345   /* flags for handling composite chars.  We do a little switcharoo
3346      on the source while we're outputting the composite char. */
3347   unsigned int saved_n = 0;
3348   CONST unsigned char *saved_src = NULL;
3349   int in_composite = 0;
3350
3351  back_to_square_n:
3352 #endif
3353
3354   while (n--)
3355     {
3356       unsigned char c = *src++;
3357
3358       if (BYTE_ASCII_P (c))
3359         {               /* Processing ASCII character */
3360           ch = 0;
3361           encode_ucs4 (Vcharset_ascii, c, 0, dst);
3362           char_boundary = 1;
3363         }
3364       else if (BUFBYTE_LEADING_BYTE_P (c) || BUFBYTE_LEADING_BYTE_P (ch))
3365         { /* Processing Leading Byte */
3366           ch = 0;
3367           charset = CHARSET_BY_LEADING_BYTE (c);
3368           if (LEADING_BYTE_PREFIX_P(c))
3369             ch = c;
3370           char_boundary = 0;
3371         }
3372       else
3373         {                       /* Processing Non-ASCII character */
3374           char_boundary = 1;
3375           if (EQ (charset, Vcharset_control_1))
3376             {
3377               encode_ucs4 (Vcharset_control_1, c, 0, dst);
3378             }
3379           else
3380             {
3381               switch (XCHARSET_REP_BYTES (charset))
3382                 {
3383                 case 2:
3384                   encode_ucs4 (charset, c, 0, dst);
3385                   break;
3386                 case 3:
3387                   if (XCHARSET_PRIVATE_P (charset))
3388                     {
3389                       encode_ucs4 (charset, c, 0, dst);
3390                       ch = 0;
3391                     }
3392                   else if (ch)
3393                     {
3394 #ifdef ENABLE_COMPOSITE_CHARS
3395                       if (EQ (charset, Vcharset_composite))
3396                         {
3397                           if (in_composite)
3398                             {
3399                               /* #### Bother! We don't know how to
3400                                  handle this yet. */
3401                               Dynarr_add (dst, 0);
3402                               Dynarr_add (dst, 0);
3403                               Dynarr_add (dst, 0);
3404                               Dynarr_add (dst, '~');
3405                             }
3406                           else
3407                             {
3408                               Emchar emch = MAKE_CHAR (Vcharset_composite,
3409                                                        ch & 0x7F, c & 0x7F);
3410                               Lisp_Object lstr = composite_char_string (emch);
3411                               saved_n = n;
3412                               saved_src = src;
3413                               in_composite = 1;
3414                               src = XSTRING_DATA   (lstr);
3415                               n   = XSTRING_LENGTH (lstr);
3416                             }
3417                         }
3418                       else
3419 #endif /* ENABLE_COMPOSITE_CHARS */
3420                         {
3421                           encode_ucs4(charset, ch, c, dst);
3422                         }
3423                       ch = 0;
3424                     }
3425                   else
3426                     {
3427                       ch = c;
3428                       char_boundary = 0;
3429                     }
3430                   break;
3431                 case 4:
3432                   if (ch)
3433                     {
3434                       encode_ucs4 (charset, ch, c, dst);
3435                       ch = 0;
3436                     }
3437                   else
3438                     {
3439                       ch = c;
3440                       char_boundary = 0;
3441                     }
3442                   break;
3443                 default:
3444                   abort ();
3445                 }
3446             }
3447         }
3448     }
3449
3450 #ifdef ENABLE_COMPOSITE_CHARS
3451   if (in_composite)
3452     {
3453       n = saved_n;
3454       src = saved_src;
3455       in_composite = 0;
3456       goto back_to_square_n; /* Wheeeeeeeee ..... */
3457     }
3458 #endif /* ENABLE_COMPOSITE_CHARS */
3459
3460   str->flags = flags;
3461   str->ch = ch;
3462   str->iso2022.current_char_boundary = char_boundary;
3463   str->iso2022.current_charset = charset;
3464
3465   /* Verbum caro factum est! */
3466 }
3467
3468 \f
3469 /************************************************************************/
3470 /*                           UTF-8 methods                              */
3471 /************************************************************************/
3472
3473 static int
3474 detect_coding_utf8 (struct detection_state *st, CONST unsigned char *src,
3475                     unsigned int n)
3476 {
3477   while (n--)
3478     {
3479       unsigned char c