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 decode_flush_er_chars (struct decoding_stream *str, unsigned_char_dynarr* dst);
2267 INLINE_HEADER void
2268 decode_flush_er_chars (struct decoding_stream *str, unsigned_char_dynarr* dst)
2269 {
2270   if ( str->er_counter > 0)
2271     {
2272       Dynarr_add_many (dst, str->er_buf, str->er_counter);
2273       str->er_counter = 0;
2274     }
2275 }
2276
2277 INLINE_HEADER void
2278 COMPOSE_FLUSH_CHARS (struct decoding_stream *str, unsigned_char_dynarr* dst);
2279 INLINE_HEADER void
2280 COMPOSE_FLUSH_CHARS (struct decoding_stream *str, unsigned_char_dynarr* dst)
2281 {
2282   unsigned i;
2283
2284   for (i = 0; i < str->combined_char_count; i++)
2285     DECODE_ADD_UCS_CHAR (str->combined_chars[i], dst);
2286   str->combined_char_count = 0;
2287   str->combining_table = Qnil;
2288 }
2289
2290 void COMPOSE_ADD_CHAR(struct decoding_stream *str, Emchar character,
2291                       unsigned_char_dynarr* dst);
2292 void
2293 COMPOSE_ADD_CHAR(struct decoding_stream *str,
2294                  Emchar character, unsigned_char_dynarr* dst)
2295 {
2296   if (CODING_SYSTEM_DISABLE_COMPOSITION (str->codesys))
2297     DECODE_ADD_UCS_CHAR (character, dst);
2298   else if (!CHAR_TABLEP (str->combining_table))
2299     {
2300       Lisp_Object ret
2301         = get_char_id_table (XCHAR_TABLE(Vcharacter_composition_table),
2302                              character);
2303
2304       if (NILP (ret))
2305         DECODE_ADD_UCS_CHAR (character, dst);
2306       else
2307         {
2308           str->combined_chars[0] = character;
2309           str->combined_char_count = 1;
2310           str->combining_table = ret;
2311         }
2312     }
2313   else
2314     {
2315       Lisp_Object ret
2316         = get_char_id_table (XCHAR_TABLE(str->combining_table),
2317                              character);
2318
2319       if (CHARP (ret))
2320         {
2321           Emchar char2 = XCHARVAL (ret);
2322           ret =
2323             get_char_id_table (XCHAR_TABLE(Vcharacter_composition_table),
2324                                char2);
2325           if (NILP (ret))
2326             {
2327               DECODE_ADD_UCS_CHAR (char2, dst);
2328               str->combined_char_count = 0;
2329               str->combining_table = Qnil;
2330             }
2331           else
2332             {
2333               str->combined_chars[0] = char2;
2334               str->combined_char_count = 1;
2335               str->combining_table = ret;
2336             }
2337         }
2338       else if (CHAR_TABLEP (ret))
2339         {
2340           str->combined_chars[str->combined_char_count++] = character;
2341           str->combining_table = ret;
2342         }
2343       else
2344         {
2345           COMPOSE_FLUSH_CHARS (str, dst);
2346           DECODE_ADD_UCS_CHAR (character, dst);
2347         }
2348     }
2349 }
2350 #else /* not UTF2000 */
2351 #define COMPOSE_FLUSH_CHARS(str, dst)
2352 #define COMPOSE_ADD_CHAR(str, ch, dst) DECODE_ADD_UCS_CHAR (ch, dst)
2353 #endif /* UTF2000 */
2354
2355 static ssize_t decoding_reader (Lstream *stream,
2356                                 unsigned char *data, size_t size);
2357 static ssize_t decoding_writer (Lstream *stream,
2358                                 const unsigned char *data, size_t size);
2359 static int decoding_rewinder   (Lstream *stream);
2360 static int decoding_seekable_p (Lstream *stream);
2361 static int decoding_flusher    (Lstream *stream);
2362 static int decoding_closer     (Lstream *stream);
2363
2364 static Lisp_Object decoding_marker (Lisp_Object stream);
2365
2366 DEFINE_LSTREAM_IMPLEMENTATION ("decoding", lstream_decoding,
2367                                sizeof (struct decoding_stream));
2368
2369 static Lisp_Object
2370 decoding_marker (Lisp_Object stream)
2371 {
2372   Lstream *str = DECODING_STREAM_DATA (XLSTREAM (stream))->other_end;
2373   Lisp_Object str_obj;
2374
2375   /* We do not need to mark the coding systems or charsets stored
2376      within the stream because they are stored in a global list
2377      and automatically marked. */
2378
2379   XSETLSTREAM (str_obj, str);
2380   mark_object (str_obj);
2381   if (str->imp->marker)
2382     return (str->imp->marker) (str_obj);
2383   else
2384     return Qnil;
2385 }
2386
2387 /* Read SIZE bytes of data and store it into DATA.  We are a decoding stream
2388    so we read data from the other end, decode it, and store it into DATA. */
2389
2390 static ssize_t
2391 decoding_reader (Lstream *stream, unsigned char *data, size_t size)
2392 {
2393   struct decoding_stream *str = DECODING_STREAM_DATA (stream);
2394   unsigned char *orig_data = data;
2395   ssize_t read_size;
2396   int error_occurred = 0;
2397
2398   /* We need to interface to mule_decode(), which expects to take some
2399      amount of data and store the result into a Dynarr.  We have
2400      mule_decode() store into str->runoff, and take data from there
2401      as necessary. */
2402
2403   /* We loop until we have enough data, reading chunks from the other
2404      end and decoding it. */
2405   while (1)
2406     {
2407       /* Take data from the runoff if we can.  Make sure to take at
2408          most SIZE bytes, and delete the data from the runoff. */
2409       if (Dynarr_length (str->runoff) > 0)
2410         {
2411           size_t chunk = min (size, (size_t) Dynarr_length (str->runoff));
2412           memcpy (data, Dynarr_atp (str->runoff, 0), chunk);
2413           Dynarr_delete_many (str->runoff, 0, chunk);
2414           data += chunk;
2415           size -= chunk;
2416         }
2417
2418       if (size == 0)
2419         break; /* No more room for data */
2420
2421       if (str->flags & CODING_STATE_END)
2422         /* This means that on the previous iteration, we hit the EOF on
2423            the other end.  We loop once more so that mule_decode() can
2424            output any final stuff it may be holding, or any "go back
2425            to a sane state" escape sequences. (This latter makes sense
2426            during encoding.) */
2427         break;
2428
2429       /* Exhausted the runoff, so get some more.  DATA has at least
2430          SIZE bytes left of storage in it, so it's OK to read directly
2431          into it.  (We'll be overwriting above, after we've decoded it
2432          into the runoff.) */
2433       read_size = Lstream_read (str->other_end, data, size);
2434       if (read_size < 0)
2435         {
2436           error_occurred = 1;
2437           break;
2438         }
2439       if (read_size == 0)
2440         /* There might be some more end data produced in the translation.
2441            See the comment above. */
2442         str->flags |= CODING_STATE_END;
2443       mule_decode (stream, (Extbyte *) data, str->runoff, read_size);
2444     }
2445
2446   if (data - orig_data == 0)
2447     return error_occurred ? -1 : 0;
2448   else
2449     return data - orig_data;
2450 }
2451
2452 static ssize_t
2453 decoding_writer (Lstream *stream, const unsigned char *data, size_t size)
2454 {
2455   struct decoding_stream *str = DECODING_STREAM_DATA (stream);
2456   ssize_t retval;
2457
2458   /* Decode all our data into the runoff, and then attempt to write
2459      it all out to the other end.  Remove whatever chunk we succeeded
2460      in writing. */
2461   mule_decode (stream, (Extbyte *) data, str->runoff, size);
2462   retval = Lstream_write (str->other_end, Dynarr_atp (str->runoff, 0),
2463                           Dynarr_length (str->runoff));
2464   if (retval > 0)
2465     Dynarr_delete_many (str->runoff, 0, retval);
2466   /* Do NOT return retval.  The return value indicates how much
2467      of the incoming data was written, not how many bytes were
2468      written. */
2469   return size;
2470 }
2471
2472 static void
2473 reset_decoding_stream (struct decoding_stream *str)
2474 {
2475 #ifdef MULE
2476   if (CODING_SYSTEM_TYPE (str->codesys) == CODESYS_ISO2022)
2477     {
2478       Lisp_Object coding_system;
2479       XSETCODING_SYSTEM (coding_system, str->codesys);
2480       reset_iso2022 (coding_system, &str->iso2022);
2481     }
2482   else if (CODING_SYSTEM_TYPE (str->codesys) == CODESYS_CCL)
2483     {
2484       setup_ccl_program (&str->ccl, CODING_SYSTEM_CCL_DECODE (str->codesys));
2485     }
2486   str->counter = 0;
2487 #endif /* MULE */
2488 #ifdef UTF2000
2489   str->er_counter = 0;
2490   str->combined_char_count = 0;
2491   str->combining_table = Qnil;
2492 #endif
2493   str->flags = str->cpos = 0;
2494 }
2495
2496 static int
2497 decoding_rewinder (Lstream *stream)
2498 {
2499   struct decoding_stream *str = DECODING_STREAM_DATA (stream);
2500   reset_decoding_stream (str);
2501   Dynarr_reset (str->runoff);
2502   return Lstream_rewind (str->other_end);
2503 }
2504
2505 static int
2506 decoding_seekable_p (Lstream *stream)
2507 {
2508   struct decoding_stream *str = DECODING_STREAM_DATA (stream);
2509   return Lstream_seekable_p (str->other_end);
2510 }
2511
2512 static int
2513 decoding_flusher (Lstream *stream)
2514 {
2515   struct decoding_stream *str = DECODING_STREAM_DATA (stream);
2516   return Lstream_flush (str->other_end);
2517 }
2518
2519 static int
2520 decoding_closer (Lstream *stream)
2521 {
2522   struct decoding_stream *str = DECODING_STREAM_DATA (stream);
2523   if (stream->flags & LSTREAM_FL_WRITE)
2524     {
2525       str->flags |= CODING_STATE_END;
2526       decoding_writer (stream, 0, 0);
2527     }
2528   Dynarr_free (str->runoff);
2529 #ifdef MULE
2530 #ifdef ENABLE_COMPOSITE_CHARS
2531   if (str->iso2022.composite_chars)
2532     Dynarr_free (str->iso2022.composite_chars);
2533 #endif
2534 #endif
2535   return Lstream_close (str->other_end);
2536 }
2537
2538 Lisp_Object
2539 decoding_stream_coding_system (Lstream *stream)
2540 {
2541   Lisp_Object coding_system;
2542   struct decoding_stream *str = DECODING_STREAM_DATA (stream);
2543
2544   XSETCODING_SYSTEM (coding_system, str->codesys);
2545   return subsidiary_coding_system (coding_system, str->eol_type);
2546 }
2547
2548 void
2549 set_decoding_stream_coding_system (Lstream *lstr, Lisp_Object codesys)
2550 {
2551   Lisp_Coding_System *cs = XCODING_SYSTEM (codesys);
2552   struct decoding_stream *str = DECODING_STREAM_DATA (lstr);
2553   str->codesys = cs;
2554   if (CODING_SYSTEM_EOL_TYPE (cs) != EOL_AUTODETECT)
2555     str->eol_type = CODING_SYSTEM_EOL_TYPE (cs);
2556   reset_decoding_stream (str);
2557 }
2558
2559 /* WARNING WARNING WARNING WARNING!!!!!  If you open up a decoding
2560    stream for writing, no automatic code detection will be performed.
2561    The reason for this is that automatic code detection requires a
2562    seekable input.  Things will also fail if you open a decoding
2563    stream for reading using a non-fully-specified coding system and
2564    a non-seekable input stream. */
2565
2566 static Lisp_Object
2567 make_decoding_stream_1 (Lstream *stream, Lisp_Object codesys,
2568                         const char *mode)
2569 {
2570   Lstream *lstr = Lstream_new (lstream_decoding, mode);
2571   struct decoding_stream *str = DECODING_STREAM_DATA (lstr);
2572   Lisp_Object obj;
2573
2574   xzero (*str);
2575   str->other_end = stream;
2576   str->runoff = (unsigned_char_dynarr *) Dynarr_new (unsigned_char);
2577   str->eol_type = EOL_AUTODETECT;
2578   if (!strcmp (mode, "r")
2579       && Lstream_seekable_p (stream))
2580     /* We can determine the coding system now. */
2581     determine_real_coding_system (stream, &codesys, &str->eol_type);
2582   set_decoding_stream_coding_system (lstr, codesys);
2583   str->decst.eol_type = str->eol_type;
2584   str->decst.mask = ~0;
2585   XSETLSTREAM (obj, lstr);
2586   return obj;
2587 }
2588
2589 Lisp_Object
2590 make_decoding_input_stream (Lstream *stream, Lisp_Object codesys)
2591 {
2592   return make_decoding_stream_1 (stream, codesys, "r");
2593 }
2594
2595 Lisp_Object
2596 make_decoding_output_stream (Lstream *stream, Lisp_Object codesys)
2597 {
2598   return make_decoding_stream_1 (stream, codesys, "w");
2599 }
2600
2601 /* Note: the decode_coding_* functions all take the same
2602    arguments as mule_decode(), which is to say some SRC data of
2603    size N, which is to be stored into dynamic array DST.
2604    DECODING is the stream within which the decoding is
2605    taking place, but no data is actually read from or
2606    written to that stream; that is handled in decoding_reader()
2607    or decoding_writer().  This allows the same functions to
2608    be used for both reading and writing. */
2609
2610 static void
2611 mule_decode (Lstream *decoding, const Extbyte *src,
2612              unsigned_char_dynarr *dst, size_t n)
2613 {
2614   struct decoding_stream *str = DECODING_STREAM_DATA (decoding);
2615
2616   /* If necessary, do encoding-detection now.  We do this when
2617      we're a writing stream or a non-seekable reading stream,
2618      meaning that we can't just process the whole input,
2619      rewind, and start over. */
2620
2621   if (CODING_SYSTEM_TYPE (str->codesys) == CODESYS_AUTODETECT ||
2622       str->eol_type == EOL_AUTODETECT)
2623     {
2624       Lisp_Object codesys;
2625
2626       XSETCODING_SYSTEM (codesys, str->codesys);
2627       detect_coding_type (&str->decst, src, n,
2628                           CODING_SYSTEM_TYPE (str->codesys) !=
2629                           CODESYS_AUTODETECT);
2630       if (CODING_SYSTEM_TYPE (str->codesys) == CODESYS_AUTODETECT &&
2631           str->decst.mask != ~0)
2632         /* #### This is cheesy.  What we really ought to do is
2633            buffer up a certain amount of data so as to get a
2634            less random result. */
2635         codesys = coding_system_from_mask (str->decst.mask);
2636       str->eol_type = str->decst.eol_type;
2637       if (XCODING_SYSTEM (codesys) != str->codesys)
2638         {
2639           /* Preserve the CODING_STATE_END flag in case it was set.
2640              If we erase it, bad things might happen. */
2641           int was_end = str->flags & CODING_STATE_END;
2642           set_decoding_stream_coding_system (decoding, codesys);
2643           if (was_end)
2644             str->flags |= CODING_STATE_END;
2645         }
2646     }
2647
2648   switch (CODING_SYSTEM_TYPE (str->codesys))
2649     {
2650 #ifdef DEBUG_XEMACS
2651     case CODESYS_INTERNAL:
2652       Dynarr_add_many (dst, src, n);
2653       break;
2654 #endif
2655     case CODESYS_AUTODETECT:
2656       /* If we got this far and still haven't decided on the coding
2657          system, then do no conversion. */
2658     case CODESYS_NO_CONVERSION:
2659       decode_coding_no_conversion (decoding, src, dst, n);
2660       break;
2661 #ifdef MULE
2662     case CODESYS_SHIFT_JIS:
2663       decode_coding_sjis (decoding, src, dst, n);
2664       break;
2665     case CODESYS_BIG5:
2666       decode_coding_big5 (decoding, src, dst, n);
2667       break;
2668     case CODESYS_UCS4:
2669       decode_coding_ucs4 (decoding, src, dst, n);
2670       break;
2671     case CODESYS_UTF8:
2672       decode_coding_utf8 (decoding, src, dst, n);
2673       break;
2674     case CODESYS_CCL:
2675       str->ccl.last_block = str->flags & CODING_STATE_END;
2676       /* When applying ccl program to stream, MUST NOT set NULL
2677          pointer to src.  */
2678       ccl_driver (&str->ccl, (src ? (unsigned char *)src : (unsigned char*)""),
2679                   dst, n, 0, CCL_MODE_DECODING);
2680       break;
2681     case CODESYS_ISO2022:
2682       decode_coding_iso2022 (decoding, src, dst, n);
2683       break;
2684 #endif /* MULE */
2685     default:
2686       abort ();
2687     }
2688 }
2689
2690 DEFUN ("decode-coding-region", Fdecode_coding_region, 3, 4, 0, /*
2691 Decode the text between START and END which is encoded in CODING-SYSTEM.
2692 This is useful if you've read in encoded text from a file without decoding
2693 it (e.g. you read in a JIS-formatted file but used the `binary' or
2694 `no-conversion' coding system, so that it shows up as "^[$B!<!+^[(B").
2695 Return length of decoded text.
2696 BUFFER defaults to the current buffer if unspecified.
2697 */
2698        (start, end, coding_system, buffer))
2699 {
2700   Bufpos b, e;
2701   struct buffer *buf = decode_buffer (buffer, 0);
2702   Lisp_Object instream, lb_outstream, de_outstream, outstream;
2703   Lstream *istr, *ostr;
2704   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
2705
2706   get_buffer_range_char (buf, start, end, &b, &e, 0);
2707
2708   barf_if_buffer_read_only (buf, b, e);
2709
2710   coding_system = Fget_coding_system (coding_system);
2711   instream = make_lisp_buffer_input_stream  (buf, b, e, 0);
2712   lb_outstream = make_lisp_buffer_output_stream (buf, b, 0);
2713   de_outstream = make_decoding_output_stream (XLSTREAM (lb_outstream),
2714                                               coding_system);
2715   outstream = make_encoding_output_stream (XLSTREAM (de_outstream),
2716                                            Fget_coding_system (Qbinary));
2717   istr = XLSTREAM (instream);
2718   ostr = XLSTREAM (outstream);
2719   GCPRO4 (instream, lb_outstream, de_outstream, outstream);
2720
2721   /* The chain of streams looks like this:
2722
2723      [BUFFER] <----- send through
2724                      ------> [ENCODE AS BINARY]
2725                              ------> [DECODE AS SPECIFIED]
2726                                      ------> [BUFFER]
2727    */
2728
2729   while (1)
2730     {
2731       char tempbuf[1024]; /* some random amount */
2732       Bufpos newpos, even_newer_pos;
2733       Bufpos oldpos = lisp_buffer_stream_startpos (istr);
2734       ssize_t size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf));
2735
2736       if (!size_in_bytes)
2737         break;
2738       newpos = lisp_buffer_stream_startpos (istr);
2739       Lstream_write (ostr, tempbuf, size_in_bytes);
2740       even_newer_pos = lisp_buffer_stream_startpos (istr);
2741       buffer_delete_range (buf, even_newer_pos - (newpos - oldpos),
2742                            even_newer_pos, 0);
2743     }
2744   Lstream_close (istr);
2745   Lstream_close (ostr);
2746   UNGCPRO;
2747   Lstream_delete (istr);
2748   Lstream_delete (ostr);
2749   Lstream_delete (XLSTREAM (de_outstream));
2750   Lstream_delete (XLSTREAM (lb_outstream));
2751   return Qnil;
2752 }
2753
2754 \f
2755 /************************************************************************/
2756 /*           Converting to an external encoding ("encoding")            */
2757 /************************************************************************/
2758
2759 /* An encoding stream is an output stream.  When you create the
2760    stream, you specify the coding system that governs the encoding
2761    and another stream that the resulting encoded data is to be
2762    sent to, and then start sending data to it. */
2763
2764 #define ENCODING_STREAM_DATA(stream) LSTREAM_TYPE_DATA (stream, encoding)
2765
2766 struct encoding_stream
2767 {
2768   /* Coding system that governs the conversion. */
2769   Lisp_Coding_System *codesys;
2770
2771   /* Stream that we read the encoded data from or
2772      write the decoded data to. */
2773   Lstream *other_end;
2774
2775   /* If we are reading, then we can return only a fixed amount of
2776      data, so if the conversion resulted in too much data, we store it
2777      here for retrieval the next time around. */
2778   unsigned_char_dynarr *runoff;
2779
2780   /* FLAGS holds flags indicating the current state of the encoding.
2781      Some of these flags are dependent on the coding system. */
2782   unsigned int flags;
2783
2784   /* CH holds a partially built-up character.  Since we only deal
2785      with one- and two-byte characters at the moment, we only use
2786      this to store the first byte of a two-byte character. */
2787   unsigned int ch;
2788 #ifdef MULE
2789   /* Additional information used by the ISO2022 encoder. */
2790   struct
2791     {
2792       /* CHARSET holds the character sets currently assigned to the G0
2793          through G3 registers.  It is initialized from the array
2794          INITIAL_CHARSET in CODESYS. */
2795       Lisp_Object charset[4];
2796
2797       /* Which registers are currently invoked into the left (GL) and
2798          right (GR) halves of the 8-bit encoding space? */
2799       int register_left, register_right;
2800
2801       /* Whether we need to explicitly designate the charset in the
2802          G? register before using it.  It is initialized from the
2803          array FORCE_CHARSET_ON_OUTPUT in CODESYS. */
2804       unsigned char force_charset_on_output[4];
2805
2806       /* Other state variables that need to be preserved across
2807          invocations. */
2808       Lisp_Object current_charset;
2809       int current_half;
2810       int current_char_boundary;
2811     } iso2022;
2812
2813   void (*encode_char) (struct encoding_stream *str, Emchar c,
2814                        unsigned_char_dynarr *dst, unsigned int *flags);
2815   void (*finish) (struct encoding_stream *str,
2816                   unsigned_char_dynarr *dst, unsigned int *flags);
2817
2818   /* Additional information (the state of the running CCL program)
2819      used by the CCL encoder. */
2820   struct ccl_program ccl;
2821 #endif /* MULE */
2822 };
2823
2824 static ssize_t encoding_reader (Lstream *stream, unsigned char *data, size_t size);
2825 static ssize_t encoding_writer (Lstream *stream, const unsigned char *data,
2826                                 size_t size);
2827 static int encoding_rewinder   (Lstream *stream);
2828 static int encoding_seekable_p (Lstream *stream);
2829 static int encoding_flusher    (Lstream *stream);
2830 static int encoding_closer     (Lstream *stream);
2831
2832 static Lisp_Object encoding_marker (Lisp_Object stream);
2833
2834 DEFINE_LSTREAM_IMPLEMENTATION ("encoding", lstream_encoding,
2835                                sizeof (struct encoding_stream));
2836
2837 static Lisp_Object
2838 encoding_marker (Lisp_Object stream)
2839 {
2840   Lstream *str = ENCODING_STREAM_DATA (XLSTREAM (stream))->other_end;
2841   Lisp_Object str_obj;
2842
2843   /* We do not need to mark the coding systems or charsets stored
2844      within the stream because they are stored in a global list
2845      and automatically marked. */
2846
2847   XSETLSTREAM (str_obj, str);
2848   mark_object (str_obj);
2849   if (str->imp->marker)
2850     return (str->imp->marker) (str_obj);
2851   else
2852     return Qnil;
2853 }
2854
2855 /* Read SIZE bytes of data and store it into DATA.  We are a encoding stream
2856    so we read data from the other end, encode it, and store it into DATA. */
2857
2858 static ssize_t
2859 encoding_reader (Lstream *stream, unsigned char *data, size_t size)
2860 {
2861   struct encoding_stream *str = ENCODING_STREAM_DATA (stream);
2862   unsigned char *orig_data = data;
2863   ssize_t read_size;
2864   int error_occurred = 0;
2865
2866   /* We need to interface to mule_encode(), which expects to take some
2867      amount of data and store the result into a Dynarr.  We have
2868      mule_encode() store into str->runoff, and take data from there
2869      as necessary. */
2870
2871   /* We loop until we have enough data, reading chunks from the other
2872      end and encoding it. */
2873   while (1)
2874     {
2875       /* Take data from the runoff if we can.  Make sure to take at
2876          most SIZE bytes, and delete the data from the runoff. */
2877       if (Dynarr_length (str->runoff) > 0)
2878         {
2879           int chunk = min ((int) size, Dynarr_length (str->runoff));
2880           memcpy (data, Dynarr_atp (str->runoff, 0), chunk);
2881           Dynarr_delete_many (str->runoff, 0, chunk);
2882           data += chunk;
2883           size -= chunk;
2884         }
2885
2886       if (size == 0)
2887         break; /* No more room for data */
2888
2889       if (str->flags & CODING_STATE_END)
2890         /* This means that on the previous iteration, we hit the EOF on
2891            the other end.  We loop once more so that mule_encode() can
2892            output any final stuff it may be holding, or any "go back
2893            to a sane state" escape sequences. (This latter makes sense
2894            during encoding.) */
2895         break;
2896
2897       /* Exhausted the runoff, so get some more.  DATA at least SIZE bytes
2898          left of storage in it, so it's OK to read directly into it.
2899          (We'll be overwriting above, after we've encoded it into the
2900          runoff.) */
2901       read_size = Lstream_read (str->other_end, data, size);
2902       if (read_size < 0)
2903         {
2904           error_occurred = 1;
2905           break;
2906         }
2907       if (read_size == 0)
2908         /* There might be some more end data produced in the translation.
2909            See the comment above. */
2910         str->flags |= CODING_STATE_END;
2911       mule_encode (stream, data, str->runoff, read_size);
2912     }
2913
2914   if (data == orig_data)
2915     return error_occurred ? -1 : 0;
2916   else
2917     return data - orig_data;
2918 }
2919
2920 static ssize_t
2921 encoding_writer (Lstream *stream, const unsigned char *data, size_t size)
2922 {
2923   struct encoding_stream *str = ENCODING_STREAM_DATA (stream);
2924   ssize_t retval;
2925
2926   /* Encode all our data into the runoff, and then attempt to write
2927      it all out to the other end.  Remove whatever chunk we succeeded
2928      in writing. */
2929   mule_encode (stream, data, str->runoff, size);
2930   retval = Lstream_write (str->other_end, Dynarr_atp (str->runoff, 0),
2931                           Dynarr_length (str->runoff));
2932   if (retval > 0)
2933     Dynarr_delete_many (str->runoff, 0, retval);
2934   /* Do NOT return retval.  The return value indicates how much
2935      of the incoming data was written, not how many bytes were
2936      written. */
2937   return size;
2938 }
2939
2940 static void
2941 reset_encoding_stream (struct encoding_stream *str)
2942 {
2943 #ifdef MULE
2944   switch (CODING_SYSTEM_TYPE (str->codesys))
2945     {
2946     case CODESYS_ISO2022:
2947       {
2948         int i;
2949
2950         str->encode_char = &char_encode_iso2022;
2951         str->finish = &char_finish_iso2022;
2952         for (i = 0; i < 4; i++)
2953           {
2954             str->iso2022.charset[i] =
2955               CODING_SYSTEM_ISO2022_INITIAL_CHARSET (str->codesys, i);
2956             str->iso2022.force_charset_on_output[i] =
2957               CODING_SYSTEM_ISO2022_FORCE_CHARSET_ON_OUTPUT (str->codesys, i);
2958           }
2959         str->iso2022.register_left = 0;
2960         str->iso2022.register_right = 1;
2961         str->iso2022.current_charset = Qnil;
2962         str->iso2022.current_half = 0;
2963         break;
2964       }
2965     case CODESYS_CCL:
2966       setup_ccl_program (&str->ccl, CODING_SYSTEM_CCL_ENCODE (str->codesys));
2967       break;
2968     case CODESYS_UTF8:
2969       str->encode_char = &char_encode_utf8;
2970       str->finish = &char_finish_utf8;
2971       break;
2972     case CODESYS_UCS4:
2973       str->encode_char = &char_encode_ucs4;
2974       str->finish = &char_finish_ucs4;
2975       break;
2976     case CODESYS_SHIFT_JIS:
2977       str->encode_char = &char_encode_shift_jis;
2978       str->finish = &char_finish_shift_jis;
2979       break;
2980     case CODESYS_BIG5:
2981       str->encode_char = &char_encode_big5;
2982       str->finish = &char_finish_big5;
2983       break;
2984     default:
2985       break;
2986     }
2987 #endif /* MULE */
2988   str->iso2022.current_char_boundary = 0;
2989   str->flags = str->ch = 0;
2990 }
2991
2992 static int
2993 encoding_rewinder (Lstream *stream)
2994 {
2995   struct encoding_stream *str = ENCODING_STREAM_DATA (stream);
2996   reset_encoding_stream (str);
2997   Dynarr_reset (str->runoff);
2998   return Lstream_rewind (str->other_end);
2999 }
3000
3001 static int
3002 encoding_seekable_p (Lstream *stream)
3003 {
3004   struct encoding_stream *str = ENCODING_STREAM_DATA (stream);
3005   return Lstream_seekable_p (str->other_end);
3006 }
3007
3008 static int
3009 encoding_flusher (Lstream *stream)
3010 {
3011   struct encoding_stream *str = ENCODING_STREAM_DATA (stream);
3012   return Lstream_flush (str->other_end);
3013 }
3014
3015 static int
3016 encoding_closer (Lstream *stream)
3017 {
3018   struct encoding_stream *str = ENCODING_STREAM_DATA (stream);
3019   if (stream->flags & LSTREAM_FL_WRITE)
3020     {
3021       str->flags |= CODING_STATE_END;
3022       encoding_writer (stream, 0, 0);
3023     }
3024   Dynarr_free (str->runoff);
3025   return Lstream_close (str->other_end);
3026 }
3027
3028 Lisp_Object
3029 encoding_stream_coding_system (Lstream *stream)
3030 {
3031   Lisp_Object coding_system;
3032   struct encoding_stream *str = ENCODING_STREAM_DATA (stream);
3033
3034   XSETCODING_SYSTEM (coding_system, str->codesys);
3035   return coding_system;
3036 }
3037
3038 void
3039 set_encoding_stream_coding_system (Lstream *lstr, Lisp_Object codesys)
3040 {
3041   Lisp_Coding_System *cs = XCODING_SYSTEM (codesys);
3042   struct encoding_stream *str = ENCODING_STREAM_DATA (lstr);
3043   str->codesys = cs;
3044   reset_encoding_stream (str);
3045 }
3046
3047 static Lisp_Object
3048 make_encoding_stream_1 (Lstream *stream, Lisp_Object codesys,
3049                         const char *mode)
3050 {
3051   Lstream *lstr = Lstream_new (lstream_encoding, mode);
3052   struct encoding_stream *str = ENCODING_STREAM_DATA (lstr);
3053   Lisp_Object obj;
3054
3055   xzero (*str);
3056   str->runoff = Dynarr_new (unsigned_char);
3057   str->other_end = stream;
3058   set_encoding_stream_coding_system (lstr, codesys);
3059   XSETLSTREAM (obj, lstr);
3060   return obj;
3061 }
3062
3063 Lisp_Object
3064 make_encoding_input_stream (Lstream *stream, Lisp_Object codesys)
3065 {
3066   return make_encoding_stream_1 (stream, codesys, "r");
3067 }
3068
3069 Lisp_Object
3070 make_encoding_output_stream (Lstream *stream, Lisp_Object codesys)
3071 {
3072   return make_encoding_stream_1 (stream, codesys, "w");
3073 }
3074
3075 /* Convert N bytes of internally-formatted data stored in SRC to an
3076    external format, according to the encoding stream ENCODING.
3077    Store the encoded data into DST. */
3078
3079 static void
3080 mule_encode (Lstream *encoding, const Bufbyte *src,
3081              unsigned_char_dynarr *dst, size_t n)
3082 {
3083   struct encoding_stream *str = ENCODING_STREAM_DATA (encoding);
3084
3085   switch (CODING_SYSTEM_TYPE (str->codesys))
3086     {
3087 #ifdef DEBUG_XEMACS
3088     case CODESYS_INTERNAL:
3089       Dynarr_add_many (dst, src, n);
3090       break;
3091 #endif
3092     case CODESYS_AUTODETECT:
3093       /* If we got this far and still haven't decided on the coding
3094          system, then do no conversion. */
3095     case CODESYS_NO_CONVERSION:
3096       encode_coding_no_conversion (encoding, src, dst, n);
3097       break;
3098 #ifdef MULE
3099     case CODESYS_CCL:
3100       str->ccl.last_block = str->flags & CODING_STATE_END;
3101       /* When applying ccl program to stream, MUST NOT set NULL
3102          pointer to src.  */
3103       ccl_driver (&str->ccl, ((src) ? src : (unsigned char*)""),
3104                   dst, n, 0, CCL_MODE_ENCODING);
3105       break;
3106 #endif /* MULE */
3107     default:
3108       text_encode_generic (encoding, src, dst, n);
3109     }
3110 }
3111
3112 DEFUN ("encode-coding-region", Fencode_coding_region, 3, 4, 0, /*
3113 Encode the text between START and END using CODING-SYSTEM.
3114 This will, for example, convert Japanese characters into stuff such as
3115 "^[$B!<!+^[(B" if you use the JIS encoding.  Return length of encoded
3116 text.  BUFFER defaults to the current buffer if unspecified.
3117 */
3118        (start, end, coding_system, buffer))
3119 {
3120   Bufpos b, e;
3121   struct buffer *buf = decode_buffer (buffer, 0);
3122   Lisp_Object instream, lb_outstream, de_outstream, outstream;
3123   Lstream *istr, *ostr;
3124   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3125
3126   get_buffer_range_char (buf, start, end, &b, &e, 0);
3127
3128   barf_if_buffer_read_only (buf, b, e);
3129
3130   coding_system = Fget_coding_system (coding_system);
3131   instream  = make_lisp_buffer_input_stream  (buf, b, e, 0);
3132   lb_outstream = make_lisp_buffer_output_stream (buf, b, 0);
3133   de_outstream = make_decoding_output_stream (XLSTREAM (lb_outstream),
3134                                               Fget_coding_system (Qbinary));
3135   outstream = make_encoding_output_stream (XLSTREAM (de_outstream),
3136                                            coding_system);
3137   istr = XLSTREAM (instream);
3138   ostr = XLSTREAM (outstream);
3139   GCPRO4 (instream, outstream, de_outstream, lb_outstream);
3140   /* The chain of streams looks like this:
3141
3142      [BUFFER] <----- send through
3143                      ------> [ENCODE AS SPECIFIED]
3144                              ------> [DECODE AS BINARY]
3145                                      ------> [BUFFER]
3146    */
3147   while (1)
3148     {
3149       char tempbuf[1024]; /* some random amount */
3150       Bufpos newpos, even_newer_pos;
3151       Bufpos oldpos = lisp_buffer_stream_startpos (istr);
3152       ssize_t size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf));
3153
3154       if (!size_in_bytes)
3155         break;
3156       newpos = lisp_buffer_stream_startpos (istr);
3157       Lstream_write (ostr, tempbuf, size_in_bytes);
3158       even_newer_pos = lisp_buffer_stream_startpos (istr);
3159       buffer_delete_range (buf, even_newer_pos - (newpos - oldpos),
3160                            even_newer_pos, 0);
3161     }
3162
3163   {
3164     Charcount retlen =
3165       lisp_buffer_stream_startpos (XLSTREAM (instream)) - b;
3166     Lstream_close (istr);
3167     Lstream_close (ostr);
3168     UNGCPRO;
3169     Lstream_delete (istr);
3170     Lstream_delete (ostr);
3171     Lstream_delete (XLSTREAM (de_outstream));
3172     Lstream_delete (XLSTREAM (lb_outstream));
3173     return make_int (retlen);
3174   }
3175 }
3176
3177 #ifdef MULE
3178 \f
3179 static void
3180 text_encode_generic (Lstream *encoding, const Bufbyte *src,
3181                      unsigned_char_dynarr *dst, size_t n)
3182 {
3183   unsigned char c;
3184   unsigned char char_boundary;
3185   struct encoding_stream *str = ENCODING_STREAM_DATA (encoding);
3186   unsigned int flags          = str->flags;
3187   Emchar ch                   = str->ch;
3188
3189   char_boundary = str->iso2022.current_char_boundary;
3190
3191   while (n--)
3192     {
3193       c = *src++;
3194
3195       if (char_boundary == 0)
3196         {
3197           if (c >= 0xfc)
3198             {
3199               ch = c & 0x01;
3200               char_boundary = 5;
3201             }
3202           else if (c >= 0xf8)
3203             {
3204               ch = c & 0x03;
3205               char_boundary = 4;
3206             }
3207           else if (c >= 0xf0)
3208             {
3209               ch = c & 0x07;
3210               char_boundary = 3;
3211             }
3212           else if (c >= 0xe0)
3213             {
3214               ch = c & 0x0f;
3215               char_boundary = 2;
3216             }
3217           else if (c >= 0xc0)
3218             {
3219               ch = c & 0x1f;
3220               char_boundary = 1;
3221             }
3222           else
3223             (*str->encode_char) (str, c, dst, &flags);
3224         }
3225       else if (char_boundary == 1)
3226         {
3227           (*str->encode_char) (str, (ch << 6) | (c & 0x3f), dst, &flags);
3228           ch =0;
3229           char_boundary = 0;
3230         }
3231       else
3232         {
3233           ch = (ch << 6) | (c & 0x3f);
3234           char_boundary--;
3235         }
3236     }
3237
3238   if ((char_boundary == 0) && (flags & CODING_STATE_END))
3239     {
3240       (*str->finish) (str, dst, &flags);
3241     }
3242
3243   str->flags = flags;
3244   str->ch    = ch;
3245   str->iso2022.current_char_boundary = char_boundary;
3246 }
3247
3248 \f
3249 /************************************************************************/
3250 /*                          Shift-JIS methods                           */
3251 /************************************************************************/
3252
3253 /* Shift-JIS is a coding system encoding three character sets: ASCII, right
3254    half of JISX0201-Kana, and JISX0208.  An ASCII character is encoded
3255    as is.  A character of JISX0201-Kana (DIMENSION1_CHARS94 character set) is
3256    encoded by "position-code + 0x80".  A character of JISX0208
3257    (DIMENSION2_CHARS94 character set) is encoded in 2-byte but two
3258    position-codes are divided and shifted so that it fit in the range
3259    below.
3260
3261    --- CODE RANGE of Shift-JIS ---
3262    (character set)      (range)
3263    ASCII                0x00 .. 0x7F
3264    JISX0201-Kana        0xA0 .. 0xDF
3265    JISX0208 (1st byte)  0x80 .. 0x9F and 0xE0 .. 0xEF
3266             (2nd byte)  0x40 .. 0x7E and 0x80 .. 0xFC
3267    -------------------------------
3268
3269 */
3270
3271 /* Is this the first byte of a Shift-JIS two-byte char? */
3272
3273 #define BYTE_SJIS_TWO_BYTE_1_P(c) \
3274   (((c) >= 0x81 && (c) <= 0x9F) || ((c) >= 0xE0 && (c) <= 0xEF))
3275
3276 /* Is this the second byte of a Shift-JIS two-byte char? */
3277
3278 #define BYTE_SJIS_TWO_BYTE_2_P(c) \
3279   (((c) >= 0x40 && (c) <= 0x7E) || ((c) >= 0x80 && (c) <= 0xFC))
3280
3281 #define BYTE_SJIS_KATAKANA_P(c) \
3282   ((c) >= 0xA1 && (c) <= 0xDF)
3283
3284 static int
3285 detect_coding_sjis (struct detection_state *st, const Extbyte *src, size_t n)
3286 {
3287   while (n--)
3288     {
3289       unsigned char c = *(unsigned char *)src++;
3290       if (c == ISO_CODE_ESC || c == ISO_CODE_SI || c == ISO_CODE_SO)
3291         return 0;
3292       if (st->shift_jis.in_second_byte)
3293         {
3294           st->shift_jis.in_second_byte = 0;
3295           if (c < 0x40)
3296             return 0;
3297         }
3298       else if ((c >= 0x80 && c < 0xA0) || c >= 0xE0)
3299         st->shift_jis.in_second_byte = 1;
3300     }
3301   return CODING_CATEGORY_SHIFT_JIS_MASK;
3302 }
3303
3304 /* Convert Shift-JIS data to internal format. */
3305
3306 static void
3307 decode_coding_sjis (Lstream *decoding, const Extbyte *src,
3308                     unsigned_char_dynarr *dst, size_t n)
3309 {
3310   struct decoding_stream *str = DECODING_STREAM_DATA (decoding);
3311   unsigned int flags  = str->flags;
3312   unsigned int cpos   = str->cpos;
3313   eol_type_t eol_type = str->eol_type;
3314
3315   while (n--)
3316     {
3317       unsigned char c = *(unsigned char *)src++;
3318
3319       if (cpos)
3320         {
3321           /* Previous character was first byte of Shift-JIS Kanji char. */
3322           if (BYTE_SJIS_TWO_BYTE_2_P (c))
3323             {
3324               unsigned char e1, e2;
3325
3326               DECODE_SJIS (cpos, c, e1, e2);
3327 #ifdef UTF2000
3328               DECODE_ADD_UCS_CHAR(MAKE_CHAR(Vcharset_japanese_jisx0208,
3329                                             e1 & 0x7F,
3330                                             e2 & 0x7F), dst);
3331 #else
3332               Dynarr_add (dst, LEADING_BYTE_JAPANESE_JISX0208);
3333               Dynarr_add (dst, e1);
3334               Dynarr_add (dst, e2);
3335 #endif
3336             }
3337           else
3338             {
3339               DECODE_ADD_BINARY_CHAR (cpos, dst);
3340               DECODE_ADD_BINARY_CHAR (c, dst);
3341             }
3342           cpos = 0;
3343         }
3344       else
3345         {
3346           DECODE_HANDLE_EOL_TYPE (eol_type, c, flags, dst);
3347           if (BYTE_SJIS_TWO_BYTE_1_P (c))
3348             cpos = c;
3349           else if (BYTE_SJIS_KATAKANA_P (c))
3350             {
3351 #ifdef UTF2000
3352               DECODE_ADD_UCS_CHAR(MAKE_CHAR(Vcharset_katakana_jisx0201,
3353                                             c & 0x7F, 0), dst);
3354 #else
3355               Dynarr_add (dst, LEADING_BYTE_KATAKANA_JISX0201);
3356               Dynarr_add (dst, c);
3357 #endif
3358             }
3359 #ifdef UTF2000
3360           else if (c > 32)
3361             DECODE_ADD_UCS_CHAR(MAKE_CHAR(Vcharset_latin_jisx0201,
3362                                           c, 0), dst);
3363 #endif
3364           else
3365             DECODE_ADD_BINARY_CHAR (c, dst);
3366         }
3367     label_continue_loop:;
3368     }
3369
3370   DECODE_HANDLE_END_OF_CONVERSION (flags, cpos, dst);
3371
3372   str->flags = flags;
3373   str->cpos  = cpos;
3374 }
3375
3376 /* Convert internal character representation to Shift_JIS. */
3377
3378 void
3379 char_encode_shift_jis (struct encoding_stream *str, Emchar ch,
3380                        unsigned_char_dynarr *dst, unsigned int *flags)
3381 {
3382   eol_type_t eol_type = CODING_SYSTEM_EOL_TYPE (str->codesys);
3383
3384   if (ch == '\n')
3385     {
3386       if (eol_type != EOL_LF && eol_type != EOL_AUTODETECT)
3387         Dynarr_add (dst, '\r');
3388       if (eol_type != EOL_CR)
3389         Dynarr_add (dst, ch);
3390     }
3391   else
3392     {
3393       unsigned int s1, s2;
3394 #ifdef UTF2000
3395       int code_point = charset_code_point (Vcharset_latin_jisx0201, ch);
3396
3397       if (code_point >= 0)
3398         Dynarr_add (dst, code_point);
3399       else if ((code_point
3400                 = charset_code_point (Vcharset_japanese_jisx0208_1990, ch))
3401                >= 0)
3402         {
3403           ENCODE_SJIS ((code_point >> 8) | 0x80,
3404                        (code_point & 0xFF) | 0x80, s1, s2);
3405           Dynarr_add (dst, s1);
3406           Dynarr_add (dst, s2);
3407         }
3408       else if ((code_point
3409                 = charset_code_point (Vcharset_katakana_jisx0201, ch))
3410                >= 0)
3411         Dynarr_add (dst, code_point | 0x80);
3412       else if ((code_point
3413                 = charset_code_point (Vcharset_japanese_jisx0208, ch))
3414                >= 0)
3415         {
3416           ENCODE_SJIS ((code_point >> 8) | 0x80,
3417                        (code_point & 0xFF) | 0x80, s1, s2);
3418           Dynarr_add (dst, s1);
3419           Dynarr_add (dst, s2);
3420         }
3421       else if ((code_point = charset_code_point (Vcharset_ascii, ch))
3422                >= 0)
3423         Dynarr_add (dst, code_point);
3424       else
3425         Dynarr_add (dst, '?');
3426 #else
3427       Lisp_Object charset;
3428       unsigned int c1, c2;
3429
3430       BREAKUP_CHAR (ch, charset, c1, c2);
3431
3432       if (EQ(charset, Vcharset_katakana_jisx0201))
3433         {
3434           Dynarr_add (dst, c1 | 0x80);
3435         }
3436       else if (c2 == 0)
3437         {
3438           Dynarr_add (dst, c1);
3439         }
3440       else if (EQ(charset, Vcharset_japanese_jisx0208))
3441         {
3442           ENCODE_SJIS (c1 | 0x80, c2 | 0x80, s1, s2);
3443           Dynarr_add (dst, s1);
3444           Dynarr_add (dst, s2);
3445         }
3446       else
3447         Dynarr_add (dst, '?');
3448 #endif
3449     }
3450 }
3451
3452 void
3453 char_finish_shift_jis (struct encoding_stream *str, unsigned_char_dynarr *dst,
3454                        unsigned int *flags)
3455 {
3456 }
3457
3458 DEFUN ("decode-shift-jis-char", Fdecode_shift_jis_char, 1, 1, 0, /*
3459 Decode a JISX0208 character of Shift-JIS coding-system.
3460 CODE is the character code in Shift-JIS as a cons of type bytes.
3461 Return the corresponding character.
3462 */
3463        (code))
3464 {
3465   unsigned char c1, c2, s1, s2;
3466
3467   CHECK_CONS (code);
3468   CHECK_INT (XCAR (code));
3469   CHECK_INT (XCDR (code));
3470   s1 = XINT (XCAR (code));
3471   s2 = XINT (XCDR (code));
3472   if (BYTE_SJIS_TWO_BYTE_1_P (s1) &&
3473       BYTE_SJIS_TWO_BYTE_2_P (s2))
3474     {
3475       DECODE_SJIS (s1, s2, c1, c2);
3476       return make_char (MAKE_CHAR (Vcharset_japanese_jisx0208,
3477                                    c1 & 0x7F, c2 & 0x7F));
3478     }
3479   else
3480     return Qnil;
3481 }
3482
3483 DEFUN ("encode-shift-jis-char", Fencode_shift_jis_char, 1, 1, 0, /*
3484 Encode a JISX0208 character CHARACTER to SHIFT-JIS coding-system.
3485 Return the corresponding character code in SHIFT-JIS as a cons of two bytes.
3486 */
3487        (character))
3488 {
3489   Lisp_Object charset;
3490   int c1, c2, s1, s2;
3491
3492   CHECK_CHAR_COERCE_INT (character);
3493   BREAKUP_CHAR (XCHAR (character), charset, c1, c2);
3494   if (EQ (charset, Vcharset_japanese_jisx0208))
3495     {
3496       ENCODE_SJIS (c1 | 0x80, c2 | 0x80, s1, s2);
3497       return Fcons (make_int (s1), make_int (s2));
3498     }
3499   else
3500     return Qnil;
3501 }
3502
3503 \f
3504 /************************************************************************/
3505 /*                            Big5 methods                              */
3506 /************************************************************************/
3507
3508 /* BIG5 is a coding system encoding two character sets: ASCII and
3509    Big5.  An ASCII character is encoded as is.  Big5 is a two-byte
3510    character set and is encoded in two-byte.
3511
3512    --- CODE RANGE of BIG5 ---
3513    (character set)      (range)
3514    ASCII                0x00 .. 0x7F
3515    Big5 (1st byte)      0xA1 .. 0xFE
3516         (2nd byte)      0x40 .. 0x7E and 0xA1 .. 0xFE
3517    --------------------------
3518
3519    Since the number of characters in Big5 is larger than maximum
3520    characters in Emacs' charset (96x96), it can't be handled as one
3521    charset.  So, in Emacs, Big5 is divided into two: `charset-big5-1'
3522    and `charset-big5-2'.  Both <type>s are DIMENSION2_CHARS94.  The former
3523    contains frequently used characters and the latter contains less
3524    frequently used characters.  */
3525
3526 #ifdef UTF2000
3527 #define BYTE_BIG5_TWO_BYTE_1_P(c) \
3528   ((c) >= 0x81 && (c) <= 0xFE)
3529 #else
3530 #define BYTE_BIG5_TWO_BYTE_1_P(c) \
3531   ((c) >= 0xA1 && (c) <= 0xFE)
3532 #endif
3533
3534 /* Is this the second byte of a Shift-JIS two-byte char? */
3535
3536 #define BYTE_BIG5_TWO_BYTE_2_P(c) \
3537   (((c) >= 0x40 && (c) <= 0x7E) || ((c) >= 0xA1 && (c) <= 0xFE))
3538
3539 /* Number of Big5 characters which have the same code in 1st byte.  */
3540
3541 #define BIG5_SAME_ROW (0xFF - 0xA1 + 0x7F - 0x40)
3542
3543 /* Code conversion macros.  These are macros because they are used in
3544    inner loops during code conversion.
3545
3546    Note that temporary variables in macros introduce the classic
3547    dynamic-scoping problems with variable names.  We use capital-
3548    lettered variables in the assumption that XEmacs does not use
3549    capital letters in variables except in a very formalized way
3550    (e.g. Qstring). */
3551
3552 /* Convert Big5 code (b1, b2) into its internal string representation
3553    (lb, c1, c2). */
3554
3555 /* There is a much simpler way to split the Big5 charset into two.
3556    For the moment I'm going to leave the algorithm as-is because it
3557    claims to separate out the most-used characters into a single
3558    charset, which perhaps will lead to optimizations in various
3559    places.
3560
3561    The way the algorithm works is something like this:
3562
3563    Big5 can be viewed as a 94x157 charset, where the row is
3564    encoded into the bytes 0xA1 .. 0xFE and the column is encoded
3565    into the bytes 0x40 .. 0x7E and 0xA1 .. 0xFE.  As for frequency,
3566    the split between low and high column numbers is apparently
3567    meaningless; ascending rows produce less and less frequent chars.
3568    Therefore, we assign the lower half of rows (0xA1 .. 0xC8) to
3569    the first charset, and the upper half (0xC9 .. 0xFE) to the
3570    second.  To do the conversion, we convert the character into
3571    a single number where 0 .. 156 is the first row, 157 .. 313
3572    is the second, etc.  That way, the characters are ordered by
3573    decreasing frequency.  Then we just chop the space in two
3574    and coerce the result into a 94x94 space.
3575    */
3576
3577 #define DECODE_BIG5(b1, b2, lb, c1, c2) do                              \
3578 {                                                                       \
3579   int B1 = b1, B2 = b2;                                                 \
3580   unsigned int I                                                        \
3581     = (B1 - 0xA1) * BIG5_SAME_ROW + B2 - (B2 < 0x7F ? 0x40 : 0x62);     \
3582                                                                         \
3583   if (B1 < 0xC9)                                                        \
3584     {                                                                   \
3585       lb = LEADING_BYTE_CHINESE_BIG5_1;                                 \
3586     }                                                                   \
3587   else                                                                  \
3588     {                                                                   \
3589       lb = LEADING_BYTE_CHINESE_BIG5_2;                                 \
3590       I -= (BIG5_SAME_ROW) * (0xC9 - 0xA1);                             \
3591     }                                                                   \
3592   c1 = I / (0xFF - 0xA1) + 0xA1;                                        \
3593   c2 = I % (0xFF - 0xA1) + 0xA1;                                        \
3594 } while (0)
3595
3596 /* Convert the internal string representation of a Big5 character
3597    (lb, c1, c2) into Big5 code (b1, b2). */
3598
3599 #define ENCODE_BIG5(lb, c1, c2, b1, b2) do                              \
3600 {                                                                       \
3601   unsigned int I = ((c1) - 0xA1) * (0xFF - 0xA1) + ((c2) - 0xA1);       \
3602                                                                         \
3603   if (lb == LEADING_BYTE_CHINESE_BIG5_2)                                \
3604     {                                                                   \
3605       I += BIG5_SAME_ROW * (0xC9 - 0xA1);                               \
3606     }                                                                   \
3607   b1 = I / BIG5_SAME_ROW + 0xA1;                                        \
3608   b2 = I % BIG5_SAME_ROW;                                               \
3609   b2 += b2 < 0x3F ? 0x40 : 0x62;                                        \
3610 } while (0)
3611
3612 static int
3613 detect_coding_big5 (struct detection_state *st, const Extbyte *src, size_t n)
3614 {
3615   while (n--)
3616     {
3617       unsigned char c = *(unsigned char *)src++;
3618       if (c == ISO_CODE_ESC || c == ISO_CODE_SI || c == ISO_CODE_SO
3619 #ifndef UTF2000
3620           || (c >= 0x80 && c <= 0xA0)
3621 #endif
3622           )
3623         return 0;
3624       if (st->big5.in_second_byte)
3625         {
3626           st->big5.in_second_byte = 0;
3627           if (c < 0x40 || (c >= 0x80 && c <= 0xA0))
3628             return 0;
3629         }
3630       else if (
3631 #ifdef UTF2000
3632                c >= 0x81
3633 #else
3634                c >= 0xA1
3635 #endif
3636                )
3637         st->big5.in_second_byte = 1;
3638     }
3639   return CODING_CATEGORY_BIG5_MASK;
3640 }
3641
3642 /* Convert Big5 data to internal format. */
3643
3644 static void
3645 decode_coding_big5 (Lstream *decoding, const Extbyte *src,
3646                     unsigned_char_dynarr *dst, size_t n)
3647 {
3648   struct decoding_stream *str = DECODING_STREAM_DATA (decoding);
3649   unsigned int flags  = str->flags;
3650   unsigned int cpos   = str->cpos;
3651   eol_type_t eol_type = str->eol_type;
3652 #ifdef UTF2000
3653   Lisp_Object ccs
3654     = CODING_SYSTEM_ISO2022_INITIAL_CHARSET (DECODING_STREAM_DATA
3655                                              (decoding)->codesys, 1);
3656 #endif
3657
3658   while (n--)
3659     {
3660       unsigned char c = *(unsigned char *)src++;
3661       if (cpos)
3662         {
3663           /* Previous character was first byte of Big5 char. */
3664           if (BYTE_BIG5_TWO_BYTE_2_P (c))
3665             {
3666 #ifdef UTF2000
3667               int code_point = (cpos << 8) | c;
3668               Emchar char_id = decode_defined_char (ccs, code_point);
3669
3670               if (char_id < 0)
3671                 char_id = DECODE_CHAR (Vcharset_chinese_big5, code_point);
3672               DECODE_ADD_UCS_CHAR (char_id, dst);
3673 #else
3674               unsigned char b1, b2, b3;
3675               DECODE_BIG5 (cpos, c, b1, b2, b3);
3676               Dynarr_add (dst, b1);
3677               Dynarr_add (dst, b2);
3678               Dynarr_add (dst, b3);
3679 #endif
3680             }
3681           else
3682             {
3683               DECODE_ADD_BINARY_CHAR (cpos, dst);
3684               DECODE_ADD_BINARY_CHAR (c, dst);
3685             }
3686           cpos = 0;
3687         }
3688       else
3689         {
3690           DECODE_HANDLE_EOL_TYPE (eol_type, c, flags, dst);
3691           if (BYTE_BIG5_TWO_BYTE_1_P (c))
3692             cpos = c;
3693           else
3694             DECODE_ADD_BINARY_CHAR (c, dst);
3695         }
3696     label_continue_loop:;
3697     }
3698
3699   DECODE_HANDLE_END_OF_CONVERSION (flags, cpos, dst);
3700
3701   str->flags = flags;
3702   str->cpos  = cpos;
3703 }
3704
3705 /* Convert internally-formatted data to Big5. */
3706
3707 void
3708 char_encode_big5 (struct encoding_stream *str, Emchar ch,
3709                   unsigned_char_dynarr *dst, unsigned int *flags)
3710 {
3711   eol_type_t eol_type = CODING_SYSTEM_EOL_TYPE (str->codesys);
3712
3713   if (ch == '\n')
3714     {
3715       if (eol_type != EOL_LF && eol_type != EOL_AUTODETECT)
3716         Dynarr_add (dst, '\r');
3717       if (eol_type != EOL_CR)
3718         Dynarr_add (dst, ch);
3719     }
3720   else
3721     {
3722 #ifdef UTF2000
3723       int code_point;
3724       Lisp_Object ccs
3725         = CODING_SYSTEM_ISO2022_INITIAL_CHARSET (str->codesys, 1);
3726
3727       if ((code_point = charset_code_point (Vcharset_ascii, ch)) >= 0)
3728         Dynarr_add (dst, code_point);
3729       else if ((code_point = charset_code_point (ccs, ch)) >= 0)
3730         {
3731           Dynarr_add (dst, code_point >> 8);
3732           Dynarr_add (dst, code_point & 0xFF);
3733         }
3734       else if ((code_point
3735                 = charset_code_point (Vcharset_chinese_big5, ch)) >= 0)
3736         {
3737           Dynarr_add (dst, code_point >> 8);
3738           Dynarr_add (dst, code_point & 0xFF);
3739         }
3740       else if ((code_point
3741                 = charset_code_point (Vcharset_chinese_big5_1, ch)) >= 0)
3742         {
3743           unsigned int I
3744             = ((code_point >> 8) - 33) * (0xFF - 0xA1)
3745             + ((code_point & 0xFF) - 33);
3746           unsigned char b1 = I / BIG5_SAME_ROW + 0xA1;
3747           unsigned char b2 = I % BIG5_SAME_ROW;
3748
3749           b2 += b2 < 0x3F ? 0x40 : 0x62;
3750           Dynarr_add (dst, b1);
3751           Dynarr_add (dst, b2);
3752         }
3753       else if ((code_point
3754                 = charset_code_point (Vcharset_chinese_big5_2, ch)) >= 0)
3755         {
3756           unsigned int I
3757             = ((code_point >> 8) - 33) * (0xFF - 0xA1)
3758             + ((code_point & 0xFF) - 33);
3759           unsigned char b1, b2;
3760
3761           I += BIG5_SAME_ROW * (0xC9 - 0xA1);
3762           b1 = I / BIG5_SAME_ROW + 0xA1;
3763           b2 = I % BIG5_SAME_ROW;
3764           b2 += b2 < 0x3F ? 0x40 : 0x62;
3765           Dynarr_add (dst, b1);
3766           Dynarr_add (dst, b2);
3767         }
3768       else
3769         Dynarr_add (dst, '?');
3770 #else
3771 #endif
3772     }
3773 }
3774
3775 void
3776 char_finish_big5 (struct encoding_stream *str, unsigned_char_dynarr *dst,
3777                   unsigned int *flags)
3778 {
3779 }
3780
3781
3782 DEFUN ("decode-big5-char", Fdecode_big5_char, 1, 1, 0, /*
3783 Decode a Big5 character CODE of BIG5 coding-system.
3784 CODE is the character code in BIG5, a cons of two integers.
3785 Return the corresponding character.
3786 */
3787        (code))
3788 {
3789   unsigned char c1, c2, b1, b2;
3790
3791   CHECK_CONS (code);
3792   CHECK_INT (XCAR (code));
3793   CHECK_INT (XCDR (code));
3794   b1 = XINT (XCAR (code));
3795   b2 = XINT (XCDR (code));
3796   if (BYTE_BIG5_TWO_BYTE_1_P (b1) &&
3797       BYTE_BIG5_TWO_BYTE_2_P (b2))
3798     {
3799       Charset_ID leading_byte;
3800       Lisp_Object charset;
3801       DECODE_BIG5 (b1, b2, leading_byte, c1, c2);
3802       charset = CHARSET_BY_LEADING_BYTE (leading_byte);
3803       return make_char (MAKE_CHAR (charset, c1 & 0x7F, c2 & 0x7F));
3804     }
3805   else
3806     return Qnil;
3807 }
3808
3809 DEFUN ("encode-big5-char", Fencode_big5_char, 1, 1, 0, /*
3810 Encode the Big5 character CHARACTER in the BIG5 coding-system.
3811 Return the corresponding character code in Big5.
3812 */
3813        (character))
3814 {
3815   Lisp_Object charset;
3816   int c1, c2, b1, b2;
3817
3818   CHECK_CHAR_COERCE_INT (character);
3819   BREAKUP_CHAR (XCHAR (character), charset, c1, c2);
3820   if (EQ (charset, Vcharset_chinese_big5_1) ||
3821       EQ (charset, Vcharset_chinese_big5_2))
3822     {
3823       ENCODE_BIG5 (XCHARSET_LEADING_BYTE (charset), c1 | 0x80, c2 | 0x80,
3824                    b1, b2);
3825       return Fcons (make_int (b1), make_int (b2));
3826     }
3827   else
3828     return Qnil;
3829 }
3830
3831 \f
3832 /************************************************************************/
3833 /*                           UCS-4 methods                              */
3834 /************************************************************************/
3835
3836 static int
3837 detect_coding_ucs4 (struct detection_state *st, const Extbyte *src, size_t n)
3838 {
3839   while (n--)
3840     {
3841       unsigned char c = *(unsigned char *)src++;
3842       switch (st->ucs4.in_byte)
3843         {
3844         case 0:
3845           if (c >= 128)
3846             return 0;
3847           else
3848             st->ucs4.in_byte++;
3849           break;
3850         case 3:
3851           st->ucs4.in_byte = 0;
3852           break;
3853         default:
3854           st->ucs4.in_byte++;
3855         }
3856     }
3857   return CODING_CATEGORY_UCS4_MASK;
3858 }
3859
3860 static void
3861 decode_coding_ucs4 (Lstream *decoding, const Extbyte *src,
3862                     unsigned_char_dynarr *dst, size_t n)
3863 {
3864   struct decoding_stream *str = DECODING_STREAM_DATA (decoding);
3865   unsigned int flags = str->flags;
3866   unsigned int cpos  = str->cpos;
3867   unsigned char counter = str->counter;
3868
3869   while (n--)
3870     {
3871       unsigned char c = *(unsigned char *)src++;
3872       switch (counter)
3873         {
3874         case 0:
3875           cpos = c;
3876           counter = 3;
3877           break;
3878         case 1:
3879           DECODE_ADD_UCS_CHAR ((cpos << 8) | c, dst);
3880           cpos = 0;
3881           counter = 0;
3882           break;
3883         default:
3884           cpos = ( cpos << 8 ) | c;
3885           counter--;
3886         }
3887     }
3888   if (counter & CODING_STATE_END)
3889     DECODE_OUTPUT_PARTIAL_CHAR (cpos);
3890
3891   str->flags    = flags;
3892   str->cpos     = cpos;
3893   str->counter  = counter;
3894 }
3895
3896 void
3897 char_encode_ucs4 (struct encoding_stream *str, Emchar ch,
3898                   unsigned_char_dynarr *dst, unsigned int *flags)
3899 {
3900   Dynarr_add (dst, ch >> 24);
3901   Dynarr_add (dst, ch >> 16);
3902   Dynarr_add (dst, ch >>  8);
3903   Dynarr_add (dst, ch      );
3904 }
3905
3906 void
3907 char_finish_ucs4 (struct encoding_stream *str, unsigned_char_dynarr *dst,
3908                   unsigned int *flags)
3909 {
3910 }
3911
3912 \f
3913 /************************************************************************/
3914 /*                           UTF-8 methods                              */
3915 /************************************************************************/
3916
3917 static int
3918 detect_coding_utf8 (struct detection_state *st, const Extbyte *src, size_t n)
3919 {
3920   while (n--)
3921     {
3922       unsigned char c = *(unsigned char *)src++;
3923       switch (st->utf8.in_byte)
3924         {
3925         case 0:
3926           if (c == ISO_CODE_ESC || c == ISO_CODE_SI || c == ISO_CODE_SO)
3927             return 0;
3928           else if (c >= 0xfc)
3929             st->utf8.in_byte = 5;
3930           else if (c >= 0xf8)
3931             st->utf8.in_byte = 4;
3932           else if (c >= 0xf0)
3933             st->utf8.in_byte = 3;
3934           else if (c >= 0xe0)
3935             st->utf8.in_byte = 2;
3936           else if (c >= 0xc0)
3937             st->utf8.in_byte = 1;
3938           else if (c >= 0x80)
3939             return 0;
3940           break;
3941         default:
3942           if ((c & 0xc0) != 0x80)
3943             return 0;
3944           else
3945             st->utf8.in_byte--;
3946         }
3947     }
3948   return CODING_CATEGORY_UTF8_MASK;
3949 }
3950
3951 static void
3952 decode_output_utf8_partial_char (unsigned char counter,
3953                                  unsigned int cpos,
3954                                  unsigned_char_dynarr *dst)
3955 {
3956   if (counter == 5)
3957     DECODE_ADD_BINARY_CHAR ( (cpos|0xFC), dst);
3958   else if (counter == 4)
3959     {
3960       if (cpos < (1 << 6))
3961         DECODE_ADD_BINARY_CHAR ( (cpos|0xF8), dst);
3962       else
3963         {
3964           DECODE_ADD_BINARY_CHAR ( ((cpos >> 6)|0xFC), dst);
3965           DECODE_ADD_BINARY_CHAR ( ((cpos&0x3F)|0x80), dst);
3966         }
3967     }
3968   else if (counter == 3)
3969     {
3970       if (cpos < (1 << 6))
3971         DECODE_ADD_BINARY_CHAR ( (cpos|0xF0), dst);
3972       else if (cpos < (1 << 12))
3973         {
3974           DECODE_ADD_BINARY_CHAR ( ((cpos >> 6)|0xF8), dst);
3975           DECODE_ADD_BINARY_CHAR ( ((cpos&0x3F)|0x80), dst);
3976         }
3977       else
3978         {
3979           DECODE_ADD_BINARY_CHAR ( ( (cpos >> 12)|0xFC), dst);
3980           DECODE_ADD_BINARY_CHAR ( (((cpos >>  6)&0x3F)|0x80), dst);
3981           DECODE_ADD_BINARY_CHAR ( ( (cpos       &0x3F)|0x80), dst);
3982         }
3983     }
3984   else if (counter == 2)
3985     {
3986       if (cpos < (1 << 6))
3987         DECODE_ADD_BINARY_CHAR ( (cpos|0xE0), dst);
3988       else if (cpos < (1 << 12))
3989         {
3990           DECODE_ADD_BINARY_CHAR ( ((cpos >> 6)|0xF0), dst);
3991           DECODE_ADD_BINARY_CHAR ( ((cpos&0x3F)|0x80), dst);
3992         }
3993       else if (cpos < (1 << 18))
3994         {
3995           DECODE_ADD_BINARY_CHAR ( ( (cpos >> 12)|0xF8), dst);
3996           DECODE_ADD_BINARY_CHAR ( (((cpos >> 6)&0x3F)|0x80), dst);
3997           DECODE_ADD_BINARY_CHAR ( ( (cpos      &0x3F)|0x80), dst);
3998         }
3999       else
4000         {
4001           DECODE_ADD_BINARY_CHAR ( ( (cpos >> 18)|0xFC), dst);
4002           DECODE_ADD_BINARY_CHAR ( (((cpos >> 12)&0x3F)|0x80), dst);
4003           DECODE_ADD_BINARY_CHAR ( (((cpos >>  6)&0x3F)|0x80), dst);
4004           DECODE_ADD_BINARY_CHAR ( ( (cpos       &0x3F)|0x80), dst);
4005         }
4006     }
4007   else
4008     {
4009       if (cpos < (1 << 6))
4010         DECODE_ADD_BINARY_CHAR ( (cpos|0xC0), dst);
4011       else if (cpos < (1 << 12))
4012         {
4013           DECODE_ADD_BINARY_CHAR ( ((cpos >> 6)|0xE0), dst);
4014           DECODE_ADD_BINARY_CHAR ( ((cpos&0x3F)|0x80), dst);
4015         }
4016       else if (cpos < (1 << 18))
4017         {
4018           DECODE_ADD_BINARY_CHAR ( ( (cpos >> 12)|0xF0), dst);
4019           DECODE_ADD_BINARY_CHAR ( (((cpos >>  6)&0x3F)|0x80), dst);
4020           DECODE_ADD_BINARY_CHAR ( ( (cpos       &0x3F)|0x80), dst);
4021         }
4022       else if (cpos < (1 << 24))
4023         {
4024           DECODE_ADD_BINARY_CHAR ( ( (cpos >> 18)|0xF8), dst);
4025           DECODE_ADD_BINARY_CHAR ( (((cpos >> 12)&0x3F)|0x80), dst);
4026           DECODE_ADD_BINARY_CHAR ( (((cpos >>  6)&0x3F)|0x80), dst);
4027           DECODE_ADD_BINARY_CHAR ( ( (cpos       &0x3F)|0x80), dst);
4028         }
4029       else
4030         {
4031           DECODE_ADD_BINARY_CHAR ( ( (cpos >> 24)|0xFC), dst);
4032           DECODE_ADD_BINARY_CHAR ( (((cpos >> 18)&0x3F)|0x80), dst);
4033           DECODE_ADD_BINARY_CHAR ( (((cpos >> 12)&0x3F)|0x80), dst);
4034           DECODE_ADD_BINARY_CHAR ( (((cpos >>  6)&0x3F)|0x80), dst);
4035           DECODE_ADD_BINARY_CHAR ( ( (cpos       &0x3F)|0x80), dst);
4036         }
4037     }
4038 }
4039
4040 static void
4041 decode_coding_utf8 (Lstream *decoding, const Extbyte *src,
4042                     unsigned_char_dynarr *dst, size_t n)
4043 {
4044   struct decoding_stream *str = DECODING_STREAM_DATA (decoding);
4045   unsigned int flags    = str->flags;
4046   unsigned int cpos     = str->cpos;
4047   eol_type_t eol_type   = str->eol_type;
4048   unsigned char counter = str->counter;
4049
4050   while (n--)
4051     {
4052       unsigned char c = *(unsigned char *)src++;
4053       if (counter == 0)
4054         {
4055           if ( c < ' ' )
4056             {
4057               decode_flush_er_chars (str, dst);
4058               DECODE_HANDLE_EOL_TYPE (eol_type, c, flags, dst);
4059               DECODE_ADD_UCS_CHAR (c, dst);
4060             }
4061           else if ( c < 0xC0 )
4062             {
4063               if (str->er_counter == 0)
4064                 {
4065                   if (CODING_SYSTEM_USE_ENTITY_REFERENCE (str->codesys)
4066                       && (c == '&') )
4067                     {
4068                       str->er_buf[0] = '&';
4069                       str->er_counter++;
4070                     }
4071                   else
4072                     DECODE_ADD_UCS_CHAR (c, dst);
4073                 }
4074               else if (c == ';')
4075                 {
4076                   Lisp_Object string = make_string (str->er_buf,
4077                                                     str->er_counter);
4078                   Lisp_Object rest = Vcoded_charset_entity_reference_alist;
4079                   Lisp_Object cell;
4080                   Lisp_Object ret;
4081                   Lisp_Object pat;
4082                   Lisp_Object ccs;
4083                   int base;
4084
4085                   while (!NILP (rest))
4086                     {
4087                       cell = Fcar (rest);
4088                       ccs = Fcar (cell);
4089                       if (NILP (ccs = Ffind_charset (ccs)))
4090                         continue;
4091
4092                       cell = Fcdr (cell);
4093                       ret = Fcar (cell);
4094                       if (STRINGP (ret))
4095                         pat = ret;
4096                       else
4097                         continue;
4098
4099                       cell = Fcdr (cell);
4100                       cell = Fcdr (cell);
4101                       ret = Fcar (cell);
4102                       if (EQ (ret, Qd))
4103                         {
4104                           pat = concat3 (build_string ("^&"),
4105                                          pat, build_string ("\\([0-9]+\\)$"));
4106                           base = 10;
4107                         }
4108                       else if (EQ (ret, Qx))
4109                         {
4110                           pat = concat3 (build_string ("^&"),
4111                                          pat,
4112                                          build_string ("\\([0-9a-f]+\\)$"));
4113                           base = 16;
4114                         }
4115                       else if (EQ (ret, QX))
4116                         {
4117                           pat = concat3 (build_string ("^&"),
4118                                          pat,
4119                                          build_string ("\\([0-9A-F]+\\)$"));
4120                           base = 16;
4121                         }
4122                       else
4123                         continue;
4124
4125                       if (!NILP (Fstring_match (pat, string, Qnil, Qnil)))
4126                         {
4127                           int code
4128                             = XINT (Fstring_to_number
4129                                     (Fsubstring (string,
4130                                                  Fmatch_beginning
4131                                                  (make_int (1)),
4132                                                  Fmatch_end (make_int (1))),
4133                                      make_int (base)));
4134
4135                           DECODE_ADD_UCS_CHAR (DECODE_CHAR (ccs, code), dst);
4136                           goto decoded;
4137                         }
4138                       rest = Fcdr (rest);
4139                     }
4140                   if (!NILP (Fstring_match
4141                              (build_string ("^&MCS-\\([0-9A-F]+\\)$"),
4142                               string, Qnil, Qnil)))
4143                     {
4144                       int code
4145                         = XINT (Fstring_to_number
4146                                 (Fsubstring (string,
4147                                              Fmatch_beginning
4148                                              (make_int (1)),
4149                                              Fmatch_end (make_int (1))),
4150                                  make_int (16)));
4151
4152                       DECODE_ADD_UCS_CHAR (code, dst);
4153                     }
4154                   else
4155                     {
4156                       Dynarr_add_many (dst, str->er_buf, str->er_counter);
4157                       Dynarr_add (dst, ';');
4158                     }
4159                 decoded:
4160                   str->er_counter = 0;
4161                 }
4162               else if ( (str->er_counter >= 16) || (c >= 0x7F) )
4163                 {
4164                   Dynarr_add_many (dst, str->er_buf, str->er_counter);
4165                   str->er_counter = 0;
4166                   DECODE_ADD_UCS_CHAR (c, dst);
4167                 }
4168               else
4169                 str->er_buf[str->er_counter++] = c;
4170             }
4171           else
4172             {
4173               Dynarr_add_many (dst, str->er_buf, str->er_counter);
4174               str->er_counter = 0;
4175               if ( c < 0xE0 )
4176                 {
4177                   cpos = c & 0x1f;
4178                   counter = 1;
4179                 }
4180               else if ( c < 0xF0 )
4181                 {
4182                   cpos = c & 0x0f;
4183                   counter = 2;
4184                 }
4185               else if ( c < 0xF8 )
4186                 {
4187                   cpos = c & 0x07;
4188                   counter = 3;
4189                 }
4190               else if ( c < 0xFC )
4191                 {
4192                   cpos = c & 0x03;
4193                   counter = 4;
4194                 }
4195               else
4196                 {
4197                   cpos = c & 0x01;
4198                   counter = 5;
4199                 }
4200             }
4201         }
4202       else if ( (c & 0xC0) == 0x80 )
4203         {
4204           cpos = ( cpos << 6 ) | ( c & 0x3f );
4205           if (counter == 1)
4206             {
4207               DECODE_ADD_UCS_CHAR (cpos, dst);
4208               cpos = 0;
4209               counter = 0;
4210             }
4211           else
4212             counter--;
4213         }
4214       else
4215         {
4216           decode_output_utf8_partial_char (counter, cpos, dst);
4217           DECODE_ADD_BINARY_CHAR (c, dst);
4218           cpos = 0;
4219           counter = 0;
4220         }
4221     label_continue_loop:;
4222     }
4223
4224   if (flags & CODING_STATE_END)
4225     {
4226       decode_flush_er_chars (str, dst);
4227       if (counter > 0)
4228         {
4229           decode_output_utf8_partial_char (counter, cpos, dst);
4230           cpos = 0;
4231           counter = 0;
4232         }
4233     }
4234   str->flags    = flags;
4235   str->cpos     = cpos;
4236   str->counter  = counter;
4237 }
4238
4239 void
4240 char_encode_utf8 (struct encoding_stream *str, Emchar ch,
4241                   unsigned_char_dynarr *dst, unsigned int *flags)
4242 {
4243   eol_type_t eol_type = CODING_SYSTEM_EOL_TYPE (str->codesys);
4244
4245   if (ch == '\n')
4246     {
4247       if (eol_type != EOL_LF && eol_type != EOL_AUTODETECT)
4248         Dynarr_add (dst, '\r');
4249       if (eol_type != EOL_CR)
4250         Dynarr_add (dst, ch);
4251     }
4252   else if (ch <= 0x7f)
4253     {
4254       Dynarr_add (dst, ch);
4255     }
4256   else
4257     {
4258       int code_point = charset_code_point (Vcharset_ucs, ch);
4259
4260       if ( (code_point < 0) || (code_point > 0x10FFFF) )
4261         {
4262           if (CODING_SYSTEM_USE_ENTITY_REFERENCE (str->codesys))
4263             {
4264               Lisp_Object rest = Vcoded_charset_entity_reference_alist;
4265               Lisp_Object cell;
4266               Lisp_Object ret;
4267               Lisp_Object ccs;
4268               int format_columns, idx;
4269               char buf[16], format[16];
4270
4271               while (!NILP (rest))
4272                 {
4273                   cell = Fcar (rest);
4274                   ccs = Fcar (cell);
4275                   if (!NILP (ccs = Ffind_charset (ccs)))
4276                     {
4277                       if ( (code_point
4278                             = charset_code_point (ccs, ch)) >= 0 )
4279                         {
4280                           cell = Fcdr (cell);
4281                           ret = Fcar (cell);
4282                           if (STRINGP (ret)
4283                               && ((idx =XSTRING_LENGTH (ret)) <= 6))
4284                             {
4285                               strncpy (format, XSTRING_DATA (ret), idx);
4286                             }
4287                           else
4288                             continue;
4289
4290                           cell = Fcdr (cell);
4291                           ret = Fcar (cell);
4292                           if (INTP (ret))
4293                             {
4294                               format [idx++] = '%';
4295                               format_columns = XINT (ret);
4296                               if ( (2 <= format_columns)
4297                                    && (format_columns <= 8) )
4298                                 {
4299                                   format [idx++] = '0';
4300                                   format [idx++] = '0' + format_columns;
4301                                 }
4302                             }
4303
4304                           cell = Fcdr (cell);
4305                           ret = Fcar (cell);
4306                           if (EQ (ret, Qd))
4307                             format [idx++] = 'd';
4308                           else if (EQ (ret, Qx))
4309                             format [idx++] = 'x';
4310                           else if (EQ (ret, QX))
4311                             format [idx++] = 'X';
4312                           else
4313                             continue;
4314                           format [idx++] = 0;
4315
4316                           sprintf (buf, format, code_point);
4317                           Dynarr_add (dst, '&');
4318                           Dynarr_add_many (dst, buf, strlen (buf));
4319                           Dynarr_add (dst, ';');
4320                           return;
4321                         }
4322                     }
4323                   rest = Fcdr (rest);
4324                 }
4325               sprintf (buf, "&MCS-%08X;", ch);
4326               Dynarr_add_many (dst, buf, strlen (buf));
4327               return;
4328             }
4329           else
4330             code_point = ch;
4331         }
4332       if (code_point <= 0x7ff)
4333         {
4334           Dynarr_add (dst, (code_point >> 6) | 0xc0);
4335           Dynarr_add (dst, (code_point & 0x3f) | 0x80);
4336         }
4337       else if (code_point <= 0xffff)
4338         {
4339           Dynarr_add (dst,  (code_point >> 12) | 0xe0);
4340           Dynarr_add (dst, ((code_point >>  6) & 0x3f) | 0x80);
4341           Dynarr_add (dst,  (code_point        & 0x3f) | 0x80);
4342         }
4343       else if (code_point <= 0x1fffff)
4344         {
4345           Dynarr_add (dst,  (code_point >> 18) | 0xf0);
4346           Dynarr_add (dst, ((code_point >> 12) & 0x3f) | 0x80);
4347           Dynarr_add (dst, ((code_point >>  6) & 0x3f) | 0x80);
4348           Dynarr_add (dst,  (code_point        & 0x3f) | 0x80);
4349         }
4350       else if (code_point <= 0x3ffffff)
4351         {
4352           Dynarr_add (dst,  (code_point >> 24) | 0xf8);
4353           Dynarr_add (dst, ((code_point >> 18) & 0x3f) | 0x80);
4354           Dynarr_add (dst, ((code_point >> 12) & 0x3f) | 0x80);
4355           Dynarr_add (dst, ((code_point >>  6) & 0x3f) | 0x80);
4356           Dynarr_add (dst,  (code_point        & 0x3f) | 0x80);
4357         }
4358       else
4359         {
4360           Dynarr_add (dst,  (code_point >> 30) | 0xfc);
4361           Dynarr_add (dst, ((code_point >> 24) & 0x3f) | 0x80);
4362           Dynarr_add (dst, ((code_point >> 18) & 0x3f) | 0x80);
4363           Dynarr_add (dst, ((code_point >> 12) & 0x3f) | 0x80);
4364           Dynarr_add (dst, ((code_point >>  6) & 0x3f) | 0x80);
4365           Dynarr_add (dst,  (code_point        & 0x3f) | 0x80);
4366         }
4367     }
4368 }
4369
4370 void
4371 char_finish_utf8 (struct encoding_stream *str, unsigned_char_dynarr *dst,
4372                   unsigned int *flags)
4373 {
4374 }
4375
4376 \f
4377 /************************************************************************/
4378 /*                           ISO2022 methods                            */
4379 /************************************************************************/
4380
4381 /* The following note describes the coding system ISO2022 briefly.
4382    Since the intention of this note is to help understand the
4383    functions in this file, some parts are NOT ACCURATE or OVERLY
4384    SIMPLIFIED.  For thorough understanding, please refer to the
4385    original document of ISO2022.
4386
4387    ISO2022 provides many mechanisms to encode several character sets
4388    in 7-bit and 8-bit environments.  For 7-bit environments, all text
4389    is encoded using bytes less than 128.  This may make the encoded
4390    text a little bit longer, but the text passes more easily through
4391    several gateways, some of which strip off MSB (Most Signigant Bit).
4392
4393    There are two kinds of character sets: control character set and
4394    graphic character set.  The former contains control characters such
4395    as `newline' and `escape' to provide control functions (control
4396    functions are also provided by escape sequences).  The latter
4397    contains graphic characters such as 'A' and '-'.  Emacs recognizes
4398    two control character sets and many graphic character sets.
4399
4400    Graphic character sets are classified into one of the following
4401    four classes, according to the number of bytes (DIMENSION) and
4402    number of characters in one dimension (CHARS) of the set:
4403    - DIMENSION1_CHARS94
4404    - DIMENSION1_CHARS96
4405    - DIMENSION2_CHARS94
4406    - DIMENSION2_CHARS96
4407
4408    In addition, each character set is assigned an identification tag,
4409    unique for each set, called "final character" (denoted as <F>
4410    hereafter).  The <F> of each character set is decided by ECMA(*)
4411    when it is registered in ISO.  The code range of <F> is 0x30..0x7F
4412    (0x30..0x3F are for private use only).
4413
4414    Note (*): ECMA = European Computer Manufacturers Association
4415
4416    Here are examples of graphic character set [NAME(<F>)]:
4417         o DIMENSION1_CHARS94 -- ASCII('B'), right-half-of-JISX0201('I'), ...
4418         o DIMENSION1_CHARS96 -- right-half-of-ISO8859-1('A'), ...
4419         o DIMENSION2_CHARS94 -- GB2312('A'), JISX0208('B'), ...
4420         o DIMENSION2_CHARS96 -- none for the moment
4421
4422    A code area (1 byte = 8 bits) is divided into 4 areas, C0, GL, C1, and GR.
4423         C0 [0x00..0x1F] -- control character plane 0
4424         GL [0x20..0x7F] -- graphic character plane 0
4425         C1 [0x80..0x9F] -- control character plane 1
4426         GR [0xA0..0xFF] -- graphic character plane 1
4427
4428    A control character set is directly designated and invoked to C0 or
4429    C1 by an escape sequence.  The most common case is that:
4430    - ISO646's  control character set is designated/invoked to C0, and
4431    - ISO6429's control character set is designated/invoked to C1,
4432    and usually these designations/invocations are omitted in encoded
4433    text.  In a 7-bit environment, only C0 can be used, and a control
4434    character for C1 is encoded by an appropriate escape sequence to
4435    fit into the environment.  All control characters for C1 are
4436    defined to have corresponding escape sequences.
4437
4438    A graphic character set is at first designated to one of four
4439    graphic registers (G0 through G3), then these graphic registers are
4440    invoked to GL or GR.  These designations and invocations can be
4441    done independently.  The most common case is that G0 is invoked to
4442    GL, G1 is invoked to GR, and ASCII is designated to G0.  Usually
4443    these invocations and designations are omitted in encoded text.
4444    In a 7-bit environment, only GL can be used.
4445
4446    When a graphic character set of CHARS94 is invoked to GL, codes
4447    0x20 and 0x7F of the GL area work as control characters SPACE and
4448    DEL respectively, and codes 0xA0 and 0xFF of the GR area should not
4449    be used.
4450
4451    There are two ways of invocation: locking-shift and single-shift.
4452    With locking-shift, the invocation lasts until the next different
4453    invocation, whereas with single-shift, the invocation affects the
4454    following character only and doesn't affect the locking-shift
4455    state.  Invocations are done by the following control characters or
4456    escape sequences:
4457
4458    ----------------------------------------------------------------------
4459    abbrev  function                  cntrl escape seq   description
4460    ----------------------------------------------------------------------
4461    SI/LS0  (shift-in)                0x0F  none         invoke G0 into GL
4462    SO/LS1  (shift-out)               0x0E  none         invoke G1 into GL
4463    LS2     (locking-shift-2)         none  ESC 'n'      invoke G2 into GL
4464    LS3     (locking-shift-3)         none  ESC 'o'      invoke G3 into GL
4465    LS1R    (locking-shift-1 right)   none  ESC '~'      invoke G1 into GR (*)
4466    LS2R    (locking-shift-2 right)   none  ESC '}'      invoke G2 into GR (*)
4467    LS3R    (locking-shift 3 right)   none  ESC '|'      invoke G3 into GR (*)
4468    SS2     (single-shift-2)          0x8E  ESC 'N'      invoke G2 for one char
4469    SS3     (single-shift-3)          0x8F  ESC 'O'      invoke G3 for one char
4470    ----------------------------------------------------------------------
4471    (*) These are not used by any known coding system.
4472
4473    Control characters for these functions are defined by macros
4474    ISO_CODE_XXX in `coding.h'.
4475
4476    Designations are done by the following escape sequences:
4477    ----------------------------------------------------------------------
4478    escape sequence      description
4479    ----------------------------------------------------------------------
4480    ESC '(' <F>          designate DIMENSION1_CHARS94<F> to G0
4481    ESC ')' <F>          designate DIMENSION1_CHARS94<F> to G1
4482    ESC '*' <F>          designate DIMENSION1_CHARS94<F> to G2
4483    ESC '+' <F>          designate DIMENSION1_CHARS94<F> to G3
4484    ESC ',' <F>          designate DIMENSION1_CHARS96<F> to G0 (*)
4485    ESC '-' <F>          designate DIMENSION1_CHARS96<F> to G1
4486    ESC '.' <F>          designate DIMENSION1_CHARS96<F> to G2
4487    ESC '/' <F>          designate DIMENSION1_CHARS96<F> to G3
4488    ESC '$' '(' <F>      designate DIMENSION2_CHARS94<F> to G0 (**)
4489    ESC '$' ')' <F>      designate DIMENSION2_CHARS94<F> to G1
4490    ESC '$' '*' <F>      designate DIMENSION2_CHARS94<F> to G2
4491    ESC '$' '+' <F>      designate DIMENSION2_CHARS94<F> to G3
4492    ESC '$' ',' <F>      designate DIMENSION2_CHARS96<F> to G0 (*)
4493    ESC '$' '-' <F>      designate DIMENSION2_CHARS96<F> to G1
4494    ESC '$' '.' <F>      designate DIMENSION2_CHARS96<F> to G2
4495    ESC '$' '/' <F>      designate DIMENSION2_CHARS96<F> to G3
4496    ----------------------------------------------------------------------
4497
4498    In this list, "DIMENSION1_CHARS94<F>" means a graphic character set
4499    of dimension 1, chars 94, and final character <F>, etc...
4500
4501    Note (*): Although these designations are not allowed in ISO2022,
4502    Emacs accepts them on decoding, and produces them on encoding
4503    CHARS96 character sets in a coding system which is characterized as
4504    7-bit environment, non-locking-shift, and non-single-shift.
4505
4506    Note (**): If <F> is '@', 'A', or 'B', the intermediate character
4507    '(' can be omitted.  We refer to this as "short-form" hereafter.
4508
4509    Now you may notice that there are a lot of ways for encoding the
4510    same multilingual text in ISO2022.  Actually, there exist many
4511    coding systems such as Compound Text (used in X11's inter client
4512    communication, ISO-2022-JP (used in Japanese internet), ISO-2022-KR
4513    (used in Korean internet), EUC (Extended UNIX Code, used in Asian
4514    localized platforms), and all of these are variants of ISO2022.
4515
4516    In addition to the above, Emacs handles two more kinds of escape
4517    sequences: ISO6429's direction specification and Emacs' private
4518    sequence for specifying character composition.
4519
4520    ISO6429's direction specification takes the following form:
4521         o CSI ']'      -- end of the current direction
4522         o CSI '0' ']'  -- end of the current direction
4523         o CSI '1' ']'  -- start of left-to-right text
4524         o CSI '2' ']'  -- start of right-to-left text
4525    The control character CSI (0x9B: control sequence introducer) is
4526    abbreviated to the escape sequence ESC '[' in a 7-bit environment.
4527
4528    Character composition specification takes the following form:
4529         o ESC '0' -- start character composition
4530         o ESC '1' -- end character composition
4531    Since these are not standard escape sequences of any ISO standard,
4532    their use with these meanings is restricted to Emacs only.  */
4533
4534 static void
4535 reset_iso2022 (Lisp_Object coding_system, struct iso2022_decoder *iso)
4536 {
4537   int i;
4538
4539   for (i = 0; i < 4; i++)
4540     {
4541       if (!NILP (coding_system))
4542         iso->charset[i] =
4543           XCODING_SYSTEM_ISO2022_INITIAL_CHARSET (coding_system, i);
4544       else
4545         iso->charset[i] = Qt;
4546       iso->invalid_designated[i] = 0;
4547     }
4548   iso->esc = ISO_ESC_NOTHING;
4549   iso->esc_bytes_index = 0;
4550   iso->register_left = 0;
4551   iso->register_right = 1;
4552   iso->switched_dir_and_no_valid_charset_yet = 0;
4553   iso->invalid_switch_dir = 0;
4554   iso->output_direction_sequence = 0;
4555   iso->output_literally = 0;
4556 #ifdef ENABLE_COMPOSITE_CHARS
4557   if (iso->composite_chars)
4558     Dynarr_reset (iso->composite_chars);
4559 #endif
4560 }
4561
4562 static int
4563 fit_to_be_escape_quoted (unsigned char c)
4564 {
4565   switch (c)
4566     {
4567     case ISO_CODE_ESC:
4568     case ISO_CODE_CSI:
4569     case ISO_CODE_SS2:
4570     case ISO_CODE_SS3:
4571     case ISO_CODE_SO:
4572     case ISO_CODE_SI:
4573       return 1;
4574
4575     default:
4576       return 0;
4577     }
4578 }
4579
4580 /* Parse one byte of an ISO2022 escape sequence.
4581    If the result is an invalid escape sequence, return 0 and
4582    do not change anything in STR.  Otherwise, if the result is
4583    an incomplete escape sequence, update ISO2022.ESC and
4584    ISO2022.ESC_BYTES and return -1.  Otherwise, update
4585    all the state variables (but not ISO2022.ESC_BYTES) and
4586    return 1.
4587
4588    If CHECK_INVALID_CHARSETS is non-zero, check for designation
4589    or invocation of an invalid character set and treat that as
4590    an unrecognized escape sequence. */
4591
4592 static int
4593 parse_iso2022_esc (Lisp_Object codesys, struct iso2022_decoder *iso,
4594                    unsigned char c, unsigned int *flags,
4595                    int check_invalid_charsets)
4596 {
4597   /* (1) If we're at the end of a designation sequence, CS is the
4598      charset being designated and REG is the register to designate
4599      it to.
4600
4601      (2) If we're at the end of a locking-shift sequence, REG is
4602      the register to invoke and HALF (0 == left, 1 == right) is
4603      the half to invoke it into.
4604
4605      (3) If we're at the end of a single-shift sequence, REG is
4606      the register to invoke. */
4607   Lisp_Object cs = Qnil;
4608   int reg, half;
4609
4610   /* NOTE: This code does goto's all over the fucking place.
4611      The reason for this is that we're basically implementing
4612      a state machine here, and hierarchical languages like C
4613      don't really provide a clean way of doing this. */
4614
4615   if (! (*flags & CODING_STATE_ESCAPE))
4616     /* At beginning of escape sequence; we need to reset our
4617        escape-state variables. */
4618     iso->esc = ISO_ESC_NOTHING;
4619
4620   iso->output_literally = 0;
4621   iso->output_direction_sequence = 0;
4622
4623   switch (iso->esc)
4624     {
4625     case ISO_ESC_NOTHING:
4626       iso->esc_bytes_index = 0;
4627       switch (c)
4628         {
4629         case ISO_CODE_ESC:      /* Start escape sequence */
4630           *flags |= CODING_STATE_ESCAPE;
4631           iso->esc = ISO_ESC;
4632           goto not_done;
4633
4634         case ISO_CODE_CSI:      /* ISO6429 (specifying directionality) */
4635           *flags |= CODING_STATE_ESCAPE;
4636           iso->esc = ISO_ESC_5_11;
4637           goto not_done;
4638
4639         case ISO_CODE_SO:       /* locking shift 1 */
4640           reg = 1; half = 0;
4641           goto locking_shift;
4642         case ISO_CODE_SI:       /* locking shift 0 */
4643           reg = 0; half = 0;
4644           goto locking_shift;
4645
4646         case ISO_CODE_SS2:      /* single shift */
4647           reg = 2;
4648           goto single_shift;
4649         case ISO_CODE_SS3:      /* single shift */
4650           reg = 3;
4651           goto single_shift;
4652
4653         default:                        /* Other control characters */
4654           return 0;
4655         }
4656
4657     case ISO_ESC:
4658       switch (c)
4659         {
4660           /**** single shift ****/
4661
4662         case 'N':       /* single shift 2 */
4663           reg = 2;
4664           goto single_shift;
4665         case 'O':       /* single shift 3 */
4666           reg = 3;
4667           goto single_shift;
4668
4669           /**** locking shift ****/
4670
4671         case '~':       /* locking shift 1 right */
4672           reg = 1; half = 1;
4673           goto locking_shift;
4674         case 'n':       /* locking shift 2 */
4675           reg = 2; half = 0;
4676           goto locking_shift;
4677         case '}':       /* locking shift 2 right */
4678           reg = 2; half = 1;
4679           goto locking_shift;
4680         case 'o':       /* locking shift 3 */
4681           reg = 3; half = 0;
4682           goto locking_shift;
4683         case '|':       /* locking shift 3 right */
4684           reg = 3; half = 1;
4685           goto locking_shift;
4686
4687 #ifdef ENABLE_COMPOSITE_CHARS
4688           /**** composite ****/
4689
4690         case '0':
4691           iso->esc = ISO_ESC_START_COMPOSITE;
4692           *flags = (*flags & CODING_STATE_ISO2022_LOCK) |
4693             CODING_STATE_COMPOSITE;
4694           return 1;
4695
4696         case '1':
4697           iso->esc = ISO_ESC_END_COMPOSITE;
4698           *flags = (*flags & CODING_STATE_ISO2022_LOCK) &
4699             ~CODING_STATE_COMPOSITE;
4700           return 1;
4701 #endif /* ENABLE_COMPOSITE_CHARS */
4702
4703           /**** directionality ****/
4704
4705         case '[':
4706           iso->esc = ISO_ESC_5_11;
4707           goto not_done;
4708
4709           /**** designation ****/
4710
4711         case '$':       /* multibyte charset prefix */
4712           iso->esc = ISO_ESC_2_4;
4713           goto not_done;
4714
4715         default:
4716           if (0x28 <= c && c <= 0x2F)
4717             {
4718               iso->esc = (enum iso_esc_flag) (c - 0x28 + ISO_ESC_2_8);
4719               goto not_done;
4720             }
4721
4722           /* This function is called with CODESYS equal to nil when
4723              doing coding-system detection. */
4724           if (!NILP (codesys)
4725               && XCODING_SYSTEM_ISO2022_ESCAPE_QUOTED (codesys)
4726               && fit_to_be_escape_quoted (c))
4727             {
4728               iso->esc = ISO_ESC_LITERAL;
4729               *flags &= CODING_STATE_ISO2022_LOCK;
4730               return 1;
4731             }
4732
4733           /* bzzzt! */
4734           return 0;
4735         }
4736
4737
4738
4739       /**** directionality ****/
4740
4741     case ISO_ESC_5_11:          /* ISO6429 direction control */
4742       if (c == ']')
4743         {
4744           *flags &= (CODING_STATE_ISO2022_LOCK & ~CODING_STATE_R2L);
4745           goto directionality;
4746         }
4747       if      (c == '0') iso->esc = ISO_ESC_5_11_0;
4748       else if (c == '1') iso->esc = ISO_ESC_5_11_1;
4749       else if (c == '2') iso->esc = ISO_ESC_5_11_2;
4750       else               return 0;
4751       goto not_done;
4752
4753     case ISO_ESC_5_11_0:
4754       if (c == ']')
4755         {
4756           *flags &= (CODING_STATE_ISO2022_LOCK & ~CODING_STATE_R2L);
4757           goto directionality;
4758         }
4759       return 0;
4760
4761     case ISO_ESC_5_11_1:
4762       if (c == ']')
4763         {
4764           *flags = (CODING_STATE_ISO2022_LOCK & ~CODING_STATE_R2L);
4765           goto directionality;
4766         }
4767       return 0;
4768
4769     case ISO_ESC_5_11_2:
4770       if (c == ']')
4771         {
4772           *flags = (*flags & CODING_STATE_ISO2022_LOCK) | CODING_STATE_R2L;
4773           goto directionality;
4774         }
4775       return 0;
4776
4777     directionality:
4778       iso->esc = ISO_ESC_DIRECTIONALITY;
4779       /* Various junk here to attempt to preserve the direction sequences
4780          literally in the text if they would otherwise be swallowed due
4781          to invalid designations that don't show up as actual charset
4782          changes in the text. */
4783       if (iso->invalid_switch_dir)
4784         {
4785           /* We already inserted a direction switch literally into the
4786              text.  We assume (#### this may not be right) that the
4787              next direction switch is the one going the other way,
4788              and we need to output that literally as well. */
4789           iso->output_literally = 1;
4790           iso->invalid_switch_dir = 0;
4791         }
4792       else
4793         {
4794           int jj;
4795
4796           /* If we are in the thrall of an invalid designation,
4797            then stick the directionality sequence literally into the
4798            output stream so it ends up in the original text again. */
4799           for (jj = 0; jj < 4; jj++)
4800             if (iso->invalid_designated[jj])
4801               break;
4802           if (jj < 4)
4803             {
4804               iso->output_literally = 1;
4805               iso->invalid_switch_dir = 1;
4806             }
4807           else
4808             /* Indicate that we haven't yet seen a valid designation,
4809                so that if a switch-dir is directly followed by an
4810                invalid designation, both get inserted literally. */
4811             iso->switched_dir_and_no_valid_charset_yet = 1;
4812         }
4813       return 1;
4814
4815
4816       /**** designation ****/
4817
4818     case ISO_ESC_2_4:
4819       if (0x28 <= c && c <= 0x2F)
4820         {
4821           iso->esc = (enum iso_esc_flag) (c - 0x28 + ISO_ESC_2_4_8);
4822           goto not_done;
4823         }
4824       if (0x40 <= c && c <= 0x42)
4825         {
4826           /* 94^n-set */
4827           cs = CHARSET_BY_ATTRIBUTES (94, -1, c,
4828                                       *flags & CODING_STATE_R2L ?
4829                                       CHARSET_RIGHT_TO_LEFT :
4830                                       CHARSET_LEFT_TO_RIGHT);
4831           reg = 0;
4832           goto designated;
4833         }
4834       return 0;
4835
4836     default:
4837       {
4838         int chars = 0;
4839         int single = 0;
4840
4841         if (c < '0' || c > '~')
4842           return 0; /* bad final byte */
4843
4844         if (iso->esc >= ISO_ESC_2_8 &&
4845             iso->esc <= ISO_ESC_2_15)
4846           {
4847             chars = (iso->esc >= ISO_ESC_2_12) ? 96 : 94;
4848             single = 1; /* single-byte */
4849             reg = (iso->esc - ISO_ESC_2_8) & 3;
4850           }
4851         else if (iso->esc >= ISO_ESC_2_4_8 &&
4852                  iso->esc <= ISO_ESC_2_4_15)
4853           {
4854             chars = (iso->esc >= ISO_ESC_2_4_12) ? 96 : 94;
4855             single = -1; /* multi-byte */
4856             reg = (iso->esc - ISO_ESC_2_4_8) & 3;
4857           }
4858         else
4859           {
4860             /* Can this ever be reached? -slb */
4861             abort();
4862           }
4863
4864         cs = CHARSET_BY_ATTRIBUTES (chars, single, c,
4865                                     *flags & CODING_STATE_R2L ?
4866                                     CHARSET_RIGHT_TO_LEFT :
4867                                     CHARSET_LEFT_TO_RIGHT);
4868         goto designated;
4869       }
4870     }
4871
4872  not_done:
4873   iso->esc_bytes[iso->esc_bytes_index++] = (unsigned char) c;
4874   return -1;
4875
4876  single_shift:
4877   if (check_invalid_charsets && !CHARSETP (iso->charset[reg]))
4878     /* can't invoke something that ain't there. */
4879     return 0;
4880   iso->esc = ISO_ESC_SINGLE_SHIFT;
4881   *flags &= CODING_STATE_ISO2022_LOCK;
4882   if (reg == 2)
4883     *flags |= CODING_STATE_SS2;
4884   else
4885     *flags |= CODING_STATE_SS3;
4886   return 1;
4887
4888  locking_shift:
4889   if (check_invalid_charsets &&
4890       !CHARSETP (iso->charset[reg]))
4891     /* can't invoke something that ain't there. */
4892     return 0;
4893   if (half)
4894     iso->register_right = reg;
4895   else
4896     iso->register_left = reg;
4897   *flags &= CODING_STATE_ISO2022_LOCK;
4898   iso->esc = ISO_ESC_LOCKING_SHIFT;
4899   return 1;
4900
4901  designated:
4902   if (NILP (cs) && check_invalid_charsets)
4903     {
4904       iso->invalid_designated[reg] = 1;
4905       iso->charset[reg] = Vcharset_ascii;
4906       iso->esc = ISO_ESC_DESIGNATE;
4907       *flags &= CODING_STATE_ISO2022_LOCK;
4908       iso->output_literally = 1;
4909       if (iso->switched_dir_and_no_valid_charset_yet)
4910         {
4911           /* We encountered a switch-direction followed by an
4912              invalid designation.  Ensure that the switch-direction
4913              gets outputted; otherwise it will probably get eaten
4914              when the text is written out again. */
4915           iso->switched_dir_and_no_valid_charset_yet = 0;
4916           iso->output_direction_sequence = 1;
4917           /* And make sure that the switch-dir going the other
4918              way gets outputted, as well. */
4919           iso->invalid_switch_dir = 1;
4920         }
4921       return 1;
4922     }
4923   /* This function is called with CODESYS equal to nil when
4924      doing coding-system detection. */
4925   if (!NILP (codesys))
4926     {
4927       charset_conversion_spec_dynarr *dyn =
4928         XCODING_SYSTEM (codesys)->iso2022.input_conv;
4929
4930       if (dyn)
4931         {
4932           int i;
4933
4934           for (i = 0; i < Dynarr_length (dyn); i++)
4935             {
4936               struct charset_conversion_spec *spec = Dynarr_atp (dyn, i);
4937               if (EQ (cs, spec->from_charset))
4938                 cs = spec->to_charset;
4939             }
4940         }
4941     }
4942
4943   iso->charset[reg] = cs;
4944   iso->esc = ISO_ESC_DESIGNATE;
4945   *flags &= CODING_STATE_ISO2022_LOCK;
4946   if (iso->invalid_designated[reg])
4947     {
4948       iso->invalid_designated[reg] = 0;
4949       iso->output_literally = 1;
4950     }
4951   if (iso->switched_dir_and_no_valid_charset_yet)
4952     iso->switched_dir_and_no_valid_charset_yet = 0;
4953   return 1;
4954 }
4955
4956 static int
4957 detect_coding_iso2022 (struct detection_state *st, const Extbyte *src, size_t n)
4958 {
4959   int mask;
4960
4961   /* #### There are serious deficiencies in the recognition mechanism
4962      here.  This needs to be much smarter if it's going to cut it.
4963      The sequence "\xff\x0f" is currently detected as LOCK_SHIFT while
4964      it should be detected as Latin-1.
4965      All the ISO2022 stuff in this file should be synced up with the
4966      code from FSF Emacs-20.4, in which Mule should be more or less stable.
4967      Perhaps we should wait till R2L works in FSF Emacs? */
4968
4969   if (!st->iso2022.initted)
4970     {
4971       reset_iso2022 (Qnil, &st->iso2022.iso);
4972       st->iso2022.mask = (CODING_CATEGORY_ISO_7_MASK |
4973                           CODING_CATEGORY_ISO_8_DESIGNATE_MASK |
4974                           CODING_CATEGORY_ISO_8_1_MASK |
4975                           CODING_CATEGORY_ISO_8_2_MASK |
4976                           CODING_CATEGORY_ISO_LOCK_SHIFT_MASK);
4977       st->iso2022.flags = 0;
4978       st->iso2022.high_byte_count = 0;
4979       st->iso2022.saw_single_shift = 0;
4980       st->iso2022.initted = 1;
4981     }
4982
4983   mask = st->iso2022.mask;
4984
4985   while (n--)
4986     {
4987       unsigned char c = *(unsigned char *)src++;
4988       if (c >= 0xA0)
4989         {
4990           mask &= ~CODING_CATEGORY_ISO_7_MASK;
4991           st->iso2022.high_byte_count++;
4992         }
4993       else
4994         {
4995           if (st->iso2022.high_byte_count && !st->iso2022.saw_single_shift)
4996             {
4997               if (st->iso2022.high_byte_count & 1)
4998                 /* odd number of high bytes; assume not iso-8-2 */
4999                 mask &= ~CODING_CATEGORY_ISO_8_2_MASK;
5000             }
5001           st->iso2022.high_byte_count = 0;
5002           st->iso2022.saw_single_shift = 0;
5003           if (c > 0x80)
5004             mask &= ~CODING_CATEGORY_ISO_7_MASK;
5005         }
5006       if (!(st->iso2022.flags & CODING_STATE_ESCAPE)
5007           && (BYTE_C0_P (c) || BYTE_C1_P (c)))
5008         { /* control chars */
5009           switch (c)
5010             {
5011               /* Allow and ignore control characters that you might
5012                  reasonably see in a text file */
5013             case '\r':
5014             case '\n':
5015             case '\t':
5016             case  7: /* bell */
5017             case  8: /* backspace */
5018             case 11: /* vertical tab */
5019             case 12: /* form feed */
5020             case 26: /* MS-DOS C-z junk */
5021             case 31: /* '^_' -- for info */
5022               goto label_continue_loop;
5023
5024             default:
5025               break;
5026             }
5027         }
5028
5029       if ((st->iso2022.flags & CODING_STATE_ESCAPE) || BYTE_C0_P (c)
5030           || BYTE_C1_P (c))
5031         {
5032           if (parse_iso2022_esc (Qnil, &st->iso2022.iso, c,
5033                                  &st->iso2022.flags, 0))
5034             {
5035               switch (st->iso2022.iso.esc)
5036                 {
5037                 case ISO_ESC_DESIGNATE:
5038                   mask &= ~CODING_CATEGORY_ISO_8_1_MASK;
5039                   mask &= ~CODING_CATEGORY_ISO_8_2_MASK;
5040                   break;
5041                 case ISO_ESC_LOCKING_SHIFT:
5042                   mask = CODING_CATEGORY_ISO_LOCK_SHIFT_MASK;
5043                   goto ran_out_of_chars;
5044                 case ISO_ESC_SINGLE_SHIFT:
5045                   mask &= ~CODING_CATEGORY_ISO_8_DESIGNATE_MASK;
5046                   st->iso2022.saw_single_shift = 1;
5047                   break;
5048                 default:
5049                   break;
5050                 }
5051             }
5052           else
5053             {
5054               mask = 0;
5055               goto ran_out_of_chars;
5056             }
5057         }
5058     label_continue_loop:;
5059     }
5060
5061  ran_out_of_chars:
5062
5063   return mask;
5064 }
5065
5066 static int
5067 postprocess_iso2022_mask (int mask)
5068 {
5069   /* #### kind of cheesy */
5070   /* If seven-bit ISO is allowed, then assume that the encoding is
5071      entirely seven-bit and turn off the eight-bit ones. */
5072   if (mask & CODING_CATEGORY_ISO_7_MASK)
5073     mask &= ~ (CODING_CATEGORY_ISO_8_DESIGNATE_MASK |
5074                CODING_CATEGORY_ISO_8_1_MASK |
5075                CODING_CATEGORY_ISO_8_2_MASK);
5076   return mask;
5077 }
5078
5079 /* If FLAGS is a null pointer or specifies right-to-left motion,
5080    output a switch-dir-to-left-to-right sequence to DST.
5081    Also update FLAGS if it is not a null pointer.
5082    If INTERNAL_P is set, we are outputting in internal format and
5083    need to handle the CSI differently. */
5084
5085 static void
5086 restore_left_to_right_direction (Lisp_Coding_System *codesys,
5087                                  unsigned_char_dynarr *dst,
5088                                  unsigned int *flags,
5089                                  int internal_p)
5090 {
5091   if (!flags || (*flags & CODING_STATE_R2L))
5092     {
5093       if (CODING_SYSTEM_ISO2022_SEVEN (codesys))
5094         {
5095           Dynarr_add (dst, ISO_CODE_ESC);
5096           Dynarr_add (dst, '[');
5097         }
5098       else if (internal_p)
5099         DECODE_ADD_BINARY_CHAR (ISO_CODE_CSI, dst);
5100       else
5101         Dynarr_add (dst, ISO_CODE_CSI);
5102       Dynarr_add (dst, '0');
5103       Dynarr_add (dst, ']');
5104       if (flags)
5105         *flags &= ~CODING_STATE_R2L;
5106     }
5107 }
5108
5109 /* If FLAGS is a null pointer or specifies a direction different from
5110    DIRECTION (which should be either CHARSET_RIGHT_TO_LEFT or
5111    CHARSET_LEFT_TO_RIGHT), output the appropriate switch-dir escape
5112    sequence to DST.  Also update FLAGS if it is not a null pointer.
5113    If INTERNAL_P is set, we are outputting in internal format and
5114    need to handle the CSI differently. */
5115
5116 static void
5117 ensure_correct_direction (int direction, Lisp_Coding_System *codesys,
5118                           unsigned_char_dynarr *dst, unsigned int *flags,
5119                           int internal_p)
5120 {
5121   if ((!flags || (*flags & CODING_STATE_R2L)) &&
5122       direction == CHARSET_LEFT_TO_RIGHT)
5123     restore_left_to_right_direction (codesys, dst, flags, internal_p);
5124   else if (!CODING_SYSTEM_ISO2022_NO_ISO6429 (codesys)
5125            && (!flags || !(*flags & CODING_STATE_R2L)) &&
5126            direction == CHARSET_RIGHT_TO_LEFT)
5127     {
5128       if (CODING_SYSTEM_ISO2022_SEVEN (codesys))
5129         {
5130           Dynarr_add (dst, ISO_CODE_ESC);
5131           Dynarr_add (dst, '[');
5132         }
5133       else if (internal_p)
5134         DECODE_ADD_BINARY_CHAR (ISO_CODE_CSI, dst);
5135       else
5136         Dynarr_add (dst, ISO_CODE_CSI);
5137       Dynarr_add (dst, '2');
5138       Dynarr_add (dst, ']');
5139       if (flags)
5140         *flags |= CODING_STATE_R2L;
5141     }
5142 }
5143
5144 /* Convert ISO2022-format data to internal format. */
5145
5146 static void
5147 decode_coding_iso2022 (Lstream *decoding, const Extbyte *src,
5148                        unsigned_char_dynarr *dst, size_t n)
5149 {
5150   struct decoding_stream *str = DECODING_STREAM_DATA (decoding);
5151   unsigned int flags    = str->flags;
5152   unsigned int cpos     = str->cpos;
5153   unsigned char counter = str->counter;
5154   eol_type_t eol_type   = str->eol_type;
5155 #ifdef ENABLE_COMPOSITE_CHARS
5156   unsigned_char_dynarr *real_dst = dst;
5157 #endif
5158   Lisp_Object coding_system;
5159
5160   XSETCODING_SYSTEM (coding_system, str->codesys);
5161
5162 #ifdef ENABLE_COMPOSITE_CHARS
5163   if (flags & CODING_STATE_COMPOSITE)
5164     dst = str->iso2022.composite_chars;
5165 #endif /* ENABLE_COMPOSITE_CHARS */
5166
5167   while (n--)
5168     {
5169       unsigned char c = *(unsigned char *)src++;
5170       if (flags & CODING_STATE_ESCAPE)
5171         {       /* Within ESC sequence */
5172           int retval = parse_iso2022_esc (coding_system, &str->iso2022,
5173                                           c, &flags, 1);
5174
5175           if (retval)
5176             {
5177               switch (str->iso2022.esc)
5178                 {
5179 #ifdef ENABLE_COMPOSITE_CHARS
5180                 case ISO_ESC_START_COMPOSITE:
5181                   if (str->iso2022.composite_chars)
5182                     Dynarr_reset (str->iso2022.composite_chars);
5183                   else
5184                     str->iso2022.composite_chars = Dynarr_new (unsigned_char);
5185                   dst = str->iso2022.composite_chars;
5186                   break;
5187                 case ISO_ESC_END_COMPOSITE:
5188                   {
5189                     Bufbyte comstr[MAX_EMCHAR_LEN];
5190                     Bytecount len;
5191                     Emchar emch = lookup_composite_char (Dynarr_atp (dst, 0),
5192                                                          Dynarr_length (dst));
5193                     dst = real_dst;
5194                     len = set_charptr_emchar (comstr, emch);
5195                     Dynarr_add_many (dst, comstr, len);
5196                     break;
5197                   }
5198 #endif /* ENABLE_COMPOSITE_CHARS */
5199
5200                 case ISO_ESC_LITERAL:
5201                   COMPOSE_FLUSH_CHARS (str, dst);
5202                   DECODE_ADD_BINARY_CHAR (c, dst);
5203                   break;
5204
5205                 default:
5206                   /* Everything else handled already */
5207                   break;
5208                 }
5209             }
5210
5211           /* Attempted error recovery. */
5212           if (str->iso2022.output_direction_sequence)
5213             ensure_correct_direction (flags & CODING_STATE_R2L ?
5214                                       CHARSET_RIGHT_TO_LEFT :
5215                                       CHARSET_LEFT_TO_RIGHT,
5216                                       str->codesys, dst, 0, 1);
5217           /* More error recovery. */
5218           if (!retval || str->iso2022.output_literally)
5219             {
5220               /* Output the (possibly invalid) sequence */
5221               int i;
5222               COMPOSE_FLUSH_CHARS (str, dst);
5223               for (i = 0; i < str->iso2022.esc_bytes_index; i++)
5224                 DECODE_ADD_BINARY_CHAR (str->iso2022.esc_bytes[i], dst);
5225               flags &= CODING_STATE_ISO2022_LOCK;
5226               if (!retval)
5227                 n++, src--;/* Repeat the loop with the same character. */
5228               else
5229                 {
5230                   /* No sense in reprocessing the final byte of the
5231                      escape sequence; it could mess things up anyway.
5232                      Just add it now. */
5233                   COMPOSE_FLUSH_CHARS (str, dst);
5234                   DECODE_ADD_BINARY_CHAR (c, dst);
5235                 }
5236             }
5237           cpos = 0;
5238           counter = 0;
5239         }
5240       else if (BYTE_C0_P (c) || BYTE_C1_P (c))
5241         { /* Control characters */
5242
5243           /***** Error-handling *****/
5244
5245           /* If we were in the middle of a character, dump out the
5246              partial character. */
5247           if (counter)
5248             {
5249               COMPOSE_FLUSH_CHARS (str, dst);
5250               while (counter > 0)
5251                 {
5252                   counter--;
5253                   DECODE_ADD_BINARY_CHAR
5254                     ((unsigned char)(cpos >> (counter * 8)), dst);
5255                 }
5256               cpos = 0;
5257             }
5258
5259           /* If we just saw a single-shift character, dump it out.
5260              This may dump out the wrong sort of single-shift character,
5261              but least it will give an indication that something went
5262              wrong. */
5263           if (flags & CODING_STATE_SS2)
5264             {
5265               COMPOSE_FLUSH_CHARS (str, dst);
5266               DECODE_ADD_BINARY_CHAR (ISO_CODE_SS2, dst);
5267               flags &= ~CODING_STATE_SS2;
5268             }
5269           if (flags & CODING_STATE_SS3)
5270             {
5271               COMPOSE_FLUSH_CHARS (str, dst);
5272               DECODE_ADD_BINARY_CHAR (ISO_CODE_SS3, dst);
5273               flags &= ~CODING_STATE_SS3;
5274             }
5275
5276           /***** Now handle the control characters. *****/
5277
5278           /* Handle CR/LF */
5279 #ifdef UTF2000
5280           if (c == '\r')
5281             {
5282               COMPOSE_FLUSH_CHARS (str, dst);
5283               if (eol_type == EOL_CR)
5284                 Dynarr_add (dst, '\n');
5285               else if (eol_type != EOL_CRLF || flags & CODING_STATE_CR)
5286                 Dynarr_add (dst, c);
5287               else
5288                 flags |= CODING_STATE_CR;
5289               goto label_continue_loop;
5290             }
5291           else if (flags & CODING_STATE_CR)
5292             {   /* eol_type == CODING_SYSTEM_EOL_CRLF */
5293               if (c != '\n')
5294                 Dynarr_add (dst, '\r');
5295               flags &= ~CODING_STATE_CR;
5296             }
5297 #else
5298           DECODE_HANDLE_EOL_TYPE (eol_type, c, flags, dst);
5299 #endif
5300
5301           flags &= CODING_STATE_ISO2022_LOCK;
5302
5303           if (!parse_iso2022_esc (coding_system, &str->iso2022, c, &flags, 1))
5304             {
5305               COMPOSE_FLUSH_CHARS (str, dst);
5306               DECODE_ADD_BINARY_CHAR (c, dst);
5307             }
5308         }
5309       else
5310         {                       /* Graphic characters */
5311           Lisp_Object charset;
5312 #ifndef UTF2000
5313           Charset_ID lb;
5314 #endif
5315           int reg;
5316
5317 #ifdef UTF2000
5318           if (c == '\r')
5319             {
5320               COMPOSE_FLUSH_CHARS (str, dst);
5321               if (eol_type == EOL_CR)
5322                 Dynarr_add (dst, '\n');
5323               else if (eol_type != EOL_CRLF || flags & CODING_STATE_CR)
5324                 Dynarr_add (dst, c);
5325               else
5326                 flags |= CODING_STATE_CR;
5327               goto label_continue_loop;
5328             }
5329           else if (flags & CODING_STATE_CR)
5330             {   /* eol_type == CODING_SYSTEM_EOL_CRLF */
5331               if (c != '\n')
5332                 Dynarr_add (dst, '\r');
5333               flags &= ~CODING_STATE_CR;
5334             }
5335 #else
5336           DECODE_HANDLE_EOL_TYPE (eol_type, c, flags, dst);
5337 #endif
5338
5339           /* Now determine the charset. */
5340           reg = ((flags & CODING_STATE_SS2) ? 2
5341                  : (flags & CODING_STATE_SS3) ? 3
5342                  : !BYTE_ASCII_P (c) ? str->iso2022.register_right
5343                  : str->iso2022.register_left);
5344           charset = str->iso2022.charset[reg];
5345
5346           /* Error checking: */
5347           if (! CHARSETP (charset)
5348               || str->iso2022.invalid_designated[reg]
5349               || (((c & 0x7F) == ' ' || (c & 0x7F) == ISO_CODE_DEL)
5350                   && XCHARSET_CHARS (charset) == 94))
5351             /* Mrmph.  We are trying to invoke a register that has no
5352                or an invalid charset in it, or trying to add a character
5353                outside the range of the charset.  Insert that char literally
5354                to preserve it for the output. */
5355             {
5356               COMPOSE_FLUSH_CHARS (str, dst);
5357               while (counter > 0)
5358                 {
5359                   counter--;
5360                   DECODE_ADD_BINARY_CHAR
5361                     ((unsigned char)(cpos >> (counter * 8)), dst);
5362                 }
5363               cpos = 0;
5364               DECODE_ADD_BINARY_CHAR (c, dst);
5365             }
5366
5367           else
5368             {
5369               /* Things are probably hunky-dorey. */
5370
5371               /* Fetch reverse charset, maybe. */
5372               if (((flags & CODING_STATE_R2L) &&
5373                    XCHARSET_DIRECTION (charset) == CHARSET_LEFT_TO_RIGHT)
5374                   ||
5375                   (!(flags & CODING_STATE_R2L) &&
5376                    XCHARSET_DIRECTION (charset) == CHARSET_RIGHT_TO_LEFT))
5377                 {
5378                   Lisp_Object new_charset =
5379                     XCHARSET_REVERSE_DIRECTION_CHARSET (charset);
5380                   if (!NILP (new_charset))
5381                     charset = new_charset;
5382                 }
5383
5384 #ifdef UTF2000
5385               counter++;
5386               if (XCHARSET_DIMENSION (charset) == counter)
5387                 {
5388                   COMPOSE_ADD_CHAR (str,
5389                                     DECODE_CHAR (charset,
5390                                                  ((cpos & 0x7F7F7F) << 8)
5391                                                  | (c & 0x7F)),
5392                                     dst);
5393                   cpos = 0;
5394                   counter = 0;
5395                 }
5396               else
5397                 cpos = (cpos << 8) | c;
5398 #else
5399               lb = XCHARSET_LEADING_BYTE (charset);
5400               switch (XCHARSET_REP_BYTES (charset))
5401                 {
5402                 case 1: /* ASCII */
5403                   DECODE_OUTPUT_PARTIAL_CHAR (ch);
5404                   Dynarr_add (dst, c & 0x7F);
5405                   break;
5406
5407                 case 2: /* one-byte official */
5408                   DECODE_OUTPUT_PARTIAL_CHAR (ch);
5409                   Dynarr_add (dst, lb);
5410                   Dynarr_add (dst, c | 0x80);
5411                   break;
5412
5413                 case 3: /* one-byte private or two-byte official */
5414                   if (XCHARSET_PRIVATE_P (charset))
5415                     {
5416                       DECODE_OUTPUT_PARTIAL_CHAR (ch);
5417                       Dynarr_add (dst, PRE_LEADING_BYTE_PRIVATE_1);
5418                       Dynarr_add (dst, lb);
5419                       Dynarr_add (dst, c | 0x80);
5420                     }
5421                   else
5422                     {
5423                       if (ch)
5424                         {
5425                           Dynarr_add (dst, lb);
5426                           Dynarr_add (dst, ch | 0x80);
5427                           Dynarr_add (dst, c | 0x80);
5428                           ch = 0;
5429                         }
5430                       else
5431                         ch = c;
5432                     }
5433                   break;
5434
5435                 default:        /* two-byte private */
5436                   if (ch)
5437                     {
5438                       Dynarr_add (dst, PRE_LEADING_BYTE_PRIVATE_2);
5439                       Dynarr_add (dst, lb);
5440                       Dynarr_add (dst, ch | 0x80);
5441                       Dynarr_add (dst, c | 0x80);
5442                       ch = 0;
5443                     }
5444                   else
5445                     ch = c;
5446                 }
5447 #endif
5448             }
5449
5450           if (!cpos)
5451             flags &= CODING_STATE_ISO2022_LOCK;
5452         }
5453
5454     label_continue_loop:;
5455     }
5456
5457   if (flags & CODING_STATE_END)
5458     {
5459       COMPOSE_FLUSH_CHARS (str, dst);
5460       DECODE_OUTPUT_PARTIAL_CHAR (cpos);
5461     }
5462   str->flags   = flags;
5463   str->cpos    = cpos;
5464   str->counter = counter;
5465 }
5466
5467
5468 /***** ISO2022 encoder *****/
5469
5470 /* Designate CHARSET into register REG. */
5471
5472 static void
5473 iso2022_designate (Lisp_Object charset, unsigned char reg,
5474                    struct encoding_stream *str, unsigned_char_dynarr *dst)
5475 {
5476   static const char inter94[] = "()*+";
5477   static const char inter96[] = ",-./";
5478   unsigned short chars;
5479   unsigned char dimension;
5480   unsigned char final;
5481   Lisp_Object old_charset = str->iso2022.charset[reg];
5482
5483   str->iso2022.charset[reg] = charset;
5484   if (!CHARSETP (charset))
5485     /* charset might be an initial nil or t. */
5486     return;
5487   chars = XCHARSET_CHARS (charset);
5488   dimension = XCHARSET_DIMENSION (charset);
5489   final = XCHARSET_FINAL (charset);
5490   if (!str->iso2022.force_charset_on_output[reg] &&
5491       CHARSETP (old_charset) &&
5492       XCHARSET_CHARS (old_charset) == chars &&
5493       XCHARSET_DIMENSION (old_charset) == dimension &&
5494       XCHARSET_FINAL (old_charset) == final)
5495     return;
5496
5497   str->iso2022.force_charset_on_output[reg] = 0;
5498
5499   {
5500     charset_conversion_spec_dynarr *dyn =
5501       str->codesys->iso2022.output_conv;
5502
5503     if (dyn)
5504       {
5505         int i;
5506
5507         for (i = 0; i < Dynarr_length (dyn); i++)
5508           {
5509             struct charset_conversion_spec *spec = Dynarr_atp (dyn, i);
5510             if (EQ (charset, spec->from_charset))
5511                 charset = spec->to_charset;
5512           }
5513       }
5514   }
5515
5516   Dynarr_add (dst, ISO_CODE_ESC);
5517   switch (chars)
5518     {
5519     case 94:
5520       if (dimension == 1)
5521         Dynarr_add (dst, inter94[reg]);
5522       else
5523         {
5524           Dynarr_add (dst, '$');
5525           if (reg != 0
5526               || !(CODING_SYSTEM_ISO2022_SHORT (str->codesys))
5527               || final < '@'
5528               || final > 'B')
5529             Dynarr_add (dst, inter94[reg]);
5530         }
5531       break;
5532     case 96:
5533       if (dimension == 1)
5534         Dynarr_add (dst, inter96[reg]);
5535       else
5536         {
5537           Dynarr_add (dst, '$');
5538           Dynarr_add (dst, inter96[reg]);
5539         }
5540       break;
5541     }
5542   Dynarr_add (dst, final);
5543 }
5544
5545 static void
5546 ensure_normal_shift (struct encoding_stream *str, unsigned_char_dynarr *dst)
5547 {
5548   if (str->iso2022.register_left != 0)
5549     {
5550       Dynarr_add (dst, ISO_CODE_SI);
5551       str->iso2022.register_left = 0;
5552     }
5553 }
5554
5555 static void
5556 ensure_shift_out (struct encoding_stream *str, unsigned_char_dynarr *dst)
5557 {
5558   if (str->iso2022.register_left != 1)
5559     {
5560       Dynarr_add (dst, ISO_CODE_SO);
5561       str->iso2022.register_left = 1;
5562     }
5563 }
5564
5565 void
5566 char_encode_iso2022 (struct encoding_stream *str, Emchar ch,
5567                      unsigned_char_dynarr *dst, unsigned int *flags)
5568 {
5569   unsigned char charmask;
5570   Lisp_Coding_System* codesys = str->codesys;
5571   eol_type_t eol_type         = CODING_SYSTEM_EOL_TYPE (str->codesys);
5572   int i;
5573   Lisp_Object charset = str->iso2022.current_charset;
5574   int half = str->iso2022.current_half;
5575   int code_point = -1;
5576
5577   if (ch <= 0x7F)
5578     {
5579       restore_left_to_right_direction (codesys, dst, flags, 0);
5580
5581       /* Make sure G0 contains ASCII */
5582       if ((ch > ' ' && ch < ISO_CODE_DEL)
5583           || !CODING_SYSTEM_ISO2022_NO_ASCII_CNTL (codesys))
5584         {
5585           ensure_normal_shift (str, dst);
5586           iso2022_designate (Vcharset_ascii, 0, str, dst);
5587         }
5588
5589       /* If necessary, restore everything to the default state
5590          at end-of-line */
5591       if (ch == '\n' && !(CODING_SYSTEM_ISO2022_NO_ASCII_EOL (codesys)))
5592         {
5593           restore_left_to_right_direction (codesys, dst, flags, 0);
5594
5595           ensure_normal_shift (str, dst);
5596
5597           for (i = 0; i < 4; i++)
5598             {
5599               Lisp_Object initial_charset =
5600                 CODING_SYSTEM_ISO2022_INITIAL_CHARSET (codesys, i);
5601               iso2022_designate (initial_charset, i, str, dst);
5602             }
5603         }
5604       if (ch == '\n')
5605         {
5606           if (eol_type != EOL_LF && eol_type != EOL_AUTODETECT)
5607             Dynarr_add (dst, '\r');
5608           if (eol_type != EOL_CR)
5609             Dynarr_add (dst, ch);
5610         }
5611       else
5612         {
5613           if (CODING_SYSTEM_ISO2022_ESCAPE_QUOTED (codesys)
5614               && fit_to_be_escape_quoted (ch))
5615             Dynarr_add (dst, ISO_CODE_ESC);
5616           Dynarr_add (dst, ch);
5617         }
5618     }
5619   else if ( (0x80 <= ch) && (ch <= 0x9f) )
5620     {
5621       charmask = (half == 0 ? 0x00 : 0x80);
5622
5623       if (CODING_SYSTEM_ISO2022_ESCAPE_QUOTED (codesys)
5624           && fit_to_be_escape_quoted (ch))
5625         Dynarr_add (dst, ISO_CODE_ESC);
5626       /* you asked for it ... */
5627       Dynarr_add (dst, ch);
5628     }
5629   else
5630     {
5631       int reg;
5632
5633       /* Now determine which register to use. */
5634       reg = -1;
5635       for (i = 0; i < 4; i++)
5636         {
5637           if ((CHARSETP (charset = str->iso2022.charset[i])
5638                && ((code_point = charset_code_point (charset, ch)) >= 0))
5639               ||
5640               (CHARSETP
5641                (charset
5642                 = CODING_SYSTEM_ISO2022_INITIAL_CHARSET (codesys, i))
5643                && ((code_point = charset_code_point (charset, ch)) >= 0)))
5644             {
5645               reg = i;
5646               break;
5647             }
5648         }
5649       if (reg == -1)
5650         {
5651           Lisp_Object original_default_coded_charset_priority_list
5652             = Vdefault_coded_charset_priority_list;
5653
5654           while (!EQ (Vdefault_coded_charset_priority_list, Qnil))
5655             {
5656               code_point = ENCODE_CHAR (ch, charset);
5657               if (XCHARSET_FINAL (charset))
5658                 goto found;
5659               Vdefault_coded_charset_priority_list
5660                 = Fcdr (Fmemq (XCHARSET_NAME (charset),
5661                                Vdefault_coded_charset_priority_list));
5662             }
5663           code_point = ENCODE_CHAR (ch, charset);
5664           if (!XCHARSET_FINAL (charset))
5665             {
5666               charset = Vcharset_ascii;
5667               code_point = '~';
5668             }
5669         found:
5670           Vdefault_coded_charset_priority_list
5671             = original_default_coded_charset_priority_list;
5672         }
5673       ensure_correct_direction (XCHARSET_DIRECTION (charset),
5674                                 codesys, dst, flags, 0);
5675
5676       if (reg == -1)
5677         {
5678           if (XCHARSET_GRAPHIC (charset) != 0)
5679             {
5680               if (!NILP (str->iso2022.charset[1]) &&
5681                   (!CODING_SYSTEM_ISO2022_SEVEN (codesys)
5682                    || CODING_SYSTEM_ISO2022_LOCK_SHIFT (codesys)))
5683                 reg = 1;
5684               else if (!NILP (str->iso2022.charset[2]))
5685                 reg = 2;
5686               else if (!NILP (str->iso2022.charset[3]))
5687                 reg = 3;
5688               else
5689                 reg = 0;
5690             }
5691           else
5692             reg = 0;
5693         }
5694
5695       iso2022_designate (charset, reg, str, dst);
5696
5697       /* Now invoke that register. */
5698       switch (reg)
5699         {
5700         case 0:
5701           ensure_normal_shift (str, dst);
5702           half = 0;
5703           break;
5704         case 1:
5705           if (CODING_SYSTEM_ISO2022_SEVEN (codesys))
5706             {
5707               ensure_shift_out (str, dst);
5708               half = 0;
5709             }
5710           else
5711             half = 1;
5712           break;
5713         case 2:
5714           if (CODING_SYSTEM_ISO2022_SEVEN (str->codesys))
5715             {
5716               Dynarr_add (dst, ISO_CODE_ESC);
5717               Dynarr_add (dst, 'N');
5718               half = 0;
5719             }
5720           else
5721             {
5722               Dynarr_add (dst, ISO_CODE_SS2);
5723               half = 1;
5724             }
5725           break;
5726         case 3:
5727           if (CODING_SYSTEM_ISO2022_SEVEN (str->codesys))
5728             {
5729               Dynarr_add (dst, ISO_CODE_ESC);
5730               Dynarr_add (dst, 'O');
5731               half = 0;
5732             }
5733           else
5734             {
5735               Dynarr_add (dst, ISO_CODE_SS3);
5736               half = 1;
5737             }
5738           break;
5739         default:
5740           abort ();
5741         }
5742
5743       charmask = (half == 0 ? 0x00 : 0x80);
5744
5745       switch (XCHARSET_DIMENSION (charset))
5746         {
5747         case 1:
5748           Dynarr_add (dst, (code_point & 0xFF) | charmask);
5749           break;
5750         case 2:
5751           Dynarr_add (dst, ((code_point >> 8) & 0xFF) | charmask);
5752           Dynarr_add (dst, ( code_point       & 0xFF) | charmask);
5753           break;
5754         case 3:
5755           Dynarr_add (dst, ((code_point >> 16) & 0xFF) | charmask);
5756           Dynarr_add (dst, ((code_point >>  8) & 0xFF) | charmask);
5757           Dynarr_add (dst, ( code_point        & 0xFF) | charmask);
5758           break;
5759         case 4:
5760           Dynarr_add (dst, ((code_point >> 24) & 0xFF) | charmask);
5761           Dynarr_add (dst, ((code_point >> 16) & 0xFF) | charmask);
5762           Dynarr_add (dst, ((code_point >>  8) & 0xFF) | charmask);
5763           Dynarr_add (dst, ( code_point        & 0xFF) | charmask);
5764           break;
5765         default:
5766           abort ();
5767         }
5768     }
5769   str->iso2022.current_charset = charset;
5770   str->iso2022.current_half = half;
5771 }
5772
5773 void
5774 char_finish_iso2022 (struct encoding_stream *str, unsigned_char_dynarr *dst,
5775                      unsigned int *flags)
5776 {
5777   Lisp_Coding_System* codesys = str->codesys;
5778   int i;
5779
5780   restore_left_to_right_direction (codesys, dst, flags, 0);
5781   ensure_normal_shift (str, dst);
5782   for (i = 0; i < 4; i++)
5783     {
5784       Lisp_Object initial_charset
5785         = CODING_SYSTEM_ISO2022_INITIAL_CHARSET (codesys, i);
5786       iso2022_designate (initial_charset, i, str, dst);
5787     }
5788 }
5789 #endif /* MULE */
5790 \f
5791 /************************************************************************/
5792 /*                     No-conversion methods                            */
5793 /************************************************************************/
5794
5795 /* This is used when reading in "binary" files -- i.e. files that may
5796    contain all 256 possible byte values and that are not to be
5797    interpreted as being in any particular decoding. */
5798 static void
5799 decode_coding_no_conversion (Lstream *decoding, const Extbyte *src,
5800                              unsigned_char_dynarr *dst, size_t n)
5801 {
5802   struct decoding_stream *str = DECODING_STREAM_DATA (decoding);
5803   unsigned int flags  = str->flags;
5804   unsigned int cpos   = str->cpos;
5805   eol_type_t eol_type = str->eol_type;
5806
5807   while (n--)
5808     {
5809       unsigned char c = *(unsigned char *)src++;
5810
5811       DECODE_HANDLE_EOL_TYPE (eol_type, c, flags, dst);
5812       DECODE_ADD_BINARY_CHAR (c, dst);
5813     label_continue_loop:;
5814     }
5815
5816   DECODE_HANDLE_END_OF_CONVERSION (flags, cpos, dst);
5817
5818   str->flags = flags;
5819   str->cpos  = cpos;
5820 }
5821
5822 static void
5823 encode_coding_no_conversion (Lstream *encoding, const Bufbyte *src,
5824                              unsigned_char_dynarr *dst, size_t n)
5825 {
5826   unsigned char c;
5827   struct encoding_stream *str = ENCODING_STREAM_DATA (encoding);
5828   unsigned int flags  = str->flags;
5829   unsigned int ch     = str->ch;
5830   eol_type_t eol_type = CODING_SYSTEM_EOL_TYPE (str->codesys);
5831 #ifdef UTF2000
5832   unsigned char char_boundary = str->iso2022.current_char_boundary;
5833 #endif
5834
5835   while (n--)
5836     {
5837       c = *src++;
5838 #ifdef UTF2000
5839       if (char_boundary == 0)
5840         if ( c >= 0xfc )
5841           {
5842             ch = c & 0x01;
5843             char_boundary = 5;
5844           }
5845         else if ( c >= 0xf8 )
5846           {
5847             ch = c & 0x03;
5848             char_boundary = 4;
5849           }
5850         else if ( c >= 0xf0 )
5851           {
5852             ch = c & 0x07;
5853             char_boundary = 3;
5854           }
5855         else if ( c >= 0xe0 )
5856           {
5857             ch = c & 0x0f;
5858             char_boundary = 2;
5859           }
5860         else if ( c >= 0xc0 )
5861           {
5862             ch = c & 0x1f;
5863             char_boundary = 1;
5864           }
5865         else
5866           {
5867             ch = 0;
5868             if (c == '\n')
5869               {
5870                 if (eol_type != EOL_LF && eol_type != EOL_AUTODETECT)
5871                   Dynarr_add (dst, '\r');
5872                 if (eol_type != EOL_CR)
5873                   Dynarr_add (dst, c);
5874               }
5875             else
5876               Dynarr_add (dst, c);
5877             char_boundary = 0;
5878           }
5879       else if (char_boundary == 1)
5880         {
5881           ch = ( ch << 6 ) | ( c & 0x3f );
5882           Dynarr_add (dst, ch & 0xff);
5883           char_boundary = 0;
5884         }
5885       else
5886         {
5887           ch = ( ch << 6 ) | ( c & 0x3f );
5888           char_boundary--;
5889         }
5890 #else /* not UTF2000 */
5891       if (c == '\n')
5892         {
5893           if (eol_type != EOL_LF && eol_type != EOL_AUTODETECT)
5894             Dynarr_add (dst, '\r');
5895           if (eol_type != EOL_CR)
5896             Dynarr_add (dst, '\n');
5897           ch = 0;
5898         }
5899       else if (BYTE_ASCII_P (c))
5900         {
5901           assert (ch == 0);
5902           Dynarr_add (dst, c);
5903         }
5904       else if (BUFBYTE_LEADING_BYTE_P (c))
5905         {
5906           assert (ch == 0);
5907           if (c == LEADING_BYTE_LATIN_ISO8859_1 ||
5908               c == LEADING_BYTE_CONTROL_1)
5909             ch = c;
5910           else
5911             Dynarr_add (dst, '~'); /* untranslatable character */
5912         }
5913       else
5914         {
5915           if (ch == LEADING_BYTE_LATIN_ISO8859_1)
5916             Dynarr_add (dst, c);
5917           else if (ch == LEADING_BYTE_CONTROL_1)
5918             {
5919               assert (c < 0xC0);
5920               Dynarr_add (dst, c - 0x20);
5921             }
5922           /* else it should be the second or third byte of an
5923              untranslatable character, so ignore it */
5924           ch = 0;
5925         }
5926 #endif /* not UTF2000 */
5927     }
5928
5929   str->flags = flags;
5930   str->ch    = ch;
5931 #ifdef UTF2000
5932   str->iso2022.current_char_boundary = char_boundary;
5933 #endif
5934 }
5935
5936 \f
5937
5938 /************************************************************************/
5939 /*                             Initialization                           */
5940 /************************************************************************/
5941
5942 void
5943 syms_of_file_coding (void)
5944 {
5945   INIT_LRECORD_IMPLEMENTATION (coding_system);
5946
5947   deferror (&Qcoding_system_error, "coding-system-error",
5948             "Coding-system error", Qio_error);
5949
5950   DEFSUBR (Fcoding_system_p);
5951   DEFSUBR (Ffind_coding_system);
5952   DEFSUBR (Fget_coding_system);
5953   DEFSUBR (Fcoding_system_list);
5954   DEFSUBR (Fcoding_system_name);
5955   DEFSUBR (Fmake_coding_system);
5956   DEFSUBR (Fcopy_coding_system);
5957   DEFSUBR (Fcoding_system_canonical_name_p);
5958   DEFSUBR (Fcoding_system_alias_p);
5959   DEFSUBR (Fcoding_system_aliasee);
5960   DEFSUBR (Fdefine_coding_system_alias);
5961   DEFSUBR (Fsubsidiary_coding_system);
5962
5963   DEFSUBR (Fcoding_system_type);
5964   DEFSUBR (Fcoding_system_doc_string);
5965 #ifdef MULE
5966   DEFSUBR (Fcoding_system_charset);
5967 #endif
5968   DEFSUBR (Fcoding_system_property);
5969
5970   DEFSUBR (Fcoding_category_list);
5971   DEFSUBR (Fset_coding_priority_list);
5972   DEFSUBR (Fcoding_priority_list);
5973   DEFSUBR (Fset_coding_category_system);
5974   DEFSUBR (Fcoding_category_system);
5975
5976   DEFSUBR (Fdetect_coding_region);
5977   DEFSUBR (Fdecode_coding_region);
5978   DEFSUBR (Fencode_coding_region);
5979 #ifdef MULE
5980   DEFSUBR (Fdecode_shift_jis_char);
5981   DEFSUBR (Fencode_shift_jis_char);
5982   DEFSUBR (Fdecode_big5_char);
5983   DEFSUBR (Fencode_big5_char);
5984 #endif /* MULE */
5985   defsymbol (&Qcoding_systemp, "coding-system-p");
5986   defsymbol (&Qno_conversion, "no-conversion");
5987   defsymbol (&Qraw_text, "raw-text");
5988 #ifdef MULE
5989   defsymbol (&Qbig5, "big5");
5990   defsymbol (&Qshift_jis, "shift-jis");
5991   defsymbol (&Qucs4, "ucs-4");
5992   defsymbol (&Qutf8, "utf-8");
5993   defsymbol (&Qccl, "ccl");
5994   defsymbol (&Qiso2022, "iso2022");
5995 #endif /* MULE */
5996   defsymbol (&Qmnemonic, "mnemonic");
5997   defsymbol (&Qeol_type, "eol-type");
5998   defsymbol (&Qpost_read_conversion, "post-read-conversion");
5999   defsymbol (&Qpre_write_conversion, "pre-write-conversion");
6000
6001   defsymbol (&Qcr, "cr");
6002   defsymbol (&Qlf, "lf");
6003   defsymbol (&Qcrlf, "crlf");
6004   defsymbol (&Qeol_cr, "eol-cr");
6005   defsymbol (&Qeol_lf, "eol-lf");
6006   defsymbol (&Qeol_crlf, "eol-crlf");
6007 #ifdef MULE
6008   defsymbol (&Qcharset_g0, "charset-g0");
6009   defsymbol (&Qcharset_g1, "charset-g1");
6010   defsymbol (&Qcharset_g2, "charset-g2");
6011   defsymbol (&Qcharset_g3, "charset-g3");
6012   defsymbol (&Qforce_g0_on_output, "force-g0-on-output");
6013   defsymbol (&Qforce_g1_on_output, "force-g1-on-output");
6014   defsymbol (&Qforce_g2_on_output, "force-g2-on-output");
6015   defsymbol (&Qforce_g3_on_output, "force-g3-on-output");
6016   defsymbol (&Qno_iso6429, "no-iso6429");
6017   defsymbol (&Qinput_charset_conversion, "input-charset-conversion");
6018   defsymbol (&Qoutput_charset_conversion, "output-charset-conversion");
6019
6020   defsymbol (&Qshort, "short");
6021   defsymbol (&Qno_ascii_eol, "no-ascii-eol");
6022   defsymbol (&Qno_ascii_cntl, "no-ascii-cntl");
6023   defsymbol (&Qseven, "seven");
6024   defsymbol (&Qlock_shift, "lock-shift");
6025   defsymbol (&Qescape_quoted, "escape-quoted");
6026 #endif /* MULE */
6027 #ifdef UTF2000
6028   defsymbol (&Qdisable_composition, "disable-composition");
6029   defsymbol (&Quse_entity_reference, "use-entity-reference");
6030   defsymbol (&Qd, "d");
6031   defsymbol (&Qx, "x");
6032   defsymbol (&QX, "X");
6033 #endif
6034   defsymbol (&Qencode, "encode");
6035   defsymbol (&Qdecode, "decode");
6036
6037 #ifdef MULE
6038   defsymbol (&coding_category_symbol[CODING_CATEGORY_SHIFT_JIS],
6039              "shift-jis");
6040   defsymbol (&coding_category_symbol[CODING_CATEGORY_BIG5],
6041              "big5");
6042   defsymbol (&coding_category_symbol[CODING_CATEGORY_UCS4],
6043              "ucs-4");
6044   defsymbol (&coding_category_symbol[CODING_CATEGORY_UTF8],
6045              "utf-8");
6046   defsymbol (&coding_category_symbol[CODING_CATEGORY_ISO_7],
6047              "iso-7");
6048   defsymbol (&coding_category_symbol[CODING_CATEGORY_ISO_8_DESIGNATE],
6049              "iso-8-designate");
6050   defsymbol (&coding_category_symbol[CODING_CATEGORY_ISO_8_1],
6051              "iso-8-1");
6052   defsymbol (&coding_category_symbol[CODING_CATEGORY_ISO_8_2],
6053              "iso-8-2");
6054   defsymbol (&coding_category_symbol[CODING_CATEGORY_ISO_LOCK_SHIFT],
6055              "iso-lock-shift");
6056 #endif /* MULE */
6057   defsymbol (&coding_category_symbol[CODING_CATEGORY_NO_CONVERSION],
6058              "no-conversion");
6059 }
6060
6061 void
6062 lstream_type_create_file_coding (void)
6063 {
6064   LSTREAM_HAS_METHOD (decoding, reader);
6065   LSTREAM_HAS_METHOD (decoding, writer);
6066   LSTREAM_HAS_METHOD (decoding, rewinder);
6067   LSTREAM_HAS_METHOD (decoding, seekable_p);
6068   LSTREAM_HAS_METHOD (decoding, flusher);
6069   LSTREAM_HAS_METHOD (decoding, closer);
6070   LSTREAM_HAS_METHOD (decoding, marker);
6071
6072   LSTREAM_HAS_METHOD (encoding, reader);
6073   LSTREAM_HAS_METHOD (encoding, writer);
6074   LSTREAM_HAS_METHOD (encoding, rewinder);
6075   LSTREAM_HAS_METHOD (encoding, seekable_p);
6076   LSTREAM_HAS_METHOD (encoding, flusher);
6077   LSTREAM_HAS_METHOD (encoding, closer);
6078   LSTREAM_HAS_METHOD (encoding, marker);
6079 }
6080
6081 void
6082 vars_of_file_coding (void)
6083 {
6084   int i;
6085
6086   fcd = xnew (struct file_coding_dump);
6087   dump_add_root_struct_ptr (&fcd, &fcd_description);
6088
6089   /* Initialize to something reasonable ... */
6090   for (i = 0; i < CODING_CATEGORY_LAST; i++)
6091     {
6092       fcd->coding_category_system[i] = Qnil;
6093       fcd->coding_category_by_priority[i] = i;
6094     }
6095
6096   Fprovide (intern ("file-coding"));
6097
6098   DEFVAR_LISP ("keyboard-coding-system", &Vkeyboard_coding_system /*
6099 Coding system used for TTY keyboard input.
6100 Not used under a windowing system.
6101 */ );
6102   Vkeyboard_coding_system = Qnil;
6103
6104   DEFVAR_LISP ("terminal-coding-system", &Vterminal_coding_system /*
6105 Coding system used for TTY display output.
6106 Not used under a windowing system.
6107 */ );
6108   Vterminal_coding_system = Qnil;
6109
6110   DEFVAR_LISP ("coding-system-for-read", &Vcoding_system_for_read /*
6111 Overriding coding system used when reading from a file or process.
6112 You should bind this variable with `let', but do not set it globally.
6113 If this is non-nil, it specifies the coding system that will be used
6114 to decode input on read operations, such as from a file or process.
6115 It overrides `buffer-file-coding-system-for-read',
6116 `insert-file-contents-pre-hook', etc.  Use those variables instead of
6117 this one for permanent changes to the environment.  */ );
6118   Vcoding_system_for_read = Qnil;
6119
6120   DEFVAR_LISP ("coding-system-for-write",
6121                &Vcoding_system_for_write /*
6122 Overriding coding system used when writing to a file or process.
6123 You should bind this variable with `let', but do not set it globally.
6124 If this is non-nil, it specifies the coding system that will be used
6125 to encode output for write operations, such as to a file or process.
6126 It overrides `buffer-file-coding-system', `write-region-pre-hook', etc.
6127 Use those variables instead of this one for permanent changes to the
6128 environment.  */ );
6129   Vcoding_system_for_write = Qnil;
6130
6131   DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system /*
6132 Coding system used to convert pathnames when accessing files.
6133 */ );
6134   Vfile_name_coding_system = Qnil;
6135
6136   DEFVAR_LISP ("coded-charset-entity-reference-alist",
6137                &Vcoded_charset_entity_reference_alist /*
6138 Alist of coded-charset vs corresponding entity-reference.
6139 Each element looks like (CCS PREFIX CODE-COLUMNS CODE-TYPE).
6140 CCS is coded-charset.
6141 CODE-COLUMNS is columns of code-point of entity-reference.
6142 CODE-TYPE is format type of code-point of entity-reference.
6143 `d' means decimal value and `x' means hexadecimal value.
6144 */ );
6145   Vcoded_charset_entity_reference_alist = Qnil;
6146
6147   DEFVAR_BOOL ("enable-multibyte-characters", &enable_multibyte_characters /*
6148 Non-nil means the buffer contents are regarded as multi-byte form
6149 of characters, not a binary code.  This affects the display, file I/O,
6150 and behaviors of various editing commands.
6151
6152 Setting this to nil does not do anything.
6153 */ );
6154   enable_multibyte_characters = 1;
6155 }
6156
6157 void
6158 complex_vars_of_file_coding (void)
6159 {
6160   staticpro (&Vcoding_system_hash_table);
6161   Vcoding_system_hash_table =
6162     make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
6163
6164   the_codesys_prop_dynarr = Dynarr_new (codesys_prop);
6165   dump_add_root_struct_ptr (&the_codesys_prop_dynarr, &codesys_prop_dynarr_description);
6166
6167 #define DEFINE_CODESYS_PROP(Prop_Type, Sym) do  \
6168 {                                               \
6169   struct codesys_prop csp;                      \
6170   csp.sym = (Sym);                              \
6171   csp.prop_type = (Prop_Type);                  \
6172   Dynarr_add (the_codesys_prop_dynarr, csp);    \
6173 } while (0)
6174
6175   DEFINE_CODESYS_PROP (CODESYS_PROP_ALL_OK,  Qmnemonic);
6176   DEFINE_CODESYS_PROP (CODESYS_PROP_ALL_OK,  Qeol_type);
6177   DEFINE_CODESYS_PROP (CODESYS_PROP_ALL_OK,  Qeol_cr);
6178   DEFINE_CODESYS_PROP (CODESYS_PROP_ALL_OK,  Qeol_crlf);
6179   DEFINE_CODESYS_PROP (CODESYS_PROP_ALL_OK,  Qeol_lf);
6180   DEFINE_CODESYS_PROP (CODESYS_PROP_ALL_OK,  Qpost_read_conversion);
6181   DEFINE_CODESYS_PROP (CODESYS_PROP_ALL_OK,  Qpre_write_conversion);
6182 #ifdef MULE
6183   DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qcharset_g0);
6184   DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qcharset_g1);
6185   DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qcharset_g2);
6186   DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qcharset_g3);
6187   DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qforce_g0_on_output);
6188   DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qforce_g1_on_output);
6189   DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qforce_g2_on_output);
6190   DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qforce_g3_on_output);
6191   DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qshort);
6192   DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qno_ascii_eol);
6193   DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qno_ascii_cntl);
6194   DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qseven);
6195   DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qlock_shift);
6196   DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qno_iso6429);
6197   DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qescape_quoted);
6198   DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qinput_charset_conversion);
6199   DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qoutput_charset_conversion);
6200
6201   DEFINE_CODESYS_PROP (CODESYS_PROP_CCL,     Qencode);
6202   DEFINE_CODESYS_PROP (CODESYS_PROP_CCL,     Qdecode);
6203 #ifdef UTF2000
6204   DEFINE_CODESYS_PROP (CODESYS_PROP_ALL_OK,  Qdisable_composition);
6205   DEFINE_CODESYS_PROP (CODESYS_PROP_ALL_OK,  Quse_entity_reference);
6206 #endif
6207 #endif /* MULE */
6208   /* Need to create this here or we're really screwed. */
6209   Fmake_coding_system
6210     (Qraw_text, Qno_conversion,
6211      build_string ("Raw text, which means it converts only line-break-codes."),
6212      list2 (Qmnemonic, build_string ("Raw")));
6213
6214   Fmake_coding_system
6215     (Qbinary, Qno_conversion,
6216      build_string ("Binary, which means it does not convert anything."),
6217      list4 (Qeol_type, Qlf,
6218             Qmnemonic, build_string ("Binary")));
6219
6220 #ifdef UTF2000
6221   Fmake_coding_system
6222     (Qutf8, Qutf8,
6223      build_string ("Coding-system of ISO/IEC 10646 UTF-8."),
6224      list2 (Qmnemonic, build_string ("UTF8")));
6225 #endif
6226
6227   Fdefine_coding_system_alias (Qno_conversion, Qraw_text);
6228
6229   Fdefine_coding_system_alias (Qfile_name, Qbinary);
6230
6231   Fdefine_coding_system_alias (Qterminal, Qbinary);
6232   Fdefine_coding_system_alias (Qkeyboard, Qbinary);
6233
6234   /* Need this for bootstrapping */
6235   fcd->coding_category_system[CODING_CATEGORY_NO_CONVERSION] =
6236     Fget_coding_system (Qraw_text);
6237
6238 #ifdef UTF2000
6239   fcd->coding_category_system[CODING_CATEGORY_UTF8]
6240    = Fget_coding_system (Qutf8);
6241 #endif
6242
6243 #if defined(MULE) && !defined(UTF2000)
6244   {
6245     size_t i;
6246
6247     for (i = 0; i < countof (fcd->ucs_to_mule_table); i++)
6248       fcd->ucs_to_mule_table[i] = Qnil;
6249   }
6250   staticpro (&mule_to_ucs_table);
6251   mule_to_ucs_table = Fmake_char_table(Qgeneric);
6252 #endif /* defined(MULE) && !defined(UTF2000) */
6253 }