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