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