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