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

   1 /* Functions to handle multilingual characters.
   2    Copyright (C) 1992, 1995 Free Software Foundation, Inc.
   3    Copyright (C) 1995 Sun Microsystems, Inc.
   4
   5 This file is part of XEmacs.
   6
   7 XEmacs is free software; you can redistribute it and/or modify it
   8 under the terms of the GNU General Public License as published by the
   9 Free Software Foundation; either version 2, or (at your option) any
  10 later version.
  11
  12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
  13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  14 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  15 for more details.
  16
  17 You should have received a copy of the GNU General Public License
  18 along with XEmacs; see the file COPYING.  If not, write to
  19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  20 Boston, MA 02111-1307, USA.  */
  21
  22 /* Synched up with: FSF 20.3.  Not in FSF. */
  23
  24 /* Rewritten by Ben Wing <ben@xemacs.org>. */
  25
  26 #include <config.h>
  27 #include "lisp.h"
  28
  29 #include "buffer.h"
  30 #include "chartab.h"
  31 #include "elhash.h"
  32 #include "lstream.h"
  33 #include "device.h"
  34 #include "faces.h"
  35 #include "mule-ccl.h"
  36
  37 /* The various pre-defined charsets. */
  38
  39 Lisp_Object Vcharset_ascii;
  40 Lisp_Object Vcharset_control_1;
  41 Lisp_Object Vcharset_latin_iso8859_1;
  42 Lisp_Object Vcharset_latin_iso8859_2;
  43 Lisp_Object Vcharset_latin_iso8859_3;
  44 Lisp_Object Vcharset_latin_iso8859_4;
  45 Lisp_Object Vcharset_thai_tis620;
  46 Lisp_Object Vcharset_greek_iso8859_7;
  47 Lisp_Object Vcharset_arabic_iso8859_6;
  48 Lisp_Object Vcharset_hebrew_iso8859_8;
  49 Lisp_Object Vcharset_katakana_jisx0201;
  50 Lisp_Object Vcharset_latin_jisx0201;
  51 Lisp_Object Vcharset_cyrillic_iso8859_5;
  52 Lisp_Object Vcharset_latin_iso8859_9;
  53 Lisp_Object Vcharset_japanese_jisx0208_1978;
  54 Lisp_Object Vcharset_chinese_gb2312;
  55 Lisp_Object Vcharset_japanese_jisx0208;
  56 Lisp_Object Vcharset_korean_ksc5601;
  57 Lisp_Object Vcharset_japanese_jisx0212;
  58 Lisp_Object Vcharset_chinese_cns11643_1;
  59 Lisp_Object Vcharset_chinese_cns11643_2;
  60 #ifdef UTF2000
  61 Lisp_Object Vcharset_ucs_bmp;
  62 Lisp_Object Vcharset_latin_viscii;
  63 Lisp_Object Vcharset_latin_viscii_lower;
  64 Lisp_Object Vcharset_latin_viscii_upper;
  65 Lisp_Object Vcharset_hiragana_jisx0208;
  66 Lisp_Object Vcharset_katakana_jisx0208;
  67 #endif
  68 Lisp_Object Vcharset_chinese_big5_1;
  69 Lisp_Object Vcharset_chinese_big5_2;
  70
  71 #ifdef ENABLE_COMPOSITE_CHARS
  72 Lisp_Object Vcharset_composite;
  73
  74 /* Hash tables for composite chars.  One maps string representing
  75    composed chars to their equivalent chars; one goes the
  76    other way. */
  77 Lisp_Object Vcomposite_char_char2string_hash_table;
  78 Lisp_Object Vcomposite_char_string2char_hash_table;
  79
  80 static int composite_char_row_next;
  81 static int composite_char_col_next;
  82
  83 #endif /* ENABLE_COMPOSITE_CHARS */
  84
  85 /* Table of charsets indexed by leading byte. */
  86 Lisp_Object charset_by_leading_byte[NUM_LEADING_BYTES];
  87
  88 /* Table of charsets indexed by type/final-byte/direction. */
  89 #ifdef UTF2000
  90 Lisp_Object charset_by_attributes[4][128];
  91 #else
  92 Lisp_Object charset_by_attributes[4][128][2];
  93 #endif
  94
  95 #ifndef UTF2000
  96 /* Table of number of bytes in the string representation of a character
  97    indexed by the first byte of that representation.
  98
  99    rep_bytes_by_first_byte(c) is more efficient than the equivalent
 100    canonical computation:
 101
 102    (BYTE_ASCII_P (c) ? 1 : XCHARSET_REP_BYTES (CHARSET_BY_LEADING_BYTE (c))) */
 103
 104 Bytecount rep_bytes_by_first_byte[0xA0] =
 105 { /* 0x00 - 0x7f are for straight ASCII */
 106   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
 107   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
 108   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
 109   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
 110   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
 111   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
 112   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
 113   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
 114   /* 0x80 - 0x8f are for Dimension-1 official charsets */
 115 #ifdef CHAR_IS_UCS4
 116   2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3,
 117 #else
 118   2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
 119 #endif
 120   /* 0x90 - 0x9d are for Dimension-2 official charsets */
 121   /* 0x9e is for Dimension-1 private charsets */
 122   /* 0x9f is for Dimension-2 private charsets */
 123   3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4
 124 };
 125 #endif
 126
 127 #ifdef UTF2000
 128 static Lisp_Object
 129 mark_char_byte_table (Lisp_Object obj, void (*markobj) (Lisp_Object))
 130 {
 131   struct Lisp_Char_Byte_Table *cte = XCHAR_BYTE_TABLE (obj);
 132   int i;
 133
 134   for (i = 0; i < 256; i++)
 135     {
 136       markobj (cte->property[i]);
 137     }
 138   return Qnil;
 139 }
 140
 141 static int
 142 char_byte_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
 143 {
 144   struct Lisp_Char_Byte_Table *cte1 = XCHAR_BYTE_TABLE (obj1);
 145   struct Lisp_Char_Byte_Table *cte2 = XCHAR_BYTE_TABLE (obj2);
 146   int i;
 147
 148   for (i = 0; i < 256; i++)
 149     if (CHAR_BYTE_TABLE_P (cte1->property[i]))
 150       {
 151         if (CHAR_BYTE_TABLE_P (cte2->property[i]))
 152           {
 153             if (!char_byte_table_equal (cte1->property[i],
 154                                         cte2->property[i], depth + 1))
 155               return 0;
 156           }
 157         else
 158           return 0;
 159       }
 160     else
 161       if (!internal_equal (cte1->property[i], cte2->property[i], depth + 1))
 162         return 0;
 163   return 1;
 164 }
 165
 166 static unsigned long
 167 char_byte_table_hash (Lisp_Object obj, int depth)
 168 {
 169   struct Lisp_Char_Byte_Table *cte = XCHAR_BYTE_TABLE (obj);
 170
 171   return internal_array_hash (cte->property, 256, depth);
 172 }
 173
 174 static const struct lrecord_description char_byte_table_description[] = {
 175   { XD_LISP_OBJECT, offsetof(struct Lisp_Char_Byte_Table, property), 256 },
 176   { XD_END }
 177 };
 178
 179 DEFINE_LRECORD_IMPLEMENTATION ("char-code-table", char_byte_table,
 180                                mark_char_byte_table,
 181                                internal_object_printer,
 182                                0, char_byte_table_equal,
 183                                char_byte_table_hash,
 184                                char_byte_table_description,
 185                                struct Lisp_Char_Byte_Table);
 186
 187
 188 static Lisp_Object
 189 make_char_byte_table (Lisp_Object initval)
 190 {
 191   Lisp_Object obj;
 192   int i;
 193   struct Lisp_Char_Byte_Table *cte =
 194     alloc_lcrecord_type (struct Lisp_Char_Byte_Table,
 195                          &lrecord_char_byte_table);
 196
 197   for (i = 0; i < 256; i++)
 198     cte->property[i] = initval;
 199
 200   XSETCHAR_BYTE_TABLE (obj, cte);
 201   return obj;
 202 }
 203
 204 static Lisp_Object
 205 copy_char_byte_table (Lisp_Object entry)
 206 {
 207   struct Lisp_Char_Byte_Table *cte = XCHAR_BYTE_TABLE (entry);
 208   Lisp_Object obj;
 209   int i;
 210   struct Lisp_Char_Byte_Table *ctenew =
 211     alloc_lcrecord_type (struct Lisp_Char_Byte_Table,
 212                          &lrecord_char_byte_table);
 213
 214   for (i = 0; i < 256; i++)
 215     {
 216       Lisp_Object new = cte->property[i];
 217       if (CHAR_BYTE_TABLE_P (new))
 218         ctenew->property[i] = copy_char_byte_table (new);
 219       else
 220         ctenew->property[i] = new;
 221     }
 222
 223   XSETCHAR_BYTE_TABLE (obj, ctenew);
 224   return obj;
 225 }
 226
 227 #define make_char_code_table(initval) make_char_byte_table(initval)
 228
 229 Lisp_Object
 230 get_char_code_table (Emchar ch, Lisp_Object table)
 231 {
 232   struct Lisp_Char_Byte_Table* cpt = XCHAR_BYTE_TABLE (table);
 233   Lisp_Object ret = cpt->property [ch >> 24];
 234
 235   if (CHAR_BYTE_TABLE_P (ret))
 236     cpt = XCHAR_BYTE_TABLE (ret);
 237   else
 238     return ret;
 239
 240   ret = cpt->property [(unsigned char) (ch >> 16)];
 241   if (CHAR_BYTE_TABLE_P (ret))
 242     cpt = XCHAR_BYTE_TABLE (ret);
 243   else
 244     return ret;
 245
 246   ret = cpt->property [(unsigned char) (ch >> 8)];
 247   if (CHAR_BYTE_TABLE_P (ret))
 248     cpt = XCHAR_BYTE_TABLE (ret);
 249   else
 250     return ret;
 251
 252   return cpt->property [(unsigned char) ch];
 253 }
 254
 255 void
 256 put_char_code_table (Emchar ch, Lisp_Object value, Lisp_Object table)
 257 {
 258   struct Lisp_Char_Byte_Table* cpt1 = XCHAR_BYTE_TABLE (table);
 259   Lisp_Object ret = cpt1->property[ch >> 24];
 260
 261   if (CHAR_BYTE_TABLE_P (ret))
 262     {
 263       struct Lisp_Char_Byte_Table* cpt2 = XCHAR_BYTE_TABLE (ret);
 264
 265       ret = cpt2->property[(unsigned char)(ch >> 16)];
 266       if (CHAR_BYTE_TABLE_P (ret))
 267         {
 268           struct Lisp_Char_Byte_Table* cpt3 = XCHAR_BYTE_TABLE (ret);
 269
 270           ret = cpt3->property[(unsigned char)(ch >> 8)];
 271           if (CHAR_BYTE_TABLE_P (ret))
 272             {
 273               struct Lisp_Char_Byte_Table* cpt4
 274                 = XCHAR_BYTE_TABLE (ret);
 275
 276               cpt4->property[(unsigned char)ch] = value;
 277             }
 278           else if (!EQ (ret, value))
 279             {
 280               Lisp_Object cpt4 = make_char_byte_table (ret);
 281
 282               XCHAR_BYTE_TABLE(cpt4)->property[(unsigned char)ch] = value;
 283               cpt3->property[(unsigned char)(ch >> 8)] = cpt4;
 284             }
 285         }
 286       else if (!EQ (ret, value))
 287         {
 288           Lisp_Object cpt3 = make_char_byte_table (ret);
 289           Lisp_Object cpt4 = make_char_byte_table (ret);
 290
 291           XCHAR_BYTE_TABLE(cpt4)->property[(unsigned char)ch] = value;
 292           XCHAR_BYTE_TABLE(cpt3)->property[(unsigned char)(ch >> 8)]
 293             = cpt4;
 294           cpt2->property[(unsigned char)(ch >> 16)] = cpt3;
 295         }
 296     }
 297   else if (!EQ (ret, value))
 298     {
 299       Lisp_Object cpt2 = make_char_byte_table (ret);
 300       Lisp_Object cpt3 = make_char_byte_table (ret);
 301       Lisp_Object cpt4 = make_char_byte_table (ret);
 302
 303       XCHAR_BYTE_TABLE(cpt4)->property[(unsigned char)ch] = value;
 304       XCHAR_BYTE_TABLE(cpt3)->property[(unsigned char)(ch >>  8)] = cpt4;
 305       XCHAR_BYTE_TABLE(cpt2)->property[(unsigned char)(ch >> 16)] = cpt3;
 306       cpt1->property[(unsigned char)(ch >> 24)] = cpt2;
 307     }
 308 }
 309
 310
 311 Lisp_Object 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   unsigned char byte_offset = 0;
1218 #endif
1219
1220   CHECK_SYMBOL (name);
1221   if (!NILP (doc_string))
1222     CHECK_STRING (doc_string);
1223
1224   charset = Ffind_charset (name);
1225   if (!NILP (charset))
1226     signal_simple_error ("Cannot redefine existing charset", name);
1227
1228   EXTERNAL_PROPERTY_LIST_LOOP (rest, keyword, value, props)
1229     {
1230       if (EQ (keyword, Qshort_name))
1231         {
1232           CHECK_STRING (value);
1233           short_name = value;
1234         }
1235
1236       if (EQ (keyword, Qlong_name))
1237         {
1238           CHECK_STRING (value);
1239           long_name = value;
1240         }
1241
1242       else if (EQ (keyword, Qdimension))
1243         {
1244           CHECK_INT (value);
1245           dimension = XINT (value);
1246           if (dimension < 1 || dimension > 2)
1247             signal_simple_error ("Invalid value for 'dimension", value);
1248         }
1249
1250       else if (EQ (keyword, Qchars))
1251         {
1252           CHECK_INT (value);
1253           chars = XINT (value);
1254           if (chars != 94 && chars != 96)
1255             signal_simple_error ("Invalid value for 'chars", value);
1256         }
1257
1258       else if (EQ (keyword, Qcolumns))
1259         {
1260           CHECK_INT (value);
1261           columns = XINT (value);
1262           if (columns != 1 && columns != 2)
1263             signal_simple_error ("Invalid value for 'columns", value);
1264         }
1265
1266       else if (EQ (keyword, Qgraphic))
1267         {
1268           CHECK_INT (value);
1269           graphic = XINT (value);
1270 #ifdef UTF2000
1271           if (graphic < 0 || graphic > 2)
1272 #else
1273           if (graphic < 0 || graphic > 1)
1274 #endif
1275             signal_simple_error ("Invalid value for 'graphic", value);
1276         }
1277
1278       else if (EQ (keyword, Qregistry))
1279         {
1280           CHECK_STRING (value);
1281           registry = value;
1282         }
1283
1284       else if (EQ (keyword, Qdirection))
1285         {
1286           if (EQ (value, Ql2r))
1287             direction = CHARSET_LEFT_TO_RIGHT;
1288           else if (EQ (value, Qr2l))
1289             direction = CHARSET_RIGHT_TO_LEFT;
1290           else
1291             signal_simple_error ("Invalid value for 'direction", value);
1292         }
1293
1294       else if (EQ (keyword, Qfinal))
1295         {
1296           CHECK_CHAR_COERCE_INT (value);
1297           final = XCHAR (value);
1298           if (final < '0' || final > '~')
1299             signal_simple_error ("Invalid value for 'final", value);
1300         }
1301
1302       else if (EQ (keyword, Qccl_program))
1303         {
1304           CHECK_VECTOR (value);
1305           ccl_program = value;
1306         }
1307
1308       else
1309         signal_simple_error ("Unrecognized property", keyword);
1310     }
1311
1312   if (!final)
1313     error ("'final must be specified");
1314   if (dimension == 2 && final > 0x5F)
1315     signal_simple_error
1316       ("Final must be in the range 0x30 - 0x5F for dimension == 2",
1317        make_char (final));
1318
1319   if (dimension == 1)
1320     type = (chars == 94) ? CHARSET_TYPE_94    : CHARSET_TYPE_96;
1321   else
1322     type = (chars == 94) ? CHARSET_TYPE_94X94 : CHARSET_TYPE_96X96;
1323
1324   if (!NILP (CHARSET_BY_ATTRIBUTES (type, final, CHARSET_LEFT_TO_RIGHT)) ||
1325       !NILP (CHARSET_BY_ATTRIBUTES (type, final, CHARSET_RIGHT_TO_LEFT)))
1326     error
1327       ("Character set already defined for this DIMENSION/CHARS/FINAL combo");
1328
1329 #ifdef UTF2000
1330   if (dimension == 1)
1331     {
1332       if (chars == 94)
1333         {
1334           /* id = CHARSET_ID_OFFSET_94 + final; */
1335           id = get_unallocated_leading_byte (dimension);
1336         }
1337       else if (chars == 96)
1338         {
1339           id = get_unallocated_leading_byte (dimension);
1340         }
1341       else
1342         {
1343           abort ();
1344         }
1345     }
1346   else if (dimension == 2)
1347     {
1348       if (chars == 94)
1349         {
1350           id = get_unallocated_leading_byte (dimension);
1351         }
1352       else if (chars == 96)
1353         {
1354           id = get_unallocated_leading_byte (dimension);
1355         }
1356       else
1357         {
1358           abort ();
1359         }
1360     }
1361   else
1362     {
1363       abort ();
1364     }
1365   if (final)
1366     {
1367       if (chars == 94)
1368         byte_offset = 33;
1369       else if (chars == 96)
1370         byte_offset = 32;
1371     }
1372 #else
1373   id = get_unallocated_leading_byte (dimension);
1374 #endif
1375
1376   if (NILP (doc_string))
1377     doc_string = build_string ("");
1378
1379   if (NILP (registry))
1380     registry = build_string ("");
1381
1382   if (NILP (short_name))
1383     XSETSTRING (short_name, XSYMBOL (name)->name);
1384
1385   if (NILP (long_name))
1386     long_name = doc_string;
1387
1388   if (columns == -1)
1389     columns = dimension;
1390   charset = make_charset (id, name, type, columns, graphic,
1391                           final, direction, short_name, long_name,
1392                           doc_string, registry,
1393                           Qnil, 0, 0, 0, byte_offset);
1394   if (!NILP (ccl_program))
1395     XCHARSET_CCL_PROGRAM (charset) = ccl_program;
1396   return charset;
1397 }
1398
1399 DEFUN ("make-reverse-direction-charset", Fmake_reverse_direction_charset,
1400        2, 2, 0, /*
1401 Make a charset equivalent to CHARSET but which goes in the opposite direction.
1402 NEW-NAME is the name of the new charset.  Return the new charset.
1403 */
1404        (charset, new_name))
1405 {
1406   Lisp_Object new_charset = Qnil;
1407   int id, dimension, columns, graphic, final;
1408   int direction, type;
1409   Lisp_Object registry, doc_string, short_name, long_name;
1410   struct Lisp_Charset *cs;
1411
1412   charset = Fget_charset (charset);
1413   if (!NILP (XCHARSET_REVERSE_DIRECTION_CHARSET (charset)))
1414     signal_simple_error ("Charset already has reverse-direction charset",
1415                          charset);
1416
1417   CHECK_SYMBOL (new_name);
1418   if (!NILP (Ffind_charset (new_name)))
1419     signal_simple_error ("Cannot redefine existing charset", new_name);
1420
1421   cs = XCHARSET (charset);
1422
1423   type      = CHARSET_TYPE      (cs);
1424   columns   = CHARSET_COLUMNS   (cs);
1425   dimension = CHARSET_DIMENSION (cs);
1426   id = get_unallocated_leading_byte (dimension);
1427
1428   graphic = CHARSET_GRAPHIC (cs);
1429   final = CHARSET_FINAL (cs);
1430   direction = CHARSET_RIGHT_TO_LEFT;
1431   if (CHARSET_DIRECTION (cs) == CHARSET_RIGHT_TO_LEFT)
1432     direction = CHARSET_LEFT_TO_RIGHT;
1433   doc_string = CHARSET_DOC_STRING (cs);
1434   short_name = CHARSET_SHORT_NAME (cs);
1435   long_name = CHARSET_LONG_NAME (cs);
1436   registry = CHARSET_REGISTRY (cs);
1437
1438   new_charset = make_charset (id, new_name, type, columns,
1439                               graphic, final, direction, short_name, long_name,
1440                               doc_string, registry,
1441 #ifdef UTF2000
1442                               CHARSET_DECODING_TABLE(cs),
1443                               CHARSET_UCS_MIN(cs),
1444                               CHARSET_UCS_MAX(cs),
1445                               CHARSET_CODE_OFFSET(cs),
1446                               CHARSET_BYTE_OFFSET(cs)
1447 #else
1448                               Qnil, 0, 0, 0, 0
1449 #endif
1450 );
1451
1452   CHARSET_REVERSE_DIRECTION_CHARSET (cs) = new_charset;
1453   XCHARSET_REVERSE_DIRECTION_CHARSET (new_charset) = charset;
1454
1455   return new_charset;
1456 }
1457
1458 DEFUN ("define-charset-alias", Fdefine_charset_alias, 2, 2, 0, /*
1459 Define symbol ALIAS as an alias for CHARSET.
1460 */
1461        (alias, charset))
1462 {
1463   CHECK_SYMBOL (alias);
1464   charset = Fget_charset (charset);
1465   return Fputhash (alias, charset, Vcharset_hash_table);
1466 }
1467
1468 /* #### Reverse direction charsets not yet implemented.  */
1469 #if 0
1470 DEFUN ("charset-reverse-direction-charset", Fcharset_reverse_direction_charset,
1471        1, 1, 0, /*
1472 Return the reverse-direction charset parallel to CHARSET, if any.
1473 This is the charset with the same properties (in particular, the same
1474 dimension, number of characters per dimension, and final byte) as
1475 CHARSET but whose characters are displayed in the opposite direction.
1476 */
1477        (charset))
1478 {
1479   charset = Fget_charset (charset);
1480   return XCHARSET_REVERSE_DIRECTION_CHARSET (charset);
1481 }
1482 #endif
1483
1484 DEFUN ("charset-from-attributes", Fcharset_from_attributes, 3, 4, 0, /*
1485 Return a charset with the given DIMENSION, CHARS, FINAL, and DIRECTION.
1486 If DIRECTION is omitted, both directions will be checked (left-to-right
1487 will be returned if character sets exist for both directions).
1488 */
1489        (dimension, chars, final, direction))
1490 {
1491   int dm, ch, fi, di = -1;
1492   int type;
1493   Lisp_Object obj = Qnil;
1494
1495   CHECK_INT (dimension);
1496   dm = XINT (dimension);
1497   if (dm < 1 || dm > 2)
1498     signal_simple_error ("Invalid value for DIMENSION", dimension);
1499
1500   CHECK_INT (chars);
1501   ch = XINT (chars);
1502   if (ch != 94 && ch != 96)
1503     signal_simple_error ("Invalid value for CHARS", chars);
1504
1505   CHECK_CHAR_COERCE_INT (final);
1506   fi = XCHAR (final);
1507   if (fi < '0' || fi > '~')
1508     signal_simple_error ("Invalid value for FINAL", final);
1509
1510   if (EQ (direction, Ql2r))
1511     di = CHARSET_LEFT_TO_RIGHT;
1512   else if (EQ (direction, Qr2l))
1513     di = CHARSET_RIGHT_TO_LEFT;
1514   else if (!NILP (direction))
1515     signal_simple_error ("Invalid value for DIRECTION", direction);
1516
1517   if (dm == 2 && fi > 0x5F)
1518     signal_simple_error
1519       ("Final must be in the range 0x30 - 0x5F for dimension == 2", final);
1520
1521   if (dm == 1)
1522     type = (ch == 94) ? CHARSET_TYPE_94    : CHARSET_TYPE_96;
1523   else
1524     type = (ch == 94) ? CHARSET_TYPE_94X94 : CHARSET_TYPE_96X96;
1525
1526   if (di == -1)
1527     {
1528       obj = CHARSET_BY_ATTRIBUTES (type, fi, CHARSET_LEFT_TO_RIGHT);
1529       if (NILP (obj))
1530         obj = CHARSET_BY_ATTRIBUTES (type, fi, CHARSET_RIGHT_TO_LEFT);
1531     }
1532   else
1533     obj = CHARSET_BY_ATTRIBUTES (type, fi, di);
1534
1535   if (CHARSETP (obj))
1536     return XCHARSET_NAME (obj);
1537   return obj;
1538 }
1539
1540 DEFUN ("charset-short-name", Fcharset_short_name, 1, 1, 0, /*
1541 Return short name of CHARSET.
1542 */
1543        (charset))
1544 {
1545   return XCHARSET_SHORT_NAME (Fget_charset (charset));
1546 }
1547
1548 DEFUN ("charset-long-name", Fcharset_long_name, 1, 1, 0, /*
1549 Return long name of CHARSET.
1550 */
1551        (charset))
1552 {
1553   return XCHARSET_LONG_NAME (Fget_charset (charset));
1554 }
1555
1556 DEFUN ("charset-description", Fcharset_description, 1, 1, 0, /*
1557 Return description of CHARSET.
1558 */
1559        (charset))
1560 {
1561   return XCHARSET_DOC_STRING (Fget_charset (charset));
1562 }
1563
1564 DEFUN ("charset-dimension", Fcharset_dimension, 1, 1, 0, /*
1565 Return dimension of CHARSET.
1566 */
1567        (charset))
1568 {
1569   return make_int (XCHARSET_DIMENSION (Fget_charset (charset)));
1570 }
1571
1572 DEFUN ("charset-property", Fcharset_property, 2, 2, 0, /*
1573 Return property PROP of CHARSET.
1574 Recognized properties are those listed in `make-charset', as well as
1575 'name and 'doc-string.
1576 */
1577        (charset, prop))
1578 {
1579   struct Lisp_Charset *cs;
1580
1581   charset = Fget_charset (charset);
1582   cs = XCHARSET (charset);
1583
1584   CHECK_SYMBOL (prop);
1585   if (EQ (prop, Qname))        return CHARSET_NAME (cs);
1586   if (EQ (prop, Qshort_name))  return CHARSET_SHORT_NAME (cs);
1587   if (EQ (prop, Qlong_name))   return CHARSET_LONG_NAME (cs);
1588   if (EQ (prop, Qdoc_string))  return CHARSET_DOC_STRING (cs);
1589   if (EQ (prop, Qdimension))   return make_int (CHARSET_DIMENSION (cs));
1590   if (EQ (prop, Qcolumns))     return make_int (CHARSET_COLUMNS (cs));
1591   if (EQ (prop, Qgraphic))     return make_int (CHARSET_GRAPHIC (cs));
1592   if (EQ (prop, Qfinal))       return make_char (CHARSET_FINAL (cs));
1593   if (EQ (prop, Qchars))       return make_int (CHARSET_CHARS (cs));
1594   if (EQ (prop, Qregistry))    return CHARSET_REGISTRY (cs);
1595   if (EQ (prop, Qccl_program)) return CHARSET_CCL_PROGRAM (cs);
1596   if (EQ (prop, Qdirection))
1597     return CHARSET_DIRECTION (cs) == CHARSET_LEFT_TO_RIGHT ? Ql2r : Qr2l;
1598   if (EQ (prop, Qreverse_direction_charset))
1599     {
1600       Lisp_Object obj = CHARSET_REVERSE_DIRECTION_CHARSET (cs);
1601       if (NILP (obj))
1602         return Qnil;
1603       else
1604         return XCHARSET_NAME (obj);
1605     }
1606   signal_simple_error ("Unrecognized charset property name", prop);
1607   return Qnil; /* not reached */
1608 }
1609
1610 DEFUN ("charset-id", Fcharset_id, 1, 1, 0, /*
1611 Return charset identification number of CHARSET.
1612 */
1613         (charset))
1614 {
1615   return make_int(XCHARSET_LEADING_BYTE (Fget_charset (charset)));
1616 }
1617
1618 /* #### We need to figure out which properties we really want to
1619    allow to be set. */
1620
1621 DEFUN ("set-charset-ccl-program", Fset_charset_ccl_program, 2, 2, 0, /*
1622 Set the 'ccl-program property of CHARSET to CCL-PROGRAM.
1623 */
1624        (charset, ccl_program))
1625 {
1626   charset = Fget_charset (charset);
1627   CHECK_VECTOR (ccl_program);
1628   XCHARSET_CCL_PROGRAM (charset) = ccl_program;
1629   return Qnil;
1630 }
1631
1632 static void
1633 invalidate_charset_font_caches (Lisp_Object charset)
1634 {
1635   /* Invalidate font cache entries for charset on all devices. */
1636   Lisp_Object devcons, concons, hash_table;
1637   DEVICE_LOOP_NO_BREAK (devcons, concons)
1638     {
1639       struct device *d = XDEVICE (XCAR (devcons));
1640       hash_table = Fgethash (charset, d->charset_font_cache, Qunbound);
1641       if (!UNBOUNDP (hash_table))
1642         Fclrhash (hash_table);
1643     }
1644 }
1645
1646 DEFUN ("set-charset-registry", Fset_charset_registry, 2, 2, 0, /*
1647 Set the 'registry property of CHARSET to REGISTRY.
1648 */
1649        (charset, registry))
1650 {
1651   charset = Fget_charset (charset);
1652   CHECK_STRING (registry);
1653   XCHARSET_REGISTRY (charset) = registry;
1654   invalidate_charset_font_caches (charset);
1655   face_property_was_changed (Vdefault_face, Qfont, Qglobal);
1656   return Qnil;
1657 }
1658
1659 #ifdef UTF2000
1660 DEFUN ("charset-mapping-table", Fcharset_mapping_table, 1, 1, 0, /*
1661 Return mapping-table of CHARSET.
1662 */
1663        (charset))
1664 {
1665   return XCHARSET_DECODING_TABLE (Fget_charset (charset));
1666 }
1667
1668 DEFUN ("set-charset-mapping-table", Fset_charset_mapping_table, 2, 2, 0, /*
1669 Set mapping-table of CHARSET to TABLE.
1670 */
1671        (charset, table))
1672 {
1673   struct Lisp_Charset *cs;
1674   Lisp_Object old_table;
1675   size_t i;
1676
1677   charset = Fget_charset (charset);
1678   cs = XCHARSET (charset);
1679
1680   if (EQ (table, Qnil))
1681     {
1682       CHARSET_DECODING_TABLE(cs) = table;
1683       CHARSET_ENCODING_TABLE(cs) = Qnil;
1684       return table;
1685     }
1686   else if (VECTORP (table))
1687     {
1688       if (XVECTOR_LENGTH (table) > CHARSET_CHARS (cs))
1689         args_out_of_range (table, make_int (CHARSET_CHARS (cs)));
1690       old_table = CHARSET_ENCODING_TABLE(cs);
1691       CHARSET_DECODING_TABLE(cs) = table;
1692     }
1693   else
1694     signal_error (Qwrong_type_argument,
1695                   list2 (build_translated_string ("vector-or-nil-p"),
1696                          table));
1697   /* signal_simple_error ("Wrong type argument: vector-or-nil-p", table); */
1698
1699   switch (CHARSET_DIMENSION (cs))
1700     {
1701     case 1:
1702       CHARSET_ENCODING_TABLE(cs) = make_char_code_table (Qnil);
1703       for (i = 0; i < XVECTOR_LENGTH (table); i++)
1704         {
1705           Lisp_Object c = XVECTOR_DATA(table)[i];
1706
1707           if (CHARP (c))
1708             put_char_code_table (XCHAR (c),
1709                                  make_int (i + CHARSET_BYTE_OFFSET (cs)),
1710                                  CHARSET_ENCODING_TABLE(cs));
1711         }
1712       break;
1713     case 2:
1714       CHARSET_ENCODING_TABLE(cs) = make_char_code_table (Qnil);
1715       for (i = 0; i < XVECTOR_LENGTH (table); i++)
1716         {
1717           Lisp_Object v = XVECTOR_DATA(table)[i];
1718
1719           if (VECTORP (v))
1720             {
1721               size_t j;
1722
1723               if (XVECTOR_LENGTH (v) > CHARSET_CHARS (cs))
1724                 {
1725                   CHARSET_DECODING_TABLE(cs) = old_table;
1726                   args_out_of_range (v, make_int (CHARSET_CHARS (cs)));
1727                 }
1728               for (j = 0; j < XVECTOR_LENGTH (v); j++)
1729                 {
1730                   Lisp_Object c = XVECTOR_DATA(v)[j];
1731
1732                   if (CHARP (c))
1733                     put_char_code_table
1734                       (XCHAR (c),
1735                        make_int (( (i + CHARSET_BYTE_OFFSET (cs)) << 8)
1736                                  | (j + CHARSET_BYTE_OFFSET (cs))),
1737                        CHARSET_ENCODING_TABLE(cs));
1738                 }
1739             }
1740           else if (CHARP (v))
1741             put_char_code_table (XCHAR (v),
1742                                  make_int (i + CHARSET_BYTE_OFFSET (cs)),
1743                                  CHARSET_ENCODING_TABLE(cs));
1744         }
1745       break;
1746     }
1747   return table;
1748 }
1749 #endif
1750
1751 \f
1752 /************************************************************************/
1753 /*              Lisp primitives for working with characters             */
1754 /************************************************************************/
1755
1756 DEFUN ("make-char", Fmake_char, 2, 3, 0, /*
1757 Make a character from CHARSET and octets ARG1 and ARG2.
1758 ARG2 is required only for characters from two-dimensional charsets.
1759 For example, (make-char 'latin-iso8859-2 185) will return the Latin 2
1760 character s with caron.
1761 */
1762        (charset, arg1, arg2))
1763 {
1764   struct Lisp_Charset *cs;
1765   int a1, a2;
1766   int lowlim, highlim;
1767
1768   charset = Fget_charset (charset);
1769   cs = XCHARSET (charset);
1770
1771   if      (EQ (charset, Vcharset_ascii))     lowlim =  0, highlim = 127;
1772   else if (EQ (charset, Vcharset_control_1)) lowlim =  0, highlim =  31;
1773 #ifdef UTF2000
1774   else if (CHARSET_CHARS (cs) == 256)        lowlim =  0, highlim = 255;
1775 #endif
1776   else if (CHARSET_CHARS (cs) == 94)         lowlim = 33, highlim = 126;
1777   else  /* CHARSET_CHARS (cs) == 96) */      lowlim = 32, highlim = 127;
1778
1779   CHECK_INT (arg1);
1780   /* It is useful (and safe, according to Olivier Galibert) to strip
1781      the 8th bit off ARG1 and ARG2 becaue it allows programmers to
1782      write (make-char 'latin-iso8859-2 CODE) where code is the actual
1783      Latin 2 code of the character.  */
1784 #ifdef UTF2000
1785   a1 = XINT (arg1);
1786   if (highlim < 128)
1787     a1 &= 0x7f;
1788 #else
1789   a1 = XINT (arg1);
1790 #endif
1791   if (a1 < lowlim || a1 > highlim)
1792     args_out_of_range_3 (arg1, make_int (lowlim), make_int (highlim));
1793
1794   if (CHARSET_DIMENSION (cs) == 1)
1795     {
1796       if (!NILP (arg2))
1797         signal_simple_error
1798           ("Charset is of dimension one; second octet must be nil", arg2);
1799       return make_char (MAKE_CHAR (charset, a1, 0));
1800     }
1801
1802   CHECK_INT (arg2);
1803 #ifdef UTF2000
1804   a2 = XINT (arg2);
1805   if (highlim < 128)
1806     a2 &= 0x7f;
1807 #else
1808   a2 = XINT (arg2) & 0x7f;
1809 #endif
1810   if (a2 < lowlim || a2 > highlim)
1811     args_out_of_range_3 (arg2, make_int (lowlim), make_int (highlim));
1812
1813   return make_char (MAKE_CHAR (charset, a1, a2));
1814 }
1815
1816 DEFUN ("char-charset", Fchar_charset, 1, 1, 0, /*
1817 Return the character set of char CH.
1818 */
1819        (ch))
1820 {
1821   CHECK_CHAR_COERCE_INT (ch);
1822
1823   return XCHARSET_NAME (CHAR_CHARSET (XCHAR (ch)));
1824 }
1825
1826 DEFUN ("split-char", Fsplit_char, 1, 1, 0, /*
1827 Return list of charset and one or two position-codes of CHAR.
1828 */
1829        (character))
1830 {
1831   /* This function can GC */
1832   struct gcpro gcpro1, gcpro2;
1833   Lisp_Object charset = Qnil;
1834   Lisp_Object rc = Qnil;
1835   int c1, c2;
1836
1837   GCPRO2 (charset, rc);
1838   CHECK_CHAR_COERCE_INT (character);
1839
1840   BREAKUP_CHAR (XCHAR (character), charset, c1, c2);
1841
1842   if (XCHARSET_DIMENSION (Fget_charset (charset)) == 2)
1843     {
1844       rc = list3 (XCHARSET_NAME (charset), make_int (c1), make_int (c2));
1845     }
1846   else
1847     {
1848       rc = list2 (XCHARSET_NAME (charset), make_int (c1));
1849     }
1850   UNGCPRO;
1851
1852   return rc;
1853 }
1854
1855 \f
1856 #ifdef ENABLE_COMPOSITE_CHARS
1857 /************************************************************************/
1858 /*                     composite character functions                    */
1859 /************************************************************************/
1860
1861 Emchar
1862 lookup_composite_char (Bufbyte *str, int len)
1863 {
1864   Lisp_Object lispstr = make_string (str, len);
1865   Lisp_Object ch = Fgethash (lispstr,
1866                              Vcomposite_char_string2char_hash_table,
1867                              Qunbound);
1868   Emchar emch;
1869
1870   if (UNBOUNDP (ch))
1871     {
1872       if (composite_char_row_next >= 128)
1873         signal_simple_error ("No more composite chars available", lispstr);
1874       emch = MAKE_CHAR (Vcharset_composite, composite_char_row_next,
1875                         composite_char_col_next);
1876       Fputhash (make_char (emch), lispstr,
1877                 Vcomposite_char_char2string_hash_table);
1878       Fputhash (lispstr, make_char (emch),
1879                 Vcomposite_char_string2char_hash_table);
1880       composite_char_col_next++;
1881       if (composite_char_col_next >= 128)
1882         {
1883           composite_char_col_next = 32;
1884           composite_char_row_next++;
1885         }
1886     }
1887   else
1888     emch = XCHAR (ch);
1889   return emch;
1890 }
1891
1892 Lisp_Object
1893 composite_char_string (Emchar ch)
1894 {
1895   Lisp_Object str = Fgethash (make_char (ch),
1896                               Vcomposite_char_char2string_hash_table,
1897                               Qunbound);
1898   assert (!UNBOUNDP (str));
1899   return str;
1900 }
1901
1902 xxDEFUN ("make-composite-char", Fmake_composite_char, 1, 1, 0, /*
1903 Convert a string into a single composite character.
1904 The character is the result of overstriking all the characters in
1905 the string.
1906 */
1907        (string))
1908 {
1909   CHECK_STRING (string);
1910   return make_char (lookup_composite_char (XSTRING_DATA (string),
1911                                            XSTRING_LENGTH (string)));
1912 }
1913
1914 xxDEFUN ("composite-char-string", Fcomposite_char_string, 1, 1, 0, /*
1915 Return a string of the characters comprising a composite character.
1916 */
1917        (ch))
1918 {
1919   Emchar emch;
1920
1921   CHECK_CHAR (ch);
1922   emch = XCHAR (ch);
1923   if (CHAR_LEADING_BYTE (emch) != LEADING_BYTE_COMPOSITE)
1924     signal_simple_error ("Must be composite char", ch);
1925   return composite_char_string (emch);
1926 }
1927 #endif /* ENABLE_COMPOSITE_CHARS */
1928
1929 \f
1930 /************************************************************************/
1931 /*                            initialization                            */
1932 /************************************************************************/
1933
1934 void
1935 syms_of_mule_charset (void)
1936 {
1937   DEFSUBR (Fcharsetp);
1938   DEFSUBR (Ffind_charset);
1939   DEFSUBR (Fget_charset);
1940   DEFSUBR (Fcharset_list);
1941   DEFSUBR (Fcharset_name);
1942   DEFSUBR (Fmake_charset);
1943   DEFSUBR (Fmake_reverse_direction_charset);
1944   /*  DEFSUBR (Freverse_direction_charset); */
1945   DEFSUBR (Fdefine_charset_alias);
1946   DEFSUBR (Fcharset_from_attributes);
1947   DEFSUBR (Fcharset_short_name);
1948   DEFSUBR (Fcharset_long_name);
1949   DEFSUBR (Fcharset_description);
1950   DEFSUBR (Fcharset_dimension);
1951   DEFSUBR (Fcharset_property);
1952   DEFSUBR (Fcharset_id);
1953   DEFSUBR (Fset_charset_ccl_program);
1954   DEFSUBR (Fset_charset_registry);
1955 #ifdef UTF2000
1956   DEFSUBR (Fcharset_mapping_table);
1957   DEFSUBR (Fset_charset_mapping_table);
1958 #endif
1959
1960   DEFSUBR (Fmake_char);
1961   DEFSUBR (Fchar_charset);
1962   DEFSUBR (Fsplit_char);
1963
1964 #ifdef ENABLE_COMPOSITE_CHARS
1965   DEFSUBR (Fmake_composite_char);
1966   DEFSUBR (Fcomposite_char_string);
1967 #endif
1968
1969   defsymbol (&Qcharsetp, "charsetp");
1970   defsymbol (&Qregistry, "registry");
1971   defsymbol (&Qfinal, "final");
1972   defsymbol (&Qgraphic, "graphic");
1973   defsymbol (&Qdirection, "direction");
1974   defsymbol (&Qreverse_direction_charset, "reverse-direction-charset");
1975   defsymbol (&Qshort_name, "short-name");
1976   defsymbol (&Qlong_name, "long-name");
1977
1978   defsymbol (&Ql2r, "l2r");
1979   defsymbol (&Qr2l, "r2l");
1980
1981   /* Charsets, compatible with FSF 20.3
1982      Naming convention is Script-Charset[-Edition] */
1983   defsymbol (&Qascii,                   "ascii");
1984   defsymbol (&Qcontrol_1,               "control-1");
1985   defsymbol (&Qlatin_iso8859_1,         "latin-iso8859-1");
1986   defsymbol (&Qlatin_iso8859_2,         "latin-iso8859-2");
1987   defsymbol (&Qlatin_iso8859_3,         "latin-iso8859-3");
1988   defsymbol (&Qlatin_iso8859_4,         "latin-iso8859-4");
1989   defsymbol (&Qthai_tis620,             "thai-tis620");
1990   defsymbol (&Qgreek_iso8859_7,         "greek-iso8859-7");
1991   defsymbol (&Qarabic_iso8859_6,        "arabic-iso8859-6");
1992   defsymbol (&Qhebrew_iso8859_8,        "hebrew-iso8859-8");
1993   defsymbol (&Qkatakana_jisx0201,       "katakana-jisx0201");
1994   defsymbol (&Qlatin_jisx0201,          "latin-jisx0201");
1995   defsymbol (&Qcyrillic_iso8859_5,      "cyrillic-iso8859-5");
1996   defsymbol (&Qlatin_iso8859_9,         "latin-iso8859-9");
1997   defsymbol (&Qjapanese_jisx0208_1978,  "japanese-jisx0208-1978");
1998   defsymbol (&Qchinese_gb2312,          "chinese-gb2312");
1999   defsymbol (&Qjapanese_jisx0208,       "japanese-jisx0208");
2000   defsymbol (&Qkorean_ksc5601,          "korean-ksc5601");
2001   defsymbol (&Qjapanese_jisx0212,       "japanese-jisx0212");
2002   defsymbol (&Qchinese_cns11643_1,      "chinese-cns11643-1");
2003   defsymbol (&Qchinese_cns11643_2,      "chinese-cns11643-2");
2004 #ifdef UTF2000
2005   defsymbol (&Qucs_bmp,                 "ucs-bmp");
2006   defsymbol (&Qlatin_viscii,            "latin-viscii");
2007   defsymbol (&Qlatin_viscii_lower,      "latin-viscii-lower");
2008   defsymbol (&Qlatin_viscii_upper,      "latin-viscii-upper");
2009   defsymbol (&Qvietnamese_viscii_lower, "vietnamese-viscii-lower");
2010   defsymbol (&Qvietnamese_viscii_upper, "vietnamese-viscii-upper");
2011   defsymbol (&Qhiragana_jisx0208,       "hiragana-jisx0208");
2012   defsymbol (&Qkatakana_jisx0208,       "katakana-jisx0208");
2013 #endif
2014   defsymbol (&Qchinese_big5_1,          "chinese-big5-1");
2015   defsymbol (&Qchinese_big5_2,          "chinese-big5-2");
2016
2017   defsymbol (&Qcomposite,               "composite");
2018 }
2019
2020 void
2021 vars_of_mule_charset (void)
2022 {
2023   int i, j;
2024 #ifndef UTF2000
2025   int k;
2026 #endif
2027
2028   /* Table of charsets indexed by leading byte. */
2029   for (i = 0; i < countof (charset_by_leading_byte); i++)
2030     charset_by_leading_byte[i] = Qnil;
2031
2032 #ifdef UTF2000
2033   /* Table of charsets indexed by type/final-byte. */
2034   for (i = 0; i < countof (charset_by_attributes); i++)
2035     for (j = 0; j < countof (charset_by_attributes[0]); j++)
2036         charset_by_attributes[i][j] = Qnil;
2037 #else
2038   /* Table of charsets indexed by type/final-byte/direction. */
2039   for (i = 0; i < countof (charset_by_attributes); i++)
2040     for (j = 0; j < countof (charset_by_attributes[0]); j++)
2041       for (k = 0; k < countof (charset_by_attributes[0][0]); k++)
2042         charset_by_attributes[i][j][k] = Qnil;
2043 #endif
2044
2045   next_allocated_1_byte_leading_byte = MIN_LEADING_BYTE_PRIVATE_1;
2046 #ifdef UTF2000
2047   next_allocated_2_byte_leading_byte = LEADING_BYTE_CHINESE_BIG5_2 + 1;
2048 #else
2049   next_allocated_2_byte_leading_byte = MIN_LEADING_BYTE_PRIVATE_2;
2050 #endif
2051
2052 #ifndef UTF2000
2053   leading_code_private_11 = PRE_LEADING_BYTE_PRIVATE_1;
2054   DEFVAR_INT ("leading-code-private-11", &leading_code_private_11 /*
2055 Leading-code of private TYPE9N charset of column-width 1.
2056 */ );
2057   leading_code_private_11 = PRE_LEADING_BYTE_PRIVATE_1;
2058 #endif
2059
2060 #ifdef UTF2000
2061   Vutf_2000_version = build_string("0.8 (Kami)");
2062   DEFVAR_LISP ("utf-2000-version", &Vutf_2000_version /*
2063 Version number of UTF-2000.
2064 */ );
2065
2066   Vdefault_coded_charset_priority_list = Qnil;
2067   DEFVAR_LISP ("default-coded-charset-priority-list",
2068                &Vdefault_coded_charset_priority_list /*
2069 Default order of preferred coded-character-set.
2070 */ );
2071 #endif
2072 }
2073
2074 void
2075 complex_vars_of_mule_charset (void)
2076 {
2077   staticpro (&Vcharset_hash_table);
2078   Vcharset_hash_table =
2079     make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
2080
2081   /* Predefined character sets.  We store them into variables for
2082      ease of access. */
2083
2084 #ifdef UTF2000
2085   Vcharset_ucs_bmp =
2086     make_charset (LEADING_BYTE_UCS_BMP, Qucs_bmp,
2087                   CHARSET_TYPE_256X256, 1, 2, 0,
2088                   CHARSET_LEFT_TO_RIGHT,
2089                   build_string ("BMP"),
2090                   build_string ("BMP"),
2091                   build_string ("ISO/IEC 10646 Group 0 Plane 0 (BMP)"),
2092                   build_string ("\\(ISO10646.*-1\\|UNICODE[23]?-0\\)"),
2093                   Qnil, 0, 0xFFFF, 0, 0);
2094 #else
2095 # define MIN_CHAR_THAI 0
2096 # define MAX_CHAR_THAI 0
2097 # define MIN_CHAR_GREEK 0
2098 # define MAX_CHAR_GREEK 0
2099 # define MIN_CHAR_HEBREW 0
2100 # define MAX_CHAR_HEBREW 0
2101 # define MIN_CHAR_HALFWIDTH_KATAKANA 0
2102 # define MAX_CHAR_HALFWIDTH_KATAKANA 0
2103 # define MIN_CHAR_CYRILLIC 0
2104 # define MAX_CHAR_CYRILLIC 0
2105 #endif
2106   Vcharset_ascii =
2107     make_charset (LEADING_BYTE_ASCII, Qascii,
2108                   CHARSET_TYPE_94, 1, 0, 'B',
2109                   CHARSET_LEFT_TO_RIGHT,
2110                   build_string ("ASCII"),
2111                   build_string ("ASCII)"),
2112                   build_string ("ASCII (ISO646 IRV)"),
2113                   build_string ("\\(iso8859-[0-9]*\\|-ascii\\)"),
2114                   Qnil, 0, 0x7F, 0, 0);
2115   Vcharset_control_1 =
2116     make_charset (LEADING_BYTE_CONTROL_1, Qcontrol_1,
2117                   CHARSET_TYPE_94, 1, 1, 0,
2118                   CHARSET_LEFT_TO_RIGHT,
2119                   build_string ("C1"),
2120                   build_string ("Control characters"),
2121                   build_string ("Control characters 128-191"),
2122                   build_string (""),
2123                   Qnil, 0x80, 0x9F, 0, 0);
2124   Vcharset_latin_iso8859_1 =
2125     make_charset (LEADING_BYTE_LATIN_ISO8859_1, Qlatin_iso8859_1,
2126                   CHARSET_TYPE_96, 1, 1, 'A',
2127                   CHARSET_LEFT_TO_RIGHT,
2128                   build_string ("Latin-1"),
2129                   build_string ("ISO8859-1 (Latin-1)"),
2130                   build_string ("ISO8859-1 (Latin-1)"),
2131                   build_string ("iso8859-1"),
2132                   Qnil, 0xA0, 0xFF, 0, 32);
2133   Vcharset_latin_iso8859_2 =
2134     make_charset (LEADING_BYTE_LATIN_ISO8859_2, Qlatin_iso8859_2,
2135                   CHARSET_TYPE_96, 1, 1, 'B',
2136                   CHARSET_LEFT_TO_RIGHT,
2137                   build_string ("Latin-2"),
2138                   build_string ("ISO8859-2 (Latin-2)"),
2139                   build_string ("ISO8859-2 (Latin-2)"),
2140                   build_string ("iso8859-2"),
2141                   Qnil, 0, 0, 0, 32);
2142   Vcharset_latin_iso8859_3 =
2143     make_charset (LEADING_BYTE_LATIN_ISO8859_3, Qlatin_iso8859_3,
2144                   CHARSET_TYPE_96, 1, 1, 'C',
2145                   CHARSET_LEFT_TO_RIGHT,
2146                   build_string ("Latin-3"),
2147                   build_string ("ISO8859-3 (Latin-3)"),
2148                   build_string ("ISO8859-3 (Latin-3)"),
2149                   build_string ("iso8859-3"),
2150                   Qnil, 0, 0, 0, 32);
2151   Vcharset_latin_iso8859_4 =
2152     make_charset (LEADING_BYTE_LATIN_ISO8859_4, Qlatin_iso8859_4,
2153                   CHARSET_TYPE_96, 1, 1, 'D',
2154                   CHARSET_LEFT_TO_RIGHT,
2155                   build_string ("Latin-4"),
2156                   build_string ("ISO8859-4 (Latin-4)"),
2157                   build_string ("ISO8859-4 (Latin-4)"),
2158                   build_string ("iso8859-4"),
2159                   Qnil, 0, 0, 0, 32);
2160   Vcharset_thai_tis620 =
2161     make_charset (LEADING_BYTE_THAI_TIS620, Qthai_tis620,
2162                   CHARSET_TYPE_96, 1, 1, 'T',
2163                   CHARSET_LEFT_TO_RIGHT,
2164                   build_string ("TIS620"),
2165                   build_string ("TIS620 (Thai)"),
2166                   build_string ("TIS620.2529 (Thai)"),
2167                   build_string ("tis620"),
2168                   Qnil, MIN_CHAR_THAI, MAX_CHAR_THAI, 0, 32);
2169   Vcharset_greek_iso8859_7 =
2170     make_charset (LEADING_BYTE_GREEK_ISO8859_7, Qgreek_iso8859_7,
2171                   CHARSET_TYPE_96, 1, 1, 'F',
2172                   CHARSET_LEFT_TO_RIGHT,
2173                   build_string ("ISO8859-7"),
2174                   build_string ("ISO8859-7 (Greek)"),
2175                   build_string ("ISO8859-7 (Greek)"),
2176                   build_string ("iso8859-7"),
2177                   Qnil, MIN_CHAR_GREEK, MAX_CHAR_GREEK, 0, 32);
2178   Vcharset_arabic_iso8859_6 =
2179     make_charset (LEADING_BYTE_ARABIC_ISO8859_6, Qarabic_iso8859_6,
2180                   CHARSET_TYPE_96, 1, 1, 'G',
2181                   CHARSET_RIGHT_TO_LEFT,
2182                   build_string ("ISO8859-6"),
2183                   build_string ("ISO8859-6 (Arabic)"),
2184                   build_string ("ISO8859-6 (Arabic)"),
2185                   build_string ("iso8859-6"),
2186                   Qnil, 0, 0, 0, 32);
2187   Vcharset_hebrew_iso8859_8 =
2188     make_charset (LEADING_BYTE_HEBREW_ISO8859_8, Qhebrew_iso8859_8,
2189                   CHARSET_TYPE_96, 1, 1, 'H',
2190                   CHARSET_RIGHT_TO_LEFT,
2191                   build_string ("ISO8859-8"),
2192                   build_string ("ISO8859-8 (Hebrew)"),
2193                   build_string ("ISO8859-8 (Hebrew)"),
2194                   build_string ("iso8859-8"),
2195                   Qnil, MIN_CHAR_HEBREW, MAX_CHAR_HEBREW, 0, 32);
2196   Vcharset_katakana_jisx0201 =
2197     make_charset (LEADING_BYTE_KATAKANA_JISX0201, Qkatakana_jisx0201,
2198                   CHARSET_TYPE_94, 1, 1, 'I',
2199                   CHARSET_LEFT_TO_RIGHT,
2200                   build_string ("JISX0201 Kana"),
2201                   build_string ("JISX0201.1976 (Japanese Kana)"),
2202                   build_string ("JISX0201.1976 Japanese Kana"),
2203                   build_string ("jisx0201\\.1976"),
2204                   Qnil,
2205                   MIN_CHAR_HALFWIDTH_KATAKANA,
2206                   MAX_CHAR_HALFWIDTH_KATAKANA, 0, 33);
2207   Vcharset_latin_jisx0201 =
2208     make_charset (LEADING_BYTE_LATIN_JISX0201, Qlatin_jisx0201,
2209                   CHARSET_TYPE_94, 1, 0, 'J',
2210                   CHARSET_LEFT_TO_RIGHT,
2211                   build_string ("JISX0201 Roman"),
2212                   build_string ("JISX0201.1976 (Japanese Roman)"),
2213                   build_string ("JISX0201.1976 Japanese Roman"),
2214                   build_string ("jisx0201\\.1976"),
2215                   Qnil, 0, 0, 0, 33);
2216   Vcharset_cyrillic_iso8859_5 =
2217     make_charset (LEADING_BYTE_CYRILLIC_ISO8859_5, Qcyrillic_iso8859_5,
2218                   CHARSET_TYPE_96, 1, 1, 'L',
2219                   CHARSET_LEFT_TO_RIGHT,
2220                   build_string ("ISO8859-5"),
2221                   build_string ("ISO8859-5 (Cyrillic)"),
2222                   build_string ("ISO8859-5 (Cyrillic)"),
2223                   build_string ("iso8859-5"),
2224                   Qnil, MIN_CHAR_CYRILLIC, MAX_CHAR_CYRILLIC, 0, 32);
2225   Vcharset_latin_iso8859_9 =
2226     make_charset (LEADING_BYTE_LATIN_ISO8859_9, Qlatin_iso8859_9,
2227                   CHARSET_TYPE_96, 1, 1, 'M',
2228                   CHARSET_LEFT_TO_RIGHT,
2229                   build_string ("Latin-5"),
2230                   build_string ("ISO8859-9 (Latin-5)"),
2231                   build_string ("ISO8859-9 (Latin-5)"),
2232                   build_string ("iso8859-9"),
2233                   Qnil, 0, 0, 0, 32);
2234   Vcharset_japanese_jisx0208_1978 =
2235     make_charset (LEADING_BYTE_JAPANESE_JISX0208_1978, Qjapanese_jisx0208_1978,
2236                   CHARSET_TYPE_94X94, 2, 0, '@',
2237                   CHARSET_LEFT_TO_RIGHT,
2238                   build_string ("JIS X0208:1978"),
2239                   build_string ("JIS X0208:1978 (Japanese)"),
2240                   build_string
2241                   ("JIS X0208:1978 Japanese Kanji (so called \"old JIS\")"),
2242                   build_string ("\\(jisx0208\\|jisc6226\\)\\.1978"),
2243                   Qnil, 0, 0, 0, 33);
2244   Vcharset_chinese_gb2312 =
2245     make_charset (LEADING_BYTE_CHINESE_GB2312, Qchinese_gb2312,
2246                   CHARSET_TYPE_94X94, 2, 0, 'A',
2247                   CHARSET_LEFT_TO_RIGHT,
2248                   build_string ("GB2312"),
2249                   build_string ("GB2312)"),
2250                   build_string ("GB2312 Chinese simplified"),
2251                   build_string ("gb2312"),
2252                   Qnil, 0, 0, 0, 33);
2253   Vcharset_japanese_jisx0208 =
2254     make_charset (LEADING_BYTE_JAPANESE_JISX0208, Qjapanese_jisx0208,
2255                   CHARSET_TYPE_94X94, 2, 0, 'B',
2256                   CHARSET_LEFT_TO_RIGHT,
2257                   build_string ("JISX0208"),
2258                   build_string ("JIS X0208:1983 (Japanese)"),
2259                   build_string ("JIS X0208:1983 Japanese Kanji"),
2260                   build_string ("jisx0208\\.1983"),
2261                   Qnil, 0, 0, 0, 33);
2262   Vcharset_korean_ksc5601 =
2263     make_charset (LEADING_BYTE_KOREAN_KSC5601, Qkorean_ksc5601,
2264                   CHARSET_TYPE_94X94, 2, 0, 'C',
2265                   CHARSET_LEFT_TO_RIGHT,
2266                   build_string ("KSC5601"),
2267                   build_string ("KSC5601 (Korean"),
2268                   build_string ("KSC5601 Korean Hangul and Hanja"),
2269                   build_string ("ksc5601"),
2270                   Qnil, 0, 0, 0, 33);
2271   Vcharset_japanese_jisx0212 =
2272     make_charset (LEADING_BYTE_JAPANESE_JISX0212, Qjapanese_jisx0212,
2273                   CHARSET_TYPE_94X94, 2, 0, 'D',
2274                   CHARSET_LEFT_TO_RIGHT,
2275                   build_string ("JISX0212"),
2276                   build_string ("JISX0212 (Japanese)"),
2277                   build_string ("JISX0212 Japanese Supplement"),
2278                   build_string ("jisx0212"),
2279                   Qnil, 0, 0, 0, 33);
2280
2281 #define CHINESE_CNS_PLANE_RE(n) "cns11643[.-]\\(.*[.-]\\)?" n "$"
2282   Vcharset_chinese_cns11643_1 =
2283     make_charset (LEADING_BYTE_CHINESE_CNS11643_1, Qchinese_cns11643_1,
2284                   CHARSET_TYPE_94X94, 2, 0, 'G',
2285                   CHARSET_LEFT_TO_RIGHT,
2286                   build_string ("CNS11643-1"),
2287                   build_string ("CNS11643-1 (Chinese traditional)"),
2288                   build_string
2289                   ("CNS 11643 Plane 1 Chinese traditional"),
2290                   build_string (CHINESE_CNS_PLANE_RE("1")),
2291                   Qnil, 0, 0, 0, 33);
2292   Vcharset_chinese_cns11643_2 =
2293     make_charset (LEADING_BYTE_CHINESE_CNS11643_2, Qchinese_cns11643_2,
2294                   CHARSET_TYPE_94X94, 2, 0, 'H',
2295                   CHARSET_LEFT_TO_RIGHT,
2296                   build_string ("CNS11643-2"),
2297                   build_string ("CNS11643-2 (Chinese traditional)"),
2298                   build_string
2299                   ("CNS 11643 Plane 2 Chinese traditional"),
2300                   build_string (CHINESE_CNS_PLANE_RE("2")),
2301                   Qnil, 0, 0, 0, 33);
2302 #ifdef UTF2000
2303   Vcharset_latin_viscii_lower =
2304     make_charset (LEADING_BYTE_LATIN_VISCII_LOWER, Qlatin_viscii_lower,
2305                   CHARSET_TYPE_96, 1, 1, '1',
2306                   CHARSET_LEFT_TO_RIGHT,
2307                   build_string ("VISCII lower"),
2308                   build_string ("VISCII lower (Vietnamese)"),
2309                   build_string ("VISCII lower (Vietnamese)"),
2310                   build_string ("MULEVISCII-LOWER"),
2311                   Qnil, 0, 0, 0, 32);
2312   Vcharset_latin_viscii_upper =
2313     make_charset (LEADING_BYTE_LATIN_VISCII_UPPER, Qlatin_viscii_upper,
2314                   CHARSET_TYPE_96, 1, 1, '2',
2315                   CHARSET_LEFT_TO_RIGHT,
2316                   build_string ("VISCII upper"),
2317                   build_string ("VISCII upper (Vietnamese)"),
2318                   build_string ("VISCII upper (Vietnamese)"),
2319                   build_string ("MULEVISCII-UPPER"),
2320                   Qnil, 0, 0, 0, 32);
2321   Vcharset_latin_viscii =
2322     make_charset (LEADING_BYTE_LATIN_VISCII, Qlatin_viscii,
2323                   CHARSET_TYPE_256, 1, 2, 0,
2324                   CHARSET_LEFT_TO_RIGHT,
2325                   build_string ("VISCII"),
2326                   build_string ("VISCII 1.1 (Vietnamese)"),
2327                   build_string ("VISCII 1.1 (Vietnamese)"),
2328                   build_string ("VISCII1\\.1"),
2329                   Qnil, 0, 0, 0, 0);
2330   Vcharset_hiragana_jisx0208 =
2331     make_charset (LEADING_BYTE_HIRAGANA_JISX0208, Qhiragana_jisx0208,
2332                   CHARSET_TYPE_94X94, 2, 0, 'B',
2333                   CHARSET_LEFT_TO_RIGHT,
2334                   build_string ("Hiragana"),
2335                   build_string ("Hiragana of JIS X0208"),
2336                   build_string ("Japanese Hiragana of JIS X0208"),
2337                   build_string ("jisx0208\\.19\\(78\\|83\\|90\\)"),
2338                   Qnil, MIN_CHAR_HIRAGANA, MAX_CHAR_HIRAGANA,
2339                   (0x24 - 33) * 94 + (0x21 - 33), 33);
2340   Vcharset_katakana_jisx0208 =
2341     make_charset (LEADING_BYTE_KATAKANA_JISX0208, Qkatakana_jisx0208,
2342                   CHARSET_TYPE_94X94, 2, 0, 'B',
2343                   CHARSET_LEFT_TO_RIGHT,
2344                   build_string ("Katakana"),
2345                   build_string ("Katakana of JIS X0208"),
2346                   build_string ("Japanese Katakana of JIS X0208"),
2347                   build_string ("jisx0208\\.19\\(78\\|83\\|90\\)"),
2348                   Qnil, MIN_CHAR_KATAKANA, MAX_CHAR_KATAKANA,
2349                   (0x25 - 33) * 94 + (0x21 - 33), 33);
2350 #endif
2351   Vcharset_chinese_big5_1 =
2352     make_charset (LEADING_BYTE_CHINESE_BIG5_1, Qchinese_big5_1,
2353                   CHARSET_TYPE_94X94, 2, 0, '0',
2354                   CHARSET_LEFT_TO_RIGHT,
2355                   build_string ("Big5"),
2356                   build_string ("Big5 (Level-1)"),
2357                   build_string
2358                   ("Big5 Level-1 Chinese traditional"),
2359                   build_string ("big5"),
2360                   Qnil, 0, 0, 0, 33);
2361   Vcharset_chinese_big5_2 =
2362     make_charset (LEADING_BYTE_CHINESE_BIG5_2, Qchinese_big5_2,
2363                   CHARSET_TYPE_94X94, 2, 0, '1',
2364                   CHARSET_LEFT_TO_RIGHT,
2365                   build_string ("Big5"),
2366                   build_string ("Big5 (Level-2)"),
2367                   build_string
2368                   ("Big5 Level-2 Chinese traditional"),
2369                   build_string ("big5"),
2370                   Qnil, 0, 0, 0, 33);
2371
2372 #ifdef ENABLE_COMPOSITE_CHARS
2373   /* #### For simplicity, we put composite chars into a 96x96 charset.
2374      This is going to lead to problems because you can run out of
2375      room, esp. as we don't yet recycle numbers. */
2376   Vcharset_composite =
2377     make_charset (LEADING_BYTE_COMPOSITE, Qcomposite,
2378                   CHARSET_TYPE_96X96, 2, 0, 0,
2379                   CHARSET_LEFT_TO_RIGHT,
2380                   build_string ("Composite"),
2381                   build_string ("Composite characters"),
2382                   build_string ("Composite characters"),
2383                   build_string (""));
2384
2385   composite_char_row_next = 32;
2386   composite_char_col_next = 32;
2387
2388   Vcomposite_char_string2char_hash_table =
2389     make_lisp_hash_table (500, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL);
2390   Vcomposite_char_char2string_hash_table =
2391     make_lisp_hash_table (500, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
2392   staticpro (&Vcomposite_char_string2char_hash_table);
2393   staticpro (&Vcomposite_char_char2string_hash_table);
2394 #endif /* ENABLE_COMPOSITE_CHARS */
2395
2396 }