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

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