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