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

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