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   int byte_offset = -1;
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
1556   if (byte_offset < 0)
1557     {
1558       if (chars == 94)
1559         byte_offset = 33;
1560       else if (chars == 96)
1561         byte_offset = 32;
1562       else
1563         byte_offset = 0;
1564     }
1565
1566   charset = make_charset (id, name, type, columns, graphic,
1567                           final, direction, short_name, long_name,
1568                           doc_string, registry,
1569                           Qnil, 0, 0, 0, byte_offset);
1570   if (!NILP (ccl_program))
1571     XCHARSET_CCL_PROGRAM (charset) = ccl_program;
1572   return charset;
1573 }
1574
1575 DEFUN ("make-reverse-direction-charset", Fmake_reverse_direction_charset,
1576        2, 2, 0, /*
1577 Make a charset equivalent to CHARSET but which goes in the opposite direction.
1578 NEW-NAME is the name of the new charset.  Return the new charset.
1579 */
1580        (charset, new_name))
1581 {
1582   Lisp_Object new_charset = Qnil;
1583   int id, dimension, columns, graphic, final;
1584   int direction, type;
1585   Lisp_Object registry, doc_string, short_name, long_name;
1586   struct Lisp_Charset *cs;
1587
1588   charset = Fget_charset (charset);
1589   if (!NILP (XCHARSET_REVERSE_DIRECTION_CHARSET (charset)))
1590     signal_simple_error ("Charset already has reverse-direction charset",
1591                          charset);
1592
1593   CHECK_SYMBOL (new_name);
1594   if (!NILP (Ffind_charset (new_name)))
1595     signal_simple_error ("Cannot redefine existing charset", new_name);
1596
1597   cs = XCHARSET (charset);
1598
1599   type      = CHARSET_TYPE      (cs);
1600   columns   = CHARSET_COLUMNS   (cs);
1601   dimension = CHARSET_DIMENSION (cs);
1602   id = get_unallocated_leading_byte (dimension);
1603
1604   graphic = CHARSET_GRAPHIC (cs);
1605   final = CHARSET_FINAL (cs);
1606   direction = CHARSET_RIGHT_TO_LEFT;
1607   if (CHARSET_DIRECTION (cs) == CHARSET_RIGHT_TO_LEFT)
1608     direction = CHARSET_LEFT_TO_RIGHT;
1609   doc_string = CHARSET_DOC_STRING (cs);
1610   short_name = CHARSET_SHORT_NAME (cs);
1611   long_name = CHARSET_LONG_NAME (cs);
1612   registry = CHARSET_REGISTRY (cs);
1613
1614   new_charset = make_charset (id, new_name, type, columns,
1615                               graphic, final, direction, short_name, long_name,
1616                               doc_string, registry,
1617 #ifdef UTF2000
1618                               CHARSET_DECODING_TABLE(cs),
1619                               CHARSET_UCS_MIN(cs),
1620                               CHARSET_UCS_MAX(cs),
1621                               CHARSET_CODE_OFFSET(cs),
1622                               CHARSET_BYTE_OFFSET(cs)
1623 #else
1624                               Qnil, 0, 0, 0, 0
1625 #endif
1626 );
1627
1628   CHARSET_REVERSE_DIRECTION_CHARSET (cs) = new_charset;
1629   XCHARSET_REVERSE_DIRECTION_CHARSET (new_charset) = charset;
1630
1631   return new_charset;
1632 }
1633
1634 DEFUN ("define-charset-alias", Fdefine_charset_alias, 2, 2, 0, /*
1635 Define symbol ALIAS as an alias for CHARSET.
1636 */
1637        (alias, charset))
1638 {
1639   CHECK_SYMBOL (alias);
1640   charset = Fget_charset (charset);
1641   return Fputhash (alias, charset, Vcharset_hash_table);
1642 }
1643
1644 /* #### Reverse direction charsets not yet implemented.  */
1645 #if 0
1646 DEFUN ("charset-reverse-direction-charset", Fcharset_reverse_direction_charset,
1647        1, 1, 0, /*
1648 Return the reverse-direction charset parallel to CHARSET, if any.
1649 This is the charset with the same properties (in particular, the same
1650 dimension, number of characters per dimension, and final byte) as
1651 CHARSET but whose characters are displayed in the opposite direction.
1652 */
1653        (charset))
1654 {
1655   charset = Fget_charset (charset);
1656   return XCHARSET_REVERSE_DIRECTION_CHARSET (charset);
1657 }
1658 #endif
1659
1660 DEFUN ("charset-from-attributes", Fcharset_from_attributes, 3, 4, 0, /*
1661 Return a charset with the given DIMENSION, CHARS, FINAL, and DIRECTION.
1662 If DIRECTION is omitted, both directions will be checked (left-to-right
1663 will be returned if character sets exist for both directions).
1664 */
1665        (dimension, chars, final, direction))
1666 {
1667   int dm, ch, fi, di = -1;
1668   int type;
1669   Lisp_Object obj = Qnil;
1670
1671   CHECK_INT (dimension);
1672   dm = XINT (dimension);
1673   if (dm < 1 || dm > 2)
1674     signal_simple_error ("Invalid value for DIMENSION", dimension);
1675
1676   CHECK_INT (chars);
1677   ch = XINT (chars);
1678   if (ch != 94 && ch != 96)
1679     signal_simple_error ("Invalid value for CHARS", chars);
1680
1681   CHECK_CHAR_COERCE_INT (final);
1682   fi = XCHAR (final);
1683   if (fi < '0' || fi > '~')
1684     signal_simple_error ("Invalid value for FINAL", final);
1685
1686   if (EQ (direction, Ql2r))
1687     di = CHARSET_LEFT_TO_RIGHT;
1688   else if (EQ (direction, Qr2l))
1689     di = CHARSET_RIGHT_TO_LEFT;
1690   else if (!NILP (direction))
1691     signal_simple_error ("Invalid value for DIRECTION", direction);
1692
1693   if (dm == 2 && fi > 0x5F)
1694     signal_simple_error
1695       ("Final must be in the range 0x30 - 0x5F for dimension == 2", final);
1696
1697   if (dm == 1)
1698     type = (ch == 94) ? CHARSET_TYPE_94    : CHARSET_TYPE_96;
1699   else
1700     type = (ch == 94) ? CHARSET_TYPE_94X94 : CHARSET_TYPE_96X96;
1701
1702   if (di == -1)
1703     {
1704       obj = CHARSET_BY_ATTRIBUTES (type, fi, CHARSET_LEFT_TO_RIGHT);
1705       if (NILP (obj))
1706         obj = CHARSET_BY_ATTRIBUTES (type, fi, CHARSET_RIGHT_TO_LEFT);
1707     }
1708   else
1709     obj = CHARSET_BY_ATTRIBUTES (type, fi, di);
1710
1711   if (CHARSETP (obj))
1712     return XCHARSET_NAME (obj);
1713   return obj;
1714 }
1715
1716 DEFUN ("charset-short-name", Fcharset_short_name, 1, 1, 0, /*
1717 Return short name of CHARSET.
1718 */
1719        (charset))
1720 {
1721   return XCHARSET_SHORT_NAME (Fget_charset (charset));
1722 }
1723
1724 DEFUN ("charset-long-name", Fcharset_long_name, 1, 1, 0, /*
1725 Return long name of CHARSET.
1726 */
1727        (charset))
1728 {
1729   return XCHARSET_LONG_NAME (Fget_charset (charset));
1730 }
1731
1732 DEFUN ("charset-description", Fcharset_description, 1, 1, 0, /*
1733 Return description of CHARSET.
1734 */
1735        (charset))
1736 {
1737   return XCHARSET_DOC_STRING (Fget_charset (charset));
1738 }
1739
1740 DEFUN ("charset-dimension", Fcharset_dimension, 1, 1, 0, /*
1741 Return dimension of CHARSET.
1742 */
1743        (charset))
1744 {
1745   return make_int (XCHARSET_DIMENSION (Fget_charset (charset)));
1746 }
1747
1748 DEFUN ("charset-property", Fcharset_property, 2, 2, 0, /*
1749 Return property PROP of CHARSET.
1750 Recognized properties are those listed in `make-charset', as well as
1751 'name and 'doc-string.
1752 */
1753        (charset, prop))
1754 {
1755   struct Lisp_Charset *cs;
1756
1757   charset = Fget_charset (charset);
1758   cs = XCHARSET (charset);
1759
1760   CHECK_SYMBOL (prop);
1761   if (EQ (prop, Qname))        return CHARSET_NAME (cs);
1762   if (EQ (prop, Qshort_name))  return CHARSET_SHORT_NAME (cs);
1763   if (EQ (prop, Qlong_name))   return CHARSET_LONG_NAME (cs);
1764   if (EQ (prop, Qdoc_string))  return CHARSET_DOC_STRING (cs);
1765   if (EQ (prop, Qdimension))   return make_int (CHARSET_DIMENSION (cs));
1766   if (EQ (prop, Qcolumns))     return make_int (CHARSET_COLUMNS (cs));
1767   if (EQ (prop, Qgraphic))     return make_int (CHARSET_GRAPHIC (cs));
1768   if (EQ (prop, Qfinal))       return make_char (CHARSET_FINAL (cs));
1769   if (EQ (prop, Qchars))       return make_int (CHARSET_CHARS (cs));
1770   if (EQ (prop, Qregistry))    return CHARSET_REGISTRY (cs);
1771   if (EQ (prop, Qccl_program)) return CHARSET_CCL_PROGRAM (cs);
1772   if (EQ (prop, Qdirection))
1773     return CHARSET_DIRECTION (cs) == CHARSET_LEFT_TO_RIGHT ? Ql2r : Qr2l;
1774   if (EQ (prop, Qreverse_direction_charset))
1775     {
1776       Lisp_Object obj = CHARSET_REVERSE_DIRECTION_CHARSET (cs);
1777       if (NILP (obj))
1778         return Qnil;
1779       else
1780         return XCHARSET_NAME (obj);
1781     }
1782   signal_simple_error ("Unrecognized charset property name", prop);
1783   return Qnil; /* not reached */
1784 }
1785
1786 DEFUN ("charset-id", Fcharset_id, 1, 1, 0, /*
1787 Return charset identification number of CHARSET.
1788 */
1789         (charset))
1790 {
1791   return make_int(XCHARSET_LEADING_BYTE (Fget_charset (charset)));
1792 }
1793
1794 /* #### We need to figure out which properties we really want to
1795    allow to be set. */
1796
1797 DEFUN ("set-charset-ccl-program", Fset_charset_ccl_program, 2, 2, 0, /*
1798 Set the 'ccl-program property of CHARSET to CCL-PROGRAM.
1799 */
1800        (charset, ccl_program))
1801 {
1802   charset = Fget_charset (charset);
1803   CHECK_VECTOR (ccl_program);
1804   XCHARSET_CCL_PROGRAM (charset) = ccl_program;
1805   return Qnil;
1806 }
1807
1808 static void
1809 invalidate_charset_font_caches (Lisp_Object charset)
1810 {
1811   /* Invalidate font cache entries for charset on all devices. */
1812   Lisp_Object devcons, concons, hash_table;
1813   DEVICE_LOOP_NO_BREAK (devcons, concons)
1814     {
1815       struct device *d = XDEVICE (XCAR (devcons));
1816       hash_table = Fgethash (charset, d->charset_font_cache, Qunbound);
1817       if (!UNBOUNDP (hash_table))
1818         Fclrhash (hash_table);
1819     }
1820 }
1821
1822 DEFUN ("set-charset-registry", Fset_charset_registry, 2, 2, 0, /*
1823 Set the 'registry property of CHARSET to REGISTRY.
1824 */
1825        (charset, registry))
1826 {
1827   charset = Fget_charset (charset);
1828   CHECK_STRING (registry);
1829   XCHARSET_REGISTRY (charset) = registry;
1830   invalidate_charset_font_caches (charset);
1831   face_property_was_changed (Vdefault_face, Qfont, Qglobal);
1832   return Qnil;
1833 }
1834
1835 #ifdef UTF2000
1836 DEFUN ("charset-mapping-table", Fcharset_mapping_table, 1, 1, 0, /*
1837 Return mapping-table of CHARSET.
1838 */
1839        (charset))
1840 {
1841   return XCHARSET_DECODING_TABLE (Fget_charset (charset));
1842 }
1843
1844 DEFUN ("set-charset-mapping-table", Fset_charset_mapping_table, 2, 2, 0, /*
1845 Set mapping-table of CHARSET to TABLE.
1846 */
1847        (charset, table))
1848 {
1849   struct Lisp_Charset *cs;
1850   Lisp_Object old_table;
1851   size_t i;
1852
1853   charset = Fget_charset (charset);
1854   cs = XCHARSET (charset);
1855
1856   if (EQ (table, Qnil))
1857     {
1858       CHARSET_DECODING_TABLE(cs) = table;
1859       return table;
1860     }
1861   else if (VECTORP (table))
1862     {
1863       if (XVECTOR_LENGTH (table) > CHARSET_CHARS (cs))
1864         args_out_of_range (table, make_int (CHARSET_CHARS (cs)));
1865       old_table = CHARSET_DECODING_TABLE(cs);
1866       CHARSET_DECODING_TABLE(cs) = table;
1867     }
1868   else
1869     signal_error (Qwrong_type_argument,
1870                   list2 (build_translated_string ("vector-or-nil-p"),
1871                          table));
1872   /* signal_simple_error ("Wrong type argument: vector-or-nil-p", table); */
1873
1874   switch (CHARSET_DIMENSION (cs))
1875     {
1876     case 1:
1877       for (i = 0; i < XVECTOR_LENGTH (table); i++)
1878         {
1879           Lisp_Object c = XVECTOR_DATA(table)[i];
1880
1881           if (CHARP (c))
1882             put_char_attribute
1883               (c, charset,
1884                list1 (make_int (i + CHARSET_BYTE_OFFSET (cs))));
1885         }
1886       break;
1887     case 2:
1888       for (i = 0; i < XVECTOR_LENGTH (table); i++)
1889         {
1890           Lisp_Object v = XVECTOR_DATA(table)[i];
1891
1892           if (VECTORP (v))
1893             {
1894               size_t j;
1895
1896               if (XVECTOR_LENGTH (v) > CHARSET_CHARS (cs))
1897                 {
1898                   CHARSET_DECODING_TABLE(cs) = old_table;
1899                   args_out_of_range (v, make_int (CHARSET_CHARS (cs)));
1900                 }
1901               for (j = 0; j < XVECTOR_LENGTH (v); j++)
1902                 {
1903                   Lisp_Object c = XVECTOR_DATA(v)[j];
1904
1905                   if (CHARP (c))
1906                     put_char_attribute (c, charset,
1907                                         list2
1908                                         (make_int
1909                                          (i + CHARSET_BYTE_OFFSET (cs)),
1910                                          make_int
1911                                          (j + CHARSET_BYTE_OFFSET (cs))));
1912                 }
1913             }
1914           else if (CHARP (v))
1915             put_char_attribute (v, charset,
1916                                 list1
1917                                 (make_int (i + CHARSET_BYTE_OFFSET (cs))));
1918         }
1919       break;
1920     }
1921   return table;
1922 }
1923 #endif
1924
1925 \f
1926 /************************************************************************/
1927 /*              Lisp primitives for working with characters             */
1928 /************************************************************************/
1929
1930 DEFUN ("make-char", Fmake_char, 2, 3, 0, /*
1931 Make a character from CHARSET and octets ARG1 and ARG2.
1932 ARG2 is required only for characters from two-dimensional charsets.
1933 For example, (make-char 'latin-iso8859-2 185) will return the Latin 2
1934 character s with caron.
1935 */
1936        (charset, arg1, arg2))
1937 {
1938   struct Lisp_Charset *cs;
1939   int a1, a2;
1940   int lowlim, highlim;
1941
1942   charset = Fget_charset (charset);
1943   cs = XCHARSET (charset);
1944
1945   if      (EQ (charset, Vcharset_ascii))     lowlim =  0, highlim = 127;
1946   else if (EQ (charset, Vcharset_control_1)) lowlim =  0, highlim =  31;
1947 #ifdef UTF2000
1948   else if (CHARSET_CHARS (cs) == 256)        lowlim =  0, highlim = 255;
1949 #endif
1950   else if (CHARSET_CHARS (cs) == 94)         lowlim = 33, highlim = 126;
1951   else  /* CHARSET_CHARS (cs) == 96) */      lowlim = 32, highlim = 127;
1952
1953   CHECK_INT (arg1);
1954   /* It is useful (and safe, according to Olivier Galibert) to strip
1955      the 8th bit off ARG1 and ARG2 becaue it allows programmers to
1956      write (make-char 'latin-iso8859-2 CODE) where code is the actual
1957      Latin 2 code of the character.  */
1958 #ifdef UTF2000
1959   a1 = XINT (arg1);
1960   if (highlim < 128)
1961     a1 &= 0x7f;
1962 #else
1963   a1 = XINT (arg1);
1964 #endif
1965   if (a1 < lowlim || a1 > highlim)
1966     args_out_of_range_3 (arg1, make_int (lowlim), make_int (highlim));
1967
1968   if (CHARSET_DIMENSION (cs) == 1)
1969     {
1970       if (!NILP (arg2))
1971         signal_simple_error
1972           ("Charset is of dimension one; second octet must be nil", arg2);
1973       return make_char (MAKE_CHAR (charset, a1, 0));
1974     }
1975
1976   CHECK_INT (arg2);
1977 #ifdef UTF2000
1978   a2 = XINT (arg2);
1979   if (highlim < 128)
1980     a2 &= 0x7f;
1981 #else
1982   a2 = XINT (arg2) & 0x7f;
1983 #endif
1984   if (a2 < lowlim || a2 > highlim)
1985     args_out_of_range_3 (arg2, make_int (lowlim), make_int (highlim));
1986
1987   return make_char (MAKE_CHAR (charset, a1, a2));
1988 }
1989
1990 DEFUN ("char-charset", Fchar_charset, 1, 1, 0, /*
1991 Return the character set of char CH.
1992 */
1993        (ch))
1994 {
1995   CHECK_CHAR_COERCE_INT (ch);
1996
1997   return XCHARSET_NAME (CHAR_CHARSET (XCHAR (ch)));
1998 }
1999
2000 DEFUN ("split-char", Fsplit_char, 1, 1, 0, /*
2001 Return list of charset and one or two position-codes of CHAR.
2002 */
2003        (character))
2004 {
2005   /* This function can GC */
2006   struct gcpro gcpro1, gcpro2;
2007   Lisp_Object charset = Qnil;
2008   Lisp_Object rc = Qnil;
2009   int c1, c2;
2010
2011   GCPRO2 (charset, rc);
2012   CHECK_CHAR_COERCE_INT (character);
2013
2014   BREAKUP_CHAR (XCHAR (character), charset, c1, c2);
2015
2016   if (XCHARSET_DIMENSION (Fget_charset (charset)) == 2)
2017     {
2018       rc = list3 (XCHARSET_NAME (charset), make_int (c1), make_int (c2));
2019     }
2020   else
2021     {
2022       rc = list2 (XCHARSET_NAME (charset), make_int (c1));
2023     }
2024   UNGCPRO;
2025
2026   return rc;
2027 }
2028
2029 \f
2030 #ifdef ENABLE_COMPOSITE_CHARS
2031 /************************************************************************/
2032 /*                     composite character functions                    */
2033 /************************************************************************/
2034
2035 Emchar
2036 lookup_composite_char (Bufbyte *str, int len)
2037 {
2038   Lisp_Object lispstr = make_string (str, len);
2039   Lisp_Object ch = Fgethash (lispstr,
2040                              Vcomposite_char_string2char_hash_table,
2041                              Qunbound);
2042   Emchar emch;
2043
2044   if (UNBOUNDP (ch))
2045     {
2046       if (composite_char_row_next >= 128)
2047         signal_simple_error ("No more composite chars available", lispstr);
2048       emch = MAKE_CHAR (Vcharset_composite, composite_char_row_next,
2049                         composite_char_col_next);
2050       Fputhash (make_char (emch), lispstr,
2051                 Vcomposite_char_char2string_hash_table);
2052       Fputhash (lispstr, make_char (emch),
2053                 Vcomposite_char_string2char_hash_table);
2054       composite_char_col_next++;
2055       if (composite_char_col_next >= 128)
2056         {
2057           composite_char_col_next = 32;
2058           composite_char_row_next++;
2059         }
2060     }
2061   else
2062     emch = XCHAR (ch);
2063   return emch;
2064 }
2065
2066 Lisp_Object
2067 composite_char_string (Emchar ch)
2068 {
2069   Lisp_Object str = Fgethash (make_char (ch),
2070                               Vcomposite_char_char2string_hash_table,
2071                               Qunbound);
2072   assert (!UNBOUNDP (str));
2073   return str;
2074 }
2075
2076 xxDEFUN ("make-composite-char", Fmake_composite_char, 1, 1, 0, /*
2077 Convert a string into a single composite character.
2078 The character is the result of overstriking all the characters in
2079 the string.
2080 */
2081        (string))
2082 {
2083   CHECK_STRING (string);
2084   return make_char (lookup_composite_char (XSTRING_DATA (string),
2085                                            XSTRING_LENGTH (string)));
2086 }
2087
2088 xxDEFUN ("composite-char-string", Fcomposite_char_string, 1, 1, 0, /*
2089 Return a string of the characters comprising a composite character.
2090 */
2091        (ch))
2092 {
2093   Emchar emch;
2094
2095   CHECK_CHAR (ch);
2096   emch = XCHAR (ch);
2097   if (CHAR_LEADING_BYTE (emch) != LEADING_BYTE_COMPOSITE)
2098     signal_simple_error ("Must be composite char", ch);
2099   return composite_char_string (emch);
2100 }
2101 #endif /* ENABLE_COMPOSITE_CHARS */
2102
2103 \f
2104 /************************************************************************/
2105 /*                            initialization                            */
2106 /************************************************************************/
2107
2108 void
2109 syms_of_mule_charset (void)
2110 {
2111   DEFSUBR (Fcharsetp);
2112   DEFSUBR (Ffind_charset);
2113   DEFSUBR (Fget_charset);
2114   DEFSUBR (Fcharset_list);
2115   DEFSUBR (Fcharset_name);
2116   DEFSUBR (Fmake_charset);
2117   DEFSUBR (Fmake_reverse_direction_charset);
2118   /*  DEFSUBR (Freverse_direction_charset); */
2119   DEFSUBR (Fdefine_charset_alias);
2120   DEFSUBR (Fcharset_from_attributes);
2121   DEFSUBR (Fcharset_short_name);
2122   DEFSUBR (Fcharset_long_name);
2123   DEFSUBR (Fcharset_description);
2124   DEFSUBR (Fcharset_dimension);
2125   DEFSUBR (Fcharset_property);
2126   DEFSUBR (Fcharset_id);
2127   DEFSUBR (Fset_charset_ccl_program);
2128   DEFSUBR (Fset_charset_registry);
2129 #ifdef UTF2000
2130   DEFSUBR (Fchar_attribute_alist);
2131   DEFSUBR (Fget_char_attribute);
2132   DEFSUBR (Fput_char_attribute);
2133   DEFSUBR (Fdefine_char);
2134   DEFSUBR (Fcharset_mapping_table);
2135   DEFSUBR (Fset_charset_mapping_table);
2136 #endif
2137
2138   DEFSUBR (Fmake_char);
2139   DEFSUBR (Fchar_charset);
2140   DEFSUBR (Fsplit_char);
2141
2142 #ifdef ENABLE_COMPOSITE_CHARS
2143   DEFSUBR (Fmake_composite_char);
2144   DEFSUBR (Fcomposite_char_string);
2145 #endif
2146
2147   defsymbol (&Qcharsetp, "charsetp");
2148   defsymbol (&Qregistry, "registry");
2149   defsymbol (&Qfinal, "final");
2150   defsymbol (&Qgraphic, "graphic");
2151   defsymbol (&Qdirection, "direction");
2152   defsymbol (&Qreverse_direction_charset, "reverse-direction-charset");
2153   defsymbol (&Qshort_name, "short-name");
2154   defsymbol (&Qlong_name, "long-name");
2155
2156   defsymbol (&Ql2r, "l2r");
2157   defsymbol (&Qr2l, "r2l");
2158
2159   /* Charsets, compatible with FSF 20.3
2160      Naming convention is Script-Charset[-Edition] */
2161   defsymbol (&Qascii,                   "ascii");
2162   defsymbol (&Qcontrol_1,               "control-1");
2163   defsymbol (&Qlatin_iso8859_1,         "latin-iso8859-1");
2164   defsymbol (&Qlatin_iso8859_2,         "latin-iso8859-2");
2165   defsymbol (&Qlatin_iso8859_3,         "latin-iso8859-3");
2166   defsymbol (&Qlatin_iso8859_4,         "latin-iso8859-4");
2167   defsymbol (&Qthai_tis620,             "thai-tis620");
2168   defsymbol (&Qgreek_iso8859_7,         "greek-iso8859-7");
2169   defsymbol (&Qarabic_iso8859_6,        "arabic-iso8859-6");
2170   defsymbol (&Qhebrew_iso8859_8,        "hebrew-iso8859-8");
2171   defsymbol (&Qkatakana_jisx0201,       "katakana-jisx0201");
2172   defsymbol (&Qlatin_jisx0201,          "latin-jisx0201");
2173   defsymbol (&Qcyrillic_iso8859_5,      "cyrillic-iso8859-5");
2174   defsymbol (&Qlatin_iso8859_9,         "latin-iso8859-9");
2175   defsymbol (&Qjapanese_jisx0208_1978,  "japanese-jisx0208-1978");
2176   defsymbol (&Qchinese_gb2312,          "chinese-gb2312");
2177   defsymbol (&Qjapanese_jisx0208,       "japanese-jisx0208");
2178   defsymbol (&Qkorean_ksc5601,          "korean-ksc5601");
2179   defsymbol (&Qjapanese_jisx0212,       "japanese-jisx0212");
2180   defsymbol (&Qchinese_cns11643_1,      "chinese-cns11643-1");
2181   defsymbol (&Qchinese_cns11643_2,      "chinese-cns11643-2");
2182 #ifdef UTF2000
2183   defsymbol (&Qucs,                     "ucs");
2184   defsymbol (&Qucs_bmp,                 "ucs-bmp");
2185   defsymbol (&Qlatin_viscii,            "latin-viscii");
2186   defsymbol (&Qlatin_viscii_lower,      "latin-viscii-lower");
2187   defsymbol (&Qlatin_viscii_upper,      "latin-viscii-upper");
2188   defsymbol (&Qvietnamese_viscii_lower, "vietnamese-viscii-lower");
2189   defsymbol (&Qvietnamese_viscii_upper, "vietnamese-viscii-upper");
2190   defsymbol (&Qhiragana_jisx0208,       "hiragana-jisx0208");
2191   defsymbol (&Qkatakana_jisx0208,       "katakana-jisx0208");
2192 #endif
2193   defsymbol (&Qchinese_big5_1,          "chinese-big5-1");
2194   defsymbol (&Qchinese_big5_2,          "chinese-big5-2");
2195
2196   defsymbol (&Qcomposite,               "composite");
2197 }
2198
2199 void
2200 vars_of_mule_charset (void)
2201 {
2202   int i, j;
2203 #ifndef UTF2000
2204   int k;
2205 #endif
2206
2207   /* Table of charsets indexed by leading byte. */
2208   for (i = 0; i < countof (charset_by_leading_byte); i++)
2209     charset_by_leading_byte[i] = Qnil;
2210
2211 #ifdef UTF2000
2212   /* Table of charsets indexed by type/final-byte. */
2213   for (i = 0; i < countof (charset_by_attributes); i++)
2214     for (j = 0; j < countof (charset_by_attributes[0]); j++)
2215         charset_by_attributes[i][j] = Qnil;
2216 #else
2217   /* Table of charsets indexed by type/final-byte/direction. */
2218   for (i = 0; i < countof (charset_by_attributes); i++)
2219     for (j = 0; j < countof (charset_by_attributes[0]); j++)
2220       for (k = 0; k < countof (charset_by_attributes[0][0]); k++)
2221         charset_by_attributes[i][j][k] = Qnil;
2222 #endif
2223
2224 #ifdef UTF2000
2225   next_allocated_leading_byte = MIN_LEADING_BYTE_PRIVATE;
2226 #else
2227   next_allocated_1_byte_leading_byte = MIN_LEADING_BYTE_PRIVATE_1;
2228   next_allocated_2_byte_leading_byte = MIN_LEADING_BYTE_PRIVATE_2;
2229 #endif
2230
2231 #ifndef UTF2000
2232   leading_code_private_11 = PRE_LEADING_BYTE_PRIVATE_1;
2233   DEFVAR_INT ("leading-code-private-11", &leading_code_private_11 /*
2234 Leading-code of private TYPE9N charset of column-width 1.
2235 */ );
2236   leading_code_private_11 = PRE_LEADING_BYTE_PRIVATE_1;
2237 #endif
2238
2239 #ifdef UTF2000
2240   Vutf_2000_version = build_string("0.11 (Shiki)");
2241   DEFVAR_LISP ("utf-2000-version", &Vutf_2000_version /*
2242 Version number of UTF-2000.
2243 */ );
2244
2245   staticpro (&Vcharacter_attribute_table);
2246   Vcharacter_attribute_table = make_char_code_table (Qnil);
2247
2248   Vdefault_coded_charset_priority_list = Qnil;
2249   DEFVAR_LISP ("default-coded-charset-priority-list",
2250                &Vdefault_coded_charset_priority_list /*
2251 Default order of preferred coded-character-sets.
2252 */ );
2253 #endif
2254 }
2255
2256 void
2257 complex_vars_of_mule_charset (void)
2258 {
2259   staticpro (&Vcharset_hash_table);
2260   Vcharset_hash_table =
2261     make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
2262
2263   /* Predefined character sets.  We store them into variables for
2264      ease of access. */
2265
2266 #ifdef UTF2000
2267   Vcharset_ucs_bmp =
2268     make_charset (LEADING_BYTE_UCS_BMP, Qucs_bmp,
2269                   CHARSET_TYPE_256X256, 1, 2, 0,
2270                   CHARSET_LEFT_TO_RIGHT,
2271                   build_string ("BMP"),
2272                   build_string ("BMP"),
2273                   build_string ("ISO/IEC 10646 Group 0 Plane 0 (BMP)"),
2274                   build_string ("\\(ISO10646.*-1\\|UNICODE[23]?-0\\)"),
2275                   Qnil, 0, 0xFFFF, 0, 0);
2276 #else
2277 # define MIN_CHAR_THAI 0
2278 # define MAX_CHAR_THAI 0
2279 # define MIN_CHAR_GREEK 0
2280 # define MAX_CHAR_GREEK 0
2281 # define MIN_CHAR_HEBREW 0
2282 # define MAX_CHAR_HEBREW 0
2283 # define MIN_CHAR_HALFWIDTH_KATAKANA 0
2284 # define MAX_CHAR_HALFWIDTH_KATAKANA 0
2285 # define MIN_CHAR_CYRILLIC 0
2286 # define MAX_CHAR_CYRILLIC 0
2287 #endif
2288   Vcharset_ascii =
2289     make_charset (LEADING_BYTE_ASCII, Qascii,
2290                   CHARSET_TYPE_94, 1, 0, 'B',
2291                   CHARSET_LEFT_TO_RIGHT,
2292                   build_string ("ASCII"),
2293                   build_string ("ASCII)"),
2294                   build_string ("ASCII (ISO646 IRV)"),
2295                   build_string ("\\(iso8859-[0-9]*\\|-ascii\\)"),
2296                   Qnil, 0, 0x7F, 0, 0);
2297   Vcharset_control_1 =
2298     make_charset (LEADING_BYTE_CONTROL_1, Qcontrol_1,
2299                   CHARSET_TYPE_94, 1, 1, 0,
2300                   CHARSET_LEFT_TO_RIGHT,
2301                   build_string ("C1"),
2302                   build_string ("Control characters"),
2303                   build_string ("Control characters 128-191"),
2304                   build_string (""),
2305                   Qnil, 0x80, 0x9F, 0, 0);
2306   Vcharset_latin_iso8859_1 =
2307     make_charset (LEADING_BYTE_LATIN_ISO8859_1, Qlatin_iso8859_1,
2308                   CHARSET_TYPE_96, 1, 1, 'A',
2309                   CHARSET_LEFT_TO_RIGHT,
2310                   build_string ("Latin-1"),
2311                   build_string ("ISO8859-1 (Latin-1)"),
2312                   build_string ("ISO8859-1 (Latin-1)"),
2313                   build_string ("iso8859-1"),
2314                   Qnil, 0xA0, 0xFF, 0, 32);
2315   Vcharset_latin_iso8859_2 =
2316     make_charset (LEADING_BYTE_LATIN_ISO8859_2, Qlatin_iso8859_2,
2317                   CHARSET_TYPE_96, 1, 1, 'B',
2318                   CHARSET_LEFT_TO_RIGHT,
2319                   build_string ("Latin-2"),
2320                   build_string ("ISO8859-2 (Latin-2)"),
2321                   build_string ("ISO8859-2 (Latin-2)"),
2322                   build_string ("iso8859-2"),
2323                   Qnil, 0, 0, 0, 32);
2324   Vcharset_latin_iso8859_3 =
2325     make_charset (LEADING_BYTE_LATIN_ISO8859_3, Qlatin_iso8859_3,
2326                   CHARSET_TYPE_96, 1, 1, 'C',
2327                   CHARSET_LEFT_TO_RIGHT,
2328                   build_string ("Latin-3"),
2329                   build_string ("ISO8859-3 (Latin-3)"),
2330                   build_string ("ISO8859-3 (Latin-3)"),
2331                   build_string ("iso8859-3"),
2332                   Qnil, 0, 0, 0, 32);
2333   Vcharset_latin_iso8859_4 =
2334     make_charset (LEADING_BYTE_LATIN_ISO8859_4, Qlatin_iso8859_4,
2335                   CHARSET_TYPE_96, 1, 1, 'D',
2336                   CHARSET_LEFT_TO_RIGHT,
2337                   build_string ("Latin-4"),
2338                   build_string ("ISO8859-4 (Latin-4)"),
2339                   build_string ("ISO8859-4 (Latin-4)"),
2340                   build_string ("iso8859-4"),
2341                   Qnil, 0, 0, 0, 32);
2342   Vcharset_thai_tis620 =
2343     make_charset (LEADING_BYTE_THAI_TIS620, Qthai_tis620,
2344                   CHARSET_TYPE_96, 1, 1, 'T',
2345                   CHARSET_LEFT_TO_RIGHT,
2346                   build_string ("TIS620"),
2347                   build_string ("TIS620 (Thai)"),
2348                   build_string ("TIS620.2529 (Thai)"),
2349                   build_string ("tis620"),
2350                   Qnil, MIN_CHAR_THAI, MAX_CHAR_THAI, 0, 32);
2351   Vcharset_greek_iso8859_7 =
2352     make_charset (LEADING_BYTE_GREEK_ISO8859_7, Qgreek_iso8859_7,
2353                   CHARSET_TYPE_96, 1, 1, 'F',
2354                   CHARSET_LEFT_TO_RIGHT,
2355                   build_string ("ISO8859-7"),
2356                   build_string ("ISO8859-7 (Greek)"),
2357                   build_string ("ISO8859-7 (Greek)"),
2358                   build_string ("iso8859-7"),
2359                   Qnil, MIN_CHAR_GREEK, MAX_CHAR_GREEK, 0, 32);
2360   Vcharset_arabic_iso8859_6 =
2361     make_charset (LEADING_BYTE_ARABIC_ISO8859_6, Qarabic_iso8859_6,
2362                   CHARSET_TYPE_96, 1, 1, 'G',
2363                   CHARSET_RIGHT_TO_LEFT,
2364                   build_string ("ISO8859-6"),
2365                   build_string ("ISO8859-6 (Arabic)"),
2366                   build_string ("ISO8859-6 (Arabic)"),
2367                   build_string ("iso8859-6"),
2368                   Qnil, 0, 0, 0, 32);
2369   Vcharset_hebrew_iso8859_8 =
2370     make_charset (LEADING_BYTE_HEBREW_ISO8859_8, Qhebrew_iso8859_8,
2371                   CHARSET_TYPE_96, 1, 1, 'H',
2372                   CHARSET_RIGHT_TO_LEFT,
2373                   build_string ("ISO8859-8"),
2374                   build_string ("ISO8859-8 (Hebrew)"),
2375                   build_string ("ISO8859-8 (Hebrew)"),
2376                   build_string ("iso8859-8"),
2377                   Qnil, MIN_CHAR_HEBREW, MAX_CHAR_HEBREW, 0, 32);
2378   Vcharset_katakana_jisx0201 =
2379     make_charset (LEADING_BYTE_KATAKANA_JISX0201, Qkatakana_jisx0201,
2380                   CHARSET_TYPE_94, 1, 1, 'I',
2381                   CHARSET_LEFT_TO_RIGHT,
2382                   build_string ("JISX0201 Kana"),
2383                   build_string ("JISX0201.1976 (Japanese Kana)"),
2384                   build_string ("JISX0201.1976 Japanese Kana"),
2385                   build_string ("jisx0201\\.1976"),
2386                   Qnil,
2387                   MIN_CHAR_HALFWIDTH_KATAKANA,
2388                   MAX_CHAR_HALFWIDTH_KATAKANA, 0, 33);
2389   Vcharset_latin_jisx0201 =
2390     make_charset (LEADING_BYTE_LATIN_JISX0201, Qlatin_jisx0201,
2391                   CHARSET_TYPE_94, 1, 0, 'J',
2392                   CHARSET_LEFT_TO_RIGHT,
2393                   build_string ("JISX0201 Roman"),
2394                   build_string ("JISX0201.1976 (Japanese Roman)"),
2395                   build_string ("JISX0201.1976 Japanese Roman"),
2396                   build_string ("jisx0201\\.1976"),
2397                   Qnil, 0, 0, 0, 33);
2398   Vcharset_cyrillic_iso8859_5 =
2399     make_charset (LEADING_BYTE_CYRILLIC_ISO8859_5, Qcyrillic_iso8859_5,
2400                   CHARSET_TYPE_96, 1, 1, 'L',
2401                   CHARSET_LEFT_TO_RIGHT,
2402                   build_string ("ISO8859-5"),
2403                   build_string ("ISO8859-5 (Cyrillic)"),
2404                   build_string ("ISO8859-5 (Cyrillic)"),
2405                   build_string ("iso8859-5"),
2406                   Qnil, MIN_CHAR_CYRILLIC, MAX_CHAR_CYRILLIC, 0, 32);
2407   Vcharset_latin_iso8859_9 =
2408     make_charset (LEADING_BYTE_LATIN_ISO8859_9, Qlatin_iso8859_9,
2409                   CHARSET_TYPE_96, 1, 1, 'M',
2410                   CHARSET_LEFT_TO_RIGHT,
2411                   build_string ("Latin-5"),
2412                   build_string ("ISO8859-9 (Latin-5)"),
2413                   build_string ("ISO8859-9 (Latin-5)"),
2414                   build_string ("iso8859-9"),
2415                   Qnil, 0, 0, 0, 32);
2416   Vcharset_japanese_jisx0208_1978 =
2417     make_charset (LEADING_BYTE_JAPANESE_JISX0208_1978, Qjapanese_jisx0208_1978,
2418                   CHARSET_TYPE_94X94, 2, 0, '@',
2419                   CHARSET_LEFT_TO_RIGHT,
2420                   build_string ("JIS X0208:1978"),
2421                   build_string ("JIS X0208:1978 (Japanese)"),
2422                   build_string
2423                   ("JIS X0208:1978 Japanese Kanji (so called \"old JIS\")"),
2424                   build_string ("\\(jisx0208\\|jisc6226\\)\\.1978"),
2425                   Qnil, 0, 0, 0, 33);
2426   Vcharset_chinese_gb2312 =
2427     make_charset (LEADING_BYTE_CHINESE_GB2312, Qchinese_gb2312,
2428                   CHARSET_TYPE_94X94, 2, 0, 'A',
2429                   CHARSET_LEFT_TO_RIGHT,
2430                   build_string ("GB2312"),
2431                   build_string ("GB2312)"),
2432                   build_string ("GB2312 Chinese simplified"),
2433                   build_string ("gb2312"),
2434                   Qnil, 0, 0, 0, 33);
2435   Vcharset_japanese_jisx0208 =
2436     make_charset (LEADING_BYTE_JAPANESE_JISX0208, Qjapanese_jisx0208,
2437                   CHARSET_TYPE_94X94, 2, 0, 'B',
2438                   CHARSET_LEFT_TO_RIGHT,
2439                   build_string ("JISX0208"),
2440                   build_string ("JIS X0208:1983 (Japanese)"),
2441                   build_string ("JIS X0208:1983 Japanese Kanji"),
2442                   build_string ("jisx0208\\.1983"),
2443                   Qnil, 0, 0, 0, 33);
2444   Vcharset_korean_ksc5601 =
2445     make_charset (LEADING_BYTE_KOREAN_KSC5601, Qkorean_ksc5601,
2446                   CHARSET_TYPE_94X94, 2, 0, 'C',
2447                   CHARSET_LEFT_TO_RIGHT,
2448                   build_string ("KSC5601"),
2449                   build_string ("KSC5601 (Korean"),
2450                   build_string ("KSC5601 Korean Hangul and Hanja"),
2451                   build_string ("ksc5601"),
2452                   Qnil, 0, 0, 0, 33);
2453   Vcharset_japanese_jisx0212 =
2454     make_charset (LEADING_BYTE_JAPANESE_JISX0212, Qjapanese_jisx0212,
2455                   CHARSET_TYPE_94X94, 2, 0, 'D',
2456                   CHARSET_LEFT_TO_RIGHT,
2457                   build_string ("JISX0212"),
2458                   build_string ("JISX0212 (Japanese)"),
2459                   build_string ("JISX0212 Japanese Supplement"),
2460                   build_string ("jisx0212"),
2461                   Qnil, 0, 0, 0, 33);
2462
2463 #define CHINESE_CNS_PLANE_RE(n) "cns11643[.-]\\(.*[.-]\\)?" n "$"
2464   Vcharset_chinese_cns11643_1 =
2465     make_charset (LEADING_BYTE_CHINESE_CNS11643_1, Qchinese_cns11643_1,
2466                   CHARSET_TYPE_94X94, 2, 0, 'G',
2467                   CHARSET_LEFT_TO_RIGHT,
2468                   build_string ("CNS11643-1"),
2469                   build_string ("CNS11643-1 (Chinese traditional)"),
2470                   build_string
2471                   ("CNS 11643 Plane 1 Chinese traditional"),
2472                   build_string (CHINESE_CNS_PLANE_RE("1")),
2473                   Qnil, 0, 0, 0, 33);
2474   Vcharset_chinese_cns11643_2 =
2475     make_charset (LEADING_BYTE_CHINESE_CNS11643_2, Qchinese_cns11643_2,
2476                   CHARSET_TYPE_94X94, 2, 0, 'H',
2477                   CHARSET_LEFT_TO_RIGHT,
2478                   build_string ("CNS11643-2"),
2479                   build_string ("CNS11643-2 (Chinese traditional)"),
2480                   build_string
2481                   ("CNS 11643 Plane 2 Chinese traditional"),
2482                   build_string (CHINESE_CNS_PLANE_RE("2")),
2483                   Qnil, 0, 0, 0, 33);
2484 #ifdef UTF2000
2485   Vcharset_latin_viscii_lower =
2486     make_charset (LEADING_BYTE_LATIN_VISCII_LOWER, Qlatin_viscii_lower,
2487                   CHARSET_TYPE_96, 1, 1, '1',
2488                   CHARSET_LEFT_TO_RIGHT,
2489                   build_string ("VISCII lower"),
2490                   build_string ("VISCII lower (Vietnamese)"),
2491                   build_string ("VISCII lower (Vietnamese)"),
2492                   build_string ("MULEVISCII-LOWER"),
2493                   Qnil, 0, 0, 0, 32);
2494   Vcharset_latin_viscii_upper =
2495     make_charset (LEADING_BYTE_LATIN_VISCII_UPPER, Qlatin_viscii_upper,
2496                   CHARSET_TYPE_96, 1, 1, '2',
2497                   CHARSET_LEFT_TO_RIGHT,
2498                   build_string ("VISCII upper"),
2499                   build_string ("VISCII upper (Vietnamese)"),
2500                   build_string ("VISCII upper (Vietnamese)"),
2501                   build_string ("MULEVISCII-UPPER"),
2502                   Qnil, 0, 0, 0, 32);
2503   Vcharset_latin_viscii =
2504     make_charset (LEADING_BYTE_LATIN_VISCII, Qlatin_viscii,
2505                   CHARSET_TYPE_256, 1, 2, 0,
2506                   CHARSET_LEFT_TO_RIGHT,
2507                   build_string ("VISCII"),
2508                   build_string ("VISCII 1.1 (Vietnamese)"),
2509                   build_string ("VISCII 1.1 (Vietnamese)"),
2510                   build_string ("VISCII1\\.1"),
2511                   Qnil, 0, 0, 0, 0);
2512   Vcharset_hiragana_jisx0208 =
2513     make_charset (LEADING_BYTE_HIRAGANA_JISX0208, Qhiragana_jisx0208,
2514                   CHARSET_TYPE_94X94, 2, 0, 'B',
2515                   CHARSET_LEFT_TO_RIGHT,
2516                   build_string ("Hiragana"),
2517                   build_string ("Hiragana of JIS X0208"),
2518                   build_string ("Japanese Hiragana of JIS X0208"),
2519                   build_string ("jisx0208\\.19\\(78\\|83\\|90\\)"),
2520                   Qnil, MIN_CHAR_HIRAGANA, MAX_CHAR_HIRAGANA,
2521                   (0x24 - 33) * 94 + (0x21 - 33), 33);
2522   Vcharset_katakana_jisx0208 =
2523     make_charset (LEADING_BYTE_KATAKANA_JISX0208, Qkatakana_jisx0208,
2524                   CHARSET_TYPE_94X94, 2, 0, 'B',
2525                   CHARSET_LEFT_TO_RIGHT,
2526                   build_string ("Katakana"),
2527                   build_string ("Katakana of JIS X0208"),
2528                   build_string ("Japanese Katakana of JIS X0208"),
2529                   build_string ("jisx0208\\.19\\(78\\|83\\|90\\)"),
2530                   Qnil, MIN_CHAR_KATAKANA, MAX_CHAR_KATAKANA,
2531                   (0x25 - 33) * 94 + (0x21 - 33), 33);
2532 #endif
2533   Vcharset_chinese_big5_1 =
2534     make_charset (LEADING_BYTE_CHINESE_BIG5_1, Qchinese_big5_1,
2535                   CHARSET_TYPE_94X94, 2, 0, '0',
2536                   CHARSET_LEFT_TO_RIGHT,
2537                   build_string ("Big5"),
2538                   build_string ("Big5 (Level-1)"),
2539                   build_string
2540                   ("Big5 Level-1 Chinese traditional"),
2541                   build_string ("big5"),
2542                   Qnil, 0, 0, 0, 33);
2543   Vcharset_chinese_big5_2 =
2544     make_charset (LEADING_BYTE_CHINESE_BIG5_2, Qchinese_big5_2,
2545                   CHARSET_TYPE_94X94, 2, 0, '1',
2546                   CHARSET_LEFT_TO_RIGHT,
2547                   build_string ("Big5"),
2548                   build_string ("Big5 (Level-2)"),
2549                   build_string
2550                   ("Big5 Level-2 Chinese traditional"),
2551                   build_string ("big5"),
2552                   Qnil, 0, 0, 0, 33);
2553
2554 #ifdef ENABLE_COMPOSITE_CHARS
2555   /* #### For simplicity, we put composite chars into a 96x96 charset.
2556      This is going to lead to problems because you can run out of
2557      room, esp. as we don't yet recycle numbers. */
2558   Vcharset_composite =
2559     make_charset (LEADING_BYTE_COMPOSITE, Qcomposite,
2560                   CHARSET_TYPE_96X96, 2, 0, 0,
2561                   CHARSET_LEFT_TO_RIGHT,
2562                   build_string ("Composite"),
2563                   build_string ("Composite characters"),
2564                   build_string ("Composite characters"),
2565                   build_string (""));
2566
2567   composite_char_row_next = 32;
2568   composite_char_col_next = 32;
2569
2570   Vcomposite_char_string2char_hash_table =
2571     make_lisp_hash_table (500, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL);
2572   Vcomposite_char_char2string_hash_table =
2573     make_lisp_hash_table (500, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
2574   staticpro (&Vcomposite_char_string2char_hash_table);
2575   staticpro (&Vcomposite_char_char2string_hash_table);
2576 #endif /* ENABLE_COMPOSITE_CHARS */
2577
2578 }