src/mule-charset.c

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