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