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