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

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