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