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

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