git.chise.org Git - chise/xemacs-chise.git.1/blob - src/mule-charset.c

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