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