git.chise.org Git - chise/xemacs-chise.git-/blob - src/mule-charset.c

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