git.chise.org Git - chise/xemacs-chise.git-/blob - src/mule-charset.c

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