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