src/mule-charset.c

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