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

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