src/mule-charset.c

   1 /* Functions to handle multilingual characters.
   2    Copyright (C) 1992, 1995 Free Software Foundation, Inc.
   3    Copyright (C) 1995 Sun Microsystems, Inc.
   4    Copyright (C) 1999,2000,2001 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 /* Rewritten by Ben Wing <ben@xemacs.org>. */
  24
  25 /* Rewritten by MORIOKA Tomohiko <tomo@m17n.org> for XEmacs UTF-2000. */
  26
  27 #include <config.h>
  28 #ifdef UTF2000
  29 #include <limits.h>
  30 #endif
  31 #include "lisp.h"
  32
  33 #include "buffer.h"
  34 #include "chartab.h"
  35 #include "elhash.h"
  36 #include "lstream.h"
  37 #include "device.h"
  38 #include "faces.h"
  39 #include "mule-ccl.h"
  40
  41 /* The various pre-defined charsets. */
  42
  43 Lisp_Object Vcharset_ascii;
  44 Lisp_Object Vcharset_control_1;
  45 Lisp_Object Vcharset_latin_iso8859_1;
  46 Lisp_Object Vcharset_latin_iso8859_2;
  47 Lisp_Object Vcharset_latin_iso8859_3;
  48 Lisp_Object Vcharset_latin_iso8859_4;
  49 Lisp_Object Vcharset_thai_tis620;
  50 Lisp_Object Vcharset_greek_iso8859_7;
  51 Lisp_Object Vcharset_arabic_iso8859_6;
  52 Lisp_Object Vcharset_hebrew_iso8859_8;
  53 Lisp_Object Vcharset_katakana_jisx0201;
  54 Lisp_Object Vcharset_latin_jisx0201;
  55 Lisp_Object Vcharset_cyrillic_iso8859_5;
  56 Lisp_Object Vcharset_latin_iso8859_9;
  57 Lisp_Object Vcharset_japanese_jisx0208_1978;
  58 Lisp_Object Vcharset_chinese_gb2312;
  59 Lisp_Object Vcharset_chinese_gb12345;
  60 Lisp_Object Vcharset_japanese_jisx0208;
  61 Lisp_Object Vcharset_japanese_jisx0208_1990;
  62 Lisp_Object Vcharset_korean_ksc5601;
  63 Lisp_Object Vcharset_japanese_jisx0212;
  64 Lisp_Object Vcharset_chinese_cns11643_1;
  65 Lisp_Object Vcharset_chinese_cns11643_2;
  66 #ifdef UTF2000
  67 Lisp_Object Vcharset_ucs;
  68 Lisp_Object Vcharset_ucs_bmp;
  69 Lisp_Object Vcharset_ucs_cns;
  70 Lisp_Object Vcharset_ucs_jis;
  71 Lisp_Object Vcharset_ucs_big5;
  72 Lisp_Object Vcharset_latin_viscii;
  73 Lisp_Object Vcharset_latin_tcvn5712;
  74 Lisp_Object Vcharset_latin_viscii_lower;
  75 Lisp_Object Vcharset_latin_viscii_upper;
  76 Lisp_Object Vcharset_chinese_big5;
  77 Lisp_Object Vcharset_chinese_big5_cdp;
  78 Lisp_Object Vcharset_ideograph_gt;
  79 Lisp_Object Vcharset_ideograph_gt_pj_1;
  80 Lisp_Object Vcharset_ideograph_gt_pj_2;
  81 Lisp_Object Vcharset_ideograph_gt_pj_3;
  82 Lisp_Object Vcharset_ideograph_gt_pj_4;
  83 Lisp_Object Vcharset_ideograph_gt_pj_5;
  84 Lisp_Object Vcharset_ideograph_gt_pj_6;
  85 Lisp_Object Vcharset_ideograph_gt_pj_7;
  86 Lisp_Object Vcharset_ideograph_gt_pj_8;
  87 Lisp_Object Vcharset_ideograph_gt_pj_9;
  88 Lisp_Object Vcharset_ideograph_gt_pj_10;
  89 Lisp_Object Vcharset_ideograph_gt_pj_11;
  90 Lisp_Object Vcharset_ideograph_daikanwa;
  91 Lisp_Object Vcharset_mojikyo;
  92 Lisp_Object Vcharset_mojikyo_2022_1;
  93 Lisp_Object Vcharset_mojikyo_pj_1;
  94 Lisp_Object Vcharset_mojikyo_pj_2;
  95 Lisp_Object Vcharset_mojikyo_pj_3;
  96 Lisp_Object Vcharset_mojikyo_pj_4;
  97 Lisp_Object Vcharset_mojikyo_pj_5;
  98 Lisp_Object Vcharset_mojikyo_pj_6;
  99 Lisp_Object Vcharset_mojikyo_pj_7;
 100 Lisp_Object Vcharset_mojikyo_pj_8;
 101 Lisp_Object Vcharset_mojikyo_pj_9;
 102 Lisp_Object Vcharset_mojikyo_pj_10;
 103 Lisp_Object Vcharset_mojikyo_pj_11;
 104 Lisp_Object Vcharset_mojikyo_pj_12;
 105 Lisp_Object Vcharset_mojikyo_pj_13;
 106 Lisp_Object Vcharset_mojikyo_pj_14;
 107 Lisp_Object Vcharset_mojikyo_pj_15;
 108 Lisp_Object Vcharset_mojikyo_pj_16;
 109 Lisp_Object Vcharset_mojikyo_pj_17;
 110 Lisp_Object Vcharset_mojikyo_pj_18;
 111 Lisp_Object Vcharset_mojikyo_pj_19;
 112 Lisp_Object Vcharset_mojikyo_pj_20;
 113 Lisp_Object Vcharset_mojikyo_pj_21;
 114 Lisp_Object Vcharset_ethiopic_ucs;
 115 #endif
 116 Lisp_Object Vcharset_chinese_big5_1;
 117 Lisp_Object Vcharset_chinese_big5_2;
 118
 119 #ifdef ENABLE_COMPOSITE_CHARS
 120 Lisp_Object Vcharset_composite;
 121
 122 /* Hash tables for composite chars.  One maps string representing
 123    composed chars to their equivalent chars; one goes the
 124    other way. */
 125 Lisp_Object Vcomposite_char_char2string_hash_table;
 126 Lisp_Object Vcomposite_char_string2char_hash_table;
 127
 128 static int composite_char_row_next;
 129 static int composite_char_col_next;
 130
 131 #endif /* ENABLE_COMPOSITE_CHARS */
 132
 133 struct charset_lookup *chlook;
 134
 135 static const struct lrecord_description charset_lookup_description_1[] = {
 136   { XD_LISP_OBJECT_ARRAY, offsetof (struct charset_lookup, charset_by_leading_byte),
 137 #ifdef UTF2000
 138     128+4*128
 139 #else
 140     128+4*128*2
 141 #endif
 142   }, { XD_END }
 143 };
 144
 145 static const struct struct_description charset_lookup_description = {
 146   sizeof (struct charset_lookup),
 147   charset_lookup_description_1
 148 };
 149
 150 #ifndef UTF2000
 151 /* Table of number of bytes in the string representation of a character
 152    indexed by the first byte of that representation.
 153
 154    rep_bytes_by_first_byte(c) is more efficient than the equivalent
 155    canonical computation:
 156
 157    XCHARSET_REP_BYTES (CHARSET_BY_LEADING_BYTE (c)) */
 158
 159 const Bytecount rep_bytes_by_first_byte[0xA0] =
 160 { /* 0x00 - 0x7f are for straight ASCII */
 161   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
 162   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
 163   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
 164   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
 165   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
 166   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
 167   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
 168   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
 169   /* 0x80 - 0x8f are for Dimension-1 official charsets */
 170 #ifdef CHAR_IS_UCS4
 171   2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3,
 172 #else
 173   2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
 174 #endif
 175   /* 0x90 - 0x9d are for Dimension-2 official charsets */
 176   /* 0x9e is for Dimension-1 private charsets */
 177   /* 0x9f is for Dimension-2 private charsets */
 178   3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4
 179 };
 180 #endif
 181
 182 #ifdef UTF2000
 183
 184 INLINE_HEADER int CHARSET_BYTE_SIZE (Lisp_Charset* cs);
 185 INLINE_HEADER int
 186 CHARSET_BYTE_SIZE (Lisp_Charset* cs)
 187 {
 188   /* ad-hoc method for `ascii' */
 189   if ((CHARSET_CHARS (cs) == 94) &&
 190       (CHARSET_BYTE_OFFSET (cs) != 33))
 191     return 128 - CHARSET_BYTE_OFFSET (cs);
 192   else
 193     return CHARSET_CHARS (cs);
 194 }
 195
 196 #define XCHARSET_BYTE_SIZE(ccs) CHARSET_BYTE_SIZE (XCHARSET (ccs))
 197
 198 int decoding_table_check_elements (Lisp_Object v, int dim, int ccs_len);
 199 int
 200 decoding_table_check_elements (Lisp_Object v, int dim, int ccs_len)
 201 {
 202   int i;
 203
 204   if (XVECTOR_LENGTH (v) > ccs_len)
 205     return -1;
 206
 207   for (i = 0; i < XVECTOR_LENGTH (v); i++)
 208     {
 209       Lisp_Object c = XVECTOR_DATA(v)[i];
 210
 211       if (!NILP (c) && !CHARP (c))
 212         {
 213           if (VECTORP (c))
 214             {
 215               int ret = decoding_table_check_elements (c, dim - 1, ccs_len);
 216               if (ret)
 217                 return ret;
 218             }
 219           else
 220             return -2;
 221         }
 222     }
 223   return 0;
 224 }
 225
 226 INLINE_HEADER void
 227 decoding_table_remove_char (Lisp_Object v, int dim, int byte_offset,
 228                             int code_point);
 229 INLINE_HEADER void
 230 decoding_table_remove_char (Lisp_Object v, int dim, int byte_offset,
 231                             int code_point)
 232 {
 233   int i = -1;
 234
 235   while (dim > 0)
 236     {
 237       Lisp_Object nv;
 238
 239       dim--;
 240       i = ((code_point >> (8 * dim)) & 255) - byte_offset;
 241       nv = XVECTOR_DATA(v)[i];
 242       if (!VECTORP (nv))
 243         break;
 244       v = nv;
 245     }
 246   if (i >= 0)
 247     XVECTOR_DATA(v)[i] = Qnil;
 248 }
 249
 250 INLINE_HEADER void
 251 decoding_table_put_char (Lisp_Object v, int dim, int byte_offset,
 252                          int code_point, Lisp_Object character);
 253 INLINE_HEADER void
 254 decoding_table_put_char (Lisp_Object v, int dim, int byte_offset,
 255                          int code_point, Lisp_Object character)
 256 {
 257   int i = -1;
 258   Lisp_Object nv;
 259   int ccs_len = XVECTOR_LENGTH (v);
 260
 261   while (dim > 0)
 262     {
 263       dim--;
 264       i = ((code_point >> (8 * dim)) & 255) - byte_offset;
 265       nv = XVECTOR_DATA(v)[i];
 266       if (dim > 0)
 267         {
 268           if (!VECTORP (nv))
 269             nv = (XVECTOR_DATA(v)[i] = make_older_vector (ccs_len, Qnil));
 270           v = nv;
 271         }
 272       else
 273         break;
 274     }
 275   XVECTOR_DATA(v)[i] = character;
 276 }
 277
 278 Lisp_Object
 279 put_char_ccs_code_point (Lisp_Object character,
 280                          Lisp_Object ccs, Lisp_Object value)
 281 {
 282   Lisp_Object encoding_table;
 283
 284   if (!EQ (XCHARSET_NAME (ccs), Qucs)
 285       || (XCHAR (character) != XINT (value)))
 286     {
 287       Lisp_Object v = XCHARSET_DECODING_TABLE (ccs);
 288       int dim = XCHARSET_DIMENSION (ccs);
 289       int ccs_len = XCHARSET_BYTE_SIZE (ccs);
 290       int byte_offset = XCHARSET_BYTE_OFFSET (ccs);
 291       int code_point;
 292
 293       if (CONSP (value))
 294         { /* obsolete representation: value must be a list of bytes */
 295           Lisp_Object ret = Fcar (value);
 296           Lisp_Object rest;
 297
 298           if (!INTP (ret))
 299             signal_simple_error ("Invalid value for coded-charset", value);
 300           code_point = XINT (ret);
 301           if (XCHARSET_GRAPHIC (ccs) == 1)
 302             code_point &= 0x7F;
 303           rest = Fcdr (value);
 304           while (!NILP (rest))
 305             {
 306               int j;
 307
 308               if (!CONSP (rest))
 309                 signal_simple_error ("Invalid value for coded-charset",
 310                                      value);
 311               ret = Fcar (rest);
 312               if (!INTP (ret))
 313                 signal_simple_error ("Invalid value for coded-charset",
 314                                      value);
 315               j = XINT (ret);
 316               if (XCHARSET_GRAPHIC (ccs) == 1)
 317                 j &= 0x7F;
 318               code_point = (code_point << 8) | j;
 319               rest = Fcdr (rest);
 320             }
 321           value = make_int (code_point);
 322         }
 323       else if (INTP (value))
 324         {
 325           code_point = XINT (value);
 326           if (XCHARSET_GRAPHIC (ccs) == 1)
 327             {
 328               code_point &= 0x7F7F7F7F;
 329               value = make_int (code_point);
 330             }
 331         }
 332       else
 333         signal_simple_error ("Invalid value for coded-charset", value);
 334
 335       if (VECTORP (v))
 336         {
 337           Lisp_Object cpos = Fget_char_attribute (character, ccs, Qnil);
 338           if (!NILP (cpos))
 339             {
 340               decoding_table_remove_char (v, dim, byte_offset, XINT (cpos));
 341             }
 342         }
 343       else
 344         {
 345           XCHARSET_DECODING_TABLE (ccs)
 346             = v = make_older_vector (ccs_len, Qnil);
 347         }
 348
 349       decoding_table_put_char (v, dim, byte_offset, code_point, character);
 350     }
 351   if (NILP (encoding_table = XCHARSET_ENCODING_TABLE (ccs)))
 352     {
 353       XCHARSET_ENCODING_TABLE (ccs)
 354         = encoding_table = make_char_id_table (Qnil);
 355     }
 356   put_char_id_table (XCHAR_TABLE(encoding_table), character, value);
 357   return Qt;
 358 }
 359
 360 Lisp_Object
 361 remove_char_ccs (Lisp_Object character, Lisp_Object ccs)
 362 {
 363   Lisp_Object decoding_table = XCHARSET_DECODING_TABLE (ccs);
 364   Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (ccs);
 365
 366   if (VECTORP (decoding_table))
 367     {
 368       Lisp_Object cpos = Fget_char_attribute (character, ccs, Qnil);
 369
 370       if (!NILP (cpos))
 371         {
 372           decoding_table_remove_char (decoding_table,
 373                                       XCHARSET_DIMENSION (ccs),
 374                                       XCHARSET_BYTE_OFFSET (ccs),
 375                                       XINT (cpos));
 376         }
 377     }
 378   if (CHAR_TABLEP (encoding_table))
 379     {
 380       put_char_id_table (XCHAR_TABLE(encoding_table), character, Qnil);
 381     }
 382   return Qt;
 383 }
 384
 385 #endif
 386
 387 #ifndef UTF2000
 388 int leading_code_private_11;
 389 #endif
 390
 391 Lisp_Object Qcharsetp;
 392
 393 /* Qdoc_string, Qdimension, Qchars defined in general.c */
 394 Lisp_Object Qregistry, Qfinal, Qgraphic;
 395 Lisp_Object Qdirection;
 396 Lisp_Object Qreverse_direction_charset;
 397 Lisp_Object Qleading_byte;
 398 Lisp_Object Qshort_name, Qlong_name;
 399
 400 Lisp_Object Qascii,
 401   Qcontrol_1,
 402   Qlatin_iso8859_1,
 403   Qlatin_iso8859_2,
 404   Qlatin_iso8859_3,
 405   Qlatin_iso8859_4,
 406   Qthai_tis620,
 407   Qgreek_iso8859_7,
 408   Qarabic_iso8859_6,
 409   Qhebrew_iso8859_8,
 410   Qkatakana_jisx0201,
 411   Qlatin_jisx0201,
 412   Qcyrillic_iso8859_5,
 413   Qlatin_iso8859_9,
 414   Qjapanese_jisx0208_1978,
 415   Qchinese_gb2312,
 416   Qchinese_gb12345,
 417   Qjapanese_jisx0208,
 418   Qjapanese_jisx0208_1990,
 419   Qkorean_ksc5601,
 420   Qjapanese_jisx0212,
 421   Qchinese_cns11643_1,
 422   Qchinese_cns11643_2,
 423 #ifdef UTF2000
 424   Qucs,
 425   Qucs_bmp,
 426   Qucs_cns,
 427   Qucs_jis,
 428   Qucs_big5,
 429   Qlatin_viscii,
 430   Qlatin_tcvn5712,
 431   Qlatin_viscii_lower,
 432   Qlatin_viscii_upper,
 433   Qvietnamese_viscii_lower,
 434   Qvietnamese_viscii_upper,
 435   Qchinese_big5,
 436   Qchinese_big5_cdp,
 437   Qideograph_daikanwa,
 438   Qideograph_gt,
 439   Qideograph_gt_pj_1,
 440   Qideograph_gt_pj_2,
 441   Qideograph_gt_pj_3,
 442   Qideograph_gt_pj_4,
 443   Qideograph_gt_pj_5,
 444   Qideograph_gt_pj_6,
 445   Qideograph_gt_pj_7,
 446   Qideograph_gt_pj_8,
 447   Qideograph_gt_pj_9,
 448   Qideograph_gt_pj_10,
 449   Qideograph_gt_pj_11,
 450   Qmojikyo,
 451   Qmojikyo_2022_1,
 452   Qmojikyo_pj_1,
 453   Qmojikyo_pj_2,
 454   Qmojikyo_pj_3,
 455   Qmojikyo_pj_4,
 456   Qmojikyo_pj_5,
 457   Qmojikyo_pj_6,
 458   Qmojikyo_pj_7,
 459   Qmojikyo_pj_8,
 460   Qmojikyo_pj_9,
 461   Qmojikyo_pj_10,
 462   Qmojikyo_pj_11,
 463   Qmojikyo_pj_12,
 464   Qmojikyo_pj_13,
 465   Qmojikyo_pj_14,
 466   Qmojikyo_pj_15,
 467   Qmojikyo_pj_16,
 468   Qmojikyo_pj_17,
 469   Qmojikyo_pj_18,
 470   Qmojikyo_pj_19,
 471   Qmojikyo_pj_20,
 472   Qmojikyo_pj_21,
 473   Qethiopic_ucs,
 474 #endif
 475   Qchinese_big5_1,
 476   Qchinese_big5_2,
 477   Qcomposite;
 478
 479 Lisp_Object Ql2r, Qr2l;
 480
 481 Lisp_Object Vcharset_hash_table;
 482
 483 /* Composite characters are characters constructed by overstriking two
 484    or more regular characters.
 485
 486    1) The old Mule implementation involves storing composite characters
 487       in a buffer as a tag followed by all of the actual characters
 488       used to make up the composite character.  I think this is a bad
 489       idea; it greatly complicates code that wants to handle strings
 490       one character at a time because it has to deal with the possibility
 491       of great big ungainly characters.  It's much more reasonable to
 492       simply store an index into a table of composite characters.
 493
 494    2) The current implementation only allows for 16,384 separate
 495       composite characters over the lifetime of the XEmacs process.
 496       This could become a potential problem if the user
 497       edited lots of different files that use composite characters.
 498       Due to FSF bogosity, increasing the number of allowable
 499       composite characters under Mule would decrease the number
 500       of possible faces that can exist.  Mule already has shrunk
 501       this to 2048, and further shrinkage would become uncomfortable.
 502       No such problems exist in XEmacs.
 503
 504       Composite characters could be represented as 0x80 C1 C2 C3,
 505       where each C[1-3] is in the range 0xA0 - 0xFF.  This allows
 506       for slightly under 2^20 (one million) composite characters
 507       over the XEmacs process lifetime, and you only need to
 508       increase the size of a Mule character from 19 to 21 bits.
 509       Or you could use 0x80 C1 C2 C3 C4, allowing for about
 510       85 million (slightly over 2^26) composite characters. */
 511
 512 \f
 513 /************************************************************************/
 514 /*                       Basic Emchar functions                         */
 515 /************************************************************************/
 516
 517 /* Convert a non-ASCII Mule character C into a one-character Mule-encoded
 518    string in STR.  Returns the number of bytes stored.
 519    Do not call this directly.  Use the macro set_charptr_emchar() instead.
 520  */
 521
 522 Bytecount
 523 non_ascii_set_charptr_emchar (Bufbyte *str, Emchar c)
 524 {
 525   Bufbyte *p;
 526 #ifndef UTF2000
 527   Charset_ID lb;
 528   int c1, c2;
 529   Lisp_Object charset;
 530 #endif
 531
 532   p = str;
 533 #ifdef UTF2000
 534   if ( c <= 0x7f )
 535     {
 536       *p++ = c;
 537     }
 538   else if ( c <= 0x7ff )
 539     {
 540       *p++ = (c >> 6) | 0xc0;
 541       *p++ = (c & 0x3f) | 0x80;
 542     }
 543   else if ( c <= 0xffff )
 544     {
 545       *p++ =  (c >> 12) | 0xe0;
 546       *p++ = ((c >>  6) & 0x3f) | 0x80;
 547       *p++ =  (c        & 0x3f) | 0x80;
 548     }
 549   else if ( c <= 0x1fffff )
 550     {
 551       *p++ =  (c >> 18) | 0xf0;
 552       *p++ = ((c >> 12) & 0x3f) | 0x80;
 553       *p++ = ((c >>  6) & 0x3f) | 0x80;
 554       *p++ =  (c        & 0x3f) | 0x80;
 555     }
 556   else if ( c <= 0x3ffffff )
 557     {
 558       *p++ =  (c >> 24) | 0xf8;
 559       *p++ = ((c >> 18) & 0x3f) | 0x80;
 560       *p++ = ((c >> 12) & 0x3f) | 0x80;
 561       *p++ = ((c >>  6) & 0x3f) | 0x80;
 562       *p++ =  (c        & 0x3f) | 0x80;
 563     }
 564   else
 565     {
 566       *p++ =  (c >> 30) | 0xfc;
 567       *p++ = ((c >> 24) & 0x3f) | 0x80;
 568       *p++ = ((c >> 18) & 0x3f) | 0x80;
 569       *p++ = ((c >> 12) & 0x3f) | 0x80;
 570       *p++ = ((c >>  6) & 0x3f) | 0x80;
 571       *p++ =  (c        & 0x3f) | 0x80;
 572     }
 573 #else
 574   BREAKUP_CHAR (c, charset, c1, c2);
 575   lb = CHAR_LEADING_BYTE (c);
 576   if (LEADING_BYTE_PRIVATE_P (lb))
 577     *p++ = PRIVATE_LEADING_BYTE_PREFIX (lb);
 578   *p++ = lb;
 579   if (EQ (charset, Vcharset_control_1))
 580     c1 += 0x20;
 581   *p++ = c1 | 0x80;
 582   if (c2)
 583     *p++ = c2 | 0x80;
 584 #endif
 585   return (p - str);
 586 }
 587
 588 /* Return the first character from a Mule-encoded string in STR,
 589    assuming it's non-ASCII.  Do not call this directly.
 590    Use the macro charptr_emchar() instead. */
 591
 592 Emchar
 593 non_ascii_charptr_emchar (const Bufbyte *str)
 594 {
 595 #ifdef UTF2000
 596   Bufbyte b;
 597   Emchar ch;
 598   int len;
 599
 600   b = *str++;
 601   if ( b >= 0xfc )
 602     {
 603       ch = (b & 0x01);
 604       len = 5;
 605     }
 606   else if ( b >= 0xf8 )
 607     {
 608       ch = b & 0x03;
 609       len = 4;
 610     }
 611   else if ( b >= 0xf0 )
 612     {
 613       ch = b & 0x07;
 614       len = 3;
 615     }
 616   else if ( b >= 0xe0 )
 617     {
 618       ch = b & 0x0f;
 619       len = 2;
 620     }
 621   else if ( b >= 0xc0 )
 622     {
 623       ch = b & 0x1f;
 624       len = 1;
 625     }
 626   else
 627     {
 628       ch = b;
 629       len = 0;
 630     }
 631   for( ; len > 0; len-- )
 632     {
 633       b = *str++;
 634       ch = ( ch << 6 ) | ( b & 0x3f );
 635     }
 636   return ch;
 637 #else
 638   Bufbyte i0 = *str, i1, i2 = 0;
 639   Lisp_Object charset;
 640
 641   if (i0 == LEADING_BYTE_CONTROL_1)
 642     return (Emchar) (*++str - 0x20);
 643
 644   if (LEADING_BYTE_PREFIX_P (i0))
 645     i0 = *++str;
 646
 647   i1 = *++str & 0x7F;
 648
 649   charset = CHARSET_BY_LEADING_BYTE (i0);
 650   if (XCHARSET_DIMENSION (charset) == 2)
 651     i2 = *++str & 0x7F;
 652
 653   return MAKE_CHAR (charset, i1, i2);
 654 #endif
 655 }
 656
 657 /* Return whether CH is a valid Emchar, assuming it's non-ASCII.
 658    Do not call this directly.  Use the macro valid_char_p() instead. */
 659
 660 #ifndef UTF2000
 661 int
 662 non_ascii_valid_char_p (Emchar ch)
 663 {
 664   int f1, f2, f3;
 665
 666   /* Must have only lowest 19 bits set */
 667   if (ch & ~0x7FFFF)
 668     return 0;
 669
 670   f1 = CHAR_FIELD1 (ch);
 671   f2 = CHAR_FIELD2 (ch);
 672   f3 = CHAR_FIELD3 (ch);
 673
 674   if (f1 == 0)
 675     {
 676       Lisp_Object charset;
 677
 678       if (f2 < MIN_CHAR_FIELD2_OFFICIAL ||
 679           (f2 > MAX_CHAR_FIELD2_OFFICIAL && f2 < MIN_CHAR_FIELD2_PRIVATE) ||
 680            f2 > MAX_CHAR_FIELD2_PRIVATE)
 681         return 0;
 682       if (f3 < 0x20)
 683         return 0;
 684
 685       if (f3 != 0x20 && f3 != 0x7F && !(f2 >= MIN_CHAR_FIELD2_PRIVATE &&
 686                                         f2 <= MAX_CHAR_FIELD2_PRIVATE))
 687         return 1;
 688
 689       /*
 690          NOTE: This takes advantage of the fact that
 691          FIELD2_TO_OFFICIAL_LEADING_BYTE and
 692          FIELD2_TO_PRIVATE_LEADING_BYTE are the same.
 693          */
 694       charset = CHARSET_BY_LEADING_BYTE (f2 + FIELD2_TO_OFFICIAL_LEADING_BYTE);
 695       if (EQ (charset, Qnil))
 696         return 0;
 697       return (XCHARSET_CHARS (charset) == 96);
 698     }
 699   else
 700     {
 701       Lisp_Object charset;
 702
 703       if (f1 < MIN_CHAR_FIELD1_OFFICIAL ||
 704           (f1 > MAX_CHAR_FIELD1_OFFICIAL && f1 < MIN_CHAR_FIELD1_PRIVATE) ||
 705           f1 > MAX_CHAR_FIELD1_PRIVATE)
 706         return 0;
 707       if (f2 < 0x20 || f3 < 0x20)
 708         return 0;
 709
 710 #ifdef ENABLE_COMPOSITE_CHARS
 711       if (f1 + FIELD1_TO_OFFICIAL_LEADING_BYTE == LEADING_BYTE_COMPOSITE)
 712         {
 713           if (UNBOUNDP (Fgethash (make_int (ch),
 714                                   Vcomposite_char_char2string_hash_table,
 715                                   Qunbound)))
 716             return 0;
 717           return 1;
 718         }
 719 #endif /* ENABLE_COMPOSITE_CHARS */
 720
 721       if (f2 != 0x20 && f2 != 0x7F && f3 != 0x20 && f3 != 0x7F
 722           && !(f1 >= MIN_CHAR_FIELD1_PRIVATE && f1 <= MAX_CHAR_FIELD1_PRIVATE))
 723         return 1;
 724
 725       if (f1 <= MAX_CHAR_FIELD1_OFFICIAL)
 726         charset =
 727           CHARSET_BY_LEADING_BYTE (f1 + FIELD1_TO_OFFICIAL_LEADING_BYTE);
 728       else
 729         charset =
 730           CHARSET_BY_LEADING_BYTE (f1 + FIELD1_TO_PRIVATE_LEADING_BYTE);
 731
 732       if (EQ (charset, Qnil))
 733         return 0;
 734       return (XCHARSET_CHARS (charset) == 96);
 735     }
 736 }
 737 #endif
 738
 739 \f
 740 /************************************************************************/
 741 /*                       Basic string functions                         */
 742 /************************************************************************/
 743
 744 /* Copy the character pointed to by SRC into DST.  Do not call this
 745    directly.  Use the macro charptr_copy_char() instead.
 746    Return the number of bytes copied.  */
 747
 748 Bytecount
 749 non_ascii_charptr_copy_char (const Bufbyte *src, Bufbyte *dst)
 750 {
 751   unsigned int bytes = REP_BYTES_BY_FIRST_BYTE (*src);
 752   unsigned int i;
 753   for (i = bytes; i; i--, dst++, src++)
 754     *dst = *src;
 755   return bytes;
 756 }
 757
 758 \f
 759 /************************************************************************/
 760 /*                        streams of Emchars                            */
 761 /************************************************************************/
 762
 763 /* Treat a stream as a stream of Emchar's rather than a stream of bytes.
 764    The functions below are not meant to be called directly; use
 765    the macros in insdel.h. */
 766
 767 Emchar
 768 Lstream_get_emchar_1 (Lstream *stream, int ch)
 769 {
 770   Bufbyte str[MAX_EMCHAR_LEN];
 771   Bufbyte *strptr = str;
 772   unsigned int bytes;
 773
 774   str[0] = (Bufbyte) ch;
 775
 776   for (bytes = REP_BYTES_BY_FIRST_BYTE (ch) - 1; bytes; bytes--)
 777     {
 778       int c = Lstream_getc (stream);
 779       bufpos_checking_assert (c >= 0);
 780       *++strptr = (Bufbyte) c;
 781     }
 782   return charptr_emchar (str);
 783 }
 784
 785 int
 786 Lstream_fput_emchar (Lstream *stream, Emchar ch)
 787 {
 788   Bufbyte str[MAX_EMCHAR_LEN];
 789   Bytecount len = set_charptr_emchar (str, ch);
 790   return Lstream_write (stream, str, len);
 791 }
 792
 793 void
 794 Lstream_funget_emchar (Lstream *stream, Emchar ch)
 795 {
 796   Bufbyte str[MAX_EMCHAR_LEN];
 797   Bytecount len = set_charptr_emchar (str, ch);
 798   Lstream_unread (stream, str, len);
 799 }
 800
 801 \f
 802 /************************************************************************/
 803 /*                            charset object                            */
 804 /************************************************************************/
 805
 806 static Lisp_Object
 807 mark_charset (Lisp_Object obj)
 808 {
 809   Lisp_Charset *cs = XCHARSET (obj);
 810
 811   mark_object (cs->short_name);
 812   mark_object (cs->long_name);
 813   mark_object (cs->doc_string);
 814   mark_object (cs->registry);
 815   mark_object (cs->ccl_program);
 816 #ifdef UTF2000
 817   mark_object (cs->encoding_table);
 818   /* mark_object (cs->decoding_table); */
 819 #endif
 820   return cs->name;
 821 }
 822
 823 static void
 824 print_charset (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
 825 {
 826   Lisp_Charset *cs = XCHARSET (obj);
 827   char buf[200];
 828
 829   if (print_readably)
 830     error ("printing unreadable object #<charset %s 0x%x>",
 831            string_data (XSYMBOL (CHARSET_NAME (cs))->name),
 832            cs->header.uid);
 833
 834   write_c_string ("#<charset ", printcharfun);
 835   print_internal (CHARSET_NAME (cs), printcharfun, 0);
 836   write_c_string (" ", printcharfun);
 837   print_internal (CHARSET_SHORT_NAME (cs), printcharfun, 1);
 838   write_c_string (" ", printcharfun);
 839   print_internal (CHARSET_LONG_NAME (cs), printcharfun, 1);
 840   write_c_string (" ", printcharfun);
 841   print_internal (CHARSET_DOC_STRING (cs), printcharfun, 1);
 842   sprintf (buf, " %d^%d %s cols=%d g%d final='%c' reg=",
 843            CHARSET_CHARS (cs),
 844            CHARSET_DIMENSION (cs),
 845            CHARSET_DIRECTION (cs) == CHARSET_LEFT_TO_RIGHT ? "l2r" : "r2l",
 846            CHARSET_COLUMNS (cs),
 847            CHARSET_GRAPHIC (cs),
 848            CHARSET_FINAL (cs));
 849   write_c_string (buf, printcharfun);
 850   print_internal (CHARSET_REGISTRY (cs), printcharfun, 0);
 851   sprintf (buf, " 0x%x>", cs->header.uid);
 852   write_c_string (buf, printcharfun);
 853 }
 854
 855 static const struct lrecord_description charset_description[] = {
 856   { XD_LISP_OBJECT, offsetof (Lisp_Charset, name) },
 857   { XD_LISP_OBJECT, offsetof (Lisp_Charset, doc_string) },
 858   { XD_LISP_OBJECT, offsetof (Lisp_Charset, registry) },
 859   { XD_LISP_OBJECT, offsetof (Lisp_Charset, short_name) },
 860   { XD_LISP_OBJECT, offsetof (Lisp_Charset, long_name) },
 861   { XD_LISP_OBJECT, offsetof (Lisp_Charset, reverse_direction_charset) },
 862   { XD_LISP_OBJECT, offsetof (Lisp_Charset, ccl_program) },
 863 #ifdef UTF2000
 864   { XD_LISP_OBJECT, offsetof (Lisp_Charset, decoding_table) },
 865   { XD_LISP_OBJECT, offsetof (Lisp_Charset, encoding_table) },
 866 #endif
 867   { XD_END }
 868 };
 869
 870 DEFINE_LRECORD_IMPLEMENTATION ("charset", charset,
 871                                mark_charset, print_charset, 0, 0, 0,
 872                                charset_description,
 873                                Lisp_Charset);
 874
 875 /* Make a new charset. */
 876 /* #### SJT Should generic properties be allowed? */
 877 static Lisp_Object
 878 make_charset (Charset_ID id, Lisp_Object name,
 879               unsigned short chars, unsigned char dimension,
 880               unsigned char columns, unsigned char graphic,
 881               Bufbyte final, unsigned char direction, Lisp_Object short_name,
 882               Lisp_Object long_name, Lisp_Object doc,
 883               Lisp_Object reg,
 884               Lisp_Object decoding_table,
 885               Emchar ucs_min, Emchar ucs_max,
 886               Emchar code_offset, unsigned char byte_offset)
 887 {
 888   Lisp_Object obj;
 889   Lisp_Charset *cs = alloc_lcrecord_type (Lisp_Charset, &lrecord_charset);
 890
 891   zero_lcrecord (cs);
 892
 893   XSETCHARSET (obj, cs);
 894
 895   CHARSET_ID            (cs) = id;
 896   CHARSET_NAME          (cs) = name;
 897   CHARSET_SHORT_NAME    (cs) = short_name;
 898   CHARSET_LONG_NAME     (cs) = long_name;
 899   CHARSET_CHARS         (cs) = chars;
 900   CHARSET_DIMENSION     (cs) = dimension;
 901   CHARSET_DIRECTION     (cs) = direction;
 902   CHARSET_COLUMNS       (cs) = columns;
 903   CHARSET_GRAPHIC       (cs) = graphic;
 904   CHARSET_FINAL         (cs) = final;
 905   CHARSET_DOC_STRING    (cs) = doc;
 906   CHARSET_REGISTRY      (cs) = reg;
 907   CHARSET_CCL_PROGRAM   (cs) = Qnil;
 908   CHARSET_REVERSE_DIRECTION_CHARSET (cs) = Qnil;
 909 #ifdef UTF2000
 910   CHARSET_DECODING_TABLE(cs) = Qnil;
 911   CHARSET_ENCODING_TABLE(cs) = Qnil;
 912   CHARSET_UCS_MIN(cs) = ucs_min;
 913   CHARSET_UCS_MAX(cs) = ucs_max;
 914   CHARSET_CODE_OFFSET(cs) = code_offset;
 915   CHARSET_BYTE_OFFSET(cs) = byte_offset;
 916 #endif
 917
 918 #ifndef UTF2000
 919   if (id == LEADING_BYTE_ASCII)
 920     CHARSET_REP_BYTES (cs) = 1;
 921   else if (id < 0xA0)
 922     CHARSET_REP_BYTES (cs) = CHARSET_DIMENSION (cs) + 1;
 923   else
 924     CHARSET_REP_BYTES (cs) = CHARSET_DIMENSION (cs) + 2;
 925 #endif
 926
 927   if (final)
 928     {
 929       /* some charsets do not have final characters.  This includes
 930          ASCII, Control-1, Composite, and the two faux private
 931          charsets. */
 932       unsigned char iso2022_type
 933         = (dimension == 1 ? 0 : 2) + (chars == 94 ? 0 : 1);
 934 #if UTF2000
 935       if (code_offset == 0)
 936         {
 937           assert (NILP (chlook->charset_by_attributes[iso2022_type][final]));
 938           chlook->charset_by_attributes[iso2022_type][final] = obj;
 939         }
 940 #else
 941       assert (NILP
 942               (chlook->charset_by_attributes[iso2022_type][final][direction]));
 943       chlook->charset_by_attributes[iso2022_type][final][direction] = obj;
 944 #endif
 945     }
 946
 947   assert (NILP (chlook->charset_by_leading_byte[id - MIN_LEADING_BYTE]));
 948   chlook->charset_by_leading_byte[id - MIN_LEADING_BYTE] = obj;
 949
 950   /* Some charsets are "faux" and don't have names or really exist at
 951      all except in the leading-byte table. */
 952   if (!NILP (name))
 953     Fputhash (name, obj, Vcharset_hash_table);
 954   return obj;
 955 }
 956
 957 static int
 958 get_unallocated_leading_byte (int dimension)
 959 {
 960   Charset_ID lb;
 961
 962 #ifdef UTF2000
 963   if (chlook->next_allocated_leading_byte > MAX_LEADING_BYTE_PRIVATE)
 964     lb = 0;
 965   else
 966     lb = chlook->next_allocated_leading_byte++;
 967 #else
 968   if (dimension == 1)
 969     {
 970       if (chlook->next_allocated_1_byte_leading_byte > MAX_LEADING_BYTE_PRIVATE_1)
 971         lb = 0;
 972       else
 973         lb = chlook->next_allocated_1_byte_leading_byte++;
 974     }
 975   else
 976     {
 977       if (chlook->next_allocated_2_byte_leading_byte > MAX_LEADING_BYTE_PRIVATE_2)
 978         lb = 0;
 979       else
 980         lb = chlook->next_allocated_2_byte_leading_byte++;
 981     }
 982 #endif
 983
 984   if (!lb)
 985     signal_simple_error
 986       ("No more character sets free for this dimension",
 987        make_int (dimension));
 988
 989   return lb;
 990 }
 991
 992 #ifdef UTF2000
 993 /* Number of Big5 characters which have the same code in 1st byte.  */
 994
 995 #define BIG5_SAME_ROW (0xFF - 0xA1 + 0x7F - 0x40)
 996
 997 Emchar
 998 decode_builtin_char (Lisp_Object charset, int code_point)
 999 {
1000   int final;
1001
1002   if (EQ (charset, Vcharset_chinese_big5))
1003     {
1004       int c1 = code_point >> 8;
1005       int c2 = code_point & 0xFF;
1006       unsigned int I;
1007
1008       if ( (  (0xA1 <= c1) && (c1 <= 0xFE)  )
1009            &&
1010            ( ((0x40 <= c2) && (c2 <= 0x7E)) ||
1011              ((0xA1 <= c2) && (c2 <= 0xFE)) ) )
1012         {
1013           I = (c1 - 0xA1) * BIG5_SAME_ROW
1014             + c2 - (c2 < 0x7F ? 0x40 : 0x62);
1015
1016           if (c1 < 0xC9)
1017             {
1018               charset = Vcharset_chinese_big5_1;
1019             }
1020           else
1021             {
1022               charset = Vcharset_chinese_big5_2;
1023               I -= (BIG5_SAME_ROW) * (0xC9 - 0xA1);
1024             }
1025           code_point = ((I / 94 + 33) << 8) | (I % 94 + 33);
1026         }
1027     }
1028   if ((final = XCHARSET_FINAL (charset)) >= '0')
1029     {
1030       if (XCHARSET_DIMENSION (charset) == 1)
1031         {
1032           switch (XCHARSET_CHARS (charset))
1033             {
1034             case 94:
1035               return MIN_CHAR_94
1036                 + (final - '0') * 94 + ((code_point & 0x7F) - 33);
1037             case 96:
1038               return MIN_CHAR_96
1039                 + (final - '0') * 96 + ((code_point & 0x7F) - 32);
1040             default:
1041               abort ();
1042               return -1;
1043             }
1044         }
1045       else
1046         {
1047           switch (XCHARSET_CHARS (charset))
1048             {
1049             case 94:
1050               return MIN_CHAR_94x94
1051                 + (final - '0') * 94 * 94
1052                 + (((code_point >> 8) & 0x7F) - 33) * 94
1053                 + ((code_point & 0x7F) - 33);
1054             case 96:
1055               return MIN_CHAR_96x96
1056                 + (final - '0') * 96 * 96
1057                 + (((code_point >> 8) & 0x7F) - 32) * 96
1058                 + ((code_point & 0x7F) - 32);
1059             default:
1060               abort ();
1061               return -1;
1062             }
1063         }
1064     }
1065   else if (XCHARSET_UCS_MAX (charset))
1066     {
1067       Emchar cid
1068         = (XCHARSET_DIMENSION (charset) == 1
1069            ?
1070            code_point - XCHARSET_BYTE_OFFSET (charset)
1071            :
1072            ((code_point >> 8) - XCHARSET_BYTE_OFFSET (charset))
1073            * XCHARSET_CHARS (charset)
1074            + (code_point & 0xFF) - XCHARSET_BYTE_OFFSET (charset))
1075         - XCHARSET_CODE_OFFSET (charset) + XCHARSET_UCS_MIN (charset);
1076       if ((cid < XCHARSET_UCS_MIN (charset))
1077           || (XCHARSET_UCS_MAX (charset) < cid))
1078         return -1;
1079       return cid;
1080     }
1081   else
1082     return -1;
1083 }
1084
1085 int
1086 range_charset_code_point (Lisp_Object charset, Emchar ch)
1087 {
1088   int d;
1089
1090   if ((XCHARSET_UCS_MIN (charset) <= ch)
1091       && (ch <= XCHARSET_UCS_MAX (charset)))
1092     {
1093       d = ch - XCHARSET_UCS_MIN (charset) + XCHARSET_CODE_OFFSET (charset);
1094
1095       if (XCHARSET_CHARS (charset) == 256)
1096         return d;
1097       else if (XCHARSET_DIMENSION (charset) == 1)
1098         return d + XCHARSET_BYTE_OFFSET (charset);
1099       else if (XCHARSET_DIMENSION (charset) == 2)
1100         return
1101           ((d / XCHARSET_CHARS (charset)
1102             + XCHARSET_BYTE_OFFSET (charset)) << 8)
1103           | (d % XCHARSET_CHARS (charset) + XCHARSET_BYTE_OFFSET (charset));
1104       else if (XCHARSET_DIMENSION (charset) == 3)
1105         return
1106           ((d / (XCHARSET_CHARS (charset) * XCHARSET_CHARS (charset))
1107             + XCHARSET_BYTE_OFFSET (charset)) << 16)
1108           | ((d / XCHARSET_CHARS (charset)
1109               % XCHARSET_CHARS (charset)
1110               + XCHARSET_BYTE_OFFSET (charset)) << 8)
1111           | (d % XCHARSET_CHARS (charset) + XCHARSET_BYTE_OFFSET (charset));
1112       else /* if (XCHARSET_DIMENSION (charset) == 4) */
1113         return
1114           ((d / (XCHARSET_CHARS (charset)
1115                  * XCHARSET_CHARS (charset) * XCHARSET_CHARS (charset))
1116             + XCHARSET_BYTE_OFFSET (charset)) << 24)
1117           | ((d / (XCHARSET_CHARS (charset) * XCHARSET_CHARS (charset))
1118               % XCHARSET_CHARS (charset)
1119               + XCHARSET_BYTE_OFFSET (charset)) << 16)
1120           | ((d / XCHARSET_CHARS (charset) % XCHARSET_CHARS (charset)
1121               + XCHARSET_BYTE_OFFSET (charset)) << 8)
1122           | (d % XCHARSET_CHARS (charset) + XCHARSET_BYTE_OFFSET (charset));
1123     }
1124   else if (XCHARSET_CODE_OFFSET (charset) == 0)
1125     {
1126       if (XCHARSET_DIMENSION (charset) == 1)
1127         {
1128           if (XCHARSET_CHARS (charset) == 94)
1129             {
1130               if (((d = ch - (MIN_CHAR_94
1131                               + (XCHARSET_FINAL (charset) - '0') * 94)) >= 0)
1132                   && (d < 94))
1133                 return d + 33;
1134             }
1135           else if (XCHARSET_CHARS (charset) == 96)
1136             {
1137               if (((d = ch - (MIN_CHAR_96
1138                               + (XCHARSET_FINAL (charset) - '0') * 96)) >= 0)
1139                   && (d < 96))
1140                 return d + 32;
1141             }
1142           else
1143             return -1;
1144         }
1145       else if (XCHARSET_DIMENSION (charset) == 2)
1146         {
1147           if (XCHARSET_CHARS (charset) == 94)
1148             {
1149               if (((d = ch - (MIN_CHAR_94x94
1150                               + (XCHARSET_FINAL (charset) - '0') * 94 * 94))
1151                    >= 0)
1152                   && (d < 94 * 94))
1153                 return (((d / 94) + 33) << 8) | (d % 94 + 33);
1154             }
1155           else if (XCHARSET_CHARS (charset) == 96)
1156             {
1157               if (((d = ch - (MIN_CHAR_96x96
1158                               + (XCHARSET_FINAL (charset) - '0') * 96 * 96))
1159                    >= 0)
1160                   && (d < 96 * 96))
1161                 return (((d / 96) + 32) << 8) | (d % 96 + 32);
1162             }
1163           else
1164             return -1;
1165         }
1166     }
1167   if (EQ (charset, Vcharset_mojikyo_2022_1)
1168       && (MIN_CHAR_MOJIKYO < ch) && (ch < MIN_CHAR_MOJIKYO + 94 * 60 * 94))
1169     {
1170       int m = ch - MIN_CHAR_MOJIKYO - 1;
1171       int byte1 =  m / (94 * 60) + 33;
1172       int byte2 = (m % (94 * 60)) / 94;
1173       int byte3 =  m % 94 + 33;
1174
1175       if (byte2 < 30)
1176         byte2 += 16 + 32;
1177       else
1178         byte2 += 18 + 32;
1179       return (byte1 << 16) | (byte2 << 8) | byte3;
1180     }
1181   return -1;
1182 }
1183
1184 int
1185 encode_builtin_char_1 (Emchar c, Lisp_Object* charset)
1186 {
1187   if (c <= MAX_CHAR_BASIC_LATIN)
1188     {
1189       *charset = Vcharset_ascii;
1190       return c;
1191     }
1192   else if (c < 0xA0)
1193     {
1194       *charset = Vcharset_control_1;
1195       return c & 0x7F;
1196     }
1197   else if (c <= 0xff)
1198     {
1199       *charset = Vcharset_latin_iso8859_1;
1200       return c & 0x7F;
1201     }
1202   /*
1203   else if ((MIN_CHAR_HEBREW <= c) && (c <= MAX_CHAR_HEBREW))
1204     {
1205       *charset = Vcharset_hebrew_iso8859_8;
1206       return c - MIN_CHAR_HEBREW + 0x20;
1207     }
1208   */
1209   else if ((MIN_CHAR_THAI <= c) && (c <= MAX_CHAR_THAI))
1210     {
1211       *charset = Vcharset_thai_tis620;
1212       return c - MIN_CHAR_THAI + 0x20;
1213     }
1214   /*
1215   else if ((MIN_CHAR_HALFWIDTH_KATAKANA <= c)
1216            && (c <= MAX_CHAR_HALFWIDTH_KATAKANA))
1217     {
1218       return list2 (Vcharset_katakana_jisx0201,
1219                     make_int (c - MIN_CHAR_HALFWIDTH_KATAKANA + 33));
1220     }
1221   */
1222   else if (c <= MAX_CHAR_BMP)
1223     {
1224       *charset = Vcharset_ucs_bmp;
1225       return c;
1226     }
1227   else if (c < MIN_CHAR_DAIKANWA)
1228     {
1229       *charset = Vcharset_ucs;
1230       return c;
1231     }
1232   else if (c <= MAX_CHAR_DAIKANWA)
1233     {
1234       *charset = Vcharset_ideograph_daikanwa;
1235       return c - MIN_CHAR_DAIKANWA;
1236     }
1237   else if (c <= MAX_CHAR_MOJIKYO_0)
1238     {
1239       *charset = Vcharset_mojikyo;
1240       return c - MIN_CHAR_MOJIKYO_0;
1241     }
1242   else if (c < MIN_CHAR_94)
1243     {
1244       *charset = Vcharset_ucs;
1245       return c;
1246     }
1247   else if (c <= MAX_CHAR_94)
1248     {
1249       *charset = CHARSET_BY_ATTRIBUTES (94, 1,
1250                                         ((c - MIN_CHAR_94) / 94) + '0',
1251                                         CHARSET_LEFT_TO_RIGHT);
1252       if (!NILP (*charset))
1253         return ((c - MIN_CHAR_94) % 94) + 33;
1254       else
1255         {
1256           *charset = Vcharset_ucs;
1257           return c;
1258         }
1259     }
1260   else if (c <= MAX_CHAR_96)
1261     {
1262       *charset = CHARSET_BY_ATTRIBUTES (96, 1,
1263                                         ((c - MIN_CHAR_96) / 96) + '0',
1264                                         CHARSET_LEFT_TO_RIGHT);
1265       if (!NILP (*charset))
1266         return ((c - MIN_CHAR_96) % 96) + 32;
1267       else
1268         {
1269           *charset = Vcharset_ucs;
1270           return c;
1271         }
1272     }
1273   else if (c <= MAX_CHAR_94x94)
1274     {
1275       *charset
1276         = CHARSET_BY_ATTRIBUTES (94, 2,
1277                                  ((c - MIN_CHAR_94x94) / (94 * 94)) + '0',
1278                                  CHARSET_LEFT_TO_RIGHT);
1279       if (!NILP (*charset))
1280         return (((((c - MIN_CHAR_94x94) / 94) % 94) + 33) << 8)
1281           | (((c - MIN_CHAR_94x94) % 94) + 33);
1282       else
1283         {
1284           *charset = Vcharset_ucs;
1285           return c;
1286         }
1287     }
1288   else if (c <= MAX_CHAR_96x96)
1289     {
1290       *charset
1291         = CHARSET_BY_ATTRIBUTES (96, 2,
1292                                  ((c - MIN_CHAR_96x96) / (96 * 96)) + '0',
1293                                  CHARSET_LEFT_TO_RIGHT);
1294       if (!NILP (*charset))
1295         return ((((c - MIN_CHAR_96x96) / 96) % 96) + 32) << 8
1296           | (((c - MIN_CHAR_96x96) % 96) + 32);
1297       else
1298         {
1299           *charset = Vcharset_ucs;
1300           return c;
1301         }
1302     }
1303   else if (c < MIN_CHAR_MOJIKYO)
1304     {
1305       *charset = Vcharset_ucs;
1306       return c;
1307     }
1308   else if (c <= MAX_CHAR_MOJIKYO)
1309     {
1310       *charset = Vcharset_mojikyo;
1311       return c - MIN_CHAR_MOJIKYO;
1312     }
1313   else
1314     {
1315       *charset = Vcharset_ucs;
1316       return c;
1317     }
1318 }
1319
1320 Lisp_Object Vdefault_coded_charset_priority_list;
1321 #endif
1322
1323 \f
1324 /************************************************************************/
1325 /*                      Basic charset Lisp functions                    */
1326 /************************************************************************/
1327
1328 DEFUN ("charsetp", Fcharsetp, 1, 1, 0, /*
1329 Return non-nil if OBJECT is a charset.
1330 */
1331        (object))
1332 {
1333   return CHARSETP (object) ? Qt : Qnil;
1334 }
1335
1336 DEFUN ("find-charset", Ffind_charset, 1, 1, 0, /*
1337 Retrieve the charset of the given name.
1338 If CHARSET-OR-NAME is a charset object, it is simply returned.
1339 Otherwise, CHARSET-OR-NAME should be a symbol.  If there is no such charset,
1340 nil is returned.  Otherwise the associated charset object is returned.
1341 */
1342        (charset_or_name))
1343 {
1344   if (CHARSETP (charset_or_name))
1345     return charset_or_name;
1346
1347   CHECK_SYMBOL (charset_or_name);
1348   return Fgethash (charset_or_name, Vcharset_hash_table, Qnil);
1349 }
1350
1351 DEFUN ("get-charset", Fget_charset, 1, 1, 0, /*
1352 Retrieve the charset of the given name.
1353 Same as `find-charset' except an error is signalled if there is no such
1354 charset instead of returning nil.
1355 */
1356        (name))
1357 {
1358   Lisp_Object charset = Ffind_charset (name);
1359
1360   if (NILP (charset))
1361     signal_simple_error ("No such charset", name);
1362   return charset;
1363 }
1364
1365 /* We store the charsets in hash tables with the names as the key and the
1366    actual charset object as the value.  Occasionally we need to use them
1367    in a list format.  These routines provide us with that. */
1368 struct charset_list_closure
1369 {
1370   Lisp_Object *charset_list;
1371 };
1372
1373 static int
1374 add_charset_to_list_mapper (Lisp_Object key, Lisp_Object value,
1375                             void *charset_list_closure)
1376 {
1377   /* This function can GC */
1378   struct charset_list_closure *chcl =
1379     (struct charset_list_closure*) charset_list_closure;
1380   Lisp_Object *charset_list = chcl->charset_list;
1381
1382   *charset_list = Fcons (key /* XCHARSET_NAME (value) */, *charset_list);
1383   return 0;
1384 }
1385
1386 DEFUN ("charset-list", Fcharset_list, 0, 0, 0, /*
1387 Return a list of the names of all defined charsets.
1388 */
1389        ())
1390 {
1391   Lisp_Object charset_list = Qnil;
1392   struct gcpro gcpro1;
1393   struct charset_list_closure charset_list_closure;
1394
1395   GCPRO1 (charset_list);
1396   charset_list_closure.charset_list = &charset_list;
1397   elisp_maphash (add_charset_to_list_mapper, Vcharset_hash_table,
1398                  &charset_list_closure);
1399   UNGCPRO;
1400
1401   return charset_list;
1402 }
1403
1404 DEFUN ("charset-name", Fcharset_name, 1, 1, 0, /*
1405 Return the name of charset CHARSET.
1406 */
1407        (charset))
1408 {
1409   return XCHARSET_NAME (Fget_charset (charset));
1410 }
1411
1412 /* #### SJT Should generic properties be allowed? */
1413 DEFUN ("make-charset", Fmake_charset, 3, 3, 0, /*
1414 Define a new character set.
1415 This function is for use with Mule support.
1416 NAME is a symbol, the name by which the character set is normally referred.
1417 DOC-STRING is a string describing the character set.
1418 PROPS is a property list, describing the specific nature of the
1419 character set.  Recognized properties are:
1420
1421 'short-name     Short version of the charset name (ex: Latin-1)
1422 'long-name      Long version of the charset name (ex: ISO8859-1 (Latin-1))
1423 'registry       A regular expression matching the font registry field for
1424                 this character set.
1425 'dimension      Number of octets used to index a character in this charset.
1426                 Either 1 or 2.  Defaults to 1.
1427 'columns        Number of columns used to display a character in this charset.
1428                 Only used in TTY mode. (Under X, the actual width of a
1429                 character can be derived from the font used to display the
1430                 characters.) If unspecified, defaults to the dimension
1431                 (this is almost always the correct value).
1432 'chars          Number of characters in each dimension (94 or 96).
1433                 Defaults to 94.  Note that if the dimension is 2, the
1434                 character set thus described is 94x94 or 96x96.
1435 'final          Final byte of ISO 2022 escape sequence.  Must be
1436                 supplied.  Each combination of (DIMENSION, CHARS) defines a
1437                 separate namespace for final bytes.  Note that ISO
1438                 2022 restricts the final byte to the range
1439                 0x30 - 0x7E if dimension == 1, and 0x30 - 0x5F if
1440                 dimension == 2.  Note also that final bytes in the range
1441                 0x30 - 0x3F are reserved for user-defined (not official)
1442                 character sets.
1443 'graphic        0 (use left half of font on output) or 1 (use right half
1444                 of font on output).  Defaults to 0.  For example, for
1445                 a font whose registry is ISO8859-1, the left half
1446                 (octets 0x20 - 0x7F) is the `ascii' character set, while
1447                 the right half (octets 0xA0 - 0xFF) is the `latin-1'
1448                 character set.  With 'graphic set to 0, the octets
1449                 will have their high bit cleared; with it set to 1,
1450                 the octets will have their high bit set.
1451 'direction      'l2r (left-to-right) or 'r2l (right-to-left).
1452                 Defaults to 'l2r.
1453 'ccl-program    A compiled CCL program used to convert a character in
1454                 this charset into an index into the font.  This is in
1455                 addition to the 'graphic property.  The CCL program
1456                 is passed the octets of the character, with the high
1457                 bit cleared and set depending upon whether the value
1458                 of the 'graphic property is 0 or 1.
1459 */
1460        (name, doc_string, props))
1461 {
1462   int id, dimension = 1, chars = 94, graphic = 0, final = 0, columns = -1;
1463   int direction = CHARSET_LEFT_TO_RIGHT;
1464   Lisp_Object registry = Qnil;
1465   Lisp_Object charset;
1466   Lisp_Object ccl_program = Qnil;
1467   Lisp_Object short_name = Qnil, long_name = Qnil;
1468   int byte_offset = -1;
1469
1470   CHECK_SYMBOL (name);
1471   if (!NILP (doc_string))
1472     CHECK_STRING (doc_string);
1473
1474   charset = Ffind_charset (name);
1475   if (!NILP (charset))
1476     signal_simple_error ("Cannot redefine existing charset", name);
1477
1478   {
1479     EXTERNAL_PROPERTY_LIST_LOOP_3 (keyword, value, props)
1480       {
1481         if (EQ (keyword, Qshort_name))
1482           {
1483             CHECK_STRING (value);
1484             short_name = value;
1485           }
1486
1487         if (EQ (keyword, Qlong_name))
1488           {
1489             CHECK_STRING (value);
1490             long_name = value;
1491           }
1492
1493         else if (EQ (keyword, Qdimension))
1494           {
1495             CHECK_INT (value);
1496             dimension = XINT (value);
1497             if (dimension < 1 || dimension > 2)
1498               signal_simple_error ("Invalid value for 'dimension", value);
1499           }
1500
1501         else if (EQ (keyword, Qchars))
1502           {
1503             CHECK_INT (value);
1504             chars = XINT (value);
1505             if (chars != 94 && chars != 96)
1506               signal_simple_error ("Invalid value for 'chars", value);
1507           }
1508
1509         else if (EQ (keyword, Qcolumns))
1510           {
1511             CHECK_INT (value);
1512             columns = XINT (value);
1513             if (columns != 1 && columns != 2)
1514               signal_simple_error ("Invalid value for 'columns", value);
1515           }
1516
1517         else if (EQ (keyword, Qgraphic))
1518           {
1519             CHECK_INT (value);
1520             graphic = XINT (value);
1521 #ifdef UTF2000
1522             if (graphic < 0 || graphic > 2)
1523 #else
1524             if (graphic < 0 || graphic > 1)
1525 #endif
1526               signal_simple_error ("Invalid value for 'graphic", value);
1527           }
1528
1529         else if (EQ (keyword, Qregistry))
1530           {
1531             CHECK_STRING (value);
1532             registry = value;
1533           }
1534
1535         else if (EQ (keyword, Qdirection))
1536           {
1537             if (EQ (value, Ql2r))
1538               direction = CHARSET_LEFT_TO_RIGHT;
1539             else if (EQ (value, Qr2l))
1540               direction = CHARSET_RIGHT_TO_LEFT;
1541             else
1542               signal_simple_error ("Invalid value for 'direction", value);
1543           }
1544
1545         else if (EQ (keyword, Qfinal))
1546           {
1547             CHECK_CHAR_COERCE_INT (value);
1548             final = XCHAR (value);
1549             if (final < '0' || final > '~')
1550               signal_simple_error ("Invalid value for 'final", value);
1551           }
1552
1553         else if (EQ (keyword, Qccl_program))
1554           {
1555             struct ccl_program test_ccl;
1556
1557             if (setup_ccl_program (&test_ccl, value) < 0)
1558               signal_simple_error ("Invalid value for 'ccl-program", value);
1559             ccl_program = value;
1560           }
1561
1562         else
1563           signal_simple_error ("Unrecognized property", keyword);
1564       }
1565   }
1566
1567   if (!final)
1568     error ("'final must be specified");
1569   if (dimension == 2 && final > 0x5F)
1570     signal_simple_error
1571       ("Final must be in the range 0x30 - 0x5F for dimension == 2",
1572        make_char (final));
1573
1574   if (!NILP (CHARSET_BY_ATTRIBUTES (chars, dimension, final,
1575                                     CHARSET_LEFT_TO_RIGHT)) ||
1576       !NILP (CHARSET_BY_ATTRIBUTES (chars, dimension, final,
1577                                     CHARSET_RIGHT_TO_LEFT)))
1578     error
1579       ("Character set already defined for this DIMENSION/CHARS/FINAL combo");
1580
1581   id = get_unallocated_leading_byte (dimension);
1582
1583   if (NILP (doc_string))
1584     doc_string = build_string ("");
1585
1586   if (NILP (registry))
1587     registry = build_string ("");
1588
1589   if (NILP (short_name))
1590     XSETSTRING (short_name, XSYMBOL (name)->name);
1591
1592   if (NILP (long_name))
1593     long_name = doc_string;
1594
1595   if (columns == -1)
1596     columns = dimension;
1597
1598   if (byte_offset < 0)
1599     {
1600       if (chars == 94)
1601         byte_offset = 33;
1602       else if (chars == 96)
1603         byte_offset = 32;
1604       else
1605         byte_offset = 0;
1606     }
1607
1608   charset = make_charset (id, name, chars, dimension, columns, graphic,
1609                           final, direction, short_name, long_name,
1610                           doc_string, registry,
1611                           Qnil, 0, 0, 0, byte_offset);
1612   if (!NILP (ccl_program))
1613     XCHARSET_CCL_PROGRAM (charset) = ccl_program;
1614   return charset;
1615 }
1616
1617 DEFUN ("make-reverse-direction-charset", Fmake_reverse_direction_charset,
1618        2, 2, 0, /*
1619 Make a charset equivalent to CHARSET but which goes in the opposite direction.
1620 NEW-NAME is the name of the new charset.  Return the new charset.
1621 */
1622        (charset, new_name))
1623 {
1624   Lisp_Object new_charset = Qnil;
1625   int id, chars, dimension, columns, graphic, final;
1626   int direction;
1627   Lisp_Object registry, doc_string, short_name, long_name;
1628   Lisp_Charset *cs;
1629
1630   charset = Fget_charset (charset);
1631   if (!NILP (XCHARSET_REVERSE_DIRECTION_CHARSET (charset)))
1632     signal_simple_error ("Charset already has reverse-direction charset",
1633                          charset);
1634
1635   CHECK_SYMBOL (new_name);
1636   if (!NILP (Ffind_charset (new_name)))
1637     signal_simple_error ("Cannot redefine existing charset", new_name);
1638
1639   cs = XCHARSET (charset);
1640
1641   chars     = CHARSET_CHARS     (cs);
1642   dimension = CHARSET_DIMENSION (cs);
1643   columns   = CHARSET_COLUMNS   (cs);
1644   id = get_unallocated_leading_byte (dimension);
1645
1646   graphic = CHARSET_GRAPHIC (cs);
1647   final = CHARSET_FINAL (cs);
1648   direction = CHARSET_RIGHT_TO_LEFT;
1649   if (CHARSET_DIRECTION (cs) == CHARSET_RIGHT_TO_LEFT)
1650     direction = CHARSET_LEFT_TO_RIGHT;
1651   doc_string = CHARSET_DOC_STRING (cs);
1652   short_name = CHARSET_SHORT_NAME (cs);
1653   long_name = CHARSET_LONG_NAME (cs);
1654   registry = CHARSET_REGISTRY (cs);
1655
1656   new_charset = make_charset (id, new_name, chars, dimension, columns,
1657                               graphic, final, direction, short_name, long_name,
1658                               doc_string, registry,
1659 #ifdef UTF2000
1660                               CHARSET_DECODING_TABLE(cs),
1661                               CHARSET_UCS_MIN(cs),
1662                               CHARSET_UCS_MAX(cs),
1663                               CHARSET_CODE_OFFSET(cs),
1664                               CHARSET_BYTE_OFFSET(cs)
1665 #else
1666                               Qnil, 0, 0, 0, 0
1667 #endif
1668 );
1669
1670   CHARSET_REVERSE_DIRECTION_CHARSET (cs) = new_charset;
1671   XCHARSET_REVERSE_DIRECTION_CHARSET (new_charset) = charset;
1672
1673   return new_charset;
1674 }
1675
1676 DEFUN ("define-charset-alias", Fdefine_charset_alias, 2, 2, 0, /*
1677 Define symbol ALIAS as an alias for CHARSET.
1678 */
1679        (alias, charset))
1680 {
1681   CHECK_SYMBOL (alias);
1682   charset = Fget_charset (charset);
1683   return Fputhash (alias, charset, Vcharset_hash_table);
1684 }
1685
1686 /* #### Reverse direction charsets not yet implemented.  */
1687 #if 0
1688 DEFUN ("charset-reverse-direction-charset", Fcharset_reverse_direction_charset,
1689        1, 1, 0, /*
1690 Return the reverse-direction charset parallel to CHARSET, if any.
1691 This is the charset with the same properties (in particular, the same
1692 dimension, number of characters per dimension, and final byte) as
1693 CHARSET but whose characters are displayed in the opposite direction.
1694 */
1695        (charset))
1696 {
1697   charset = Fget_charset (charset);
1698   return XCHARSET_REVERSE_DIRECTION_CHARSET (charset);
1699 }
1700 #endif
1701
1702 DEFUN ("charset-from-attributes", Fcharset_from_attributes, 3, 4, 0, /*
1703 Return a charset with the given DIMENSION, CHARS, FINAL, and DIRECTION.
1704 If DIRECTION is omitted, both directions will be checked (left-to-right
1705 will be returned if character sets exist for both directions).
1706 */
1707        (dimension, chars, final, direction))
1708 {
1709   int dm, ch, fi, di = -1;
1710   Lisp_Object obj = Qnil;
1711
1712   CHECK_INT (dimension);
1713   dm = XINT (dimension);
1714   if (dm < 1 || dm > 2)
1715     signal_simple_error ("Invalid value for DIMENSION", dimension);
1716
1717   CHECK_INT (chars);
1718   ch = XINT (chars);
1719   if (ch != 94 && ch != 96)
1720     signal_simple_error ("Invalid value for CHARS", chars);
1721
1722   CHECK_CHAR_COERCE_INT (final);
1723   fi = XCHAR (final);
1724   if (fi < '0' || fi > '~')
1725     signal_simple_error ("Invalid value for FINAL", final);
1726
1727   if (EQ (direction, Ql2r))
1728     di = CHARSET_LEFT_TO_RIGHT;
1729   else if (EQ (direction, Qr2l))
1730     di = CHARSET_RIGHT_TO_LEFT;
1731   else if (!NILP (direction))
1732     signal_simple_error ("Invalid value for DIRECTION", direction);
1733
1734   if (dm == 2 && fi > 0x5F)
1735     signal_simple_error
1736       ("Final must be in the range 0x30 - 0x5F for dimension == 2", final);
1737
1738     if (di == -1)
1739     {
1740       obj = CHARSET_BY_ATTRIBUTES (ch, dm, fi, CHARSET_LEFT_TO_RIGHT);
1741       if (NILP (obj))
1742         obj = CHARSET_BY_ATTRIBUTES (ch, dm, fi, CHARSET_RIGHT_TO_LEFT);
1743     }
1744   else
1745     obj = CHARSET_BY_ATTRIBUTES (ch, dm, fi, di);
1746
1747   if (CHARSETP (obj))
1748     return XCHARSET_NAME (obj);
1749   return obj;
1750 }
1751
1752 DEFUN ("charset-short-name", Fcharset_short_name, 1, 1, 0, /*
1753 Return short name of CHARSET.
1754 */
1755        (charset))
1756 {
1757   return XCHARSET_SHORT_NAME (Fget_charset (charset));
1758 }
1759
1760 DEFUN ("charset-long-name", Fcharset_long_name, 1, 1, 0, /*
1761 Return long name of CHARSET.
1762 */
1763        (charset))
1764 {
1765   return XCHARSET_LONG_NAME (Fget_charset (charset));
1766 }
1767
1768 DEFUN ("charset-description", Fcharset_description, 1, 1, 0, /*
1769 Return description of CHARSET.
1770 */
1771        (charset))
1772 {
1773   return XCHARSET_DOC_STRING (Fget_charset (charset));
1774 }
1775
1776 DEFUN ("charset-dimension", Fcharset_dimension, 1, 1, 0, /*
1777 Return dimension of CHARSET.
1778 */
1779        (charset))
1780 {
1781   return make_int (XCHARSET_DIMENSION (Fget_charset (charset)));
1782 }
1783
1784 DEFUN ("charset-property", Fcharset_property, 2, 2, 0, /*
1785 Return property PROP of CHARSET, a charset object or symbol naming a charset.
1786 Recognized properties are those listed in `make-charset', as well as
1787 'name and 'doc-string.
1788 */
1789        (charset, prop))
1790 {
1791   Lisp_Charset *cs;
1792
1793   charset = Fget_charset (charset);
1794   cs = XCHARSET (charset);
1795
1796   CHECK_SYMBOL (prop);
1797   if (EQ (prop, Qname))        return CHARSET_NAME (cs);
1798   if (EQ (prop, Qshort_name))  return CHARSET_SHORT_NAME (cs);
1799   if (EQ (prop, Qlong_name))   return CHARSET_LONG_NAME (cs);
1800   if (EQ (prop, Qdoc_string))  return CHARSET_DOC_STRING (cs);
1801   if (EQ (prop, Qdimension))   return make_int (CHARSET_DIMENSION (cs));
1802   if (EQ (prop, Qcolumns))     return make_int (CHARSET_COLUMNS (cs));
1803   if (EQ (prop, Qgraphic))     return make_int (CHARSET_GRAPHIC (cs));
1804   if (EQ (prop, Qfinal))       return make_char (CHARSET_FINAL (cs));
1805   if (EQ (prop, Qchars))       return make_int (CHARSET_CHARS (cs));
1806   if (EQ (prop, Qregistry))    return CHARSET_REGISTRY (cs);
1807   if (EQ (prop, Qccl_program)) return CHARSET_CCL_PROGRAM (cs);
1808   if (EQ (prop, Qdirection))
1809     return CHARSET_DIRECTION (cs) == CHARSET_LEFT_TO_RIGHT ? Ql2r : Qr2l;
1810   if (EQ (prop, Qreverse_direction_charset))
1811     {
1812       Lisp_Object obj = CHARSET_REVERSE_DIRECTION_CHARSET (cs);
1813       /* #### Is this translation OK?  If so, error checking sufficient? */
1814       return CHARSETP (obj) ? XCHARSET_NAME (obj) : obj;
1815     }
1816   signal_simple_error ("Unrecognized charset property name", prop);
1817   return Qnil; /* not reached */
1818 }
1819
1820 DEFUN ("charset-id", Fcharset_id, 1, 1, 0, /*
1821 Return charset identification number of CHARSET.
1822 */
1823         (charset))
1824 {
1825   return make_int(XCHARSET_LEADING_BYTE (Fget_charset (charset)));
1826 }
1827
1828 /* #### We need to figure out which properties we really want to
1829    allow to be set. */
1830
1831 DEFUN ("set-charset-ccl-program", Fset_charset_ccl_program, 2, 2, 0, /*
1832 Set the 'ccl-program property of CHARSET to CCL-PROGRAM.
1833 */
1834        (charset, ccl_program))
1835 {
1836   struct ccl_program test_ccl;
1837
1838   charset = Fget_charset (charset);
1839   if (setup_ccl_program (&test_ccl, ccl_program) < 0)
1840     signal_simple_error ("Invalid ccl-program", ccl_program);
1841   XCHARSET_CCL_PROGRAM (charset) = ccl_program;
1842   return Qnil;
1843 }
1844
1845 static void
1846 invalidate_charset_font_caches (Lisp_Object charset)
1847 {
1848   /* Invalidate font cache entries for charset on all devices. */
1849   Lisp_Object devcons, concons, hash_table;
1850   DEVICE_LOOP_NO_BREAK (devcons, concons)
1851     {
1852       struct device *d = XDEVICE (XCAR (devcons));
1853       hash_table = Fgethash (charset, d->charset_font_cache, Qunbound);
1854       if (!UNBOUNDP (hash_table))
1855         Fclrhash (hash_table);
1856     }
1857 }
1858
1859 DEFUN ("set-charset-registry", Fset_charset_registry, 2, 2, 0, /*
1860 Set the 'registry property of CHARSET to REGISTRY.
1861 */
1862        (charset, registry))
1863 {
1864   charset = Fget_charset (charset);
1865   CHECK_STRING (registry);
1866   XCHARSET_REGISTRY (charset) = registry;
1867   invalidate_charset_font_caches (charset);
1868   face_property_was_changed (Vdefault_face, Qfont, Qglobal);
1869   return Qnil;
1870 }
1871
1872 #ifdef UTF2000
1873 DEFUN ("charset-mapping-table", Fcharset_mapping_table, 1, 1, 0, /*
1874 Return mapping-table of CHARSET.
1875 */
1876        (charset))
1877 {
1878   return XCHARSET_DECODING_TABLE (Fget_charset (charset));
1879 }
1880
1881 DEFUN ("set-charset-mapping-table", Fset_charset_mapping_table, 2, 2, 0, /*
1882 Set mapping-table of CHARSET to TABLE.
1883 */
1884        (charset, table))
1885 {
1886   struct Lisp_Charset *cs;
1887   size_t i;
1888   int byte_offset;
1889
1890   charset = Fget_charset (charset);
1891   cs = XCHARSET (charset);
1892
1893   if (NILP (table))
1894     {
1895       if (VECTORP (CHARSET_DECODING_TABLE(cs)))
1896         make_vector_newer (CHARSET_DECODING_TABLE(cs));
1897       CHARSET_DECODING_TABLE(cs) = Qnil;
1898       return table;
1899     }
1900   else if (VECTORP (table))
1901     {
1902       int ccs_len = CHARSET_BYTE_SIZE (cs);
1903       int ret = decoding_table_check_elements (table,
1904                                                CHARSET_DIMENSION (cs),
1905                                                ccs_len);
1906       if (ret)
1907         {
1908           if (ret == -1)
1909             signal_simple_error ("Too big table", table);
1910           else if (ret == -2)
1911             signal_simple_error ("Invalid element is found", table);
1912           else
1913             signal_simple_error ("Something wrong", table);
1914         }
1915       CHARSET_DECODING_TABLE(cs) = Qnil;
1916     }
1917   else
1918     signal_error (Qwrong_type_argument,
1919                   list2 (build_translated_string ("vector-or-nil-p"),
1920                          table));
1921
1922   byte_offset = CHARSET_BYTE_OFFSET (cs);
1923   switch (CHARSET_DIMENSION (cs))
1924     {
1925     case 1:
1926       for (i = 0; i < XVECTOR_LENGTH (table); i++)
1927         {
1928           Lisp_Object c = XVECTOR_DATA(table)[i];
1929
1930           if (CHARP (c))
1931             put_char_ccs_code_point (c, charset,
1932                                      make_int (i + byte_offset));
1933         }
1934       break;
1935     case 2:
1936       for (i = 0; i < XVECTOR_LENGTH (table); i++)
1937         {
1938           Lisp_Object v = XVECTOR_DATA(table)[i];
1939
1940           if (VECTORP (v))
1941             {
1942               size_t j;
1943
1944               for (j = 0; j < XVECTOR_LENGTH (v); j++)
1945                 {
1946                   Lisp_Object c = XVECTOR_DATA(v)[j];
1947
1948                   if (CHARP (c))
1949                     put_char_ccs_code_point
1950                       (c, charset,
1951                        make_int ( ( (i + byte_offset) << 8 )
1952                                   | (j + byte_offset)
1953                                   ) );
1954                 }
1955             }
1956           else if (CHARP (v))
1957             put_char_ccs_code_point (v, charset,
1958                                      make_int (i + byte_offset));
1959         }
1960       break;
1961     }
1962   return table;
1963 }
1964 #endif
1965
1966 \f
1967 /************************************************************************/
1968 /*              Lisp primitives for working with characters             */
1969 /************************************************************************/
1970
1971 #ifdef UTF2000
1972 DEFUN ("decode-char", Fdecode_char, 2, 2, 0, /*
1973 Make a character from CHARSET and code-point CODE.
1974 */
1975        (charset, code))
1976 {
1977   int c;
1978
1979   charset = Fget_charset (charset);
1980   CHECK_INT (code);
1981   c = XINT (code);
1982   if (XCHARSET_GRAPHIC (charset) == 1)
1983     c &= 0x7F7F7F7F;
1984   c = DECODE_CHAR (charset, c);
1985   return c >= 0 ? make_char (c) : Qnil;
1986 }
1987
1988 DEFUN ("decode-builtin-char", Fdecode_builtin_char, 2, 2, 0, /*
1989 Make a builtin character from CHARSET and code-point CODE.
1990 */
1991        (charset, code))
1992 {
1993   int c;
1994
1995   charset = Fget_charset (charset);
1996   CHECK_INT (code);
1997   if (EQ (charset, Vcharset_latin_viscii))
1998     {
1999       Lisp_Object chr = Fdecode_char (charset, code);
2000       Lisp_Object ret;
2001
2002       if (!NILP (chr))
2003         {
2004           if (!NILP
2005               (ret = Fget_char_attribute (chr,
2006                                           Vcharset_latin_viscii_lower,
2007                                           Qnil)))
2008             {
2009               charset = Vcharset_latin_viscii_lower;
2010               code = ret;
2011             }
2012           else if (!NILP
2013                    (ret = Fget_char_attribute (chr,
2014                                                Vcharset_latin_viscii_upper,
2015                                                Qnil)))
2016             {
2017               charset = Vcharset_latin_viscii_upper;
2018               code = ret;
2019             }
2020         }
2021     }
2022   c = XINT (code);
2023 #if 0
2024   if (XCHARSET_GRAPHIC (charset) == 1)
2025     c &= 0x7F7F7F7F;
2026 #endif
2027   c = decode_builtin_char (charset, c);
2028   return c >= 0 ? make_char (c) : Fdecode_char (charset, code);
2029 }
2030 #endif
2031
2032 DEFUN ("make-char", Fmake_char, 2, 3, 0, /*
2033 Make a character from CHARSET and octets ARG1 and ARG2.
2034 ARG2 is required only for characters from two-dimensional charsets.
2035 For example, (make-char 'latin-iso8859-2 185) will return the Latin 2
2036 character s with caron.
2037 */
2038        (charset, arg1, arg2))
2039 {
2040   Lisp_Charset *cs;
2041   int a1, a2;
2042   int lowlim, highlim;
2043
2044   charset = Fget_charset (charset);
2045   cs = XCHARSET (charset);
2046
2047   if      (EQ (charset, Vcharset_ascii))     lowlim =  0, highlim = 127;
2048   else if (EQ (charset, Vcharset_control_1)) lowlim =  0, highlim =  31;
2049 #ifdef UTF2000
2050   else if (CHARSET_CHARS (cs) == 256)        lowlim =  0, highlim = 255;
2051 #endif
2052   else if (CHARSET_CHARS (cs) == 94)         lowlim = 33, highlim = 126;
2053   else  /* CHARSET_CHARS (cs) == 96) */      lowlim = 32, highlim = 127;
2054
2055   CHECK_INT (arg1);
2056   /* It is useful (and safe, according to Olivier Galibert) to strip
2057      the 8th bit off ARG1 and ARG2 because it allows programmers to
2058      write (make-char 'latin-iso8859-2 CODE) where code is the actual
2059      Latin 2 code of the character.  */
2060 #ifdef UTF2000
2061   a1 = XINT (arg1);
2062   if (highlim < 128)
2063     a1 &= 0x7f;
2064 #else
2065   a1 = XINT (arg1);
2066 #endif
2067   if (a1 < lowlim || a1 > highlim)
2068     args_out_of_range_3 (arg1, make_int (lowlim), make_int (highlim));
2069
2070   if (CHARSET_DIMENSION (cs) == 1)
2071     {
2072       if (!NILP (arg2))
2073         signal_simple_error
2074           ("Charset is of dimension one; second octet must be nil", arg2);
2075       return make_char (MAKE_CHAR (charset, a1, 0));
2076     }
2077
2078   CHECK_INT (arg2);
2079 #ifdef UTF2000
2080   a2 = XINT (arg2);
2081   if (highlim < 128)
2082     a2 &= 0x7f;
2083 #else
2084   a2 = XINT (arg2) & 0x7f;
2085 #endif
2086   if (a2 < lowlim || a2 > highlim)
2087     args_out_of_range_3 (arg2, make_int (lowlim), make_int (highlim));
2088
2089   return make_char (MAKE_CHAR (charset, a1, a2));
2090 }
2091
2092 DEFUN ("char-charset", Fchar_charset, 1, 1, 0, /*
2093 Return the character set of CHARACTER.
2094 */
2095        (character))
2096 {
2097   CHECK_CHAR_COERCE_INT (character);
2098
2099   return XCHARSET_NAME (CHAR_CHARSET (XCHAR (character)));
2100 }
2101
2102 DEFUN ("char-octet", Fchar_octet, 1, 2, 0, /*
2103 Return the octet numbered N (should be 0 or 1) of CHARACTER.
2104 N defaults to 0 if omitted.
2105 */
2106        (character, n))
2107 {
2108   Lisp_Object charset;
2109   int octet0, octet1;
2110
2111   CHECK_CHAR_COERCE_INT (character);
2112
2113   BREAKUP_CHAR (XCHAR (character), charset, octet0, octet1);
2114
2115   if (NILP (n) || EQ (n, Qzero))
2116     return make_int (octet0);
2117   else if (EQ (n, make_int (1)))
2118     return make_int (octet1);
2119   else
2120     signal_simple_error ("Octet number must be 0 or 1", n);
2121 }
2122
2123 DEFUN ("split-char", Fsplit_char, 1, 1, 0, /*
2124 Return list of charset and one or two position-codes of CHARACTER.
2125 */
2126        (character))
2127 {
2128   /* This function can GC */
2129   struct gcpro gcpro1, gcpro2;
2130   Lisp_Object charset = Qnil;
2131   Lisp_Object rc = Qnil;
2132 #ifdef UTF2000
2133   int code_point;
2134   int dimension;
2135 #else
2136   int c1, c2;
2137 #endif
2138
2139   GCPRO2 (charset, rc);
2140   CHECK_CHAR_COERCE_INT (character);
2141
2142 #ifdef UTF2000
2143   code_point = ENCODE_CHAR (XCHAR (character), charset);
2144   dimension = XCHARSET_DIMENSION (charset);
2145   while (dimension > 0)
2146     {
2147       rc = Fcons (make_int (code_point & 255), rc);
2148       code_point >>= 8;
2149       dimension--;
2150     }
2151   rc = Fcons (XCHARSET_NAME (charset), rc);
2152 #else
2153   BREAKUP_CHAR (XCHAR (character), charset, c1, c2);
2154
2155   if (XCHARSET_DIMENSION (Fget_charset (charset)) == 2)
2156     {
2157       rc = list3 (XCHARSET_NAME (charset), make_int (c1), make_int (c2));
2158     }
2159   else
2160     {
2161       rc = list2 (XCHARSET_NAME (charset), make_int (c1));
2162     }
2163 #endif
2164   UNGCPRO;
2165
2166   return rc;
2167 }
2168
2169 \f
2170 #ifdef ENABLE_COMPOSITE_CHARS
2171 /************************************************************************/
2172 /*                     composite character functions                    */
2173 /************************************************************************/
2174
2175 Emchar
2176 lookup_composite_char (Bufbyte *str, int len)
2177 {
2178   Lisp_Object lispstr = make_string (str, len);
2179   Lisp_Object ch = Fgethash (lispstr,
2180                              Vcomposite_char_string2char_hash_table,
2181                              Qunbound);
2182   Emchar emch;
2183
2184   if (UNBOUNDP (ch))
2185     {
2186       if (composite_char_row_next >= 128)
2187         signal_simple_error ("No more composite chars available", lispstr);
2188       emch = MAKE_CHAR (Vcharset_composite, composite_char_row_next,
2189                         composite_char_col_next);
2190       Fputhash (make_char (emch), lispstr,
2191                 Vcomposite_char_char2string_hash_table);
2192       Fputhash (lispstr, make_char (emch),
2193                 Vcomposite_char_string2char_hash_table);
2194       composite_char_col_next++;
2195       if (composite_char_col_next >= 128)
2196         {
2197           composite_char_col_next = 32;
2198           composite_char_row_next++;
2199         }
2200     }
2201   else
2202     emch = XCHAR (ch);
2203   return emch;
2204 }
2205
2206 Lisp_Object
2207 composite_char_string (Emchar ch)
2208 {
2209   Lisp_Object str = Fgethash (make_char (ch),
2210                               Vcomposite_char_char2string_hash_table,
2211                               Qunbound);
2212   assert (!UNBOUNDP (str));
2213   return str;
2214 }
2215
2216 xxDEFUN ("make-composite-char", Fmake_composite_char, 1, 1, 0, /*
2217 Convert a string into a single composite character.
2218 The character is the result of overstriking all the characters in
2219 the string.
2220 */
2221        (string))
2222 {
2223   CHECK_STRING (string);
2224   return make_char (lookup_composite_char (XSTRING_DATA (string),
2225                                            XSTRING_LENGTH (string)));
2226 }
2227
2228 xxDEFUN ("composite-char-string", Fcomposite_char_string, 1, 1, 0, /*
2229 Return a string of the characters comprising a composite character.
2230 */
2231        (ch))
2232 {
2233   Emchar emch;
2234
2235   CHECK_CHAR (ch);
2236   emch = XCHAR (ch);
2237   if (CHAR_LEADING_BYTE (emch) != LEADING_BYTE_COMPOSITE)
2238     signal_simple_error ("Must be composite char", ch);
2239   return composite_char_string (emch);
2240 }
2241 #endif /* ENABLE_COMPOSITE_CHARS */
2242
2243 \f
2244 /************************************************************************/
2245 /*                            initialization                            */
2246 /************************************************************************/
2247
2248 void
2249 syms_of_mule_charset (void)
2250 {
2251   INIT_LRECORD_IMPLEMENTATION (charset);
2252
2253   DEFSUBR (Fcharsetp);
2254   DEFSUBR (Ffind_charset);
2255   DEFSUBR (Fget_charset);
2256   DEFSUBR (Fcharset_list);
2257   DEFSUBR (Fcharset_name);
2258   DEFSUBR (Fmake_charset);
2259   DEFSUBR (Fmake_reverse_direction_charset);
2260   /*  DEFSUBR (Freverse_direction_charset); */
2261   DEFSUBR (Fdefine_charset_alias);
2262   DEFSUBR (Fcharset_from_attributes);
2263   DEFSUBR (Fcharset_short_name);
2264   DEFSUBR (Fcharset_long_name);
2265   DEFSUBR (Fcharset_description);
2266   DEFSUBR (Fcharset_dimension);
2267   DEFSUBR (Fcharset_property);
2268   DEFSUBR (Fcharset_id);
2269   DEFSUBR (Fset_charset_ccl_program);
2270   DEFSUBR (Fset_charset_registry);
2271 #ifdef UTF2000
2272   DEFSUBR (Fcharset_mapping_table);
2273   DEFSUBR (Fset_charset_mapping_table);
2274 #endif
2275
2276 #ifdef UTF2000
2277   DEFSUBR (Fdecode_char);
2278   DEFSUBR (Fdecode_builtin_char);
2279 #endif
2280   DEFSUBR (Fmake_char);
2281   DEFSUBR (Fchar_charset);
2282   DEFSUBR (Fchar_octet);
2283   DEFSUBR (Fsplit_char);
2284
2285 #ifdef ENABLE_COMPOSITE_CHARS
2286   DEFSUBR (Fmake_composite_char);
2287   DEFSUBR (Fcomposite_char_string);
2288 #endif
2289
2290   defsymbol (&Qcharsetp, "charsetp");
2291   defsymbol (&Qregistry, "registry");
2292   defsymbol (&Qfinal, "final");
2293   defsymbol (&Qgraphic, "graphic");
2294   defsymbol (&Qdirection, "direction");
2295   defsymbol (&Qreverse_direction_charset, "reverse-direction-charset");
2296   defsymbol (&Qshort_name, "short-name");
2297   defsymbol (&Qlong_name, "long-name");
2298
2299   defsymbol (&Ql2r, "l2r");
2300   defsymbol (&Qr2l, "r2l");
2301
2302   /* Charsets, compatible with FSF 20.3
2303      Naming convention is Script-Charset[-Edition] */
2304   defsymbol (&Qascii,                   "ascii");
2305   defsymbol (&Qcontrol_1,               "control-1");
2306   defsymbol (&Qlatin_iso8859_1,         "latin-iso8859-1");
2307   defsymbol (&Qlatin_iso8859_2,         "latin-iso8859-2");
2308   defsymbol (&Qlatin_iso8859_3,         "latin-iso8859-3");
2309   defsymbol (&Qlatin_iso8859_4,         "latin-iso8859-4");
2310   defsymbol (&Qthai_tis620,             "thai-tis620");
2311   defsymbol (&Qgreek_iso8859_7,         "greek-iso8859-7");
2312   defsymbol (&Qarabic_iso8859_6,        "arabic-iso8859-6");
2313   defsymbol (&Qhebrew_iso8859_8,        "hebrew-iso8859-8");
2314   defsymbol (&Qkatakana_jisx0201,       "katakana-jisx0201");
2315   defsymbol (&Qlatin_jisx0201,          "latin-jisx0201");
2316   defsymbol (&Qcyrillic_iso8859_5,      "cyrillic-iso8859-5");
2317   defsymbol (&Qlatin_iso8859_9,         "latin-iso8859-9");
2318   defsymbol (&Qjapanese_jisx0208_1978,  "japanese-jisx0208-1978");
2319   defsymbol (&Qchinese_gb2312,          "chinese-gb2312");
2320   defsymbol (&Qchinese_gb12345,         "chinese-gb12345");
2321   defsymbol (&Qjapanese_jisx0208,       "japanese-jisx0208");
2322   defsymbol (&Qjapanese_jisx0208_1990,  "japanese-jisx0208-1990");
2323   defsymbol (&Qkorean_ksc5601,          "korean-ksc5601");
2324   defsymbol (&Qjapanese_jisx0212,       "japanese-jisx0212");
2325   defsymbol (&Qchinese_cns11643_1,      "chinese-cns11643-1");
2326   defsymbol (&Qchinese_cns11643_2,      "chinese-cns11643-2");
2327 #ifdef UTF2000
2328   defsymbol (&Qucs,                     "ucs");
2329   defsymbol (&Qucs_bmp,                 "ucs-bmp");
2330   defsymbol (&Qucs_cns,                 "ucs-cns");
2331   defsymbol (&Qucs_jis,                 "ucs-jis");
2332   defsymbol (&Qucs_big5,                "ucs-big5");
2333   defsymbol (&Qlatin_viscii,            "latin-viscii");
2334   defsymbol (&Qlatin_tcvn5712,          "latin-tcvn5712");
2335   defsymbol (&Qlatin_viscii_lower,      "latin-viscii-lower");
2336   defsymbol (&Qlatin_viscii_upper,      "latin-viscii-upper");
2337   defsymbol (&Qvietnamese_viscii_lower, "vietnamese-viscii-lower");
2338   defsymbol (&Qvietnamese_viscii_upper, "vietnamese-viscii-upper");
2339   defsymbol (&Qideograph_gt,            "ideograph-gt");
2340   defsymbol (&Qideograph_gt_pj_1,       "ideograph-gt-pj-1");
2341   defsymbol (&Qideograph_gt_pj_2,       "ideograph-gt-pj-2");
2342   defsymbol (&Qideograph_gt_pj_3,       "ideograph-gt-pj-3");
2343   defsymbol (&Qideograph_gt_pj_4,       "ideograph-gt-pj-4");
2344   defsymbol (&Qideograph_gt_pj_5,       "ideograph-gt-pj-5");
2345   defsymbol (&Qideograph_gt_pj_6,       "ideograph-gt-pj-6");
2346   defsymbol (&Qideograph_gt_pj_7,       "ideograph-gt-pj-7");
2347   defsymbol (&Qideograph_gt_pj_8,       "ideograph-gt-pj-8");
2348   defsymbol (&Qideograph_gt_pj_9,       "ideograph-gt-pj-9");
2349   defsymbol (&Qideograph_gt_pj_10,      "ideograph-gt-pj-10");
2350   defsymbol (&Qideograph_gt_pj_11,      "ideograph-gt-pj-11");
2351   defsymbol (&Qideograph_daikanwa,      "ideograph-daikanwa");
2352   defsymbol (&Qchinese_big5,            "chinese-big5");
2353   defsymbol (&Qchinese_big5_cdp,        "chinese-big5-cdp");
2354   defsymbol (&Qmojikyo,                 "mojikyo");
2355   defsymbol (&Qmojikyo_2022_1,          "mojikyo-2022-1");
2356   defsymbol (&Qmojikyo_pj_1,            "mojikyo-pj-1");
2357   defsymbol (&Qmojikyo_pj_2,            "mojikyo-pj-2");
2358   defsymbol (&Qmojikyo_pj_3,            "mojikyo-pj-3");
2359   defsymbol (&Qmojikyo_pj_4,            "mojikyo-pj-4");
2360   defsymbol (&Qmojikyo_pj_5,            "mojikyo-pj-5");
2361   defsymbol (&Qmojikyo_pj_6,            "mojikyo-pj-6");
2362   defsymbol (&Qmojikyo_pj_7,            "mojikyo-pj-7");
2363   defsymbol (&Qmojikyo_pj_8,            "mojikyo-pj-8");
2364   defsymbol (&Qmojikyo_pj_9,            "mojikyo-pj-9");
2365   defsymbol (&Qmojikyo_pj_10,           "mojikyo-pj-10");
2366   defsymbol (&Qmojikyo_pj_11,           "mojikyo-pj-11");
2367   defsymbol (&Qmojikyo_pj_12,           "mojikyo-pj-12");
2368   defsymbol (&Qmojikyo_pj_13,           "mojikyo-pj-13");
2369   defsymbol (&Qmojikyo_pj_14,           "mojikyo-pj-14");
2370   defsymbol (&Qmojikyo_pj_15,           "mojikyo-pj-15");
2371   defsymbol (&Qmojikyo_pj_16,           "mojikyo-pj-16");
2372   defsymbol (&Qmojikyo_pj_17,           "mojikyo-pj-17");
2373   defsymbol (&Qmojikyo_pj_18,           "mojikyo-pj-18");
2374   defsymbol (&Qmojikyo_pj_19,           "mojikyo-pj-19");
2375   defsymbol (&Qmojikyo_pj_20,           "mojikyo-pj-20");
2376   defsymbol (&Qmojikyo_pj_21,           "mojikyo-pj-21");
2377   defsymbol (&Qethiopic_ucs,            "ethiopic-ucs");
2378 #endif
2379   defsymbol (&Qchinese_big5_1,          "chinese-big5-1");
2380   defsymbol (&Qchinese_big5_2,          "chinese-big5-2");
2381
2382   defsymbol (&Qcomposite,               "composite");
2383 }
2384
2385 void
2386 vars_of_mule_charset (void)
2387 {
2388   int i, j;
2389 #ifndef UTF2000
2390   int k;
2391 #endif
2392
2393   chlook = xnew_and_zero (struct charset_lookup); /* zero for Purify. */
2394   dump_add_root_struct_ptr (&chlook, &charset_lookup_description);
2395
2396   /* Table of charsets indexed by leading byte. */
2397   for (i = 0; i < countof (chlook->charset_by_leading_byte); i++)
2398     chlook->charset_by_leading_byte[i] = Qnil;
2399
2400 #ifdef UTF2000
2401   /* Table of charsets indexed by type/final-byte. */
2402   for (i = 0; i < countof (chlook->charset_by_attributes); i++)
2403     for (j = 0; j < countof (chlook->charset_by_attributes[0]); j++)
2404       chlook->charset_by_attributes[i][j] = Qnil;
2405 #else
2406   /* Table of charsets indexed by type/final-byte/direction. */
2407   for (i = 0; i < countof (chlook->charset_by_attributes); i++)
2408     for (j = 0; j < countof (chlook->charset_by_attributes[0]); j++)
2409       for (k = 0; k < countof (chlook->charset_by_attributes[0][0]); k++)
2410         chlook->charset_by_attributes[i][j][k] = Qnil;
2411 #endif
2412
2413 #ifdef UTF2000
2414   chlook->next_allocated_leading_byte = MIN_LEADING_BYTE_PRIVATE;
2415 #else
2416   chlook->next_allocated_1_byte_leading_byte = MIN_LEADING_BYTE_PRIVATE_1;
2417   chlook->next_allocated_2_byte_leading_byte = MIN_LEADING_BYTE_PRIVATE_2;
2418 #endif
2419
2420 #ifndef UTF2000
2421   leading_code_private_11 = PRE_LEADING_BYTE_PRIVATE_1;
2422   DEFVAR_INT ("leading-code-private-11", &leading_code_private_11 /*
2423 Leading-code of private TYPE9N charset of column-width 1.
2424 */ );
2425   leading_code_private_11 = PRE_LEADING_BYTE_PRIVATE_1;
2426 #endif
2427
2428 #ifdef UTF2000
2429   Vdefault_coded_charset_priority_list = Qnil;
2430   DEFVAR_LISP ("default-coded-charset-priority-list",
2431                &Vdefault_coded_charset_priority_list /*
2432 Default order of preferred coded-character-sets.
2433 */ );
2434 #endif
2435 }
2436
2437 void
2438 complex_vars_of_mule_charset (void)
2439 {
2440   staticpro (&Vcharset_hash_table);
2441   Vcharset_hash_table =
2442     make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
2443
2444   /* Predefined character sets.  We store them into variables for
2445      ease of access. */
2446
2447 #ifdef UTF2000
2448   staticpro (&Vcharset_ucs);
2449   Vcharset_ucs =
2450     make_charset (LEADING_BYTE_UCS, Qucs, 256, 4,
2451                   1, 2, 0, CHARSET_LEFT_TO_RIGHT,
2452                   build_string ("UCS"),
2453                   build_string ("UCS"),
2454                   build_string ("ISO/IEC 10646"),
2455                   build_string (""),
2456                   Qnil, 0, 0xFFFFFFF, 0, 0);
2457   staticpro (&Vcharset_ucs_bmp);
2458   Vcharset_ucs_bmp =
2459     make_charset (LEADING_BYTE_UCS_BMP, Qucs_bmp, 256, 2,
2460                   1, 2, 0, CHARSET_LEFT_TO_RIGHT,
2461                   build_string ("BMP"),
2462                   build_string ("BMP"),
2463                   build_string ("ISO/IEC 10646 Group 0 Plane 0 (BMP)"),
2464                   build_string ("\\(ISO10646.*-1\\|UNICODE[23]?-0\\)"),
2465                   Qnil, 0, 0xFFFF, 0, 0);
2466   staticpro (&Vcharset_ucs_cns);
2467   Vcharset_ucs_cns =
2468     make_charset (LEADING_BYTE_UCS_CNS, Qucs_cns, 256, 3,
2469                   1, 2, 0, CHARSET_LEFT_TO_RIGHT,
2470                   build_string ("UCS for CNS"),
2471                   build_string ("UCS for CNS 11643"),
2472                   build_string ("ISO/IEC 10646 for CNS 11643"),
2473                   build_string (""),
2474                   Qnil, 0, 0, 0, 0);
2475   staticpro (&Vcharset_ucs_jis);
2476   Vcharset_ucs_jis =
2477     make_charset (LEADING_BYTE_UCS_JIS, Qucs_jis, 256, 3,
2478                   1, 2, 0, CHARSET_LEFT_TO_RIGHT,
2479                   build_string ("UCS for JIS"),
2480                   build_string ("UCS for JIS X 0208, 0212 and 0213"),
2481                   build_string ("ISO/IEC 10646 for JIS X 0208, 0212 and 0213"),
2482                   build_string (""),
2483                   Qnil, 0, 0, 0, 0);
2484   staticpro (&Vcharset_ucs_big5);
2485   Vcharset_ucs_big5 =
2486     make_charset (LEADING_BYTE_UCS_BIG5, Qucs_big5, 256, 3,
2487                   1, 2, 0, CHARSET_LEFT_TO_RIGHT,
2488                   build_string ("UCS for Big5"),
2489                   build_string ("UCS for Big5"),
2490                   build_string ("ISO/IEC 10646 for Big5"),
2491                   build_string (""),
2492                   Qnil, 0, 0, 0, 0);
2493 #else
2494 # define MIN_CHAR_THAI 0
2495 # define MAX_CHAR_THAI 0
2496   /* # define MIN_CHAR_HEBREW 0 */
2497   /* # define MAX_CHAR_HEBREW 0 */
2498 # define MIN_CHAR_HALFWIDTH_KATAKANA 0
2499 # define MAX_CHAR_HALFWIDTH_KATAKANA 0
2500 #endif
2501   staticpro (&Vcharset_ascii);
2502   Vcharset_ascii =
2503     make_charset (LEADING_BYTE_ASCII, Qascii, 94, 1,
2504                   1, 0, 'B', CHARSET_LEFT_TO_RIGHT,
2505                   build_string ("ASCII"),
2506                   build_string ("ASCII)"),
2507                   build_string ("ASCII (ISO646 IRV)"),
2508                   build_string ("\\(iso8859-[0-9]*\\|-ascii\\)"),
2509                   Qnil, 0, 0x7F, 0, 0);
2510   staticpro (&Vcharset_control_1);
2511   Vcharset_control_1 =
2512     make_charset (LEADING_BYTE_CONTROL_1, Qcontrol_1, 94, 1,
2513                   1, 1, 0, CHARSET_LEFT_TO_RIGHT,
2514                   build_string ("C1"),
2515                   build_string ("Control characters"),
2516                   build_string ("Control characters 128-191"),
2517                   build_string (""),
2518                   Qnil, 0x80, 0x9F, 0, 0);
2519   staticpro (&Vcharset_latin_iso8859_1);
2520   Vcharset_latin_iso8859_1 =
2521     make_charset (LEADING_BYTE_LATIN_ISO8859_1, Qlatin_iso8859_1, 96, 1,
2522                   1, 1, 'A', CHARSET_LEFT_TO_RIGHT,
2523                   build_string ("Latin-1"),
2524                   build_string ("ISO8859-1 (Latin-1)"),
2525                   build_string ("ISO8859-1 (Latin-1)"),
2526                   build_string ("iso8859-1"),
2527                   Qnil, 0xA0, 0xFF, 0, 32);
2528   staticpro (&Vcharset_latin_iso8859_2);
2529   Vcharset_latin_iso8859_2 =
2530     make_charset (LEADING_BYTE_LATIN_ISO8859_2, Qlatin_iso8859_2, 96, 1,
2531                   1, 1, 'B', CHARSET_LEFT_TO_RIGHT,
2532                   build_string ("Latin-2"),
2533                   build_string ("ISO8859-2 (Latin-2)"),
2534                   build_string ("ISO8859-2 (Latin-2)"),
2535                   build_string ("iso8859-2"),
2536                   Qnil, 0, 0, 0, 32);
2537   staticpro (&Vcharset_latin_iso8859_3);
2538   Vcharset_latin_iso8859_3 =
2539     make_charset (LEADING_BYTE_LATIN_ISO8859_3, Qlatin_iso8859_3, 96, 1,
2540                   1, 1, 'C', CHARSET_LEFT_TO_RIGHT,
2541                   build_string ("Latin-3"),
2542                   build_string ("ISO8859-3 (Latin-3)"),
2543                   build_string ("ISO8859-3 (Latin-3)"),
2544                   build_string ("iso8859-3"),
2545                   Qnil, 0, 0, 0, 32);
2546   staticpro (&Vcharset_latin_iso8859_4);
2547   Vcharset_latin_iso8859_4 =
2548     make_charset (LEADING_BYTE_LATIN_ISO8859_4, Qlatin_iso8859_4, 96, 1,
2549                   1, 1, 'D', CHARSET_LEFT_TO_RIGHT,
2550                   build_string ("Latin-4"),
2551                   build_string ("ISO8859-4 (Latin-4)"),
2552                   build_string ("ISO8859-4 (Latin-4)"),
2553                   build_string ("iso8859-4"),
2554                   Qnil, 0, 0, 0, 32);
2555   staticpro (&Vcharset_thai_tis620);
2556   Vcharset_thai_tis620 =
2557     make_charset (LEADING_BYTE_THAI_TIS620, Qthai_tis620, 96, 1,
2558                   1, 1, 'T', CHARSET_LEFT_TO_RIGHT,
2559                   build_string ("TIS620"),
2560                   build_string ("TIS620 (Thai)"),
2561                   build_string ("TIS620.2529 (Thai)"),
2562                   build_string ("tis620"),
2563                   Qnil, MIN_CHAR_THAI, MAX_CHAR_THAI, 0, 32);
2564   staticpro (&Vcharset_greek_iso8859_7);
2565   Vcharset_greek_iso8859_7 =
2566     make_charset (LEADING_BYTE_GREEK_ISO8859_7, Qgreek_iso8859_7, 96, 1,
2567                   1, 1, 'F', CHARSET_LEFT_TO_RIGHT,
2568                   build_string ("ISO8859-7"),
2569                   build_string ("ISO8859-7 (Greek)"),
2570                   build_string ("ISO8859-7 (Greek)"),
2571                   build_string ("iso8859-7"),
2572                   Qnil, 0, 0, 0, 32);
2573   staticpro (&Vcharset_arabic_iso8859_6);
2574   Vcharset_arabic_iso8859_6 =
2575     make_charset (LEADING_BYTE_ARABIC_ISO8859_6, Qarabic_iso8859_6, 96, 1,
2576                   1, 1, 'G', CHARSET_RIGHT_TO_LEFT,
2577                   build_string ("ISO8859-6"),
2578                   build_string ("ISO8859-6 (Arabic)"),
2579                   build_string ("ISO8859-6 (Arabic)"),
2580                   build_string ("iso8859-6"),
2581                   Qnil, 0, 0, 0, 32);
2582   staticpro (&Vcharset_hebrew_iso8859_8);
2583   Vcharset_hebrew_iso8859_8 =
2584     make_charset (LEADING_BYTE_HEBREW_ISO8859_8, Qhebrew_iso8859_8, 96, 1,
2585                   1, 1, 'H', CHARSET_RIGHT_TO_LEFT,
2586                   build_string ("ISO8859-8"),
2587                   build_string ("ISO8859-8 (Hebrew)"),
2588                   build_string ("ISO8859-8 (Hebrew)"),
2589                   build_string ("iso8859-8"),
2590                   Qnil,
2591                   0 /* MIN_CHAR_HEBREW */,
2592                   0 /* MAX_CHAR_HEBREW */, 0, 32);
2593   staticpro (&Vcharset_katakana_jisx0201);
2594   Vcharset_katakana_jisx0201 =
2595     make_charset (LEADING_BYTE_KATAKANA_JISX0201, Qkatakana_jisx0201, 94, 1,
2596                   1, 1, 'I', CHARSET_LEFT_TO_RIGHT,
2597                   build_string ("JISX0201 Kana"),
2598                   build_string ("JISX0201.1976 (Japanese Kana)"),
2599                   build_string ("JISX0201.1976 Japanese Kana"),
2600                   build_string ("jisx0201\\.1976"),
2601                   Qnil, 0, 0, 0, 33);
2602   staticpro (&Vcharset_latin_jisx0201);
2603   Vcharset_latin_jisx0201 =
2604     make_charset (LEADING_BYTE_LATIN_JISX0201, Qlatin_jisx0201, 94, 1,
2605                   1, 0, 'J', CHARSET_LEFT_TO_RIGHT,
2606                   build_string ("JISX0201 Roman"),
2607                   build_string ("JISX0201.1976 (Japanese Roman)"),
2608                   build_string ("JISX0201.1976 Japanese Roman"),
2609                   build_string ("jisx0201\\.1976"),
2610                   Qnil, 0, 0, 0, 33);
2611   staticpro (&Vcharset_cyrillic_iso8859_5);
2612   Vcharset_cyrillic_iso8859_5 =
2613     make_charset (LEADING_BYTE_CYRILLIC_ISO8859_5, Qcyrillic_iso8859_5, 96, 1,
2614                   1, 1, 'L', CHARSET_LEFT_TO_RIGHT,
2615                   build_string ("ISO8859-5"),
2616                   build_string ("ISO8859-5 (Cyrillic)"),
2617                   build_string ("ISO8859-5 (Cyrillic)"),
2618                   build_string ("iso8859-5"),
2619                   Qnil, 0, 0, 0, 32);
2620   staticpro (&Vcharset_latin_iso8859_9);
2621   Vcharset_latin_iso8859_9 =
2622     make_charset (LEADING_BYTE_LATIN_ISO8859_9, Qlatin_iso8859_9, 96, 1,
2623                   1, 1, 'M', CHARSET_LEFT_TO_RIGHT,
2624                   build_string ("Latin-5"),
2625                   build_string ("ISO8859-9 (Latin-5)"),
2626                   build_string ("ISO8859-9 (Latin-5)"),
2627                   build_string ("iso8859-9"),
2628                   Qnil, 0, 0, 0, 32);
2629   staticpro (&Vcharset_japanese_jisx0208_1978);
2630   Vcharset_japanese_jisx0208_1978 =
2631     make_charset (LEADING_BYTE_JAPANESE_JISX0208_1978,
2632                   Qjapanese_jisx0208_1978, 94, 2,
2633                   2, 0, '@', CHARSET_LEFT_TO_RIGHT,
2634                   build_string ("JIS X0208:1978"),
2635                   build_string ("JIS X0208:1978 (Japanese)"),
2636                   build_string
2637                   ("JIS X0208:1978 Japanese Kanji (so called \"old JIS\")"),
2638                   build_string ("\\(jisx0208\\|jisc6226\\)\\.1978"),
2639                   Qnil, 0, 0, 0, 33);
2640   staticpro (&Vcharset_chinese_gb2312);
2641   Vcharset_chinese_gb2312 =
2642     make_charset (LEADING_BYTE_CHINESE_GB2312, Qchinese_gb2312, 94, 2,
2643                   2, 0, 'A', CHARSET_LEFT_TO_RIGHT,
2644                   build_string ("GB2312"),
2645                   build_string ("GB2312)"),
2646                   build_string ("GB2312 Chinese simplified"),
2647                   build_string ("gb2312"),
2648                   Qnil, 0, 0, 0, 33);
2649   staticpro (&Vcharset_chinese_gb12345);
2650   Vcharset_chinese_gb12345 =
2651     make_charset (LEADING_BYTE_CHINESE_GB12345, Qchinese_gb12345, 94, 2,
2652                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
2653                   build_string ("G1"),
2654                   build_string ("GB 12345)"),
2655                   build_string ("GB 12345-1990"),
2656                   build_string ("GB12345\\(\\.1990\\)?-0"),
2657                   Qnil, 0, 0, 0, 33);
2658   staticpro (&Vcharset_japanese_jisx0208);
2659   Vcharset_japanese_jisx0208 =
2660     make_charset (LEADING_BYTE_JAPANESE_JISX0208, Qjapanese_jisx0208, 94, 2,
2661                   2, 0, 'B', CHARSET_LEFT_TO_RIGHT,
2662                   build_string ("JISX0208"),
2663                   build_string ("JIS X0208:1983 (Japanese)"),
2664                   build_string ("JIS X0208:1983 Japanese Kanji"),
2665                   build_string ("jisx0208\\.1983"),
2666                   Qnil, 0, 0, 0, 33);
2667 #ifdef UTF2000
2668   staticpro (&Vcharset_japanese_jisx0208_1990);
2669   Vcharset_japanese_jisx0208_1990 =
2670     make_charset (LEADING_BYTE_JAPANESE_JISX0208_1990,
2671                   Qjapanese_jisx0208_1990, 94, 2,
2672                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
2673                   build_string ("JISX0208-1990"),
2674                   build_string ("JIS X0208:1990 (Japanese)"),
2675                   build_string ("JIS X0208:1990 Japanese Kanji"),
2676                   build_string ("jisx0208\\.1990"),
2677                   Qnil,
2678                   MIN_CHAR_JIS_X0208_1990,
2679                   MAX_CHAR_JIS_X0208_1990, 0, 33);
2680 #endif
2681   staticpro (&Vcharset_korean_ksc5601);
2682   Vcharset_korean_ksc5601 =
2683     make_charset (LEADING_BYTE_KOREAN_KSC5601, Qkorean_ksc5601, 94, 2,
2684                   2, 0, 'C', CHARSET_LEFT_TO_RIGHT,
2685                   build_string ("KSC5601"),
2686                   build_string ("KSC5601 (Korean"),
2687                   build_string ("KSC5601 Korean Hangul and Hanja"),
2688                   build_string ("ksc5601"),
2689                   Qnil, 0, 0, 0, 33);
2690   staticpro (&Vcharset_japanese_jisx0212);
2691   Vcharset_japanese_jisx0212 =
2692     make_charset (LEADING_BYTE_JAPANESE_JISX0212, Qjapanese_jisx0212, 94, 2,
2693                   2, 0, 'D', CHARSET_LEFT_TO_RIGHT,
2694                   build_string ("JISX0212"),
2695                   build_string ("JISX0212 (Japanese)"),
2696                   build_string ("JISX0212 Japanese Supplement"),
2697                   build_string ("jisx0212"),
2698                   Qnil, 0, 0, 0, 33);
2699
2700 #define CHINESE_CNS_PLANE_RE(n) "cns11643[.-]\\(.*[.-]\\)?" n "$"
2701   staticpro (&Vcharset_chinese_cns11643_1);
2702   Vcharset_chinese_cns11643_1 =
2703     make_charset (LEADING_BYTE_CHINESE_CNS11643_1, Qchinese_cns11643_1, 94, 2,
2704                   2, 0, 'G', CHARSET_LEFT_TO_RIGHT,
2705                   build_string ("CNS11643-1"),
2706                   build_string ("CNS11643-1 (Chinese traditional)"),
2707                   build_string
2708                   ("CNS 11643 Plane 1 Chinese traditional"),
2709                   build_string (CHINESE_CNS_PLANE_RE("1")),
2710                   Qnil, 0, 0, 0, 33);
2711   staticpro (&Vcharset_chinese_cns11643_2);
2712   Vcharset_chinese_cns11643_2 =
2713     make_charset (LEADING_BYTE_CHINESE_CNS11643_2, Qchinese_cns11643_2, 94, 2,
2714                   2, 0, 'H', CHARSET_LEFT_TO_RIGHT,
2715                   build_string ("CNS11643-2"),
2716                   build_string ("CNS11643-2 (Chinese traditional)"),
2717                   build_string
2718                   ("CNS 11643 Plane 2 Chinese traditional"),
2719                   build_string (CHINESE_CNS_PLANE_RE("2")),
2720                   Qnil, 0, 0, 0, 33);
2721 #ifdef UTF2000
2722   staticpro (&Vcharset_latin_tcvn5712);
2723   Vcharset_latin_tcvn5712 =
2724     make_charset (LEADING_BYTE_LATIN_TCVN5712, Qlatin_tcvn5712, 96, 1,
2725                   1, 1, 'Z', CHARSET_LEFT_TO_RIGHT,
2726                   build_string ("TCVN 5712"),
2727                   build_string ("TCVN 5712 (VSCII-2)"),
2728                   build_string ("Vietnamese TCVN 5712:1983 (VSCII-2)"),
2729                   build_string ("tcvn5712\\(\\.1993\\)?-1"),
2730                   Qnil, 0, 0, 0, 32);
2731   staticpro (&Vcharset_latin_viscii_lower);
2732   Vcharset_latin_viscii_lower =
2733     make_charset (LEADING_BYTE_LATIN_VISCII_LOWER, Qlatin_viscii_lower, 96, 1,
2734                   1, 1, '1', CHARSET_LEFT_TO_RIGHT,
2735                   build_string ("VISCII lower"),
2736                   build_string ("VISCII lower (Vietnamese)"),
2737                   build_string ("VISCII lower (Vietnamese)"),
2738                   build_string ("MULEVISCII-LOWER"),
2739                   Qnil, 0, 0, 0, 32);
2740   staticpro (&Vcharset_latin_viscii_upper);
2741   Vcharset_latin_viscii_upper =
2742     make_charset (LEADING_BYTE_LATIN_VISCII_UPPER, Qlatin_viscii_upper, 96, 1,
2743                   1, 1, '2', CHARSET_LEFT_TO_RIGHT,
2744                   build_string ("VISCII upper"),
2745                   build_string ("VISCII upper (Vietnamese)"),
2746                   build_string ("VISCII upper (Vietnamese)"),
2747                   build_string ("MULEVISCII-UPPER"),
2748                   Qnil, 0, 0, 0, 32);
2749   staticpro (&Vcharset_latin_viscii);
2750   Vcharset_latin_viscii =
2751     make_charset (LEADING_BYTE_LATIN_VISCII, Qlatin_viscii, 256, 1,
2752                   1, 2, 0, CHARSET_LEFT_TO_RIGHT,
2753                   build_string ("VISCII"),
2754                   build_string ("VISCII 1.1 (Vietnamese)"),
2755                   build_string ("VISCII 1.1 (Vietnamese)"),
2756                   build_string ("VISCII1\\.1"),
2757                   Qnil, 0, 0, 0, 0);
2758   staticpro (&Vcharset_chinese_big5);
2759   Vcharset_chinese_big5 =
2760     make_charset (LEADING_BYTE_CHINESE_BIG5, Qchinese_big5, 256, 2,
2761                   2, 2, 0, CHARSET_LEFT_TO_RIGHT,
2762                   build_string ("Big5"),
2763                   build_string ("Big5"),
2764                   build_string ("Big5 Chinese traditional"),
2765                   build_string ("big5"),
2766                   Qnil, 0, 0, 0, 0);
2767   staticpro (&Vcharset_chinese_big5_cdp);
2768   Vcharset_chinese_big5_cdp =
2769     make_charset (LEADING_BYTE_CHINESE_BIG5_CDP, Qchinese_big5_cdp, 256, 2,
2770                   2, 2, 0, CHARSET_LEFT_TO_RIGHT,
2771                   build_string ("Big5-CDP"),
2772                   build_string ("Big5 + CDP extension"),
2773                   build_string ("Big5 with CDP extension"),
2774                   build_string ("big5\\.cdp-0"),
2775                   Qnil, 0, 0, 0, 0);
2776   staticpro (&Vcharset_ideograph_gt);
2777   Vcharset_ideograph_gt =
2778     make_charset (LEADING_BYTE_GT, Qideograph_gt, 256, 3,
2779                   2, 2, 0, CHARSET_LEFT_TO_RIGHT,
2780                   build_string ("GT"),
2781                   build_string ("GT"),
2782                   build_string ("GT"),
2783                   build_string (""),
2784                   Qnil, MIN_CHAR_GT, MAX_CHAR_GT, 0, 0);
2785 #define DEF_GT_PJ(n)                                                    \
2786   staticpro (&Vcharset_ideograph_gt_pj_##n);                            \
2787   Vcharset_ideograph_gt_pj_##n =                                        \
2788     make_charset (LEADING_BYTE_GT_PJ_##n, Qideograph_gt_pj_##n, 94, 2,  \
2789                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,                       \
2790                   build_string ("GT-PJ-"#n),                            \
2791                   build_string ("GT (pseudo JIS encoding) part "#n),    \
2792                   build_string ("GT 2000 (pseudo JIS encoding) part "#n), \
2793                   build_string                                          \
2794                   ("\\(GTpj-"#n "\\|jisx0208\\.GT-"#n "\\)$"),  \
2795                   Qnil, 0, 0, 0, 33);
2796   DEF_GT_PJ (1);
2797   DEF_GT_PJ (2);
2798   DEF_GT_PJ (3);
2799   DEF_GT_PJ (4);
2800   DEF_GT_PJ (5);
2801   DEF_GT_PJ (6);
2802   DEF_GT_PJ (7);
2803   DEF_GT_PJ (8);
2804   DEF_GT_PJ (9);
2805   DEF_GT_PJ (10);
2806   DEF_GT_PJ (11);
2807
2808   staticpro (&Vcharset_ideograph_daikanwa);
2809   Vcharset_ideograph_daikanwa =
2810     make_charset (LEADING_BYTE_DAIKANWA, Qideograph_daikanwa, 256, 2,
2811                   2, 2, 0, CHARSET_LEFT_TO_RIGHT,
2812                   build_string ("Daikanwa"),
2813                   build_string ("Morohashi's Daikanwa"),
2814                   build_string ("Daikanwa dictionary by MOROHASHI Tetsuji"),
2815                   build_string ("Daikanwa"),
2816                   Qnil, MIN_CHAR_DAIKANWA, MAX_CHAR_DAIKANWA, 0, 0);
2817   staticpro (&Vcharset_mojikyo);
2818   Vcharset_mojikyo =
2819     make_charset (LEADING_BYTE_MOJIKYO, Qmojikyo, 256, 3,
2820                   2, 2, 0, CHARSET_LEFT_TO_RIGHT,
2821                   build_string ("Mojikyo"),
2822                   build_string ("Mojikyo"),
2823                   build_string ("Konjaku-Mojikyo"),
2824                   build_string (""),
2825                   Qnil, MIN_CHAR_MOJIKYO, MAX_CHAR_MOJIKYO, 0, 0);
2826   staticpro (&Vcharset_mojikyo_2022_1);
2827   Vcharset_mojikyo_2022_1 =
2828     make_charset (LEADING_BYTE_MOJIKYO_2022_1, Qmojikyo_2022_1, 94, 3,
2829                   2, 2, ':', CHARSET_LEFT_TO_RIGHT,
2830                   build_string ("Mojikyo-2022-1"),
2831                   build_string ("Mojikyo ISO-2022 Part 1"),
2832                   build_string ("Konjaku-Mojikyo for ISO/IEC 2022 Part 1"),
2833                   build_string (""),
2834                   Qnil, 0, 0, 0, 33);
2835
2836 #define DEF_MOJIKYO_PJ(n)                                                  \
2837   staticpro (&Vcharset_mojikyo_pj_##n);                                    \
2838   Vcharset_mojikyo_pj_##n =                                                \
2839     make_charset (LEADING_BYTE_MOJIKYO_PJ_##n, Qmojikyo_pj_##n, 94, 2,     \
2840                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,                          \
2841                   build_string ("Mojikyo-PJ-"#n),                          \
2842                   build_string ("Mojikyo (pseudo JIS encoding) part "#n), \
2843                   build_string                                             \
2844                   ("Konjaku-Mojikyo (pseudo JIS encoding) part "#n),       \
2845                   build_string                                             \
2846                   ("\\(MojikyoPJ-"#n "\\|jisx0208\\.Mojikyo-"#n "\\)$"),   \
2847                   Qnil, 0, 0, 0, 33);
2848
2849   DEF_MOJIKYO_PJ (1);
2850   DEF_MOJIKYO_PJ (2);
2851   DEF_MOJIKYO_PJ (3);
2852   DEF_MOJIKYO_PJ (4);
2853   DEF_MOJIKYO_PJ (5);
2854   DEF_MOJIKYO_PJ (6);
2855   DEF_MOJIKYO_PJ (7);
2856   DEF_MOJIKYO_PJ (8);
2857   DEF_MOJIKYO_PJ (9);
2858   DEF_MOJIKYO_PJ (10);
2859   DEF_MOJIKYO_PJ (11);
2860   DEF_MOJIKYO_PJ (12);
2861   DEF_MOJIKYO_PJ (13);
2862   DEF_MOJIKYO_PJ (14);
2863   DEF_MOJIKYO_PJ (15);
2864   DEF_MOJIKYO_PJ (16);
2865   DEF_MOJIKYO_PJ (17);
2866   DEF_MOJIKYO_PJ (18);
2867   DEF_MOJIKYO_PJ (19);
2868   DEF_MOJIKYO_PJ (20);
2869   DEF_MOJIKYO_PJ (21);
2870
2871   staticpro (&Vcharset_ethiopic_ucs);
2872   Vcharset_ethiopic_ucs =
2873     make_charset (LEADING_BYTE_ETHIOPIC_UCS, Qethiopic_ucs, 256, 2,
2874                   2, 2, 0, CHARSET_LEFT_TO_RIGHT,
2875                   build_string ("Ethiopic (UCS)"),
2876                   build_string ("Ethiopic (UCS)"),
2877                   build_string ("Ethiopic of UCS"),
2878                   build_string ("Ethiopic-Unicode"),
2879                   Qnil, 0x1200, 0x137F, 0x1200, 0);
2880 #endif
2881   staticpro (&Vcharset_chinese_big5_1);
2882   Vcharset_chinese_big5_1 =
2883     make_charset (LEADING_BYTE_CHINESE_BIG5_1, Qchinese_big5_1, 94, 2,
2884                   2, 0, '0', CHARSET_LEFT_TO_RIGHT,
2885                   build_string ("Big5"),
2886                   build_string ("Big5 (Level-1)"),
2887                   build_string
2888                   ("Big5 Level-1 Chinese traditional"),
2889                   build_string ("big5"),
2890                   Qnil, 0, 0, 0, 33);
2891   staticpro (&Vcharset_chinese_big5_2);
2892   Vcharset_chinese_big5_2 =
2893     make_charset (LEADING_BYTE_CHINESE_BIG5_2, Qchinese_big5_2, 94, 2,
2894                   2, 0, '1', CHARSET_LEFT_TO_RIGHT,
2895                   build_string ("Big5"),
2896                   build_string ("Big5 (Level-2)"),
2897                   build_string
2898                   ("Big5 Level-2 Chinese traditional"),
2899                   build_string ("big5"),
2900                   Qnil, 0, 0, 0, 33);
2901
2902 #ifdef ENABLE_COMPOSITE_CHARS
2903   /* #### For simplicity, we put composite chars into a 96x96 charset.
2904      This is going to lead to problems because you can run out of
2905      room, esp. as we don't yet recycle numbers. */
2906   staticpro (&Vcharset_composite);
2907   Vcharset_composite =
2908     make_charset (LEADING_BYTE_COMPOSITE, Qcomposite, 96, 2,
2909                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
2910                   build_string ("Composite"),
2911                   build_string ("Composite characters"),
2912                   build_string ("Composite characters"),
2913                   build_string (""));
2914
2915   /* #### not dumped properly */
2916   composite_char_row_next = 32;
2917   composite_char_col_next = 32;
2918
2919   Vcomposite_char_string2char_hash_table =
2920     make_lisp_hash_table (500, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL);
2921   Vcomposite_char_char2string_hash_table =
2922     make_lisp_hash_table (500, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
2923   staticpro (&Vcomposite_char_string2char_hash_table);
2924   staticpro (&Vcomposite_char_char2string_hash_table);
2925 #endif /* ENABLE_COMPOSITE_CHARS */
2926
2927 }