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