src/mule-charset.c

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