src/mule-charset.c

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