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