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