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