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