src/mule-charset.c

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