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