src/text-coding.c

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