git.chise.org Git - chise/xemacs-chise.git-/blob - src/mule-charset.c

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