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