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