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