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   else if (c <= MAX_CHAR_DAIKANWA)
1782     {
1783       *charset = Vcharset_ideograph_daikanwa;
1784       return c - MIN_CHAR_DAIKANWA;
1785     }
1786   else if (c < MIN_CHAR_94)
1787     {
1788       *charset = Vcharset_ucs;
1789       return c;
1790     }
1791   else if (c <= MAX_CHAR_94)
1792     {
1793       *charset = CHARSET_BY_ATTRIBUTES (CHARSET_TYPE_94,
1794                                         ((c - MIN_CHAR_94) / 94) + '0',
1795                                         CHARSET_LEFT_TO_RIGHT);
1796       if (!NILP (*charset))
1797         return ((c - MIN_CHAR_94) % 94) + 33;
1798       else
1799         {
1800           *charset = Vcharset_ucs;
1801           return c;
1802         }
1803     }
1804   else if (c <= MAX_CHAR_96)
1805     {
1806       *charset = CHARSET_BY_ATTRIBUTES (CHARSET_TYPE_96,
1807                                         ((c - MIN_CHAR_96) / 96) + '0',
1808                                         CHARSET_LEFT_TO_RIGHT);
1809       if (!NILP (*charset))
1810         return ((c - MIN_CHAR_96) % 96) + 32;
1811       else
1812         {
1813           *charset = Vcharset_ucs;
1814           return c;
1815         }
1816     }
1817   else if (c <= MAX_CHAR_94x94)
1818     {
1819       *charset
1820         = CHARSET_BY_ATTRIBUTES (CHARSET_TYPE_94X94,
1821                                  ((c - MIN_CHAR_94x94) / (94 * 94)) + '0',
1822                                  CHARSET_LEFT_TO_RIGHT);
1823       if (!NILP (*charset))
1824         return (((((c - MIN_CHAR_94x94) / 94) % 94) + 33) << 8)
1825           | (((c - MIN_CHAR_94x94) % 94) + 33);
1826       else
1827         {
1828           *charset = Vcharset_ucs;
1829           return c;
1830         }
1831     }
1832   else if (c <= MAX_CHAR_96x96)
1833     {
1834       *charset
1835         = CHARSET_BY_ATTRIBUTES (CHARSET_TYPE_96X96,
1836                                  ((c - MIN_CHAR_96x96) / (96 * 96)) + '0',
1837                                  CHARSET_LEFT_TO_RIGHT);
1838       if (!NILP (*charset))
1839         return ((((c - MIN_CHAR_96x96) / 96) % 96) + 32) << 8
1840           | (((c - MIN_CHAR_96x96) % 96) + 32);
1841       else
1842         {
1843           *charset = Vcharset_ucs;
1844           return c;
1845         }
1846     }
1847   else
1848     {
1849       *charset = Vcharset_ucs;
1850       return c;
1851     }
1852 }
1853
1854 Lisp_Object Vdefault_coded_charset_priority_list;
1855 #endif
1856
1857 \f
1858 /************************************************************************/
1859 /*                      Basic charset Lisp functions                    */
1860 /************************************************************************/
1861
1862 DEFUN ("charsetp", Fcharsetp, 1, 1, 0, /*
1863 Return non-nil if OBJECT is a charset.
1864 */
1865        (object))
1866 {
1867   return CHARSETP (object) ? Qt : Qnil;
1868 }
1869
1870 DEFUN ("find-charset", Ffind_charset, 1, 1, 0, /*
1871 Retrieve the charset of the given name.
1872 If CHARSET-OR-NAME is a charset object, it is simply returned.
1873 Otherwise, CHARSET-OR-NAME should be a symbol.  If there is no such charset,
1874 nil is returned.  Otherwise the associated charset object is returned.
1875 */
1876        (charset_or_name))
1877 {
1878   if (CHARSETP (charset_or_name))
1879     return charset_or_name;
1880
1881   CHECK_SYMBOL (charset_or_name);
1882   return Fgethash (charset_or_name, Vcharset_hash_table, Qnil);
1883 }
1884
1885 DEFUN ("get-charset", Fget_charset, 1, 1, 0, /*
1886 Retrieve the charset of the given name.
1887 Same as `find-charset' except an error is signalled if there is no such
1888 charset instead of returning nil.
1889 */
1890        (name))
1891 {
1892   Lisp_Object charset = Ffind_charset (name);
1893
1894   if (NILP (charset))
1895     signal_simple_error ("No such charset", name);
1896   return charset;
1897 }
1898
1899 /* We store the charsets in hash tables with the names as the key and the
1900    actual charset object as the value.  Occasionally we need to use them
1901    in a list format.  These routines provide us with that. */
1902 struct charset_list_closure
1903 {
1904   Lisp_Object *charset_list;
1905 };
1906
1907 static int
1908 add_charset_to_list_mapper (Lisp_Object key, Lisp_Object value,
1909                             void *charset_list_closure)
1910 {
1911   /* This function can GC */
1912   struct charset_list_closure *chcl =
1913     (struct charset_list_closure*) charset_list_closure;
1914   Lisp_Object *charset_list = chcl->charset_list;
1915
1916   *charset_list = Fcons (XCHARSET_NAME (value), *charset_list);
1917   return 0;
1918 }
1919
1920 DEFUN ("charset-list", Fcharset_list, 0, 0, 0, /*
1921 Return a list of the names of all defined charsets.
1922 */
1923        ())
1924 {
1925   Lisp_Object charset_list = Qnil;
1926   struct gcpro gcpro1;
1927   struct charset_list_closure charset_list_closure;
1928
1929   GCPRO1 (charset_list);
1930   charset_list_closure.charset_list = &charset_list;
1931   elisp_maphash (add_charset_to_list_mapper, Vcharset_hash_table,
1932                  &charset_list_closure);
1933   UNGCPRO;
1934
1935   return charset_list;
1936 }
1937
1938 DEFUN ("charset-name", Fcharset_name, 1, 1, 0, /*
1939 Return the name of the given charset.
1940 */
1941        (charset))
1942 {
1943   return XCHARSET_NAME (Fget_charset (charset));
1944 }
1945
1946 DEFUN ("make-charset", Fmake_charset, 3, 3, 0, /*
1947 Define a new character set.
1948 This function is for use with Mule support.
1949 NAME is a symbol, the name by which the character set is normally referred.
1950 DOC-STRING is a string describing the character set.
1951 PROPS is a property list, describing the specific nature of the
1952 character set.  Recognized properties are:
1953
1954 'short-name     Short version of the charset name (ex: Latin-1)
1955 'long-name      Long version of the charset name (ex: ISO8859-1 (Latin-1))
1956 'registry       A regular expression matching the font registry field for
1957                 this character set.
1958 'dimension      Number of octets used to index a character in this charset.
1959                 Either 1 or 2.  Defaults to 1.
1960 'columns        Number of columns used to display a character in this charset.
1961                 Only used in TTY mode. (Under X, the actual width of a
1962                 character can be derived from the font used to display the
1963                 characters.) If unspecified, defaults to the dimension
1964                 (this is almost always the correct value).
1965 'chars          Number of characters in each dimension (94 or 96).
1966                 Defaults to 94.  Note that if the dimension is 2, the
1967                 character set thus described is 94x94 or 96x96.
1968 'final          Final byte of ISO 2022 escape sequence.  Must be
1969                 supplied.  Each combination of (DIMENSION, CHARS) defines a
1970                 separate namespace for final bytes.  Note that ISO
1971                 2022 restricts the final byte to the range
1972                 0x30 - 0x7E if dimension == 1, and 0x30 - 0x5F if
1973                 dimension == 2.  Note also that final bytes in the range
1974                 0x30 - 0x3F are reserved for user-defined (not official)
1975                 character sets.
1976 'graphic        0 (use left half of font on output) or 1 (use right half
1977                 of font on output).  Defaults to 0.  For example, for
1978                 a font whose registry is ISO8859-1, the left half
1979                 (octets 0x20 - 0x7F) is the `ascii' character set, while
1980                 the right half (octets 0xA0 - 0xFF) is the `latin-1'
1981                 character set.  With 'graphic set to 0, the octets
1982                 will have their high bit cleared; with it set to 1,
1983                 the octets will have their high bit set.
1984 'direction      'l2r (left-to-right) or 'r2l (right-to-left).
1985                 Defaults to 'l2r.
1986 'ccl-program    A compiled CCL program used to convert a character in
1987                 this charset into an index into the font.  This is in
1988                 addition to the 'graphic property.  The CCL program
1989                 is passed the octets of the character, with the high
1990                 bit cleared and set depending upon whether the value
1991                 of the 'graphic property is 0 or 1.
1992 */
1993        (name, doc_string, props))
1994 {
1995   int id, dimension = 1, chars = 94, graphic = 0, final = 0, columns = -1;
1996   int direction = CHARSET_LEFT_TO_RIGHT;
1997   int type;
1998   Lisp_Object registry = Qnil;
1999   Lisp_Object charset;
2000   Lisp_Object rest, keyword, value;
2001   Lisp_Object ccl_program = Qnil;
2002   Lisp_Object short_name = Qnil, long_name = Qnil;
2003   int byte_offset = -1;
2004
2005   CHECK_SYMBOL (name);
2006   if (!NILP (doc_string))
2007     CHECK_STRING (doc_string);
2008
2009   charset = Ffind_charset (name);
2010   if (!NILP (charset))
2011     signal_simple_error ("Cannot redefine existing charset", name);
2012
2013   EXTERNAL_PROPERTY_LIST_LOOP (rest, keyword, value, props)
2014     {
2015       if (EQ (keyword, Qshort_name))
2016         {
2017           CHECK_STRING (value);
2018           short_name = value;
2019         }
2020
2021       if (EQ (keyword, Qlong_name))
2022         {
2023           CHECK_STRING (value);
2024           long_name = value;
2025         }
2026
2027       else if (EQ (keyword, Qdimension))
2028         {
2029           CHECK_INT (value);
2030           dimension = XINT (value);
2031           if (dimension < 1 || dimension > 2)
2032             signal_simple_error ("Invalid value for 'dimension", value);
2033         }
2034
2035       else if (EQ (keyword, Qchars))
2036         {
2037           CHECK_INT (value);
2038           chars = XINT (value);
2039           if (chars != 94 && chars != 96)
2040             signal_simple_error ("Invalid value for 'chars", value);
2041         }
2042
2043       else if (EQ (keyword, Qcolumns))
2044         {
2045           CHECK_INT (value);
2046           columns = XINT (value);
2047           if (columns != 1 && columns != 2)
2048             signal_simple_error ("Invalid value for 'columns", value);
2049         }
2050
2051       else if (EQ (keyword, Qgraphic))
2052         {
2053           CHECK_INT (value);
2054           graphic = XINT (value);
2055 #ifdef UTF2000
2056           if (graphic < 0 || graphic > 2)
2057 #else
2058           if (graphic < 0 || graphic > 1)
2059 #endif
2060             signal_simple_error ("Invalid value for 'graphic", value);
2061         }
2062
2063       else if (EQ (keyword, Qregistry))
2064         {
2065           CHECK_STRING (value);
2066           registry = value;
2067         }
2068
2069       else if (EQ (keyword, Qdirection))
2070         {
2071           if (EQ (value, Ql2r))
2072             direction = CHARSET_LEFT_TO_RIGHT;
2073           else if (EQ (value, Qr2l))
2074             direction = CHARSET_RIGHT_TO_LEFT;
2075           else
2076             signal_simple_error ("Invalid value for 'direction", value);
2077         }
2078
2079       else if (EQ (keyword, Qfinal))
2080         {
2081           CHECK_CHAR_COERCE_INT (value);
2082           final = XCHAR (value);
2083           if (final < '0' || final > '~')
2084             signal_simple_error ("Invalid value for 'final", value);
2085         }
2086
2087       else if (EQ (keyword, Qccl_program))
2088         {
2089           CHECK_VECTOR (value);
2090           ccl_program = value;
2091         }
2092
2093       else
2094         signal_simple_error ("Unrecognized property", keyword);
2095     }
2096
2097   if (!final)
2098     error ("'final must be specified");
2099   if (dimension == 2 && final > 0x5F)
2100     signal_simple_error
2101       ("Final must be in the range 0x30 - 0x5F for dimension == 2",
2102        make_char (final));
2103
2104   if (dimension == 1)
2105     type = (chars == 94) ? CHARSET_TYPE_94    : CHARSET_TYPE_96;
2106   else
2107     type = (chars == 94) ? CHARSET_TYPE_94X94 : CHARSET_TYPE_96X96;
2108
2109   if (!NILP (CHARSET_BY_ATTRIBUTES (type, final, CHARSET_LEFT_TO_RIGHT)) ||
2110       !NILP (CHARSET_BY_ATTRIBUTES (type, final, CHARSET_RIGHT_TO_LEFT)))
2111     error
2112       ("Character set already defined for this DIMENSION/CHARS/FINAL combo");
2113
2114   id = get_unallocated_leading_byte (dimension);
2115
2116   if (NILP (doc_string))
2117     doc_string = build_string ("");
2118
2119   if (NILP (registry))
2120     registry = build_string ("");
2121
2122   if (NILP (short_name))
2123     XSETSTRING (short_name, XSYMBOL (name)->name);
2124
2125   if (NILP (long_name))
2126     long_name = doc_string;
2127
2128   if (columns == -1)
2129     columns = dimension;
2130
2131   if (byte_offset < 0)
2132     {
2133       if (chars == 94)
2134         byte_offset = 33;
2135       else if (chars == 96)
2136         byte_offset = 32;
2137       else
2138         byte_offset = 0;
2139     }
2140
2141   charset = make_charset (id, name, chars, dimension, columns, graphic,
2142                           final, direction, short_name, long_name,
2143                           doc_string, registry,
2144                           Qnil, 0, 0, 0, byte_offset);
2145   if (!NILP (ccl_program))
2146     XCHARSET_CCL_PROGRAM (charset) = ccl_program;
2147   return charset;
2148 }
2149
2150 DEFUN ("make-reverse-direction-charset", Fmake_reverse_direction_charset,
2151        2, 2, 0, /*
2152 Make a charset equivalent to CHARSET but which goes in the opposite direction.
2153 NEW-NAME is the name of the new charset.  Return the new charset.
2154 */
2155        (charset, new_name))
2156 {
2157   Lisp_Object new_charset = Qnil;
2158   int id, chars, dimension, columns, graphic, final;
2159   int direction;
2160   Lisp_Object registry, doc_string, short_name, long_name;
2161   struct Lisp_Charset *cs;
2162
2163   charset = Fget_charset (charset);
2164   if (!NILP (XCHARSET_REVERSE_DIRECTION_CHARSET (charset)))
2165     signal_simple_error ("Charset already has reverse-direction charset",
2166                          charset);
2167
2168   CHECK_SYMBOL (new_name);
2169   if (!NILP (Ffind_charset (new_name)))
2170     signal_simple_error ("Cannot redefine existing charset", new_name);
2171
2172   cs = XCHARSET (charset);
2173
2174   chars     = CHARSET_CHARS     (cs);
2175   dimension = CHARSET_DIMENSION (cs);
2176   columns   = CHARSET_COLUMNS   (cs);
2177   id = get_unallocated_leading_byte (dimension);
2178
2179   graphic = CHARSET_GRAPHIC (cs);
2180   final = CHARSET_FINAL (cs);
2181   direction = CHARSET_RIGHT_TO_LEFT;
2182   if (CHARSET_DIRECTION (cs) == CHARSET_RIGHT_TO_LEFT)
2183     direction = CHARSET_LEFT_TO_RIGHT;
2184   doc_string = CHARSET_DOC_STRING (cs);
2185   short_name = CHARSET_SHORT_NAME (cs);
2186   long_name = CHARSET_LONG_NAME (cs);
2187   registry = CHARSET_REGISTRY (cs);
2188
2189   new_charset = make_charset (id, new_name, chars, dimension, columns,
2190                               graphic, final, direction, short_name, long_name,
2191                               doc_string, registry,
2192 #ifdef UTF2000
2193                               CHARSET_DECODING_TABLE(cs),
2194                               CHARSET_UCS_MIN(cs),
2195                               CHARSET_UCS_MAX(cs),
2196                               CHARSET_CODE_OFFSET(cs),
2197                               CHARSET_BYTE_OFFSET(cs)
2198 #else
2199                               Qnil, 0, 0, 0, 0
2200 #endif
2201 );
2202
2203   CHARSET_REVERSE_DIRECTION_CHARSET (cs) = new_charset;
2204   XCHARSET_REVERSE_DIRECTION_CHARSET (new_charset) = charset;
2205
2206   return new_charset;
2207 }
2208
2209 DEFUN ("define-charset-alias", Fdefine_charset_alias, 2, 2, 0, /*
2210 Define symbol ALIAS as an alias for CHARSET.
2211 */
2212        (alias, charset))
2213 {
2214   CHECK_SYMBOL (alias);
2215   charset = Fget_charset (charset);
2216   return Fputhash (alias, charset, Vcharset_hash_table);
2217 }
2218
2219 /* #### Reverse direction charsets not yet implemented.  */
2220 #if 0
2221 DEFUN ("charset-reverse-direction-charset", Fcharset_reverse_direction_charset,
2222        1, 1, 0, /*
2223 Return the reverse-direction charset parallel to CHARSET, if any.
2224 This is the charset with the same properties (in particular, the same
2225 dimension, number of characters per dimension, and final byte) as
2226 CHARSET but whose characters are displayed in the opposite direction.
2227 */
2228        (charset))
2229 {
2230   charset = Fget_charset (charset);
2231   return XCHARSET_REVERSE_DIRECTION_CHARSET (charset);
2232 }
2233 #endif
2234
2235 DEFUN ("charset-from-attributes", Fcharset_from_attributes, 3, 4, 0, /*
2236 Return a charset with the given DIMENSION, CHARS, FINAL, and DIRECTION.
2237 If DIRECTION is omitted, both directions will be checked (left-to-right
2238 will be returned if character sets exist for both directions).
2239 */
2240        (dimension, chars, final, direction))
2241 {
2242   int dm, ch, fi, di = -1;
2243   int type;
2244   Lisp_Object obj = Qnil;
2245
2246   CHECK_INT (dimension);
2247   dm = XINT (dimension);
2248   if (dm < 1 || dm > 2)
2249     signal_simple_error ("Invalid value for DIMENSION", dimension);
2250
2251   CHECK_INT (chars);
2252   ch = XINT (chars);
2253   if (ch != 94 && ch != 96)
2254     signal_simple_error ("Invalid value for CHARS", chars);
2255
2256   CHECK_CHAR_COERCE_INT (final);
2257   fi = XCHAR (final);
2258   if (fi < '0' || fi > '~')
2259     signal_simple_error ("Invalid value for FINAL", final);
2260
2261   if (EQ (direction, Ql2r))
2262     di = CHARSET_LEFT_TO_RIGHT;
2263   else if (EQ (direction, Qr2l))
2264     di = CHARSET_RIGHT_TO_LEFT;
2265   else if (!NILP (direction))
2266     signal_simple_error ("Invalid value for DIRECTION", direction);
2267
2268   if (dm == 2 && fi > 0x5F)
2269     signal_simple_error
2270       ("Final must be in the range 0x30 - 0x5F for dimension == 2", final);
2271
2272   if (dm == 1)
2273     type = (ch == 94) ? CHARSET_TYPE_94    : CHARSET_TYPE_96;
2274   else
2275     type = (ch == 94) ? CHARSET_TYPE_94X94 : CHARSET_TYPE_96X96;
2276
2277   if (di == -1)
2278     {
2279       obj = CHARSET_BY_ATTRIBUTES (type, fi, CHARSET_LEFT_TO_RIGHT);
2280       if (NILP (obj))
2281         obj = CHARSET_BY_ATTRIBUTES (type, fi, CHARSET_RIGHT_TO_LEFT);
2282     }
2283   else
2284     obj = CHARSET_BY_ATTRIBUTES (type, fi, di);
2285
2286   if (CHARSETP (obj))
2287     return XCHARSET_NAME (obj);
2288   return obj;
2289 }
2290
2291 DEFUN ("charset-short-name", Fcharset_short_name, 1, 1, 0, /*
2292 Return short name of CHARSET.
2293 */
2294        (charset))
2295 {
2296   return XCHARSET_SHORT_NAME (Fget_charset (charset));
2297 }
2298
2299 DEFUN ("charset-long-name", Fcharset_long_name, 1, 1, 0, /*
2300 Return long name of CHARSET.
2301 */
2302        (charset))
2303 {
2304   return XCHARSET_LONG_NAME (Fget_charset (charset));
2305 }
2306
2307 DEFUN ("charset-description", Fcharset_description, 1, 1, 0, /*
2308 Return description of CHARSET.
2309 */
2310        (charset))
2311 {
2312   return XCHARSET_DOC_STRING (Fget_charset (charset));
2313 }
2314
2315 DEFUN ("charset-dimension", Fcharset_dimension, 1, 1, 0, /*
2316 Return dimension of CHARSET.
2317 */
2318        (charset))
2319 {
2320   return make_int (XCHARSET_DIMENSION (Fget_charset (charset)));
2321 }
2322
2323 DEFUN ("charset-property", Fcharset_property, 2, 2, 0, /*
2324 Return property PROP of CHARSET.
2325 Recognized properties are those listed in `make-charset', as well as
2326 'name and 'doc-string.
2327 */
2328        (charset, prop))
2329 {
2330   struct Lisp_Charset *cs;
2331
2332   charset = Fget_charset (charset);
2333   cs = XCHARSET (charset);
2334
2335   CHECK_SYMBOL (prop);
2336   if (EQ (prop, Qname))        return CHARSET_NAME (cs);
2337   if (EQ (prop, Qshort_name))  return CHARSET_SHORT_NAME (cs);
2338   if (EQ (prop, Qlong_name))   return CHARSET_LONG_NAME (cs);
2339   if (EQ (prop, Qdoc_string))  return CHARSET_DOC_STRING (cs);
2340   if (EQ (prop, Qdimension))   return make_int (CHARSET_DIMENSION (cs));
2341   if (EQ (prop, Qcolumns))     return make_int (CHARSET_COLUMNS (cs));
2342   if (EQ (prop, Qgraphic))     return make_int (CHARSET_GRAPHIC (cs));
2343   if (EQ (prop, Qfinal))       return make_char (CHARSET_FINAL (cs));
2344   if (EQ (prop, Qchars))       return make_int (CHARSET_CHARS (cs));
2345   if (EQ (prop, Qregistry))    return CHARSET_REGISTRY (cs);
2346   if (EQ (prop, Qccl_program)) return CHARSET_CCL_PROGRAM (cs);
2347   if (EQ (prop, Qdirection))
2348     return CHARSET_DIRECTION (cs) == CHARSET_LEFT_TO_RIGHT ? Ql2r : Qr2l;
2349   if (EQ (prop, Qreverse_direction_charset))
2350     {
2351       Lisp_Object obj = CHARSET_REVERSE_DIRECTION_CHARSET (cs);
2352       if (NILP (obj))
2353         return Qnil;
2354       else
2355         return XCHARSET_NAME (obj);
2356     }
2357   signal_simple_error ("Unrecognized charset property name", prop);
2358   return Qnil; /* not reached */
2359 }
2360
2361 DEFUN ("charset-id", Fcharset_id, 1, 1, 0, /*
2362 Return charset identification number of CHARSET.
2363 */
2364         (charset))
2365 {
2366   return make_int(XCHARSET_LEADING_BYTE (Fget_charset (charset)));
2367 }
2368
2369 /* #### We need to figure out which properties we really want to
2370    allow to be set. */
2371
2372 DEFUN ("set-charset-ccl-program", Fset_charset_ccl_program, 2, 2, 0, /*
2373 Set the 'ccl-program property of CHARSET to CCL-PROGRAM.
2374 */
2375        (charset, ccl_program))
2376 {
2377   charset = Fget_charset (charset);
2378   CHECK_VECTOR (ccl_program);
2379   XCHARSET_CCL_PROGRAM (charset) = ccl_program;
2380   return Qnil;
2381 }
2382
2383 static void
2384 invalidate_charset_font_caches (Lisp_Object charset)
2385 {
2386   /* Invalidate font cache entries for charset on all devices. */
2387   Lisp_Object devcons, concons, hash_table;
2388   DEVICE_LOOP_NO_BREAK (devcons, concons)
2389     {
2390       struct device *d = XDEVICE (XCAR (devcons));
2391       hash_table = Fgethash (charset, d->charset_font_cache, Qunbound);
2392       if (!UNBOUNDP (hash_table))
2393         Fclrhash (hash_table);
2394     }
2395 }
2396
2397 DEFUN ("set-charset-registry", Fset_charset_registry, 2, 2, 0, /*
2398 Set the 'registry property of CHARSET to REGISTRY.
2399 */
2400        (charset, registry))
2401 {
2402   charset = Fget_charset (charset);
2403   CHECK_STRING (registry);
2404   XCHARSET_REGISTRY (charset) = registry;
2405   invalidate_charset_font_caches (charset);
2406   face_property_was_changed (Vdefault_face, Qfont, Qglobal);
2407   return Qnil;
2408 }
2409
2410 #ifdef UTF2000
2411 DEFUN ("charset-mapping-table", Fcharset_mapping_table, 1, 1, 0, /*
2412 Return mapping-table of CHARSET.
2413 */
2414        (charset))
2415 {
2416   return XCHARSET_DECODING_TABLE (Fget_charset (charset));
2417 }
2418
2419 DEFUN ("set-charset-mapping-table", Fset_charset_mapping_table, 2, 2, 0, /*
2420 Set mapping-table of CHARSET to TABLE.
2421 */
2422        (charset, table))
2423 {
2424   struct Lisp_Charset *cs;
2425   Lisp_Object old_table;
2426   size_t i;
2427
2428   charset = Fget_charset (charset);
2429   cs = XCHARSET (charset);
2430
2431   if (EQ (table, Qnil))
2432     {
2433       CHARSET_DECODING_TABLE(cs) = table;
2434       return table;
2435     }
2436   else if (VECTORP (table))
2437     {
2438       int ccs_len;
2439
2440       /* ad-hoc method for `ascii' */
2441       if ((CHARSET_CHARS (cs) == 94) &&
2442           (CHARSET_BYTE_OFFSET (cs) != 33))
2443         ccs_len = 128 - CHARSET_BYTE_OFFSET (cs);
2444       else
2445         ccs_len = CHARSET_CHARS (cs);
2446
2447       if (XVECTOR_LENGTH (table) > ccs_len)
2448         args_out_of_range (table, make_int (CHARSET_CHARS (cs)));
2449       old_table = CHARSET_DECODING_TABLE(cs);
2450       CHARSET_DECODING_TABLE(cs) = table;
2451     }
2452   else
2453     signal_error (Qwrong_type_argument,
2454                   list2 (build_translated_string ("vector-or-nil-p"),
2455                          table));
2456   /* signal_simple_error ("Wrong type argument: vector-or-nil-p", table); */
2457
2458   switch (CHARSET_DIMENSION (cs))
2459     {
2460     case 1:
2461       for (i = 0; i < XVECTOR_LENGTH (table); i++)
2462         {
2463           Lisp_Object c = XVECTOR_DATA(table)[i];
2464
2465           if (CHARP (c))
2466             put_char_attribute
2467               (c, charset,
2468                make_int (i + CHARSET_BYTE_OFFSET (cs)));
2469         }
2470       break;
2471     case 2:
2472       for (i = 0; i < XVECTOR_LENGTH (table); i++)
2473         {
2474           Lisp_Object v = XVECTOR_DATA(table)[i];
2475
2476           if (VECTORP (v))
2477             {
2478               size_t j;
2479
2480               if (XVECTOR_LENGTH (v) > CHARSET_CHARS (cs))
2481                 {
2482                   CHARSET_DECODING_TABLE(cs) = old_table;
2483                   args_out_of_range (v, make_int (CHARSET_CHARS (cs)));
2484                 }
2485               for (j = 0; j < XVECTOR_LENGTH (v); j++)
2486                 {
2487                   Lisp_Object c = XVECTOR_DATA(v)[j];
2488
2489                   if (CHARP (c))
2490                     put_char_attribute
2491                       (c, charset,
2492                        make_int ( ((i + CHARSET_BYTE_OFFSET (cs)) << 8)
2493                                   | (j + CHARSET_BYTE_OFFSET (cs)) ));
2494                 }
2495             }
2496           else if (CHARP (v))
2497             put_char_attribute (v, charset,
2498                                 make_int (i + CHARSET_BYTE_OFFSET (cs)));
2499         }
2500       break;
2501     }
2502   return table;
2503 }
2504 #endif
2505
2506 \f
2507 /************************************************************************/
2508 /*              Lisp primitives for working with characters             */
2509 /************************************************************************/
2510
2511 #ifdef UTF2000
2512 DEFUN ("decode-char", Fdecode_char, 2, 2, 0, /*
2513 Make a character from CHARSET and code-point CODE.
2514 */
2515        (charset, code))
2516 {
2517   int c;
2518
2519   charset = Fget_charset (charset);
2520   CHECK_INT (code);
2521   c = XINT (code);
2522   if (XCHARSET_GRAPHIC (charset) == 1)
2523     c &= 0x7F7F7F7F;
2524   return make_char (DECODE_CHAR (charset, c));
2525 }
2526 #endif
2527
2528 DEFUN ("make-char", Fmake_char, 2, 3, 0, /*
2529 Make a character from CHARSET and octets ARG1 and ARG2.
2530 ARG2 is required only for characters from two-dimensional charsets.
2531 For example, (make-char 'latin-iso8859-2 185) will return the Latin 2
2532 character s with caron.
2533 */
2534        (charset, arg1, arg2))
2535 {
2536   struct Lisp_Charset *cs;
2537   int a1, a2;
2538   int lowlim, highlim;
2539
2540   charset = Fget_charset (charset);
2541   cs = XCHARSET (charset);
2542
2543   if      (EQ (charset, Vcharset_ascii))     lowlim =  0, highlim = 127;
2544   else if (EQ (charset, Vcharset_control_1)) lowlim =  0, highlim =  31;
2545 #ifdef UTF2000
2546   else if (CHARSET_CHARS (cs) == 256)        lowlim =  0, highlim = 255;
2547 #endif
2548   else if (CHARSET_CHARS (cs) == 94)         lowlim = 33, highlim = 126;
2549   else  /* CHARSET_CHARS (cs) == 96) */      lowlim = 32, highlim = 127;
2550
2551   CHECK_INT (arg1);
2552   /* It is useful (and safe, according to Olivier Galibert) to strip
2553      the 8th bit off ARG1 and ARG2 becaue it allows programmers to
2554      write (make-char 'latin-iso8859-2 CODE) where code is the actual
2555      Latin 2 code of the character.  */
2556 #ifdef UTF2000
2557   a1 = XINT (arg1);
2558   if (highlim < 128)
2559     a1 &= 0x7f;
2560 #else
2561   a1 = XINT (arg1);
2562 #endif
2563   if (a1 < lowlim || a1 > highlim)
2564     args_out_of_range_3 (arg1, make_int (lowlim), make_int (highlim));
2565
2566   if (CHARSET_DIMENSION (cs) == 1)
2567     {
2568       if (!NILP (arg2))
2569         signal_simple_error
2570           ("Charset is of dimension one; second octet must be nil", arg2);
2571       return make_char (MAKE_CHAR (charset, a1, 0));
2572     }
2573
2574   CHECK_INT (arg2);
2575 #ifdef UTF2000
2576   a2 = XINT (arg2);
2577   if (highlim < 128)
2578     a2 &= 0x7f;
2579 #else
2580   a2 = XINT (arg2) & 0x7f;
2581 #endif
2582   if (a2 < lowlim || a2 > highlim)
2583     args_out_of_range_3 (arg2, make_int (lowlim), make_int (highlim));
2584
2585   return make_char (MAKE_CHAR (charset, a1, a2));
2586 }
2587
2588 DEFUN ("char-charset", Fchar_charset, 1, 1, 0, /*
2589 Return the character set of char CH.
2590 */
2591        (ch))
2592 {
2593   CHECK_CHAR_COERCE_INT (ch);
2594
2595   return XCHARSET_NAME (CHAR_CHARSET (XCHAR (ch)));
2596 }
2597
2598 DEFUN ("char-octet", Fchar_octet, 1, 2, 0, /*
2599 Return the octet numbered N (should be 0 or 1) of char CH.
2600 N defaults to 0 if omitted.
2601 */
2602        (ch, n))
2603 {
2604   Lisp_Object charset;
2605   int octet0, octet1;
2606
2607   CHECK_CHAR_COERCE_INT (ch);
2608
2609   BREAKUP_CHAR (XCHAR (ch), charset, octet0, octet1);
2610
2611   if (NILP (n) || EQ (n, Qzero))
2612     return make_int (octet0);
2613   else if (EQ (n, make_int (1)))
2614     return make_int (octet1);
2615   else
2616     signal_simple_error ("Octet number must be 0 or 1", n);
2617 }
2618
2619 DEFUN ("split-char", Fsplit_char, 1, 1, 0, /*
2620 Return list of charset and one or two position-codes of CHAR.
2621 */
2622        (character))
2623 {
2624   /* This function can GC */
2625   struct gcpro gcpro1, gcpro2;
2626   Lisp_Object charset = Qnil;
2627   Lisp_Object rc = Qnil;
2628 #ifdef UTF2000
2629   int code_point;
2630   int dimension;
2631 #else
2632   int c1, c2;
2633 #endif
2634
2635   GCPRO2 (charset, rc);
2636   CHECK_CHAR_COERCE_INT (character);
2637
2638 #ifdef UTF2000
2639   code_point = ENCODE_CHAR (XCHAR (character), charset);
2640   dimension = XCHARSET_DIMENSION (charset);
2641   while (dimension > 0)
2642     {
2643       rc = Fcons (make_int (code_point & 255), rc);
2644       code_point >>= 8;
2645       dimension--;
2646     }
2647   rc = Fcons (XCHARSET_NAME (charset), rc);
2648 #else
2649   BREAKUP_CHAR (XCHAR (character), charset, c1, c2);
2650
2651   if (XCHARSET_DIMENSION (Fget_charset (charset)) == 2)
2652     {
2653       rc = list3 (XCHARSET_NAME (charset), make_int (c1), make_int (c2));
2654     }
2655   else
2656     {
2657       rc = list2 (XCHARSET_NAME (charset), make_int (c1));
2658     }
2659 #endif
2660   UNGCPRO;
2661
2662   return rc;
2663 }
2664
2665 \f
2666 #ifdef ENABLE_COMPOSITE_CHARS
2667 /************************************************************************/
2668 /*                     composite character functions                    */
2669 /************************************************************************/
2670
2671 Emchar
2672 lookup_composite_char (Bufbyte *str, int len)
2673 {
2674   Lisp_Object lispstr = make_string (str, len);
2675   Lisp_Object ch = Fgethash (lispstr,
2676                              Vcomposite_char_string2char_hash_table,
2677                              Qunbound);
2678   Emchar emch;
2679
2680   if (UNBOUNDP (ch))
2681     {
2682       if (composite_char_row_next >= 128)
2683         signal_simple_error ("No more composite chars available", lispstr);
2684       emch = MAKE_CHAR (Vcharset_composite, composite_char_row_next,
2685                         composite_char_col_next);
2686       Fputhash (make_char (emch), lispstr,
2687                 Vcomposite_char_char2string_hash_table);
2688       Fputhash (lispstr, make_char (emch),
2689                 Vcomposite_char_string2char_hash_table);
2690       composite_char_col_next++;
2691       if (composite_char_col_next >= 128)
2692         {
2693           composite_char_col_next = 32;
2694           composite_char_row_next++;
2695         }
2696     }
2697   else
2698     emch = XCHAR (ch);
2699   return emch;
2700 }
2701
2702 Lisp_Object
2703 composite_char_string (Emchar ch)
2704 {
2705   Lisp_Object str = Fgethash (make_char (ch),
2706                               Vcomposite_char_char2string_hash_table,
2707                               Qunbound);
2708   assert (!UNBOUNDP (str));
2709   return str;
2710 }
2711
2712 xxDEFUN ("make-composite-char", Fmake_composite_char, 1, 1, 0, /*
2713 Convert a string into a single composite character.
2714 The character is the result of overstriking all the characters in
2715 the string.
2716 */
2717        (string))
2718 {
2719   CHECK_STRING (string);
2720   return make_char (lookup_composite_char (XSTRING_DATA (string),
2721                                            XSTRING_LENGTH (string)));
2722 }
2723
2724 xxDEFUN ("composite-char-string", Fcomposite_char_string, 1, 1, 0, /*
2725 Return a string of the characters comprising a composite character.
2726 */
2727        (ch))
2728 {
2729   Emchar emch;
2730
2731   CHECK_CHAR (ch);
2732   emch = XCHAR (ch);
2733   if (CHAR_LEADING_BYTE (emch) != LEADING_BYTE_COMPOSITE)
2734     signal_simple_error ("Must be composite char", ch);
2735   return composite_char_string (emch);
2736 }
2737 #endif /* ENABLE_COMPOSITE_CHARS */
2738
2739 \f
2740 /************************************************************************/
2741 /*                            initialization                            */
2742 /************************************************************************/
2743
2744 void
2745 syms_of_mule_charset (void)
2746 {
2747   DEFSUBR (Fcharsetp);
2748   DEFSUBR (Ffind_charset);
2749   DEFSUBR (Fget_charset);
2750   DEFSUBR (Fcharset_list);
2751   DEFSUBR (Fcharset_name);
2752   DEFSUBR (Fmake_charset);
2753   DEFSUBR (Fmake_reverse_direction_charset);
2754   /*  DEFSUBR (Freverse_direction_charset); */
2755   DEFSUBR (Fdefine_charset_alias);
2756   DEFSUBR (Fcharset_from_attributes);
2757   DEFSUBR (Fcharset_short_name);
2758   DEFSUBR (Fcharset_long_name);
2759   DEFSUBR (Fcharset_description);
2760   DEFSUBR (Fcharset_dimension);
2761   DEFSUBR (Fcharset_property);
2762   DEFSUBR (Fcharset_id);
2763   DEFSUBR (Fset_charset_ccl_program);
2764   DEFSUBR (Fset_charset_registry);
2765 #ifdef UTF2000
2766   DEFSUBR (Fchar_attribute_alist);
2767   DEFSUBR (Fget_char_attribute);
2768   DEFSUBR (Fput_char_attribute);
2769   DEFSUBR (Fremove_char_attribute);
2770   DEFSUBR (Fdefine_char);
2771   DEFSUBR (Fchar_variants);
2772   DEFSUBR (Fget_composite_char);
2773   DEFSUBR (Fcharset_mapping_table);
2774   DEFSUBR (Fset_charset_mapping_table);
2775 #endif
2776
2777 #ifdef UTF2000
2778   DEFSUBR (Fdecode_char);
2779 #endif
2780   DEFSUBR (Fmake_char);
2781   DEFSUBR (Fchar_charset);
2782   DEFSUBR (Fchar_octet);
2783   DEFSUBR (Fsplit_char);
2784
2785 #ifdef ENABLE_COMPOSITE_CHARS
2786   DEFSUBR (Fmake_composite_char);
2787   DEFSUBR (Fcomposite_char_string);
2788 #endif
2789
2790   defsymbol (&Qcharsetp, "charsetp");
2791   defsymbol (&Qregistry, "registry");
2792   defsymbol (&Qfinal, "final");
2793   defsymbol (&Qgraphic, "graphic");
2794   defsymbol (&Qdirection, "direction");
2795   defsymbol (&Qreverse_direction_charset, "reverse-direction-charset");
2796   defsymbol (&Qshort_name, "short-name");
2797   defsymbol (&Qlong_name, "long-name");
2798
2799   defsymbol (&Ql2r, "l2r");
2800   defsymbol (&Qr2l, "r2l");
2801
2802   /* Charsets, compatible with FSF 20.3
2803      Naming convention is Script-Charset[-Edition] */
2804   defsymbol (&Qascii,                   "ascii");
2805   defsymbol (&Qcontrol_1,               "control-1");
2806   defsymbol (&Qlatin_iso8859_1,         "latin-iso8859-1");
2807   defsymbol (&Qlatin_iso8859_2,         "latin-iso8859-2");
2808   defsymbol (&Qlatin_iso8859_3,         "latin-iso8859-3");
2809   defsymbol (&Qlatin_iso8859_4,         "latin-iso8859-4");
2810   defsymbol (&Qthai_tis620,             "thai-tis620");
2811   defsymbol (&Qgreek_iso8859_7,         "greek-iso8859-7");
2812   defsymbol (&Qarabic_iso8859_6,        "arabic-iso8859-6");
2813   defsymbol (&Qhebrew_iso8859_8,        "hebrew-iso8859-8");
2814   defsymbol (&Qkatakana_jisx0201,       "katakana-jisx0201");
2815   defsymbol (&Qlatin_jisx0201,          "latin-jisx0201");
2816   defsymbol (&Qcyrillic_iso8859_5,      "cyrillic-iso8859-5");
2817   defsymbol (&Qlatin_iso8859_9,         "latin-iso8859-9");
2818   defsymbol (&Qjapanese_jisx0208_1978,  "japanese-jisx0208-1978");
2819   defsymbol (&Qchinese_gb2312,          "chinese-gb2312");
2820   defsymbol (&Qjapanese_jisx0208,       "japanese-jisx0208");
2821   defsymbol (&Qjapanese_jisx0208_1990,  "japanese-jisx0208-1990");
2822   defsymbol (&Qkorean_ksc5601,          "korean-ksc5601");
2823   defsymbol (&Qjapanese_jisx0212,       "japanese-jisx0212");
2824   defsymbol (&Qchinese_cns11643_1,      "chinese-cns11643-1");
2825   defsymbol (&Qchinese_cns11643_2,      "chinese-cns11643-2");
2826 #ifdef UTF2000
2827   defsymbol (&Q_ucs,                    "->ucs");
2828   defsymbol (&Q_decomposition,          "->decomposition");
2829   defsymbol (&Qcompat,                  "compat");
2830   defsymbol (&Qisolated,                "isolated");
2831   defsymbol (&Qinitial,                 "initial");
2832   defsymbol (&Qmedial,                  "medial");
2833   defsymbol (&Qfinal,                   "final");
2834   defsymbol (&Qvertical,                "vertical");
2835   defsymbol (&QnoBreak,                 "noBreak");
2836   defsymbol (&Qfraction,                "fraction");
2837   defsymbol (&Qsuper,                   "super");
2838   defsymbol (&Qsub,                     "sub");
2839   defsymbol (&Qcircle,                  "circle");
2840   defsymbol (&Qsquare,                  "square");
2841   defsymbol (&Qwide,                    "wide");
2842   defsymbol (&Qnarrow,                  "narrow");
2843   defsymbol (&Qsmall,                   "small");
2844   defsymbol (&Qfont,                    "font");
2845   defsymbol (&Qucs,                     "ucs");
2846   defsymbol (&Qucs_bmp,                 "ucs-bmp");
2847   defsymbol (&Qlatin_viscii,            "latin-viscii");
2848   defsymbol (&Qlatin_tcvn5712,          "latin-tcvn5712");
2849   defsymbol (&Qlatin_viscii_lower,      "latin-viscii-lower");
2850   defsymbol (&Qlatin_viscii_upper,      "latin-viscii-upper");
2851   defsymbol (&Qvietnamese_viscii_lower, "vietnamese-viscii-lower");
2852   defsymbol (&Qvietnamese_viscii_upper, "vietnamese-viscii-upper");
2853   defsymbol (&Qideograph_daikanwa,      "ideograph-daikanwa");
2854   defsymbol (&Qmojikyo,                 "mojikyo");
2855   defsymbol (&Qmojikyo_pj_1,            "mojikyo-pj-1");
2856   defsymbol (&Qmojikyo_pj_2,            "mojikyo-pj-2");
2857   defsymbol (&Qmojikyo_pj_3,            "mojikyo-pj-3");
2858   defsymbol (&Qmojikyo_pj_4,            "mojikyo-pj-4");
2859   defsymbol (&Qmojikyo_pj_5,            "mojikyo-pj-5");
2860   defsymbol (&Qmojikyo_pj_6,            "mojikyo-pj-6");
2861   defsymbol (&Qmojikyo_pj_7,            "mojikyo-pj-7");
2862   defsymbol (&Qmojikyo_pj_8,            "mojikyo-pj-8");
2863   defsymbol (&Qmojikyo_pj_9,            "mojikyo-pj-9");
2864   defsymbol (&Qmojikyo_pj_10,           "mojikyo-pj-10");
2865   defsymbol (&Qmojikyo_pj_11,           "mojikyo-pj-11");
2866   defsymbol (&Qmojikyo_pj_12,           "mojikyo-pj-12");
2867   defsymbol (&Qmojikyo_pj_13,           "mojikyo-pj-13");
2868   defsymbol (&Qmojikyo_pj_14,           "mojikyo-pj-14");
2869   defsymbol (&Qmojikyo_pj_15,           "mojikyo-pj-15");
2870   defsymbol (&Qmojikyo_pj_16,           "mojikyo-pj-16");
2871   defsymbol (&Qmojikyo_pj_17,           "mojikyo-pj-17");
2872   defsymbol (&Qmojikyo_pj_18,           "mojikyo-pj-18");
2873   defsymbol (&Qmojikyo_pj_19,           "mojikyo-pj-19");
2874   defsymbol (&Qmojikyo_pj_20,           "mojikyo-pj-20");
2875   defsymbol (&Qmojikyo_pj_21,           "mojikyo-pj-21");
2876   defsymbol (&Qethiopic_ucs,            "ethiopic-ucs");
2877 #endif
2878   defsymbol (&Qchinese_big5_1,          "chinese-big5-1");
2879   defsymbol (&Qchinese_big5_2,          "chinese-big5-2");
2880
2881   defsymbol (&Qcomposite,               "composite");
2882 }
2883
2884 void
2885 vars_of_mule_charset (void)
2886 {
2887   int i, j;
2888 #ifndef UTF2000
2889   int k;
2890 #endif
2891
2892   chlook = xnew (struct charset_lookup);
2893   dumpstruct (&chlook, &charset_lookup_description);
2894
2895   /* Table of charsets indexed by leading byte. */
2896   for (i = 0; i < countof (chlook->charset_by_leading_byte); i++)
2897     chlook->charset_by_leading_byte[i] = Qnil;
2898
2899 #ifdef UTF2000
2900   /* Table of charsets indexed by type/final-byte. */
2901   for (i = 0; i < countof (chlook->charset_by_attributes); i++)
2902     for (j = 0; j < countof (chlook->charset_by_attributes[0]); j++)
2903       chlook->charset_by_attributes[i][j] = Qnil;
2904 #else
2905   /* Table of charsets indexed by type/final-byte/direction. */
2906   for (i = 0; i < countof (chlook->charset_by_attributes); i++)
2907     for (j = 0; j < countof (chlook->charset_by_attributes[0]); j++)
2908       for (k = 0; k < countof (chlook->charset_by_attributes[0][0]); k++)
2909         chlook->charset_by_attributes[i][j][k] = Qnil;
2910 #endif
2911
2912 #ifdef UTF2000
2913   next_allocated_leading_byte = MIN_LEADING_BYTE_PRIVATE;
2914 #else
2915   next_allocated_1_byte_leading_byte = MIN_LEADING_BYTE_PRIVATE_1;
2916   next_allocated_2_byte_leading_byte = MIN_LEADING_BYTE_PRIVATE_2;
2917 #endif
2918
2919 #ifndef UTF2000
2920   leading_code_private_11 = PRE_LEADING_BYTE_PRIVATE_1;
2921   DEFVAR_INT ("leading-code-private-11", &leading_code_private_11 /*
2922 Leading-code of private TYPE9N charset of column-width 1.
2923 */ );
2924   leading_code_private_11 = PRE_LEADING_BYTE_PRIVATE_1;
2925 #endif
2926
2927 #ifdef UTF2000
2928   Vutf_2000_version = build_string("0.15 (Sangō)");
2929   DEFVAR_LISP ("utf-2000-version", &Vutf_2000_version /*
2930 Version number of UTF-2000.
2931 */ );
2932
2933   staticpro (&Vcharacter_attribute_table);
2934   Vcharacter_attribute_table = make_char_code_table (Qnil);
2935
2936   staticpro (&Vcharacter_composition_table);
2937   Vcharacter_composition_table = make_char_code_table (Qnil);
2938
2939   staticpro (&Vcharacter_variant_table);
2940   Vcharacter_variant_table = make_char_code_table (Qnil);
2941
2942   Vdefault_coded_charset_priority_list = Qnil;
2943   DEFVAR_LISP ("default-coded-charset-priority-list",
2944                &Vdefault_coded_charset_priority_list /*
2945 Default order of preferred coded-character-sets.
2946 */ );
2947 #endif
2948 }
2949
2950 void
2951 complex_vars_of_mule_charset (void)
2952 {
2953   staticpro (&Vcharset_hash_table);
2954   Vcharset_hash_table =
2955     make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
2956
2957   /* Predefined character sets.  We store them into variables for
2958      ease of access. */
2959
2960 #ifdef UTF2000
2961   staticpro (&Vcharset_ucs);
2962   Vcharset_ucs =
2963     make_charset (LEADING_BYTE_UCS, Qucs, 256, 4,
2964                   1, 2, 0, CHARSET_LEFT_TO_RIGHT,
2965                   build_string ("UCS"),
2966                   build_string ("UCS"),
2967                   build_string ("ISO/IEC 10646"),
2968                   build_string (""),
2969                   Qnil, 0, 0xFFFFFFF, 0, 0);
2970   staticpro (&Vcharset_ucs_bmp);
2971   Vcharset_ucs_bmp =
2972     make_charset (LEADING_BYTE_UCS_BMP, Qucs_bmp, 256, 2,
2973                   1, 2, 0, CHARSET_LEFT_TO_RIGHT,
2974                   build_string ("BMP"),
2975                   build_string ("BMP"),
2976                   build_string ("ISO/IEC 10646 Group 0 Plane 0 (BMP)"),
2977                   build_string ("\\(ISO10646.*-1\\|UNICODE[23]?-0\\)"),
2978                   Qnil, 0, 0xFFFF, 0, 0);
2979 #else
2980 # define MIN_CHAR_THAI 0
2981 # define MAX_CHAR_THAI 0
2982 # define MIN_CHAR_HEBREW 0
2983 # define MAX_CHAR_HEBREW 0
2984 # define MIN_CHAR_HALFWIDTH_KATAKANA 0
2985 # define MAX_CHAR_HALFWIDTH_KATAKANA 0
2986 #endif
2987   staticpro (&Vcharset_ascii);
2988   Vcharset_ascii =
2989     make_charset (LEADING_BYTE_ASCII, Qascii, 94, 1,
2990                   1, 0, 'B', CHARSET_LEFT_TO_RIGHT,
2991                   build_string ("ASCII"),
2992                   build_string ("ASCII)"),
2993                   build_string ("ASCII (ISO646 IRV)"),
2994                   build_string ("\\(iso8859-[0-9]*\\|-ascii\\)"),
2995                   Qnil, 0, 0x7F, 0, 0);
2996   staticpro (&Vcharset_control_1);
2997   Vcharset_control_1 =
2998     make_charset (LEADING_BYTE_CONTROL_1, Qcontrol_1, 94, 1,
2999                   1, 1, 0, CHARSET_LEFT_TO_RIGHT,
3000                   build_string ("C1"),
3001                   build_string ("Control characters"),
3002                   build_string ("Control characters 128-191"),
3003                   build_string (""),
3004                   Qnil, 0x80, 0x9F, 0, 0);
3005   staticpro (&Vcharset_latin_iso8859_1);
3006   Vcharset_latin_iso8859_1 =
3007     make_charset (LEADING_BYTE_LATIN_ISO8859_1, Qlatin_iso8859_1, 96, 1,
3008                   1, 1, 'A', CHARSET_LEFT_TO_RIGHT,
3009                   build_string ("Latin-1"),
3010                   build_string ("ISO8859-1 (Latin-1)"),
3011                   build_string ("ISO8859-1 (Latin-1)"),
3012                   build_string ("iso8859-1"),
3013                   Qnil, 0xA0, 0xFF, 0, 32);
3014   staticpro (&Vcharset_latin_iso8859_2);
3015   Vcharset_latin_iso8859_2 =
3016     make_charset (LEADING_BYTE_LATIN_ISO8859_2, Qlatin_iso8859_2, 96, 1,
3017                   1, 1, 'B', CHARSET_LEFT_TO_RIGHT,
3018                   build_string ("Latin-2"),
3019                   build_string ("ISO8859-2 (Latin-2)"),
3020                   build_string ("ISO8859-2 (Latin-2)"),
3021                   build_string ("iso8859-2"),
3022                   Qnil, 0, 0, 0, 32);
3023   staticpro (&Vcharset_latin_iso8859_3);
3024   Vcharset_latin_iso8859_3 =
3025     make_charset (LEADING_BYTE_LATIN_ISO8859_3, Qlatin_iso8859_3, 96, 1,
3026                   1, 1, 'C', CHARSET_LEFT_TO_RIGHT,
3027                   build_string ("Latin-3"),
3028                   build_string ("ISO8859-3 (Latin-3)"),
3029                   build_string ("ISO8859-3 (Latin-3)"),
3030                   build_string ("iso8859-3"),
3031                   Qnil, 0, 0, 0, 32);
3032   staticpro (&Vcharset_latin_iso8859_4);
3033   Vcharset_latin_iso8859_4 =
3034     make_charset (LEADING_BYTE_LATIN_ISO8859_4, Qlatin_iso8859_4, 96, 1,
3035                   1, 1, 'D', CHARSET_LEFT_TO_RIGHT,
3036                   build_string ("Latin-4"),
3037                   build_string ("ISO8859-4 (Latin-4)"),
3038                   build_string ("ISO8859-4 (Latin-4)"),
3039                   build_string ("iso8859-4"),
3040                   Qnil, 0, 0, 0, 32);
3041   staticpro (&Vcharset_thai_tis620);
3042   Vcharset_thai_tis620 =
3043     make_charset (LEADING_BYTE_THAI_TIS620, Qthai_tis620, 96, 1,
3044                   1, 1, 'T', CHARSET_LEFT_TO_RIGHT,
3045                   build_string ("TIS620"),
3046                   build_string ("TIS620 (Thai)"),
3047                   build_string ("TIS620.2529 (Thai)"),
3048                   build_string ("tis620"),
3049                   Qnil, MIN_CHAR_THAI, MAX_CHAR_THAI, 0, 32);
3050   staticpro (&Vcharset_greek_iso8859_7);
3051   Vcharset_greek_iso8859_7 =
3052     make_charset (LEADING_BYTE_GREEK_ISO8859_7, Qgreek_iso8859_7, 96, 1,
3053                   1, 1, 'F', CHARSET_LEFT_TO_RIGHT,
3054                   build_string ("ISO8859-7"),
3055                   build_string ("ISO8859-7 (Greek)"),
3056                   build_string ("ISO8859-7 (Greek)"),
3057                   build_string ("iso8859-7"),
3058                   Qnil,
3059                   0 /* MIN_CHAR_GREEK */,
3060                   0 /* MAX_CHAR_GREEK */, 0, 32);
3061   staticpro (&Vcharset_arabic_iso8859_6);
3062   Vcharset_arabic_iso8859_6 =
3063     make_charset (LEADING_BYTE_ARABIC_ISO8859_6, Qarabic_iso8859_6, 96, 1,
3064                   1, 1, 'G', CHARSET_RIGHT_TO_LEFT,
3065                   build_string ("ISO8859-6"),
3066                   build_string ("ISO8859-6 (Arabic)"),
3067                   build_string ("ISO8859-6 (Arabic)"),
3068                   build_string ("iso8859-6"),
3069                   Qnil, 0, 0, 0, 32);
3070   staticpro (&Vcharset_hebrew_iso8859_8);
3071   Vcharset_hebrew_iso8859_8 =
3072     make_charset (LEADING_BYTE_HEBREW_ISO8859_8, Qhebrew_iso8859_8, 96, 1,
3073                   1, 1, 'H', CHARSET_RIGHT_TO_LEFT,
3074                   build_string ("ISO8859-8"),
3075                   build_string ("ISO8859-8 (Hebrew)"),
3076                   build_string ("ISO8859-8 (Hebrew)"),
3077                   build_string ("iso8859-8"),
3078                   Qnil, MIN_CHAR_HEBREW, MAX_CHAR_HEBREW, 0, 32);
3079   staticpro (&Vcharset_katakana_jisx0201);
3080   Vcharset_katakana_jisx0201 =
3081     make_charset (LEADING_BYTE_KATAKANA_JISX0201, Qkatakana_jisx0201, 94, 1,
3082                   1, 1, 'I', CHARSET_LEFT_TO_RIGHT,
3083                   build_string ("JISX0201 Kana"),
3084                   build_string ("JISX0201.1976 (Japanese Kana)"),
3085                   build_string ("JISX0201.1976 Japanese Kana"),
3086                   build_string ("jisx0201\\.1976"),
3087                   Qnil, 0, 0, 0, 33);
3088   staticpro (&Vcharset_latin_jisx0201);
3089   Vcharset_latin_jisx0201 =
3090     make_charset (LEADING_BYTE_LATIN_JISX0201, Qlatin_jisx0201, 94, 1,
3091                   1, 0, 'J', CHARSET_LEFT_TO_RIGHT,
3092                   build_string ("JISX0201 Roman"),
3093                   build_string ("JISX0201.1976 (Japanese Roman)"),
3094                   build_string ("JISX0201.1976 Japanese Roman"),
3095                   build_string ("jisx0201\\.1976"),
3096                   Qnil, 0, 0, 0, 33);
3097   staticpro (&Vcharset_cyrillic_iso8859_5);
3098   Vcharset_cyrillic_iso8859_5 =
3099     make_charset (LEADING_BYTE_CYRILLIC_ISO8859_5, Qcyrillic_iso8859_5, 96, 1,
3100                   1, 1, 'L', CHARSET_LEFT_TO_RIGHT,
3101                   build_string ("ISO8859-5"),
3102                   build_string ("ISO8859-5 (Cyrillic)"),
3103                   build_string ("ISO8859-5 (Cyrillic)"),
3104                   build_string ("iso8859-5"),
3105                   Qnil,
3106                   0 /* MIN_CHAR_CYRILLIC */,
3107                   0 /* MAX_CHAR_CYRILLIC */, 0, 32);
3108   staticpro (&Vcharset_latin_iso8859_9);
3109   Vcharset_latin_iso8859_9 =
3110     make_charset (LEADING_BYTE_LATIN_ISO8859_9, Qlatin_iso8859_9, 96, 1,
3111                   1, 1, 'M', CHARSET_LEFT_TO_RIGHT,
3112                   build_string ("Latin-5"),
3113                   build_string ("ISO8859-9 (Latin-5)"),
3114                   build_string ("ISO8859-9 (Latin-5)"),
3115                   build_string ("iso8859-9"),
3116                   Qnil, 0, 0, 0, 32);
3117   staticpro (&Vcharset_japanese_jisx0208_1978);
3118   Vcharset_japanese_jisx0208_1978 =
3119     make_charset (LEADING_BYTE_JAPANESE_JISX0208_1978,
3120                   Qjapanese_jisx0208_1978, 94, 2,
3121                   2, 0, '@', CHARSET_LEFT_TO_RIGHT,
3122                   build_string ("JIS X0208:1978"),
3123                   build_string ("JIS X0208:1978 (Japanese)"),
3124                   build_string
3125                   ("JIS X0208:1978 Japanese Kanji (so called \"old JIS\")"),
3126                   build_string ("\\(jisx0208\\|jisc6226\\)\\.1978"),
3127                   Qnil, 0, 0, 0, 33);
3128   staticpro (&Vcharset_chinese_gb2312);
3129   Vcharset_chinese_gb2312 =
3130     make_charset (LEADING_BYTE_CHINESE_GB2312, Qchinese_gb2312, 94, 2,
3131                   2, 0, 'A', CHARSET_LEFT_TO_RIGHT,
3132                   build_string ("GB2312"),
3133                   build_string ("GB2312)"),
3134                   build_string ("GB2312 Chinese simplified"),
3135                   build_string ("gb2312"),
3136                   Qnil, 0, 0, 0, 33);
3137   staticpro (&Vcharset_japanese_jisx0208);
3138   Vcharset_japanese_jisx0208 =
3139     make_charset (LEADING_BYTE_JAPANESE_JISX0208, Qjapanese_jisx0208, 94, 2,
3140                   2, 0, 'B', CHARSET_LEFT_TO_RIGHT,
3141                   build_string ("JISX0208"),
3142                   build_string ("JIS X0208:1983 (Japanese)"),
3143                   build_string ("JIS X0208:1983 Japanese Kanji"),
3144                   build_string ("jisx0208\\.1983"),
3145                   Qnil, 0, 0, 0, 33);
3146 #ifdef UTF2000
3147   staticpro (&Vcharset_japanese_jisx0208_1990);
3148   Vcharset_japanese_jisx0208_1990 =
3149     make_charset (LEADING_BYTE_JAPANESE_JISX0208_1990,
3150                   Qjapanese_jisx0208_1990, 94, 2,
3151                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3152                   build_string ("JISX0208-1990"),
3153                   build_string ("JIS X0208:1990 (Japanese)"),
3154                   build_string ("JIS X0208:1990 Japanese Kanji"),
3155                   build_string ("jisx0208\\.1990"),
3156                   Qnil,
3157                   MIN_CHAR_JIS_X0208_1990,
3158                   MAX_CHAR_JIS_X0208_1990, 0, 33);
3159 #endif
3160   staticpro (&Vcharset_korean_ksc5601);
3161   Vcharset_korean_ksc5601 =
3162     make_charset (LEADING_BYTE_KOREAN_KSC5601, Qkorean_ksc5601, 94, 2,
3163                   2, 0, 'C', CHARSET_LEFT_TO_RIGHT,
3164                   build_string ("KSC5601"),
3165                   build_string ("KSC5601 (Korean"),
3166                   build_string ("KSC5601 Korean Hangul and Hanja"),
3167                   build_string ("ksc5601"),
3168                   Qnil, 0, 0, 0, 33);
3169   staticpro (&Vcharset_japanese_jisx0212);
3170   Vcharset_japanese_jisx0212 =
3171     make_charset (LEADING_BYTE_JAPANESE_JISX0212, Qjapanese_jisx0212, 94, 2,
3172                   2, 0, 'D', CHARSET_LEFT_TO_RIGHT,
3173                   build_string ("JISX0212"),
3174                   build_string ("JISX0212 (Japanese)"),
3175                   build_string ("JISX0212 Japanese Supplement"),
3176                   build_string ("jisx0212"),
3177                   Qnil, 0, 0, 0, 33);
3178
3179 #define CHINESE_CNS_PLANE_RE(n) "cns11643[.-]\\(.*[.-]\\)?" n "$"
3180   staticpro (&Vcharset_chinese_cns11643_1);
3181   Vcharset_chinese_cns11643_1 =
3182     make_charset (LEADING_BYTE_CHINESE_CNS11643_1, Qchinese_cns11643_1, 94, 2,
3183                   2, 0, 'G', CHARSET_LEFT_TO_RIGHT,
3184                   build_string ("CNS11643-1"),
3185                   build_string ("CNS11643-1 (Chinese traditional)"),
3186                   build_string
3187                   ("CNS 11643 Plane 1 Chinese traditional"),
3188                   build_string (CHINESE_CNS_PLANE_RE("1")),
3189                   Qnil, 0, 0, 0, 33);
3190   staticpro (&Vcharset_chinese_cns11643_2);
3191   Vcharset_chinese_cns11643_2 =
3192     make_charset (LEADING_BYTE_CHINESE_CNS11643_2, Qchinese_cns11643_2, 94, 2,
3193                   2, 0, 'H', CHARSET_LEFT_TO_RIGHT,
3194                   build_string ("CNS11643-2"),
3195                   build_string ("CNS11643-2 (Chinese traditional)"),
3196                   build_string
3197                   ("CNS 11643 Plane 2 Chinese traditional"),
3198                   build_string (CHINESE_CNS_PLANE_RE("2")),
3199                   Qnil, 0, 0, 0, 33);
3200 #ifdef UTF2000
3201   staticpro (&Vcharset_latin_tcvn5712);
3202   Vcharset_latin_tcvn5712 =
3203     make_charset (LEADING_BYTE_LATIN_TCVN5712, Qlatin_tcvn5712, 96, 1,
3204                   1, 1, 'Z', CHARSET_LEFT_TO_RIGHT,
3205                   build_string ("TCVN 5712"),
3206                   build_string ("TCVN 5712 (VSCII-2)"),
3207                   build_string ("Vietnamese TCVN 5712:1983 (VSCII-2)"),
3208                   build_string ("tcvn5712-1"),
3209                   Qnil, 0, 0, 0, 32);
3210   staticpro (&Vcharset_latin_viscii_lower);
3211   Vcharset_latin_viscii_lower =
3212     make_charset (LEADING_BYTE_LATIN_VISCII_LOWER, Qlatin_viscii_lower, 96, 1,
3213                   1, 1, '1', CHARSET_LEFT_TO_RIGHT,
3214                   build_string ("VISCII lower"),
3215                   build_string ("VISCII lower (Vietnamese)"),
3216                   build_string ("VISCII lower (Vietnamese)"),
3217                   build_string ("MULEVISCII-LOWER"),
3218                   Qnil, 0, 0, 0, 32);
3219   staticpro (&Vcharset_latin_viscii_upper);
3220   Vcharset_latin_viscii_upper =
3221     make_charset (LEADING_BYTE_LATIN_VISCII_UPPER, Qlatin_viscii_upper, 96, 1,
3222                   1, 1, '2', CHARSET_LEFT_TO_RIGHT,
3223                   build_string ("VISCII upper"),
3224                   build_string ("VISCII upper (Vietnamese)"),
3225                   build_string ("VISCII upper (Vietnamese)"),
3226                   build_string ("MULEVISCII-UPPER"),
3227                   Qnil, 0, 0, 0, 32);
3228   staticpro (&Vcharset_latin_viscii);
3229   Vcharset_latin_viscii =
3230     make_charset (LEADING_BYTE_LATIN_VISCII, Qlatin_viscii, 256, 1,
3231                   1, 2, 0, CHARSET_LEFT_TO_RIGHT,
3232                   build_string ("VISCII"),
3233                   build_string ("VISCII 1.1 (Vietnamese)"),
3234                   build_string ("VISCII 1.1 (Vietnamese)"),
3235                   build_string ("VISCII1\\.1"),
3236                   Qnil, 0, 0, 0, 0);
3237   staticpro (&Vcharset_ideograph_daikanwa);
3238   Vcharset_ideograph_daikanwa =
3239     make_charset (LEADING_BYTE_DAIKANWA, Qideograph_daikanwa, 256, 2,
3240                   2, 2, 0, CHARSET_LEFT_TO_RIGHT,
3241                   build_string ("Daikanwa"),
3242                   build_string ("Morohashi's Daikanwa"),
3243                   build_string ("Daikanwa dictionary by MOROHASHI Tetsuji"),
3244                   build_string ("Daikanwa"),
3245                   Qnil, MIN_CHAR_DAIKANWA, MAX_CHAR_DAIKANWA, 0, 0);
3246   staticpro (&Vcharset_mojikyo);
3247   Vcharset_mojikyo =
3248     make_charset (LEADING_BYTE_MOJIKYO, Qmojikyo, 256, 3,
3249                   2, 2, 0, CHARSET_LEFT_TO_RIGHT,
3250                   build_string ("Mojikyo"),
3251                   build_string ("Mojikyo"),
3252                   build_string ("Konjaku-Mojikyo"),
3253                   build_string (""),
3254                   Qnil, MIN_CHAR_MOJIKYO, MAX_CHAR_MOJIKYO, 0, 0);
3255   staticpro (&Vcharset_mojikyo_pj_1);
3256   Vcharset_mojikyo_pj_1 =
3257     make_charset (LEADING_BYTE_MOJIKYO_PJ_1, Qmojikyo_pj_1, 94, 2,
3258                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3259                   build_string ("Mojikyo-PJ-1"),
3260                   build_string ("Mojikyo (pseudo JIS encoding) part 1"),
3261                   build_string
3262                   ("Konjaku-Mojikyo (pseudo JIS encoding) part 1"),
3263                   build_string ("jisx0208\\.Mojikyo-1$"),
3264                   Qnil, 0, 0, 0, 33);
3265   staticpro (&Vcharset_mojikyo_pj_2);
3266   Vcharset_mojikyo_pj_2 =
3267     make_charset (LEADING_BYTE_MOJIKYO_PJ_2, Qmojikyo_pj_2, 94, 2,
3268                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3269                   build_string ("Mojikyo-PJ-2"),
3270                   build_string ("Mojikyo (pseudo JIS encoding) part 2"),
3271                   build_string
3272                   ("Konjaku-Mojikyo (pseudo JIS encoding) part 2"),
3273                   build_string ("jisx0208\\.Mojikyo-2$"),
3274                   Qnil, 0, 0, 0, 33);
3275   staticpro (&Vcharset_mojikyo_pj_3);
3276   Vcharset_mojikyo_pj_3 =
3277     make_charset (LEADING_BYTE_MOJIKYO_PJ_3, Qmojikyo_pj_3, 94, 2,
3278                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3279                   build_string ("Mojikyo-PJ-3"),
3280                   build_string ("Mojikyo (pseudo JIS encoding) part 3"),
3281                   build_string
3282                   ("Konjaku-Mojikyo (pseudo JIS encoding) part 3"),
3283                   build_string ("jisx0208\\.Mojikyo-3$"),
3284                   Qnil, 0, 0, 0, 33);
3285   staticpro (&Vcharset_mojikyo_pj_4);
3286   Vcharset_mojikyo_pj_4 =
3287     make_charset (LEADING_BYTE_MOJIKYO_PJ_4, Qmojikyo_pj_4, 94, 2,
3288                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3289                   build_string ("Mojikyo-PJ-4"),
3290                   build_string ("Mojikyo (pseudo JIS encoding) part 4"),
3291                   build_string
3292                   ("Konjaku-Mojikyo (pseudo JIS encoding) part 4"),
3293                   build_string ("jisx0208\\.Mojikyo-4$"),
3294                   Qnil, 0, 0, 0, 33);
3295   staticpro (&Vcharset_mojikyo_pj_5);
3296   Vcharset_mojikyo_pj_5 =
3297     make_charset (LEADING_BYTE_MOJIKYO_PJ_5, Qmojikyo_pj_5, 94, 2,
3298                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3299                   build_string ("Mojikyo-PJ-5"),
3300                   build_string ("Mojikyo (pseudo JIS encoding) part 5"),
3301                   build_string
3302                   ("Konjaku-Mojikyo (pseudo JIS encoding) part 5"),
3303                   build_string ("jisx0208\\.Mojikyo-5$"),
3304                   Qnil, 0, 0, 0, 33);
3305   staticpro (&Vcharset_mojikyo_pj_6);
3306   Vcharset_mojikyo_pj_6 =
3307     make_charset (LEADING_BYTE_MOJIKYO_PJ_6, Qmojikyo_pj_6, 94, 2,
3308                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3309                   build_string ("Mojikyo-PJ-6"),
3310                   build_string ("Mojikyo (pseudo JIS encoding) part 6"),
3311                   build_string
3312                   ("Konjaku-Mojikyo (pseudo JIS encoding) part 6"),
3313                   build_string ("jisx0208\\.Mojikyo-6$"),
3314                   Qnil, 0, 0, 0, 33);
3315   staticpro (&Vcharset_mojikyo_pj_7);
3316   Vcharset_mojikyo_pj_7 =
3317     make_charset (LEADING_BYTE_MOJIKYO_PJ_7, Qmojikyo_pj_7, 94, 2,
3318                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3319                   build_string ("Mojikyo-PJ-7"),
3320                   build_string ("Mojikyo (pseudo JIS encoding) part 7"),
3321                   build_string
3322                   ("Konjaku-Mojikyo (pseudo JIS encoding) part 7"),
3323                   build_string ("jisx0208\\.Mojikyo-7$"),
3324                   Qnil, 0, 0, 0, 33);
3325   staticpro (&Vcharset_mojikyo_pj_8);
3326   Vcharset_mojikyo_pj_8 =
3327     make_charset (LEADING_BYTE_MOJIKYO_PJ_8, Qmojikyo_pj_8, 94, 2,
3328                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3329                   build_string ("Mojikyo-PJ-8"),
3330                   build_string ("Mojikyo (pseudo JIS encoding) part 8"),
3331                   build_string
3332                   ("Konjaku-Mojikyo (pseudo JIS encoding) part 8"),
3333                   build_string ("jisx0208\\.Mojikyo-8$"),
3334                   Qnil, 0, 0, 0, 33);
3335   staticpro (&Vcharset_mojikyo_pj_9);
3336   Vcharset_mojikyo_pj_9 =
3337     make_charset (LEADING_BYTE_MOJIKYO_PJ_9, Qmojikyo_pj_9, 94, 2,
3338                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3339                   build_string ("Mojikyo-PJ-9"),
3340                   build_string ("Mojikyo (pseudo JIS encoding) part 9"),
3341                   build_string
3342                   ("Konjaku-Mojikyo (pseudo JIS encoding) part 9"),
3343                   build_string ("jisx0208\\.Mojikyo-9$"),
3344                   Qnil, 0, 0, 0, 33);
3345   staticpro (&Vcharset_mojikyo_pj_10);
3346   Vcharset_mojikyo_pj_10 =
3347     make_charset (LEADING_BYTE_MOJIKYO_PJ_10, Qmojikyo_pj_10, 94, 2,
3348                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3349                   build_string ("Mojikyo-PJ-10"),
3350                   build_string ("Mojikyo (pseudo JIS encoding) part 10"),
3351                   build_string
3352                   ("Konjaku-Mojikyo (pseudo JIS encoding) part 10"),
3353                   build_string ("jisx0208\\.Mojikyo-10$"),
3354                   Qnil, 0, 0, 0, 33);
3355   staticpro (&Vcharset_mojikyo_pj_11);
3356   Vcharset_mojikyo_pj_11 =
3357     make_charset (LEADING_BYTE_MOJIKYO_PJ_11, Qmojikyo_pj_11, 94, 2,
3358                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3359                   build_string ("Mojikyo-PJ-11"),
3360                   build_string ("Mojikyo (pseudo JIS encoding) part 11"),
3361                   build_string
3362                   ("Konjaku-Mojikyo (pseudo JIS encoding) part 11"),
3363                   build_string ("jisx0208\\.Mojikyo-11$"),
3364                   Qnil, 0, 0, 0, 33);
3365   staticpro (&Vcharset_mojikyo_pj_12);
3366   Vcharset_mojikyo_pj_12 =
3367     make_charset (LEADING_BYTE_MOJIKYO_PJ_12, Qmojikyo_pj_12, 94, 2,
3368                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3369                   build_string ("Mojikyo-PJ-12"),
3370                   build_string ("Mojikyo (pseudo JIS encoding) part 12"),
3371                   build_string
3372                   ("Konjaku-Mojikyo (pseudo JIS encoding) part 12"),
3373                   build_string ("jisx0208\\.Mojikyo-12$"),
3374                   Qnil, 0, 0, 0, 33);
3375   staticpro (&Vcharset_mojikyo_pj_13);
3376   Vcharset_mojikyo_pj_13 =
3377     make_charset (LEADING_BYTE_MOJIKYO_PJ_13, Qmojikyo_pj_13, 94, 2,
3378                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3379                   build_string ("Mojikyo-PJ-13"),
3380                   build_string ("Mojikyo (pseudo JIS encoding) part 13"),
3381                   build_string
3382                   ("Konjaku-Mojikyo (pseudo JIS encoding) part 13"),
3383                   build_string ("jisx0208\\.Mojikyo-13$"),
3384                   Qnil, 0, 0, 0, 33);
3385   staticpro (&Vcharset_mojikyo_pj_14);
3386   Vcharset_mojikyo_pj_14 =
3387     make_charset (LEADING_BYTE_MOJIKYO_PJ_14, Qmojikyo_pj_14, 94, 2,
3388                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3389                   build_string ("Mojikyo-PJ-14"),
3390                   build_string ("Mojikyo (pseudo JIS encoding) part 14"),
3391                   build_string
3392                   ("Konjaku-Mojikyo (pseudo JIS encoding) part 14"),
3393                   build_string ("jisx0208\\.Mojikyo-14$"),
3394                   Qnil, 0, 0, 0, 33);
3395   staticpro (&Vcharset_mojikyo_pj_15);
3396   Vcharset_mojikyo_pj_15 =
3397     make_charset (LEADING_BYTE_MOJIKYO_PJ_15, Qmojikyo_pj_15, 94, 2,
3398                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3399                   build_string ("Mojikyo-PJ-15"),
3400                   build_string ("Mojikyo (pseudo JIS encoding) part 15"),
3401                   build_string
3402                   ("Konjaku-Mojikyo (pseudo JIS encoding) part 15"),
3403                   build_string ("jisx0208\\.Mojikyo-15$"),
3404                   Qnil, 0, 0, 0, 33);
3405   staticpro (&Vcharset_mojikyo_pj_16);
3406   Vcharset_mojikyo_pj_16 =
3407     make_charset (LEADING_BYTE_MOJIKYO_PJ_16, Qmojikyo_pj_16, 94, 2,
3408                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3409                   build_string ("Mojikyo-PJ-16"),
3410                   build_string ("Mojikyo (pseudo JIS encoding) part 16"),
3411                   build_string
3412                   ("Konjaku-Mojikyo (pseudo JIS encoding) part 16"),
3413                   build_string ("jisx0208\\.Mojikyo-16$"),
3414                   Qnil, 0, 0, 0, 33);
3415   staticpro (&Vcharset_mojikyo_pj_17);
3416   Vcharset_mojikyo_pj_17 =
3417     make_charset (LEADING_BYTE_MOJIKYO_PJ_17, Qmojikyo_pj_17, 94, 2,
3418                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3419                   build_string ("Mojikyo-PJ-17"),
3420                   build_string ("Mojikyo (pseudo JIS encoding) part 17"),
3421                   build_string
3422                   ("Konjaku-Mojikyo (pseudo JIS encoding) part 17"),
3423                   build_string ("jisx0208\\.Mojikyo-17$"),
3424                   Qnil, 0, 0, 0, 33);
3425   staticpro (&Vcharset_mojikyo_pj_18);
3426   Vcharset_mojikyo_pj_18 =
3427     make_charset (LEADING_BYTE_MOJIKYO_PJ_18, Qmojikyo_pj_18, 94, 2,
3428                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3429                   build_string ("Mojikyo-PJ-18"),
3430                   build_string ("Mojikyo (pseudo JIS encoding) part 18"),
3431                   build_string
3432                   ("Konjaku-Mojikyo (pseudo JIS encoding) part 18"),
3433                   build_string ("jisx0208\\.Mojikyo-18$"),
3434                   Qnil, 0, 0, 0, 33);
3435   staticpro (&Vcharset_mojikyo_pj_19);
3436   Vcharset_mojikyo_pj_19 =
3437     make_charset (LEADING_BYTE_MOJIKYO_PJ_19, Qmojikyo_pj_19, 94, 2,
3438                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3439                   build_string ("Mojikyo-PJ-19"),
3440                   build_string ("Mojikyo (pseudo JIS encoding) part 19"),
3441                   build_string
3442                   ("Konjaku-Mojikyo (pseudo JIS encoding) part 19"),
3443                   build_string ("jisx0208\\.Mojikyo-19$"),
3444                   Qnil, 0, 0, 0, 33);
3445   staticpro (&Vcharset_mojikyo_pj_20);
3446   Vcharset_mojikyo_pj_20 =
3447     make_charset (LEADING_BYTE_MOJIKYO_PJ_20, Qmojikyo_pj_20, 94, 2,
3448                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3449                   build_string ("Mojikyo-PJ-20"),
3450                   build_string ("Mojikyo (pseudo JIS encoding) part 20"),
3451                   build_string
3452                   ("Konjaku-Mojikyo (pseudo JIS encoding) part 20"),
3453                   build_string ("jisx0208\\.Mojikyo-20$"),
3454                   Qnil, 0, 0, 0, 33);
3455   staticpro (&Vcharset_mojikyo_pj_21);
3456   Vcharset_mojikyo_pj_21 =
3457     make_charset (LEADING_BYTE_MOJIKYO_PJ_21, Qmojikyo_pj_21, 94, 2,
3458                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3459                   build_string ("Mojikyo-PJ-21"),
3460                   build_string ("Mojikyo (pseudo JIS encoding) part 21"),
3461                   build_string
3462                   ("Konjaku-Mojikyo (pseudo JIS encoding) part 21"),
3463                   build_string ("jisx0208\\.Mojikyo-21$"),
3464                   Qnil, 0, 0, 0, 33);
3465   staticpro (&Vcharset_ethiopic_ucs);
3466   Vcharset_ethiopic_ucs =
3467     make_charset (LEADING_BYTE_ETHIOPIC_UCS, Qethiopic_ucs, 256, 2,
3468                   2, 2, 0, CHARSET_LEFT_TO_RIGHT,
3469                   build_string ("Ethiopic (UCS)"),
3470                   build_string ("Ethiopic (UCS)"),
3471                   build_string ("Ethiopic of UCS"),
3472                   build_string ("Ethiopic-Unicode"),
3473                   Qnil, 0x1200, 0x137F, 0x1200, 0);
3474 #endif
3475   staticpro (&Vcharset_chinese_big5_1);
3476   Vcharset_chinese_big5_1 =
3477     make_charset (LEADING_BYTE_CHINESE_BIG5_1, Qchinese_big5_1, 94, 2,
3478                   2, 0, '0', CHARSET_LEFT_TO_RIGHT,
3479                   build_string ("Big5"),
3480                   build_string ("Big5 (Level-1)"),
3481                   build_string
3482                   ("Big5 Level-1 Chinese traditional"),
3483                   build_string ("big5"),
3484                   Qnil, 0, 0, 0, 33);
3485   staticpro (&Vcharset_chinese_big5_2);
3486   Vcharset_chinese_big5_2 =
3487     make_charset (LEADING_BYTE_CHINESE_BIG5_2, Qchinese_big5_2, 94, 2,
3488                   2, 0, '1', CHARSET_LEFT_TO_RIGHT,
3489                   build_string ("Big5"),
3490                   build_string ("Big5 (Level-2)"),
3491                   build_string
3492                   ("Big5 Level-2 Chinese traditional"),
3493                   build_string ("big5"),
3494                   Qnil, 0, 0, 0, 33);
3495
3496 #ifdef ENABLE_COMPOSITE_CHARS
3497   /* #### For simplicity, we put composite chars into a 96x96 charset.
3498      This is going to lead to problems because you can run out of
3499      room, esp. as we don't yet recycle numbers. */
3500   staticpro (&Vcharset_composite);
3501   Vcharset_composite =
3502     make_charset (LEADING_BYTE_COMPOSITE, Qcomposite, 96, 2,
3503                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3504                   build_string ("Composite"),
3505                   build_string ("Composite characters"),
3506                   build_string ("Composite characters"),
3507                   build_string (""));
3508
3509   /* #### not dumped properly */
3510   composite_char_row_next = 32;
3511   composite_char_col_next = 32;
3512
3513   Vcomposite_char_string2char_hash_table =
3514     make_lisp_hash_table (500, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL);
3515   Vcomposite_char_char2string_hash_table =
3516     make_lisp_hash_table (500, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
3517   staticpro (&Vcomposite_char_string2char_hash_table);
3518   staticpro (&Vcomposite_char_char2string_hash_table);
3519 #endif /* ENABLE_COMPOSITE_CHARS */
3520
3521 }