src/mule-charset.c

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