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