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