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