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