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