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