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

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