src/text-coding.c

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