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