src/mule-charset.c

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