src/text-coding.c

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