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
2748   if (!final)
2749     error ("'final must be specified");
2750   if (dimension == 2 && final > 0x5F)
2751     signal_simple_error
2752       ("Final must be in the range 0x30 - 0x5F for dimension == 2",
2753        make_char (final));
2754
2755   if (!NILP (CHARSET_BY_ATTRIBUTES (chars, dimension, final,
2756                                     CHARSET_LEFT_TO_RIGHT)) ||
2757       !NILP (CHARSET_BY_ATTRIBUTES (chars, dimension, final,
2758                                     CHARSET_RIGHT_TO_LEFT)))
2759     error
2760       ("Character set already defined for this DIMENSION/CHARS/FINAL combo");
2761
2762   id = get_unallocated_leading_byte (dimension);
2763
2764   if (NILP (doc_string))
2765     doc_string = build_string ("");
2766
2767   if (NILP (registry))
2768     registry = build_string ("");
2769
2770   if (NILP (short_name))
2771     XSETSTRING (short_name, XSYMBOL (name)->name);
2772
2773   if (NILP (long_name))
2774     long_name = doc_string;
2775
2776   if (columns == -1)
2777     columns = dimension;
2778
2779   if (byte_offset < 0)
2780     {
2781       if (chars == 94)
2782         byte_offset = 33;
2783       else if (chars == 96)
2784         byte_offset = 32;
2785       else
2786         byte_offset = 0;
2787     }
2788
2789   charset = make_charset (id, name, chars, dimension, columns, graphic,
2790                           final, direction, short_name, long_name,
2791                           doc_string, registry,
2792                           Qnil, 0, 0, 0, byte_offset);
2793   if (!NILP (ccl_program))
2794     XCHARSET_CCL_PROGRAM (charset) = ccl_program;
2795   return charset;
2796 }
2797
2798 DEFUN ("make-reverse-direction-charset", Fmake_reverse_direction_charset,
2799        2, 2, 0, /*
2800 Make a charset equivalent to CHARSET but which goes in the opposite direction.
2801 NEW-NAME is the name of the new charset.  Return the new charset.
2802 */
2803        (charset, new_name))
2804 {
2805   Lisp_Object new_charset = Qnil;
2806   int id, chars, dimension, columns, graphic, final;
2807   int direction;
2808   Lisp_Object registry, doc_string, short_name, long_name;
2809   Lisp_Charset *cs;
2810
2811   charset = Fget_charset (charset);
2812   if (!NILP (XCHARSET_REVERSE_DIRECTION_CHARSET (charset)))
2813     signal_simple_error ("Charset already has reverse-direction charset",
2814                          charset);
2815
2816   CHECK_SYMBOL (new_name);
2817   if (!NILP (Ffind_charset (new_name)))
2818     signal_simple_error ("Cannot redefine existing charset", new_name);
2819
2820   cs = XCHARSET (charset);
2821
2822   chars     = CHARSET_CHARS     (cs);
2823   dimension = CHARSET_DIMENSION (cs);
2824   columns   = CHARSET_COLUMNS   (cs);
2825   id = get_unallocated_leading_byte (dimension);
2826
2827   graphic = CHARSET_GRAPHIC (cs);
2828   final = CHARSET_FINAL (cs);
2829   direction = CHARSET_RIGHT_TO_LEFT;
2830   if (CHARSET_DIRECTION (cs) == CHARSET_RIGHT_TO_LEFT)
2831     direction = CHARSET_LEFT_TO_RIGHT;
2832   doc_string = CHARSET_DOC_STRING (cs);
2833   short_name = CHARSET_SHORT_NAME (cs);
2834   long_name = CHARSET_LONG_NAME (cs);
2835   registry = CHARSET_REGISTRY (cs);
2836
2837   new_charset = make_charset (id, new_name, chars, dimension, columns,
2838                               graphic, final, direction, short_name, long_name,
2839                               doc_string, registry,
2840 #ifdef UTF2000
2841                               CHARSET_DECODING_TABLE(cs),
2842                               CHARSET_UCS_MIN(cs),
2843                               CHARSET_UCS_MAX(cs),
2844                               CHARSET_CODE_OFFSET(cs),
2845                               CHARSET_BYTE_OFFSET(cs)
2846 #else
2847                               Qnil, 0, 0, 0, 0
2848 #endif
2849 );
2850
2851   CHARSET_REVERSE_DIRECTION_CHARSET (cs) = new_charset;
2852   XCHARSET_REVERSE_DIRECTION_CHARSET (new_charset) = charset;
2853
2854   return new_charset;
2855 }
2856
2857 DEFUN ("define-charset-alias", Fdefine_charset_alias, 2, 2, 0, /*
2858 Define symbol ALIAS as an alias for CHARSET.
2859 */
2860        (alias, charset))
2861 {
2862   CHECK_SYMBOL (alias);
2863   charset = Fget_charset (charset);
2864   return Fputhash (alias, charset, Vcharset_hash_table);
2865 }
2866
2867 /* #### Reverse direction charsets not yet implemented.  */
2868 #if 0
2869 DEFUN ("charset-reverse-direction-charset", Fcharset_reverse_direction_charset,
2870        1, 1, 0, /*
2871 Return the reverse-direction charset parallel to CHARSET, if any.
2872 This is the charset with the same properties (in particular, the same
2873 dimension, number of characters per dimension, and final byte) as
2874 CHARSET but whose characters are displayed in the opposite direction.
2875 */
2876        (charset))
2877 {
2878   charset = Fget_charset (charset);
2879   return XCHARSET_REVERSE_DIRECTION_CHARSET (charset);
2880 }
2881 #endif
2882
2883 DEFUN ("charset-from-attributes", Fcharset_from_attributes, 3, 4, 0, /*
2884 Return a charset with the given DIMENSION, CHARS, FINAL, and DIRECTION.
2885 If DIRECTION is omitted, both directions will be checked (left-to-right
2886 will be returned if character sets exist for both directions).
2887 */
2888        (dimension, chars, final, direction))
2889 {
2890   int dm, ch, fi, di = -1;
2891   Lisp_Object obj = Qnil;
2892
2893   CHECK_INT (dimension);
2894   dm = XINT (dimension);
2895   if (dm < 1 || dm > 2)
2896     signal_simple_error ("Invalid value for DIMENSION", dimension);
2897
2898   CHECK_INT (chars);
2899   ch = XINT (chars);
2900   if (ch != 94 && ch != 96)
2901     signal_simple_error ("Invalid value for CHARS", chars);
2902
2903   CHECK_CHAR_COERCE_INT (final);
2904   fi = XCHAR (final);
2905   if (fi < '0' || fi > '~')
2906     signal_simple_error ("Invalid value for FINAL", final);
2907
2908   if (EQ (direction, Ql2r))
2909     di = CHARSET_LEFT_TO_RIGHT;
2910   else if (EQ (direction, Qr2l))
2911     di = CHARSET_RIGHT_TO_LEFT;
2912   else if (!NILP (direction))
2913     signal_simple_error ("Invalid value for DIRECTION", direction);
2914
2915   if (dm == 2 && fi > 0x5F)
2916     signal_simple_error
2917       ("Final must be in the range 0x30 - 0x5F for dimension == 2", final);
2918
2919     if (di == -1)
2920     {
2921       obj = CHARSET_BY_ATTRIBUTES (ch, dm, fi, CHARSET_LEFT_TO_RIGHT);
2922       if (NILP (obj))
2923         obj = CHARSET_BY_ATTRIBUTES (ch, dm, fi, CHARSET_RIGHT_TO_LEFT);
2924     }
2925   else
2926     obj = CHARSET_BY_ATTRIBUTES (ch, dm, fi, di);
2927
2928   if (CHARSETP (obj))
2929     return XCHARSET_NAME (obj);
2930   return obj;
2931 }
2932
2933 DEFUN ("charset-short-name", Fcharset_short_name, 1, 1, 0, /*
2934 Return short name of CHARSET.
2935 */
2936        (charset))
2937 {
2938   return XCHARSET_SHORT_NAME (Fget_charset (charset));
2939 }
2940
2941 DEFUN ("charset-long-name", Fcharset_long_name, 1, 1, 0, /*
2942 Return long name of CHARSET.
2943 */
2944        (charset))
2945 {
2946   return XCHARSET_LONG_NAME (Fget_charset (charset));
2947 }
2948
2949 DEFUN ("charset-description", Fcharset_description, 1, 1, 0, /*
2950 Return description of CHARSET.
2951 */
2952        (charset))
2953 {
2954   return XCHARSET_DOC_STRING (Fget_charset (charset));
2955 }
2956
2957 DEFUN ("charset-dimension", Fcharset_dimension, 1, 1, 0, /*
2958 Return dimension of CHARSET.
2959 */
2960        (charset))
2961 {
2962   return make_int (XCHARSET_DIMENSION (Fget_charset (charset)));
2963 }
2964
2965 DEFUN ("charset-property", Fcharset_property, 2, 2, 0, /*
2966 Return property PROP of CHARSET.
2967 Recognized properties are those listed in `make-charset', as well as
2968 'name and 'doc-string.
2969 */
2970        (charset, prop))
2971 {
2972   Lisp_Charset *cs;
2973
2974   charset = Fget_charset (charset);
2975   cs = XCHARSET (charset);
2976
2977   CHECK_SYMBOL (prop);
2978   if (EQ (prop, Qname))        return CHARSET_NAME (cs);
2979   if (EQ (prop, Qshort_name))  return CHARSET_SHORT_NAME (cs);
2980   if (EQ (prop, Qlong_name))   return CHARSET_LONG_NAME (cs);
2981   if (EQ (prop, Qdoc_string))  return CHARSET_DOC_STRING (cs);
2982   if (EQ (prop, Qdimension))   return make_int (CHARSET_DIMENSION (cs));
2983   if (EQ (prop, Qcolumns))     return make_int (CHARSET_COLUMNS (cs));
2984   if (EQ (prop, Qgraphic))     return make_int (CHARSET_GRAPHIC (cs));
2985   if (EQ (prop, Qfinal))       return make_char (CHARSET_FINAL (cs));
2986   if (EQ (prop, Qchars))       return make_int (CHARSET_CHARS (cs));
2987   if (EQ (prop, Qregistry))    return CHARSET_REGISTRY (cs);
2988   if (EQ (prop, Qccl_program)) return CHARSET_CCL_PROGRAM (cs);
2989   if (EQ (prop, Qdirection))
2990     return CHARSET_DIRECTION (cs) == CHARSET_LEFT_TO_RIGHT ? Ql2r : Qr2l;
2991   if (EQ (prop, Qreverse_direction_charset))
2992     {
2993       Lisp_Object obj = CHARSET_REVERSE_DIRECTION_CHARSET (cs);
2994       if (NILP (obj))
2995         return Qnil;
2996       else
2997         return XCHARSET_NAME (obj);
2998     }
2999   signal_simple_error ("Unrecognized charset property name", prop);
3000   return Qnil; /* not reached */
3001 }
3002
3003 DEFUN ("charset-id", Fcharset_id, 1, 1, 0, /*
3004 Return charset identification number of CHARSET.
3005 */
3006         (charset))
3007 {
3008   return make_int(XCHARSET_LEADING_BYTE (Fget_charset (charset)));
3009 }
3010
3011 /* #### We need to figure out which properties we really want to
3012    allow to be set. */
3013
3014 DEFUN ("set-charset-ccl-program", Fset_charset_ccl_program, 2, 2, 0, /*
3015 Set the 'ccl-program property of CHARSET to CCL-PROGRAM.
3016 */
3017        (charset, ccl_program))
3018 {
3019   charset = Fget_charset (charset);
3020   CHECK_VECTOR (ccl_program);
3021   XCHARSET_CCL_PROGRAM (charset) = ccl_program;
3022   return Qnil;
3023 }
3024
3025 static void
3026 invalidate_charset_font_caches (Lisp_Object charset)
3027 {
3028   /* Invalidate font cache entries for charset on all devices. */
3029   Lisp_Object devcons, concons, hash_table;
3030   DEVICE_LOOP_NO_BREAK (devcons, concons)
3031     {
3032       struct device *d = XDEVICE (XCAR (devcons));
3033       hash_table = Fgethash (charset, d->charset_font_cache, Qunbound);
3034       if (!UNBOUNDP (hash_table))
3035         Fclrhash (hash_table);
3036     }
3037 }
3038
3039 DEFUN ("set-charset-registry", Fset_charset_registry, 2, 2, 0, /*
3040 Set the 'registry property of CHARSET to REGISTRY.
3041 */
3042        (charset, registry))
3043 {
3044   charset = Fget_charset (charset);
3045   CHECK_STRING (registry);
3046   XCHARSET_REGISTRY (charset) = registry;
3047   invalidate_charset_font_caches (charset);
3048   face_property_was_changed (Vdefault_face, Qfont, Qglobal);
3049   return Qnil;
3050 }
3051
3052 #ifdef UTF2000
3053 DEFUN ("charset-mapping-table", Fcharset_mapping_table, 1, 1, 0, /*
3054 Return mapping-table of CHARSET.
3055 */
3056        (charset))
3057 {
3058   return XCHARSET_DECODING_TABLE (Fget_charset (charset));
3059 }
3060
3061 DEFUN ("set-charset-mapping-table", Fset_charset_mapping_table, 2, 2, 0, /*
3062 Set mapping-table of CHARSET to TABLE.
3063 */
3064        (charset, table))
3065 {
3066   struct Lisp_Charset *cs;
3067   size_t i;
3068   int byte_offset;
3069
3070   charset = Fget_charset (charset);
3071   cs = XCHARSET (charset);
3072
3073   if (NILP (table))
3074     {
3075       if (VECTORP (CHARSET_DECODING_TABLE(cs)))
3076         make_vector_newer (CHARSET_DECODING_TABLE(cs));
3077       CHARSET_DECODING_TABLE(cs) = Qnil;
3078       return table;
3079     }
3080   else if (VECTORP (table))
3081     {
3082       int ccs_len = CHARSET_BYTE_SIZE (cs);
3083       int ret = decoding_table_check_elements (table,
3084                                                CHARSET_DIMENSION (cs),
3085                                                ccs_len);
3086       if (ret)
3087         {
3088           if (ret == -1)
3089             signal_simple_error ("Too big table", table);
3090           else if (ret == -2)
3091             signal_simple_error ("Invalid element is found", table);
3092           else
3093             signal_simple_error ("Something wrong", table);
3094         }
3095       CHARSET_DECODING_TABLE(cs) = Qnil;
3096     }
3097   else
3098     signal_error (Qwrong_type_argument,
3099                   list2 (build_translated_string ("vector-or-nil-p"),
3100                          table));
3101
3102   byte_offset = CHARSET_BYTE_OFFSET (cs);
3103   switch (CHARSET_DIMENSION (cs))
3104     {
3105     case 1:
3106       for (i = 0; i < XVECTOR_LENGTH (table); i++)
3107         {
3108           Lisp_Object c = XVECTOR_DATA(table)[i];
3109
3110           if (CHARP (c))
3111             put_char_ccs_code_point (c, charset,
3112                                      make_int (i + byte_offset));
3113         }
3114       break;
3115     case 2:
3116       for (i = 0; i < XVECTOR_LENGTH (table); i++)
3117         {
3118           Lisp_Object v = XVECTOR_DATA(table)[i];
3119
3120           if (VECTORP (v))
3121             {
3122               size_t j;
3123
3124               for (j = 0; j < XVECTOR_LENGTH (v); j++)
3125                 {
3126                   Lisp_Object c = XVECTOR_DATA(v)[j];
3127
3128                   if (CHARP (c))
3129                     put_char_ccs_code_point
3130                       (c, charset,
3131                        make_int ( ( (i + byte_offset) << 8 )
3132                                   | (j + byte_offset)
3133                                   ) );
3134                 }
3135             }
3136           else if (CHARP (v))
3137             put_char_ccs_code_point (v, charset,
3138                                      make_int (i + byte_offset));
3139         }
3140       break;
3141     }
3142   return table;
3143 }
3144 #endif
3145
3146 \f
3147 /************************************************************************/
3148 /*              Lisp primitives for working with characters             */
3149 /************************************************************************/
3150
3151 #ifdef UTF2000
3152 DEFUN ("decode-char", Fdecode_char, 2, 2, 0, /*
3153 Make a character from CHARSET and code-point CODE.
3154 */
3155        (charset, code))
3156 {
3157   int c;
3158
3159   charset = Fget_charset (charset);
3160   CHECK_INT (code);
3161   c = XINT (code);
3162   if (XCHARSET_GRAPHIC (charset) == 1)
3163     c &= 0x7F7F7F7F;
3164   return make_char (DECODE_CHAR (charset, c));
3165 }
3166
3167 DEFUN ("decode-builtin-char", Fdecode_builtin_char, 2, 2, 0, /*
3168 Make a builtin character from CHARSET and code-point CODE.
3169 */
3170        (charset, code))
3171 {
3172   int c;
3173   int final;
3174
3175   charset = Fget_charset (charset);
3176   CHECK_INT (code);
3177   c = XINT (code);
3178
3179   if ((final = XCHARSET_FINAL (charset)) >= '0')
3180     {
3181       if (XCHARSET_DIMENSION (charset) == 1)
3182         {
3183           switch (XCHARSET_CHARS (charset))
3184             {
3185             case 94:
3186               return
3187                 make_char (MIN_CHAR_94 + (final - '0') * 94
3188                            + ((c & 0x7F) - 33));
3189             case 96:
3190               return
3191                 make_char (MIN_CHAR_96 + (final - '0') * 96
3192                            + ((c & 0x7F) - 32));
3193             default:
3194               return Fdecode_char (charset, code);
3195             }
3196         }
3197       else
3198         {
3199           switch (XCHARSET_CHARS (charset))
3200             {
3201             case 94:
3202               return
3203                 make_char (MIN_CHAR_94x94
3204                            + (final - '0') * 94 * 94
3205                            + (((c >> 8) & 0x7F) - 33) * 94
3206                            + ((c & 0x7F) - 33));
3207             case 96:
3208               return
3209                 make_char (MIN_CHAR_96x96
3210                            + (final - '0') * 96 * 96
3211                            + (((c >> 8) & 0x7F) - 32) * 96
3212                            + ((c & 0x7F) - 32));
3213             default:
3214               return Fdecode_char (charset, code);
3215             }
3216         }
3217     }
3218   else if (XCHARSET_UCS_MAX (charset))
3219     {
3220       Emchar cid
3221         = (XCHARSET_DIMENSION (charset) == 1
3222            ?
3223            c - XCHARSET_BYTE_OFFSET (charset)
3224            :
3225            ((c >> 8) - XCHARSET_BYTE_OFFSET (charset))
3226            * XCHARSET_CHARS (charset)
3227            + (c & 0xFF) - XCHARSET_BYTE_OFFSET (charset))
3228         - XCHARSET_CODE_OFFSET (charset) + XCHARSET_UCS_MIN (charset);
3229       if ((cid < XCHARSET_UCS_MIN (charset))
3230           || (XCHARSET_UCS_MAX (charset) < cid))
3231         return Fdecode_char (charset, code);
3232       return make_char (cid);
3233     }
3234   else
3235     return Fdecode_char (charset, code);
3236 }
3237 #endif
3238
3239 DEFUN ("make-char", Fmake_char, 2, 3, 0, /*
3240 Make a character from CHARSET and octets ARG1 and ARG2.
3241 ARG2 is required only for characters from two-dimensional charsets.
3242 For example, (make-char 'latin-iso8859-2 185) will return the Latin 2
3243 character s with caron.
3244 */
3245        (charset, arg1, arg2))
3246 {
3247   Lisp_Charset *cs;
3248   int a1, a2;
3249   int lowlim, highlim;
3250
3251   charset = Fget_charset (charset);
3252   cs = XCHARSET (charset);
3253
3254   if      (EQ (charset, Vcharset_ascii))     lowlim =  0, highlim = 127;
3255   else if (EQ (charset, Vcharset_control_1)) lowlim =  0, highlim =  31;
3256 #ifdef UTF2000
3257   else if (CHARSET_CHARS (cs) == 256)        lowlim =  0, highlim = 255;
3258 #endif
3259   else if (CHARSET_CHARS (cs) == 94)         lowlim = 33, highlim = 126;
3260   else  /* CHARSET_CHARS (cs) == 96) */      lowlim = 32, highlim = 127;
3261
3262   CHECK_INT (arg1);
3263   /* It is useful (and safe, according to Olivier Galibert) to strip
3264      the 8th bit off ARG1 and ARG2 because it allows programmers to
3265      write (make-char 'latin-iso8859-2 CODE) where code is the actual
3266      Latin 2 code of the character.  */
3267 #ifdef UTF2000
3268   a1 = XINT (arg1);
3269   if (highlim < 128)
3270     a1 &= 0x7f;
3271 #else
3272   a1 = XINT (arg1);
3273 #endif
3274   if (a1 < lowlim || a1 > highlim)
3275     args_out_of_range_3 (arg1, make_int (lowlim), make_int (highlim));
3276
3277   if (CHARSET_DIMENSION (cs) == 1)
3278     {
3279       if (!NILP (arg2))
3280         signal_simple_error
3281           ("Charset is of dimension one; second octet must be nil", arg2);
3282       return make_char (MAKE_CHAR (charset, a1, 0));
3283     }
3284
3285   CHECK_INT (arg2);
3286 #ifdef UTF2000
3287   a2 = XINT (arg2);
3288   if (highlim < 128)
3289     a2 &= 0x7f;
3290 #else
3291   a2 = XINT (arg2) & 0x7f;
3292 #endif
3293   if (a2 < lowlim || a2 > highlim)
3294     args_out_of_range_3 (arg2, make_int (lowlim), make_int (highlim));
3295
3296   return make_char (MAKE_CHAR (charset, a1, a2));
3297 }
3298
3299 DEFUN ("char-charset", Fchar_charset, 1, 1, 0, /*
3300 Return the character set of char CH.
3301 */
3302        (ch))
3303 {
3304   CHECK_CHAR_COERCE_INT (ch);
3305
3306   return XCHARSET_NAME (CHAR_CHARSET (XCHAR (ch)));
3307 }
3308
3309 DEFUN ("char-octet", Fchar_octet, 1, 2, 0, /*
3310 Return the octet numbered N (should be 0 or 1) of char CH.
3311 N defaults to 0 if omitted.
3312 */
3313        (ch, n))
3314 {
3315   Lisp_Object charset;
3316   int octet0, octet1;
3317
3318   CHECK_CHAR_COERCE_INT (ch);
3319
3320   BREAKUP_CHAR (XCHAR (ch), charset, octet0, octet1);
3321
3322   if (NILP (n) || EQ (n, Qzero))
3323     return make_int (octet0);
3324   else if (EQ (n, make_int (1)))
3325     return make_int (octet1);
3326   else
3327     signal_simple_error ("Octet number must be 0 or 1", n);
3328 }
3329
3330 DEFUN ("split-char", Fsplit_char, 1, 1, 0, /*
3331 Return list of charset and one or two position-codes of CHAR.
3332 */
3333        (character))
3334 {
3335   /* This function can GC */
3336   struct gcpro gcpro1, gcpro2;
3337   Lisp_Object charset = Qnil;
3338   Lisp_Object rc = Qnil;
3339 #ifdef UTF2000
3340   int code_point;
3341   int dimension;
3342 #else
3343   int c1, c2;
3344 #endif
3345
3346   GCPRO2 (charset, rc);
3347   CHECK_CHAR_COERCE_INT (character);
3348
3349 #ifdef UTF2000
3350   code_point = ENCODE_CHAR (XCHAR (character), charset);
3351   dimension = XCHARSET_DIMENSION (charset);
3352   while (dimension > 0)
3353     {
3354       rc = Fcons (make_int (code_point & 255), rc);
3355       code_point >>= 8;
3356       dimension--;
3357     }
3358   rc = Fcons (XCHARSET_NAME (charset), rc);
3359 #else
3360   BREAKUP_CHAR (XCHAR (character), charset, c1, c2);
3361
3362   if (XCHARSET_DIMENSION (Fget_charset (charset)) == 2)
3363     {
3364       rc = list3 (XCHARSET_NAME (charset), make_int (c1), make_int (c2));
3365     }
3366   else
3367     {
3368       rc = list2 (XCHARSET_NAME (charset), make_int (c1));
3369     }
3370 #endif
3371   UNGCPRO;
3372
3373   return rc;
3374 }
3375
3376 \f
3377 #ifdef ENABLE_COMPOSITE_CHARS
3378 /************************************************************************/
3379 /*                     composite character functions                    */
3380 /************************************************************************/
3381
3382 Emchar
3383 lookup_composite_char (Bufbyte *str, int len)
3384 {
3385   Lisp_Object lispstr = make_string (str, len);
3386   Lisp_Object ch = Fgethash (lispstr,
3387                              Vcomposite_char_string2char_hash_table,
3388                              Qunbound);
3389   Emchar emch;
3390
3391   if (UNBOUNDP (ch))
3392     {
3393       if (composite_char_row_next >= 128)
3394         signal_simple_error ("No more composite chars available", lispstr);
3395       emch = MAKE_CHAR (Vcharset_composite, composite_char_row_next,
3396                         composite_char_col_next);
3397       Fputhash (make_char (emch), lispstr,
3398                 Vcomposite_char_char2string_hash_table);
3399       Fputhash (lispstr, make_char (emch),
3400                 Vcomposite_char_string2char_hash_table);
3401       composite_char_col_next++;
3402       if (composite_char_col_next >= 128)
3403         {
3404           composite_char_col_next = 32;
3405           composite_char_row_next++;
3406         }
3407     }
3408   else
3409     emch = XCHAR (ch);
3410   return emch;
3411 }
3412
3413 Lisp_Object
3414 composite_char_string (Emchar ch)
3415 {
3416   Lisp_Object str = Fgethash (make_char (ch),
3417                               Vcomposite_char_char2string_hash_table,
3418                               Qunbound);
3419   assert (!UNBOUNDP (str));
3420   return str;
3421 }
3422
3423 xxDEFUN ("make-composite-char", Fmake_composite_char, 1, 1, 0, /*
3424 Convert a string into a single composite character.
3425 The character is the result of overstriking all the characters in
3426 the string.
3427 */
3428        (string))
3429 {
3430   CHECK_STRING (string);
3431   return make_char (lookup_composite_char (XSTRING_DATA (string),
3432                                            XSTRING_LENGTH (string)));
3433 }
3434
3435 xxDEFUN ("composite-char-string", Fcomposite_char_string, 1, 1, 0, /*
3436 Return a string of the characters comprising a composite character.
3437 */
3438        (ch))
3439 {
3440   Emchar emch;
3441
3442   CHECK_CHAR (ch);
3443   emch = XCHAR (ch);
3444   if (CHAR_LEADING_BYTE (emch) != LEADING_BYTE_COMPOSITE)
3445     signal_simple_error ("Must be composite char", ch);
3446   return composite_char_string (emch);
3447 }
3448 #endif /* ENABLE_COMPOSITE_CHARS */
3449
3450 \f
3451 /************************************************************************/
3452 /*                            initialization                            */
3453 /************************************************************************/
3454
3455 void
3456 syms_of_mule_charset (void)
3457 {
3458 #ifdef UTF2000
3459   INIT_LRECORD_IMPLEMENTATION (uint8_byte_table);
3460   INIT_LRECORD_IMPLEMENTATION (uint16_byte_table);
3461   INIT_LRECORD_IMPLEMENTATION (byte_table);
3462   INIT_LRECORD_IMPLEMENTATION (char_id_table);
3463 #endif
3464   INIT_LRECORD_IMPLEMENTATION (charset);
3465
3466   DEFSUBR (Fcharsetp);
3467   DEFSUBR (Ffind_charset);
3468   DEFSUBR (Fget_charset);
3469   DEFSUBR (Fcharset_list);
3470   DEFSUBR (Fcharset_name);
3471   DEFSUBR (Fmake_charset);
3472   DEFSUBR (Fmake_reverse_direction_charset);
3473   /*  DEFSUBR (Freverse_direction_charset); */
3474   DEFSUBR (Fdefine_charset_alias);
3475   DEFSUBR (Fcharset_from_attributes);
3476   DEFSUBR (Fcharset_short_name);
3477   DEFSUBR (Fcharset_long_name);
3478   DEFSUBR (Fcharset_description);
3479   DEFSUBR (Fcharset_dimension);
3480   DEFSUBR (Fcharset_property);
3481   DEFSUBR (Fcharset_id);
3482   DEFSUBR (Fset_charset_ccl_program);
3483   DEFSUBR (Fset_charset_registry);
3484 #ifdef UTF2000
3485   DEFSUBR (Fchar_attribute_list);
3486   DEFSUBR (Ffind_char_attribute_table);
3487   DEFSUBR (Fchar_attribute_alist);
3488   DEFSUBR (Fget_char_attribute);
3489   DEFSUBR (Fput_char_attribute);
3490   DEFSUBR (Fremove_char_attribute);
3491   DEFSUBR (Fdefine_char);
3492   DEFSUBR (Fchar_variants);
3493   DEFSUBR (Fget_composite_char);
3494   DEFSUBR (Fcharset_mapping_table);
3495   DEFSUBR (Fset_charset_mapping_table);
3496 #endif
3497
3498 #ifdef UTF2000
3499   DEFSUBR (Fdecode_char);
3500   DEFSUBR (Fdecode_builtin_char);
3501 #endif
3502   DEFSUBR (Fmake_char);
3503   DEFSUBR (Fchar_charset);
3504   DEFSUBR (Fchar_octet);
3505   DEFSUBR (Fsplit_char);
3506
3507 #ifdef ENABLE_COMPOSITE_CHARS
3508   DEFSUBR (Fmake_composite_char);
3509   DEFSUBR (Fcomposite_char_string);
3510 #endif
3511
3512   defsymbol (&Qcharsetp, "charsetp");
3513   defsymbol (&Qregistry, "registry");
3514   defsymbol (&Qfinal, "final");
3515   defsymbol (&Qgraphic, "graphic");
3516   defsymbol (&Qdirection, "direction");
3517   defsymbol (&Qreverse_direction_charset, "reverse-direction-charset");
3518   defsymbol (&Qshort_name, "short-name");
3519   defsymbol (&Qlong_name, "long-name");
3520
3521   defsymbol (&Ql2r, "l2r");
3522   defsymbol (&Qr2l, "r2l");
3523
3524   /* Charsets, compatible with FSF 20.3
3525      Naming convention is Script-Charset[-Edition] */
3526   defsymbol (&Qascii,                   "ascii");
3527   defsymbol (&Qcontrol_1,               "control-1");
3528   defsymbol (&Qlatin_iso8859_1,         "latin-iso8859-1");
3529   defsymbol (&Qlatin_iso8859_2,         "latin-iso8859-2");
3530   defsymbol (&Qlatin_iso8859_3,         "latin-iso8859-3");
3531   defsymbol (&Qlatin_iso8859_4,         "latin-iso8859-4");
3532   defsymbol (&Qthai_tis620,             "thai-tis620");
3533   defsymbol (&Qgreek_iso8859_7,         "greek-iso8859-7");
3534   defsymbol (&Qarabic_iso8859_6,        "arabic-iso8859-6");
3535   defsymbol (&Qhebrew_iso8859_8,        "hebrew-iso8859-8");
3536   defsymbol (&Qkatakana_jisx0201,       "katakana-jisx0201");
3537   defsymbol (&Qlatin_jisx0201,          "latin-jisx0201");
3538   defsymbol (&Qcyrillic_iso8859_5,      "cyrillic-iso8859-5");
3539   defsymbol (&Qlatin_iso8859_9,         "latin-iso8859-9");
3540   defsymbol (&Qjapanese_jisx0208_1978,  "japanese-jisx0208-1978");
3541   defsymbol (&Qchinese_gb2312,          "chinese-gb2312");
3542   defsymbol (&Qjapanese_jisx0208,       "japanese-jisx0208");
3543   defsymbol (&Qjapanese_jisx0208_1990,  "japanese-jisx0208-1990");
3544   defsymbol (&Qkorean_ksc5601,          "korean-ksc5601");
3545   defsymbol (&Qjapanese_jisx0212,       "japanese-jisx0212");
3546   defsymbol (&Qchinese_cns11643_1,      "chinese-cns11643-1");
3547   defsymbol (&Qchinese_cns11643_2,      "chinese-cns11643-2");
3548 #ifdef UTF2000
3549   defsymbol (&Q_ucs,                    "->ucs");
3550   defsymbol (&Q_decomposition,          "->decomposition");
3551   defsymbol (&Qcompat,                  "compat");
3552   defsymbol (&Qisolated,                "isolated");
3553   defsymbol (&Qinitial,                 "initial");
3554   defsymbol (&Qmedial,                  "medial");
3555   defsymbol (&Qfinal,                   "final");
3556   defsymbol (&Qvertical,                "vertical");
3557   defsymbol (&QnoBreak,                 "noBreak");
3558   defsymbol (&Qfraction,                "fraction");
3559   defsymbol (&Qsuper,                   "super");
3560   defsymbol (&Qsub,                     "sub");
3561   defsymbol (&Qcircle,                  "circle");
3562   defsymbol (&Qsquare,                  "square");
3563   defsymbol (&Qwide,                    "wide");
3564   defsymbol (&Qnarrow,                  "narrow");
3565   defsymbol (&Qsmall,                   "small");
3566   defsymbol (&Qfont,                    "font");
3567   defsymbol (&Qucs,                     "ucs");
3568   defsymbol (&Qucs_bmp,                 "ucs-bmp");
3569   defsymbol (&Qlatin_viscii,            "latin-viscii");
3570   defsymbol (&Qlatin_tcvn5712,          "latin-tcvn5712");
3571   defsymbol (&Qlatin_viscii_lower,      "latin-viscii-lower");
3572   defsymbol (&Qlatin_viscii_upper,      "latin-viscii-upper");
3573   defsymbol (&Qvietnamese_viscii_lower, "vietnamese-viscii-lower");
3574   defsymbol (&Qvietnamese_viscii_upper, "vietnamese-viscii-upper");
3575   defsymbol (&Qideograph_daikanwa,      "ideograph-daikanwa");
3576   defsymbol (&Qchinese_big5,            "chinese-big5");
3577   defsymbol (&Qmojikyo,                 "mojikyo");
3578   defsymbol (&Qmojikyo_2022_1,          "mojikyo-2022-1");
3579   defsymbol (&Qmojikyo_pj_1,            "mojikyo-pj-1");
3580   defsymbol (&Qmojikyo_pj_2,            "mojikyo-pj-2");
3581   defsymbol (&Qmojikyo_pj_3,            "mojikyo-pj-3");
3582   defsymbol (&Qmojikyo_pj_4,            "mojikyo-pj-4");
3583   defsymbol (&Qmojikyo_pj_5,            "mojikyo-pj-5");
3584   defsymbol (&Qmojikyo_pj_6,            "mojikyo-pj-6");
3585   defsymbol (&Qmojikyo_pj_7,            "mojikyo-pj-7");
3586   defsymbol (&Qmojikyo_pj_8,            "mojikyo-pj-8");
3587   defsymbol (&Qmojikyo_pj_9,            "mojikyo-pj-9");
3588   defsymbol (&Qmojikyo_pj_10,           "mojikyo-pj-10");
3589   defsymbol (&Qmojikyo_pj_11,           "mojikyo-pj-11");
3590   defsymbol (&Qmojikyo_pj_12,           "mojikyo-pj-12");
3591   defsymbol (&Qmojikyo_pj_13,           "mojikyo-pj-13");
3592   defsymbol (&Qmojikyo_pj_14,           "mojikyo-pj-14");
3593   defsymbol (&Qmojikyo_pj_15,           "mojikyo-pj-15");
3594   defsymbol (&Qmojikyo_pj_16,           "mojikyo-pj-16");
3595   defsymbol (&Qmojikyo_pj_17,           "mojikyo-pj-17");
3596   defsymbol (&Qmojikyo_pj_18,           "mojikyo-pj-18");
3597   defsymbol (&Qmojikyo_pj_19,           "mojikyo-pj-19");
3598   defsymbol (&Qmojikyo_pj_20,           "mojikyo-pj-20");
3599   defsymbol (&Qmojikyo_pj_21,           "mojikyo-pj-21");
3600   defsymbol (&Qethiopic_ucs,            "ethiopic-ucs");
3601 #endif
3602   defsymbol (&Qchinese_big5_1,          "chinese-big5-1");
3603   defsymbol (&Qchinese_big5_2,          "chinese-big5-2");
3604
3605   defsymbol (&Qcomposite,               "composite");
3606 }
3607
3608 void
3609 vars_of_mule_charset (void)
3610 {
3611   int i, j;
3612 #ifndef UTF2000
3613   int k;
3614 #endif
3615
3616   chlook = xnew (struct charset_lookup);
3617   dumpstruct (&chlook, &charset_lookup_description);
3618
3619   /* Table of charsets indexed by leading byte. */
3620   for (i = 0; i < countof (chlook->charset_by_leading_byte); i++)
3621     chlook->charset_by_leading_byte[i] = Qnil;
3622
3623 #ifdef UTF2000
3624   /* Table of charsets indexed by type/final-byte. */
3625   for (i = 0; i < countof (chlook->charset_by_attributes); i++)
3626     for (j = 0; j < countof (chlook->charset_by_attributes[0]); j++)
3627       chlook->charset_by_attributes[i][j] = Qnil;
3628 #else
3629   /* Table of charsets indexed by type/final-byte/direction. */
3630   for (i = 0; i < countof (chlook->charset_by_attributes); i++)
3631     for (j = 0; j < countof (chlook->charset_by_attributes[0]); j++)
3632       for (k = 0; k < countof (chlook->charset_by_attributes[0][0]); k++)
3633         chlook->charset_by_attributes[i][j][k] = Qnil;
3634 #endif
3635
3636 #ifdef UTF2000
3637   chlook->next_allocated_leading_byte = MIN_LEADING_BYTE_PRIVATE;
3638 #else
3639   chlook->next_allocated_1_byte_leading_byte = MIN_LEADING_BYTE_PRIVATE_1;
3640   chlook->next_allocated_2_byte_leading_byte = MIN_LEADING_BYTE_PRIVATE_2;
3641 #endif
3642
3643 #ifndef UTF2000
3644   leading_code_private_11 = PRE_LEADING_BYTE_PRIVATE_1;
3645   DEFVAR_INT ("leading-code-private-11", &leading_code_private_11 /*
3646 Leading-code of private TYPE9N charset of column-width 1.
3647 */ );
3648   leading_code_private_11 = PRE_LEADING_BYTE_PRIVATE_1;
3649 #endif
3650
3651 #ifdef UTF2000
3652   Vutf_2000_version = build_string("0.17 (Hōryūji)");
3653   DEFVAR_LISP ("utf-2000-version", &Vutf_2000_version /*
3654 Version number of UTF-2000.
3655 */ );
3656
3657   staticpro (&Vcharacter_composition_table);
3658   Vcharacter_composition_table = make_char_id_table (Qnil);
3659
3660   staticpro (&Vcharacter_variant_table);
3661   Vcharacter_variant_table = make_char_id_table (Qnil);
3662
3663   Vdefault_coded_charset_priority_list = Qnil;
3664   DEFVAR_LISP ("default-coded-charset-priority-list",
3665                &Vdefault_coded_charset_priority_list /*
3666 Default order of preferred coded-character-sets.
3667 */ );
3668 #endif
3669 }
3670
3671 void
3672 complex_vars_of_mule_charset (void)
3673 {
3674   staticpro (&Vcharset_hash_table);
3675   Vcharset_hash_table =
3676     make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
3677
3678   /* Predefined character sets.  We store them into variables for
3679      ease of access. */
3680
3681 #ifdef UTF2000
3682   staticpro (&Vchar_attribute_hash_table);
3683   Vchar_attribute_hash_table
3684     = make_lisp_hash_table (16, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
3685
3686   staticpro (&Vcharset_ucs);
3687   Vcharset_ucs =
3688     make_charset (LEADING_BYTE_UCS, Qucs, 256, 4,
3689                   1, 2, 0, CHARSET_LEFT_TO_RIGHT,
3690                   build_string ("UCS"),
3691                   build_string ("UCS"),
3692                   build_string ("ISO/IEC 10646"),
3693                   build_string (""),
3694                   Qnil, 0, 0xFFFFFFF, 0, 0);
3695   staticpro (&Vcharset_ucs_bmp);
3696   Vcharset_ucs_bmp =
3697     make_charset (LEADING_BYTE_UCS_BMP, Qucs_bmp, 256, 2,
3698                   1, 2, 0, CHARSET_LEFT_TO_RIGHT,
3699                   build_string ("BMP"),
3700                   build_string ("BMP"),
3701                   build_string ("ISO/IEC 10646 Group 0 Plane 0 (BMP)"),
3702                   build_string ("\\(ISO10646.*-1\\|UNICODE[23]?-0\\)"),
3703                   Qnil, 0, 0xFFFF, 0, 0);
3704 #else
3705 # define MIN_CHAR_THAI 0
3706 # define MAX_CHAR_THAI 0
3707 # define MIN_CHAR_HEBREW 0
3708 # define MAX_CHAR_HEBREW 0
3709 # define MIN_CHAR_HALFWIDTH_KATAKANA 0
3710 # define MAX_CHAR_HALFWIDTH_KATAKANA 0
3711 #endif
3712   staticpro (&Vcharset_ascii);
3713   Vcharset_ascii =
3714     make_charset (LEADING_BYTE_ASCII, Qascii, 94, 1,
3715                   1, 0, 'B', CHARSET_LEFT_TO_RIGHT,
3716                   build_string ("ASCII"),
3717                   build_string ("ASCII)"),
3718                   build_string ("ASCII (ISO646 IRV)"),
3719                   build_string ("\\(iso8859-[0-9]*\\|-ascii\\)"),
3720                   Qnil, 0, 0x7F, 0, 0);
3721   staticpro (&Vcharset_control_1);
3722   Vcharset_control_1 =
3723     make_charset (LEADING_BYTE_CONTROL_1, Qcontrol_1, 94, 1,
3724                   1, 1, 0, CHARSET_LEFT_TO_RIGHT,
3725                   build_string ("C1"),
3726                   build_string ("Control characters"),
3727                   build_string ("Control characters 128-191"),
3728                   build_string (""),
3729                   Qnil, 0x80, 0x9F, 0, 0);
3730   staticpro (&Vcharset_latin_iso8859_1);
3731   Vcharset_latin_iso8859_1 =
3732     make_charset (LEADING_BYTE_LATIN_ISO8859_1, Qlatin_iso8859_1, 96, 1,
3733                   1, 1, 'A', CHARSET_LEFT_TO_RIGHT,
3734                   build_string ("Latin-1"),
3735                   build_string ("ISO8859-1 (Latin-1)"),
3736                   build_string ("ISO8859-1 (Latin-1)"),
3737                   build_string ("iso8859-1"),
3738                   Qnil, 0xA0, 0xFF, 0, 32);
3739   staticpro (&Vcharset_latin_iso8859_2);
3740   Vcharset_latin_iso8859_2 =
3741     make_charset (LEADING_BYTE_LATIN_ISO8859_2, Qlatin_iso8859_2, 96, 1,
3742                   1, 1, 'B', CHARSET_LEFT_TO_RIGHT,
3743                   build_string ("Latin-2"),
3744                   build_string ("ISO8859-2 (Latin-2)"),
3745                   build_string ("ISO8859-2 (Latin-2)"),
3746                   build_string ("iso8859-2"),
3747                   Qnil, 0, 0, 0, 32);
3748   staticpro (&Vcharset_latin_iso8859_3);
3749   Vcharset_latin_iso8859_3 =
3750     make_charset (LEADING_BYTE_LATIN_ISO8859_3, Qlatin_iso8859_3, 96, 1,
3751                   1, 1, 'C', CHARSET_LEFT_TO_RIGHT,
3752                   build_string ("Latin-3"),
3753                   build_string ("ISO8859-3 (Latin-3)"),
3754                   build_string ("ISO8859-3 (Latin-3)"),
3755                   build_string ("iso8859-3"),
3756                   Qnil, 0, 0, 0, 32);
3757   staticpro (&Vcharset_latin_iso8859_4);
3758   Vcharset_latin_iso8859_4 =
3759     make_charset (LEADING_BYTE_LATIN_ISO8859_4, Qlatin_iso8859_4, 96, 1,
3760                   1, 1, 'D', CHARSET_LEFT_TO_RIGHT,
3761                   build_string ("Latin-4"),
3762                   build_string ("ISO8859-4 (Latin-4)"),
3763                   build_string ("ISO8859-4 (Latin-4)"),
3764                   build_string ("iso8859-4"),
3765                   Qnil, 0, 0, 0, 32);
3766   staticpro (&Vcharset_thai_tis620);
3767   Vcharset_thai_tis620 =
3768     make_charset (LEADING_BYTE_THAI_TIS620, Qthai_tis620, 96, 1,
3769                   1, 1, 'T', CHARSET_LEFT_TO_RIGHT,
3770                   build_string ("TIS620"),
3771                   build_string ("TIS620 (Thai)"),
3772                   build_string ("TIS620.2529 (Thai)"),
3773                   build_string ("tis620"),
3774                   Qnil, MIN_CHAR_THAI, MAX_CHAR_THAI, 0, 32);
3775   staticpro (&Vcharset_greek_iso8859_7);
3776   Vcharset_greek_iso8859_7 =
3777     make_charset (LEADING_BYTE_GREEK_ISO8859_7, Qgreek_iso8859_7, 96, 1,
3778                   1, 1, 'F', CHARSET_LEFT_TO_RIGHT,
3779                   build_string ("ISO8859-7"),
3780                   build_string ("ISO8859-7 (Greek)"),
3781                   build_string ("ISO8859-7 (Greek)"),
3782                   build_string ("iso8859-7"),
3783                   Qnil,
3784                   0 /* MIN_CHAR_GREEK */,
3785                   0 /* MAX_CHAR_GREEK */, 0, 32);
3786   staticpro (&Vcharset_arabic_iso8859_6);
3787   Vcharset_arabic_iso8859_6 =
3788     make_charset (LEADING_BYTE_ARABIC_ISO8859_6, Qarabic_iso8859_6, 96, 1,
3789                   1, 1, 'G', CHARSET_RIGHT_TO_LEFT,
3790                   build_string ("ISO8859-6"),
3791                   build_string ("ISO8859-6 (Arabic)"),
3792                   build_string ("ISO8859-6 (Arabic)"),
3793                   build_string ("iso8859-6"),
3794                   Qnil, 0, 0, 0, 32);
3795   staticpro (&Vcharset_hebrew_iso8859_8);
3796   Vcharset_hebrew_iso8859_8 =
3797     make_charset (LEADING_BYTE_HEBREW_ISO8859_8, Qhebrew_iso8859_8, 96, 1,
3798                   1, 1, 'H', CHARSET_RIGHT_TO_LEFT,
3799                   build_string ("ISO8859-8"),
3800                   build_string ("ISO8859-8 (Hebrew)"),
3801                   build_string ("ISO8859-8 (Hebrew)"),
3802                   build_string ("iso8859-8"),
3803                   Qnil, MIN_CHAR_HEBREW, MAX_CHAR_HEBREW, 0, 32);
3804   staticpro (&Vcharset_katakana_jisx0201);
3805   Vcharset_katakana_jisx0201 =
3806     make_charset (LEADING_BYTE_KATAKANA_JISX0201, Qkatakana_jisx0201, 94, 1,
3807                   1, 1, 'I', CHARSET_LEFT_TO_RIGHT,
3808                   build_string ("JISX0201 Kana"),
3809                   build_string ("JISX0201.1976 (Japanese Kana)"),
3810                   build_string ("JISX0201.1976 Japanese Kana"),
3811                   build_string ("jisx0201\\.1976"),
3812                   Qnil, 0, 0, 0, 33);
3813   staticpro (&Vcharset_latin_jisx0201);
3814   Vcharset_latin_jisx0201 =
3815     make_charset (LEADING_BYTE_LATIN_JISX0201, Qlatin_jisx0201, 94, 1,
3816                   1, 0, 'J', CHARSET_LEFT_TO_RIGHT,
3817                   build_string ("JISX0201 Roman"),
3818                   build_string ("JISX0201.1976 (Japanese Roman)"),
3819                   build_string ("JISX0201.1976 Japanese Roman"),
3820                   build_string ("jisx0201\\.1976"),
3821                   Qnil, 0, 0, 0, 33);
3822   staticpro (&Vcharset_cyrillic_iso8859_5);
3823   Vcharset_cyrillic_iso8859_5 =
3824     make_charset (LEADING_BYTE_CYRILLIC_ISO8859_5, Qcyrillic_iso8859_5, 96, 1,
3825                   1, 1, 'L', CHARSET_LEFT_TO_RIGHT,
3826                   build_string ("ISO8859-5"),
3827                   build_string ("ISO8859-5 (Cyrillic)"),
3828                   build_string ("ISO8859-5 (Cyrillic)"),
3829                   build_string ("iso8859-5"),
3830                   Qnil,
3831                   0 /* MIN_CHAR_CYRILLIC */,
3832                   0 /* MAX_CHAR_CYRILLIC */, 0, 32);
3833   staticpro (&Vcharset_latin_iso8859_9);
3834   Vcharset_latin_iso8859_9 =
3835     make_charset (LEADING_BYTE_LATIN_ISO8859_9, Qlatin_iso8859_9, 96, 1,
3836                   1, 1, 'M', CHARSET_LEFT_TO_RIGHT,
3837                   build_string ("Latin-5"),
3838                   build_string ("ISO8859-9 (Latin-5)"),
3839                   build_string ("ISO8859-9 (Latin-5)"),
3840                   build_string ("iso8859-9"),
3841                   Qnil, 0, 0, 0, 32);
3842   staticpro (&Vcharset_japanese_jisx0208_1978);
3843   Vcharset_japanese_jisx0208_1978 =
3844     make_charset (LEADING_BYTE_JAPANESE_JISX0208_1978,
3845                   Qjapanese_jisx0208_1978, 94, 2,
3846                   2, 0, '@', CHARSET_LEFT_TO_RIGHT,
3847                   build_string ("JIS X0208:1978"),
3848                   build_string ("JIS X0208:1978 (Japanese)"),
3849                   build_string
3850                   ("JIS X0208:1978 Japanese Kanji (so called \"old JIS\")"),
3851                   build_string ("\\(jisx0208\\|jisc6226\\)\\.1978"),
3852                   Qnil, 0, 0, 0, 33);
3853   staticpro (&Vcharset_chinese_gb2312);
3854   Vcharset_chinese_gb2312 =
3855     make_charset (LEADING_BYTE_CHINESE_GB2312, Qchinese_gb2312, 94, 2,
3856                   2, 0, 'A', CHARSET_LEFT_TO_RIGHT,
3857                   build_string ("GB2312"),
3858                   build_string ("GB2312)"),
3859                   build_string ("GB2312 Chinese simplified"),
3860                   build_string ("gb2312"),
3861                   Qnil, 0, 0, 0, 33);
3862   staticpro (&Vcharset_japanese_jisx0208);
3863   Vcharset_japanese_jisx0208 =
3864     make_charset (LEADING_BYTE_JAPANESE_JISX0208, Qjapanese_jisx0208, 94, 2,
3865                   2, 0, 'B', CHARSET_LEFT_TO_RIGHT,
3866                   build_string ("JISX0208"),
3867                   build_string ("JIS X0208:1983 (Japanese)"),
3868                   build_string ("JIS X0208:1983 Japanese Kanji"),
3869                   build_string ("jisx0208\\.1983"),
3870                   Qnil, 0, 0, 0, 33);
3871 #ifdef UTF2000
3872   staticpro (&Vcharset_japanese_jisx0208_1990);
3873   Vcharset_japanese_jisx0208_1990 =
3874     make_charset (LEADING_BYTE_JAPANESE_JISX0208_1990,
3875                   Qjapanese_jisx0208_1990, 94, 2,
3876                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3877                   build_string ("JISX0208-1990"),
3878                   build_string ("JIS X0208:1990 (Japanese)"),
3879                   build_string ("JIS X0208:1990 Japanese Kanji"),
3880                   build_string ("jisx0208\\.1990"),
3881                   Qnil,
3882                   MIN_CHAR_JIS_X0208_1990,
3883                   MAX_CHAR_JIS_X0208_1990, 0, 33);
3884 #endif
3885   staticpro (&Vcharset_korean_ksc5601);
3886   Vcharset_korean_ksc5601 =
3887     make_charset (LEADING_BYTE_KOREAN_KSC5601, Qkorean_ksc5601, 94, 2,
3888                   2, 0, 'C', CHARSET_LEFT_TO_RIGHT,
3889                   build_string ("KSC5601"),
3890                   build_string ("KSC5601 (Korean"),
3891                   build_string ("KSC5601 Korean Hangul and Hanja"),
3892                   build_string ("ksc5601"),
3893                   Qnil, 0, 0, 0, 33);
3894   staticpro (&Vcharset_japanese_jisx0212);
3895   Vcharset_japanese_jisx0212 =
3896     make_charset (LEADING_BYTE_JAPANESE_JISX0212, Qjapanese_jisx0212, 94, 2,
3897                   2, 0, 'D', CHARSET_LEFT_TO_RIGHT,
3898                   build_string ("JISX0212"),
3899                   build_string ("JISX0212 (Japanese)"),
3900                   build_string ("JISX0212 Japanese Supplement"),
3901                   build_string ("jisx0212"),
3902                   Qnil, 0, 0, 0, 33);
3903
3904 #define CHINESE_CNS_PLANE_RE(n) "cns11643[.-]\\(.*[.-]\\)?" n "$"
3905   staticpro (&Vcharset_chinese_cns11643_1);
3906   Vcharset_chinese_cns11643_1 =
3907     make_charset (LEADING_BYTE_CHINESE_CNS11643_1, Qchinese_cns11643_1, 94, 2,
3908                   2, 0, 'G', CHARSET_LEFT_TO_RIGHT,
3909                   build_string ("CNS11643-1"),
3910                   build_string ("CNS11643-1 (Chinese traditional)"),
3911                   build_string
3912                   ("CNS 11643 Plane 1 Chinese traditional"),
3913                   build_string (CHINESE_CNS_PLANE_RE("1")),
3914                   Qnil, 0, 0, 0, 33);
3915   staticpro (&Vcharset_chinese_cns11643_2);
3916   Vcharset_chinese_cns11643_2 =
3917     make_charset (LEADING_BYTE_CHINESE_CNS11643_2, Qchinese_cns11643_2, 94, 2,
3918                   2, 0, 'H', CHARSET_LEFT_TO_RIGHT,
3919                   build_string ("CNS11643-2"),
3920                   build_string ("CNS11643-2 (Chinese traditional)"),
3921                   build_string
3922                   ("CNS 11643 Plane 2 Chinese traditional"),
3923                   build_string (CHINESE_CNS_PLANE_RE("2")),
3924                   Qnil, 0, 0, 0, 33);
3925 #ifdef UTF2000
3926   staticpro (&Vcharset_latin_tcvn5712);
3927   Vcharset_latin_tcvn5712 =
3928     make_charset (LEADING_BYTE_LATIN_TCVN5712, Qlatin_tcvn5712, 96, 1,
3929                   1, 1, 'Z', CHARSET_LEFT_TO_RIGHT,
3930                   build_string ("TCVN 5712"),
3931                   build_string ("TCVN 5712 (VSCII-2)"),
3932                   build_string ("Vietnamese TCVN 5712:1983 (VSCII-2)"),
3933                   build_string ("tcvn5712-1"),
3934                   Qnil, 0, 0, 0, 32);
3935   staticpro (&Vcharset_latin_viscii_lower);
3936   Vcharset_latin_viscii_lower =
3937     make_charset (LEADING_BYTE_LATIN_VISCII_LOWER, Qlatin_viscii_lower, 96, 1,
3938                   1, 1, '1', CHARSET_LEFT_TO_RIGHT,
3939                   build_string ("VISCII lower"),
3940                   build_string ("VISCII lower (Vietnamese)"),
3941                   build_string ("VISCII lower (Vietnamese)"),
3942                   build_string ("MULEVISCII-LOWER"),
3943                   Qnil, 0, 0, 0, 32);
3944   staticpro (&Vcharset_latin_viscii_upper);
3945   Vcharset_latin_viscii_upper =
3946     make_charset (LEADING_BYTE_LATIN_VISCII_UPPER, Qlatin_viscii_upper, 96, 1,
3947                   1, 1, '2', CHARSET_LEFT_TO_RIGHT,
3948                   build_string ("VISCII upper"),
3949                   build_string ("VISCII upper (Vietnamese)"),
3950                   build_string ("VISCII upper (Vietnamese)"),
3951                   build_string ("MULEVISCII-UPPER"),
3952                   Qnil, 0, 0, 0, 32);
3953   staticpro (&Vcharset_latin_viscii);
3954   Vcharset_latin_viscii =
3955     make_charset (LEADING_BYTE_LATIN_VISCII, Qlatin_viscii, 256, 1,
3956                   1, 2, 0, CHARSET_LEFT_TO_RIGHT,
3957                   build_string ("VISCII"),
3958                   build_string ("VISCII 1.1 (Vietnamese)"),
3959                   build_string ("VISCII 1.1 (Vietnamese)"),
3960                   build_string ("VISCII1\\.1"),
3961                   Qnil, 0, 0, 0, 0);
3962   staticpro (&Vcharset_chinese_big5);
3963   Vcharset_chinese_big5 =
3964     make_charset (LEADING_BYTE_CHINESE_BIG5, Qchinese_big5, 256, 2,
3965                   2, 2, 0, CHARSET_LEFT_TO_RIGHT,
3966                   build_string ("Big5"),
3967                   build_string ("Big5"),
3968                   build_string ("Big5 Chinese traditional"),
3969                   build_string ("big5"),
3970                   Qnil, 0, 0, 0, 0);
3971   staticpro (&Vcharset_ideograph_daikanwa);
3972   Vcharset_ideograph_daikanwa =
3973     make_charset (LEADING_BYTE_DAIKANWA, Qideograph_daikanwa, 256, 2,
3974                   2, 2, 0, CHARSET_LEFT_TO_RIGHT,
3975                   build_string ("Daikanwa"),
3976                   build_string ("Morohashi's Daikanwa"),
3977                   build_string ("Daikanwa dictionary by MOROHASHI Tetsuji"),
3978                   build_string ("Daikanwa"),
3979                   Qnil, MIN_CHAR_DAIKANWA, MAX_CHAR_DAIKANWA, 0, 0);
3980   staticpro (&Vcharset_mojikyo);
3981   Vcharset_mojikyo =
3982     make_charset (LEADING_BYTE_MOJIKYO, Qmojikyo, 256, 3,
3983                   2, 2, 0, CHARSET_LEFT_TO_RIGHT,
3984                   build_string ("Mojikyo"),
3985                   build_string ("Mojikyo"),
3986                   build_string ("Konjaku-Mojikyo"),
3987                   build_string (""),
3988                   Qnil, MIN_CHAR_MOJIKYO, MAX_CHAR_MOJIKYO, 0, 0);
3989   staticpro (&Vcharset_mojikyo_2022_1);
3990   Vcharset_mojikyo_2022_1 =
3991     make_charset (LEADING_BYTE_MOJIKYO_2022_1, Qmojikyo_2022_1, 94, 3,
3992                   2, 2, ':', CHARSET_LEFT_TO_RIGHT,
3993                   build_string ("Mojikyo-2022-1"),
3994                   build_string ("Mojikyo ISO-2022 Part 1"),
3995                   build_string ("Konjaku-Mojikyo for ISO/IEC 2022 Part 1"),
3996                   build_string (""),
3997                   Qnil, 0, 0, 0, 33);
3998
3999 #define DEF_MOJIKYO_PJ(n)                                                  \
4000   staticpro (&Vcharset_mojikyo_pj_##n);                                    \
4001   Vcharset_mojikyo_pj_##n =                                                \
4002     make_charset (LEADING_BYTE_MOJIKYO_PJ_##n, Qmojikyo_pj_##n, 94, 2,     \
4003                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,                          \
4004                   build_string ("Mojikyo-PJ-"#n),                          \
4005                   build_string ("Mojikyo (pseudo JIS encoding) part "#n), \
4006                   build_string                                             \
4007                   ("Konjaku-Mojikyo (pseudo JIS encoding) part "#n),       \
4008                   build_string                                             \
4009                   ("\\(MojikyoPJ-"#n "\\|jisx0208\\.Mojikyo-"#n "\\)$"),   \
4010                   Qnil, 0, 0, 0, 33);
4011
4012   DEF_MOJIKYO_PJ (1);
4013   DEF_MOJIKYO_PJ (2);
4014   DEF_MOJIKYO_PJ (3);
4015   DEF_MOJIKYO_PJ (4);
4016   DEF_MOJIKYO_PJ (5);
4017   DEF_MOJIKYO_PJ (6);
4018   DEF_MOJIKYO_PJ (7);
4019   DEF_MOJIKYO_PJ (8);
4020   DEF_MOJIKYO_PJ (9);
4021   DEF_MOJIKYO_PJ (10);
4022   DEF_MOJIKYO_PJ (11);
4023   DEF_MOJIKYO_PJ (12);
4024   DEF_MOJIKYO_PJ (13);
4025   DEF_MOJIKYO_PJ (14);
4026   DEF_MOJIKYO_PJ (15);
4027   DEF_MOJIKYO_PJ (16);
4028   DEF_MOJIKYO_PJ (17);
4029   DEF_MOJIKYO_PJ (18);
4030   DEF_MOJIKYO_PJ (19);
4031   DEF_MOJIKYO_PJ (20);
4032   DEF_MOJIKYO_PJ (21);
4033
4034   staticpro (&Vcharset_ethiopic_ucs);
4035   Vcharset_ethiopic_ucs =
4036     make_charset (LEADING_BYTE_ETHIOPIC_UCS, Qethiopic_ucs, 256, 2,
4037                   2, 2, 0, CHARSET_LEFT_TO_RIGHT,
4038                   build_string ("Ethiopic (UCS)"),
4039                   build_string ("Ethiopic (UCS)"),
4040                   build_string ("Ethiopic of UCS"),
4041                   build_string ("Ethiopic-Unicode"),
4042                   Qnil, 0x1200, 0x137F, 0x1200, 0);
4043 #endif
4044   staticpro (&Vcharset_chinese_big5_1);
4045   Vcharset_chinese_big5_1 =
4046     make_charset (LEADING_BYTE_CHINESE_BIG5_1, Qchinese_big5_1, 94, 2,
4047                   2, 0, '0', CHARSET_LEFT_TO_RIGHT,
4048                   build_string ("Big5"),
4049                   build_string ("Big5 (Level-1)"),
4050                   build_string
4051                   ("Big5 Level-1 Chinese traditional"),
4052                   build_string ("big5"),
4053                   Qnil, 0, 0, 0, 33);
4054   staticpro (&Vcharset_chinese_big5_2);
4055   Vcharset_chinese_big5_2 =
4056     make_charset (LEADING_BYTE_CHINESE_BIG5_2, Qchinese_big5_2, 94, 2,
4057                   2, 0, '1', CHARSET_LEFT_TO_RIGHT,
4058                   build_string ("Big5"),
4059                   build_string ("Big5 (Level-2)"),
4060                   build_string
4061                   ("Big5 Level-2 Chinese traditional"),
4062                   build_string ("big5"),
4063                   Qnil, 0, 0, 0, 33);
4064
4065 #ifdef ENABLE_COMPOSITE_CHARS
4066   /* #### For simplicity, we put composite chars into a 96x96 charset.
4067      This is going to lead to problems because you can run out of
4068      room, esp. as we don't yet recycle numbers. */
4069   staticpro (&Vcharset_composite);
4070   Vcharset_composite =
4071     make_charset (LEADING_BYTE_COMPOSITE, Qcomposite, 96, 2,
4072                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
4073                   build_string ("Composite"),
4074                   build_string ("Composite characters"),
4075                   build_string ("Composite characters"),
4076                   build_string (""));
4077
4078   /* #### not dumped properly */
4079   composite_char_row_next = 32;
4080   composite_char_col_next = 32;
4081
4082   Vcomposite_char_string2char_hash_table =
4083     make_lisp_hash_table (500, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL);
4084   Vcomposite_char_char2string_hash_table =
4085     make_lisp_hash_table (500, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
4086   staticpro (&Vcomposite_char_string2char_hash_table);
4087   staticpro (&Vcomposite_char_char2string_hash_table);
4088 #endif /* ENABLE_COMPOSITE_CHARS */
4089
4090 }