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   markobj (cs->encoding_table);
 779 #endif
 780   return cs->name;
 781 }
 782
 783 static void
 784 print_charset (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
 785 {
 786   struct Lisp_Charset *cs = XCHARSET (obj);
 787   char buf[200];
 788
 789   if (print_readably)
 790     error ("printing unreadable object #<charset %s 0x%x>",
 791            string_data (XSYMBOL (CHARSET_NAME (cs))->name),
 792            cs->header.uid);
 793
 794   write_c_string ("#<charset ", printcharfun);
 795   print_internal (CHARSET_NAME (cs), printcharfun, 0);
 796   write_c_string (" ", printcharfun);
 797   print_internal (CHARSET_SHORT_NAME (cs), printcharfun, 1);
 798   write_c_string (" ", printcharfun);
 799   print_internal (CHARSET_LONG_NAME (cs), printcharfun, 1);
 800   write_c_string (" ", printcharfun);
 801   print_internal (CHARSET_DOC_STRING (cs), printcharfun, 1);
 802   sprintf (buf, " %s %s cols=%d g%d final='%c' reg=",
 803            CHARSET_TYPE (cs) == CHARSET_TYPE_94    ? "94" :
 804            CHARSET_TYPE (cs) == CHARSET_TYPE_96    ? "96" :
 805            CHARSET_TYPE (cs) == CHARSET_TYPE_94X94 ? "94x94" :
 806            "96x96",
 807            CHARSET_DIRECTION (cs) == CHARSET_LEFT_TO_RIGHT ? "l2r" : "r2l",
 808            CHARSET_COLUMNS (cs),
 809            CHARSET_GRAPHIC (cs),
 810            CHARSET_FINAL (cs));
 811   write_c_string (buf, printcharfun);
 812   print_internal (CHARSET_REGISTRY (cs), printcharfun, 0);
 813   sprintf (buf, " 0x%x>", cs->header.uid);
 814   write_c_string (buf, printcharfun);
 815 }
 816
 817 static const struct lrecord_description charset_description[] = {
 818   { XD_LISP_OBJECT, offsetof(struct Lisp_Charset, name), 7 },
 819 #ifdef UTF2000
 820   { XD_LISP_OBJECT, offsetof(struct Lisp_Charset, decoding_table), 2 },
 821 #endif
 822   { XD_END }
 823 };
 824
 825 DEFINE_LRECORD_IMPLEMENTATION ("charset", charset,
 826                                mark_charset, print_charset, 0, 0, 0,
 827                                charset_description,
 828                                struct Lisp_Charset);
 829
 830 /* Make a new charset. */
 831
 832 static Lisp_Object
 833 make_charset (Charset_ID id, Lisp_Object name,
 834               unsigned char type, unsigned char columns, unsigned char graphic,
 835               Bufbyte final, unsigned char direction, Lisp_Object short_name,
 836               Lisp_Object long_name, Lisp_Object doc,
 837               Lisp_Object reg,
 838               Lisp_Object decoding_table,
 839               Emchar ucs_min, Emchar ucs_max,
 840               Emchar code_offset, unsigned char byte_offset)
 841 {
 842   Lisp_Object obj;
 843   struct Lisp_Charset *cs =
 844     alloc_lcrecord_type (struct Lisp_Charset, &lrecord_charset);
 845   XSETCHARSET (obj, cs);
 846
 847   CHARSET_ID            (cs) = id;
 848   CHARSET_NAME          (cs) = name;
 849   CHARSET_SHORT_NAME    (cs) = short_name;
 850   CHARSET_LONG_NAME     (cs) = long_name;
 851   CHARSET_DIRECTION     (cs) = direction;
 852   CHARSET_TYPE          (cs) = type;
 853   CHARSET_COLUMNS       (cs) = columns;
 854   CHARSET_GRAPHIC       (cs) = graphic;
 855   CHARSET_FINAL         (cs) = final;
 856   CHARSET_DOC_STRING    (cs) = doc;
 857   CHARSET_REGISTRY      (cs) = reg;
 858   CHARSET_CCL_PROGRAM   (cs) = Qnil;
 859   CHARSET_REVERSE_DIRECTION_CHARSET (cs) = Qnil;
 860 #ifdef UTF2000
 861   CHARSET_DECODING_TABLE(cs) = Qnil;
 862   CHARSET_ENCODING_TABLE(cs) = Qnil;
 863   CHARSET_UCS_MIN(cs) = ucs_min;
 864   CHARSET_UCS_MAX(cs) = ucs_max;
 865   CHARSET_CODE_OFFSET(cs) = code_offset;
 866   CHARSET_BYTE_OFFSET(cs) = byte_offset;
 867 #endif
 868
 869   switch (CHARSET_TYPE (cs))
 870     {
 871     case CHARSET_TYPE_94:
 872       CHARSET_DIMENSION (cs) = 1;
 873       CHARSET_CHARS (cs) = 94;
 874       break;
 875     case CHARSET_TYPE_96:
 876       CHARSET_DIMENSION (cs) = 1;
 877       CHARSET_CHARS (cs) = 96;
 878       break;
 879     case CHARSET_TYPE_94X94:
 880       CHARSET_DIMENSION (cs) = 2;
 881       CHARSET_CHARS (cs) = 94;
 882       break;
 883     case CHARSET_TYPE_96X96:
 884       CHARSET_DIMENSION (cs) = 2;
 885       CHARSET_CHARS (cs) = 96;
 886       break;
 887 #ifdef UTF2000
 888     case CHARSET_TYPE_128:
 889       CHARSET_DIMENSION (cs) = 1;
 890       CHARSET_CHARS (cs) = 128;
 891       break;
 892     case CHARSET_TYPE_128X128:
 893       CHARSET_DIMENSION (cs) = 2;
 894       CHARSET_CHARS (cs) = 128;
 895       break;
 896     case CHARSET_TYPE_256:
 897       CHARSET_DIMENSION (cs) = 1;
 898       CHARSET_CHARS (cs) = 256;
 899       break;
 900     case CHARSET_TYPE_256X256:
 901       CHARSET_DIMENSION (cs) = 2;
 902       CHARSET_CHARS (cs) = 256;
 903       break;
 904 #endif
 905     }
 906
 907 #ifndef UTF2000
 908   if (id == LEADING_BYTE_ASCII)
 909     CHARSET_REP_BYTES (cs) = 1;
 910   else if (id < 0xA0)
 911     CHARSET_REP_BYTES (cs) = CHARSET_DIMENSION (cs) + 1;
 912   else
 913     CHARSET_REP_BYTES (cs) = CHARSET_DIMENSION (cs) + 2;
 914 #endif
 915
 916   if (final)
 917     {
 918       /* some charsets do not have final characters.  This includes
 919          ASCII, Control-1, Composite, and the two faux private
 920          charsets. */
 921 #if UTF2000
 922       if (code_offset == 0)
 923         {
 924           assert (NILP (charset_by_attributes[type][final]));
 925           charset_by_attributes[type][final] = obj;
 926         }
 927 #else
 928       assert (NILP (charset_by_attributes[type][final][direction]));
 929       charset_by_attributes[type][final][direction] = obj;
 930 #endif
 931     }
 932
 933   assert (NILP (charset_by_leading_byte[id - MIN_LEADING_BYTE]));
 934   charset_by_leading_byte[id - MIN_LEADING_BYTE] = obj;
 935 #ifndef UTF2000
 936   if (id < 0xA0)
 937     /* official leading byte */
 938     rep_bytes_by_first_byte[id] = CHARSET_REP_BYTES (cs);
 939 #endif
 940
 941   /* Some charsets are "faux" and don't have names or really exist at
 942      all except in the leading-byte table. */
 943   if (!NILP (name))
 944     Fputhash (name, obj, Vcharset_hash_table);
 945   return obj;
 946 }
 947
 948 static int
 949 get_unallocated_leading_byte (int dimension)
 950 {
 951   Charset_ID lb;
 952
 953 #ifdef UTF2000
 954   if (next_allocated_leading_byte > MAX_LEADING_BYTE_PRIVATE)
 955     lb = 0;
 956   else
 957     lb = next_allocated_leading_byte++;
 958 #else
 959   if (dimension == 1)
 960     {
 961       if (next_allocated_1_byte_leading_byte > MAX_LEADING_BYTE_PRIVATE_1)
 962         lb = 0;
 963       else
 964         lb = next_allocated_1_byte_leading_byte++;
 965     }
 966   else
 967     {
 968       if (next_allocated_2_byte_leading_byte > MAX_LEADING_BYTE_PRIVATE_2)
 969         lb = 0;
 970       else
 971         lb = next_allocated_2_byte_leading_byte++;
 972     }
 973 #endif
 974
 975   if (!lb)
 976     signal_simple_error
 977       ("No more character sets free for this dimension",
 978        make_int (dimension));
 979
 980   return lb;
 981 }
 982
 983 #ifdef UTF2000
 984 unsigned char
 985 charset_get_byte1 (Lisp_Object charset, Emchar ch)
 986 {
 987   Lisp_Object table;
 988   int d;
 989
 990   if (!EQ (table = XCHARSET_ENCODING_TABLE (charset), Qnil))
 991     {
 992       Lisp_Object value = get_char_code_table (ch, table);
 993
 994       if (INTP (value))
 995         {
 996           Emchar code = XINT (value);
 997
 998           if (code < (1 << 8))
 999             return code;
1000           else if (code < (1 << 16))
1001             return code >> 8;
1002           else if (code < (1 << 24))
1003             return code >> 16;
1004           else
1005             return code >> 24;
1006         }
1007     }
1008   if ((XCHARSET_UCS_MIN (charset) <= ch)
1009       && (ch <= XCHARSET_UCS_MAX (charset)))
1010     return (ch - XCHARSET_UCS_MIN (charset)
1011             + XCHARSET_CODE_OFFSET (charset))
1012       / (XCHARSET_DIMENSION (charset) == 1 ?
1013          1
1014          :
1015          XCHARSET_DIMENSION (charset) == 2 ?
1016          XCHARSET_CHARS (charset)
1017          :
1018          XCHARSET_DIMENSION (charset) == 3 ?
1019          XCHARSET_CHARS (charset) * XCHARSET_CHARS (charset)
1020          :
1021          XCHARSET_CHARS (charset)
1022          * XCHARSET_CHARS (charset) * XCHARSET_CHARS (charset))
1023       + XCHARSET_BYTE_OFFSET (charset);
1024   else if (XCHARSET_CODE_OFFSET (charset) == 0)
1025     {
1026       if (XCHARSET_DIMENSION (charset) == 1)
1027         {
1028           if (XCHARSET_CHARS (charset) == 94)
1029             {
1030               if (((d = ch - (MIN_CHAR_94
1031                               + (XCHARSET_FINAL (charset) - '0') * 94)) >= 0)
1032                   && (d < 94))
1033                 return d + 33;
1034             }
1035           else if (XCHARSET_CHARS (charset) == 96)
1036             {
1037               if (((d = ch - (MIN_CHAR_96
1038                               + (XCHARSET_FINAL (charset) - '0') * 96)) >= 0)
1039                   && (d < 96))
1040                 return d + 32;
1041             }
1042           else
1043             return 0;
1044         }
1045       else if (XCHARSET_DIMENSION (charset) == 2)
1046         {
1047           if (XCHARSET_CHARS (charset) == 94)
1048             {
1049               if (((d = ch - (MIN_CHAR_94x94
1050                               + (XCHARSET_FINAL (charset) - '0') * 94 * 94))
1051                    >= 0)
1052                   && (d < 94 * 94))
1053                 return (d / 94) + 33;
1054             }
1055           else if (XCHARSET_CHARS (charset) == 96)
1056             {
1057               if (((d = ch - (MIN_CHAR_96x96
1058                               + (XCHARSET_FINAL (charset) - '0') * 96 * 96))
1059                    >= 0)
1060                   && (d < 96 * 96))
1061                 return (d / 96) + 32;
1062             }
1063         }
1064     }
1065   return 0;
1066 }
1067
1068 unsigned char
1069 charset_get_byte2 (Lisp_Object charset, Emchar ch)
1070 {
1071   if (XCHARSET_DIMENSION (charset) == 1)
1072     return 0;
1073   else
1074     {
1075       Lisp_Object table;
1076
1077       if (!EQ (table = XCHARSET_ENCODING_TABLE (charset), Qnil))
1078         {
1079           Lisp_Object value = get_char_code_table (ch, table);
1080
1081           if (INTP (value))
1082             {
1083               Emchar code = XINT (value);
1084
1085               if (code < (1 << 16))
1086                 return (unsigned char)code;
1087               else if (code < (1 << 24))
1088                 return (unsigned char)(code >> 16);
1089               else
1090                 return (unsigned char)(code >> 24);
1091             }
1092         }
1093       if ((XCHARSET_UCS_MIN (charset) <= ch)
1094           && (ch <= XCHARSET_UCS_MAX (charset)))
1095         return ((ch - XCHARSET_UCS_MIN (charset)
1096                  + XCHARSET_CODE_OFFSET (charset))
1097                 / (XCHARSET_DIMENSION (charset) == 2 ?
1098                    1
1099                    :
1100                    XCHARSET_DIMENSION (charset) == 3 ?
1101                    XCHARSET_CHARS (charset)
1102                    :
1103                    XCHARSET_CHARS (charset) * XCHARSET_CHARS (charset)))
1104           % XCHARSET_CHARS (charset)
1105           + XCHARSET_BYTE_OFFSET (charset);
1106       else if (XCHARSET_CHARS (charset) == 94)
1107         return (MIN_CHAR_94x94
1108                 + (XCHARSET_FINAL (charset) - '0') * 94 * 94 <= ch)
1109           && (ch < MIN_CHAR_94x94
1110               + (XCHARSET_FINAL (charset) - '0' + 1) * 94 * 94) ?
1111           ((ch - MIN_CHAR_94x94) % 94) + 33 : 0;
1112       else /* if (XCHARSET_CHARS (charset) == 96) */
1113         return (MIN_CHAR_96x96
1114                 + (XCHARSET_FINAL (charset) - '0') * 96 * 96 <= ch)
1115           && (ch < MIN_CHAR_96x96
1116               + (XCHARSET_FINAL (charset) - '0' + 1) * 96 * 96) ?
1117           ((ch - MIN_CHAR_96x96) % 96) + 32 : 0;
1118     }
1119 }
1120
1121 Lisp_Object Vdefault_coded_charset_priority_list;
1122 #endif
1123
1124 \f
1125 /************************************************************************/
1126 /*                      Basic charset Lisp functions                    */
1127 /************************************************************************/
1128
1129 DEFUN ("charsetp", Fcharsetp, 1, 1, 0, /*
1130 Return non-nil if OBJECT is a charset.
1131 */
1132        (object))
1133 {
1134   return CHARSETP (object) ? Qt : Qnil;
1135 }
1136
1137 DEFUN ("find-charset", Ffind_charset, 1, 1, 0, /*
1138 Retrieve the charset of the given name.
1139 If CHARSET-OR-NAME is a charset object, it is simply returned.
1140 Otherwise, CHARSET-OR-NAME should be a symbol.  If there is no such charset,
1141 nil is returned.  Otherwise the associated charset object is returned.
1142 */
1143        (charset_or_name))
1144 {
1145   if (CHARSETP (charset_or_name))
1146     return charset_or_name;
1147
1148   CHECK_SYMBOL (charset_or_name);
1149   return Fgethash (charset_or_name, Vcharset_hash_table, Qnil);
1150 }
1151
1152 DEFUN ("get-charset", Fget_charset, 1, 1, 0, /*
1153 Retrieve the charset of the given name.
1154 Same as `find-charset' except an error is signalled if there is no such
1155 charset instead of returning nil.
1156 */
1157        (name))
1158 {
1159   Lisp_Object charset = Ffind_charset (name);
1160
1161   if (NILP (charset))
1162     signal_simple_error ("No such charset", name);
1163   return charset;
1164 }
1165
1166 /* We store the charsets in hash tables with the names as the key and the
1167    actual charset object as the value.  Occasionally we need to use them
1168    in a list format.  These routines provide us with that. */
1169 struct charset_list_closure
1170 {
1171   Lisp_Object *charset_list;
1172 };
1173
1174 static int
1175 add_charset_to_list_mapper (Lisp_Object key, Lisp_Object value,
1176                             void *charset_list_closure)
1177 {
1178   /* This function can GC */
1179   struct charset_list_closure *chcl =
1180     (struct charset_list_closure*) charset_list_closure;
1181   Lisp_Object *charset_list = chcl->charset_list;
1182
1183   *charset_list = Fcons (XCHARSET_NAME (value), *charset_list);
1184   return 0;
1185 }
1186
1187 DEFUN ("charset-list", Fcharset_list, 0, 0, 0, /*
1188 Return a list of the names of all defined charsets.
1189 */
1190        ())
1191 {
1192   Lisp_Object charset_list = Qnil;
1193   struct gcpro gcpro1;
1194   struct charset_list_closure charset_list_closure;
1195
1196   GCPRO1 (charset_list);
1197   charset_list_closure.charset_list = &charset_list;
1198   elisp_maphash (add_charset_to_list_mapper, Vcharset_hash_table,
1199                  &charset_list_closure);
1200   UNGCPRO;
1201
1202   return charset_list;
1203 }
1204
1205 DEFUN ("charset-name", Fcharset_name, 1, 1, 0, /*
1206 Return the name of the given charset.
1207 */
1208        (charset))
1209 {
1210   return XCHARSET_NAME (Fget_charset (charset));
1211 }
1212
1213 DEFUN ("make-charset", Fmake_charset, 3, 3, 0, /*
1214 Define a new character set.
1215 This function is for use with Mule support.
1216 NAME is a symbol, the name by which the character set is normally referred.
1217 DOC-STRING is a string describing the character set.
1218 PROPS is a property list, describing the specific nature of the
1219 character set.  Recognized properties are:
1220
1221 'short-name     Short version of the charset name (ex: Latin-1)
1222 'long-name      Long version of the charset name (ex: ISO8859-1 (Latin-1))
1223 'registry       A regular expression matching the font registry field for
1224                 this character set.
1225 'dimension      Number of octets used to index a character in this charset.
1226                 Either 1 or 2.  Defaults to 1.
1227 'columns        Number of columns used to display a character in this charset.
1228                 Only used in TTY mode. (Under X, the actual width of a
1229                 character can be derived from the font used to display the
1230                 characters.) If unspecified, defaults to the dimension
1231                 (this is almost always the correct value).
1232 'chars          Number of characters in each dimension (94 or 96).
1233                 Defaults to 94.  Note that if the dimension is 2, the
1234                 character set thus described is 94x94 or 96x96.
1235 'final          Final byte of ISO 2022 escape sequence.  Must be
1236                 supplied.  Each combination of (DIMENSION, CHARS) defines a
1237                 separate namespace for final bytes.  Note that ISO
1238                 2022 restricts the final byte to the range
1239                 0x30 - 0x7E if dimension == 1, and 0x30 - 0x5F if
1240                 dimension == 2.  Note also that final bytes in the range
1241                 0x30 - 0x3F are reserved for user-defined (not official)
1242                 character sets.
1243 'graphic        0 (use left half of font on output) or 1 (use right half
1244                 of font on output).  Defaults to 0.  For example, for
1245                 a font whose registry is ISO8859-1, the left half
1246                 (octets 0x20 - 0x7F) is the `ascii' character set, while
1247                 the right half (octets 0xA0 - 0xFF) is the `latin-1'
1248                 character set.  With 'graphic set to 0, the octets
1249                 will have their high bit cleared; with it set to 1,
1250                 the octets will have their high bit set.
1251 'direction      'l2r (left-to-right) or 'r2l (right-to-left).
1252                 Defaults to 'l2r.
1253 'ccl-program    A compiled CCL program used to convert a character in
1254                 this charset into an index into the font.  This is in
1255                 addition to the 'graphic property.  The CCL program
1256                 is passed the octets of the character, with the high
1257                 bit cleared and set depending upon whether the value
1258                 of the 'graphic property is 0 or 1.
1259 */
1260        (name, doc_string, props))
1261 {
1262   int id, dimension = 1, chars = 94, graphic = 0, final = 0, columns = -1;
1263   int direction = CHARSET_LEFT_TO_RIGHT;
1264   int type;
1265   Lisp_Object registry = Qnil;
1266   Lisp_Object charset;
1267   Lisp_Object rest, keyword, value;
1268   Lisp_Object ccl_program = Qnil;
1269   Lisp_Object short_name = Qnil, long_name = Qnil;
1270 #ifdef UTF2000
1271   Emchar code_offset = 0;
1272   unsigned char byte_offset = 0;
1273 #endif
1274
1275   CHECK_SYMBOL (name);
1276   if (!NILP (doc_string))
1277     CHECK_STRING (doc_string);
1278
1279   charset = Ffind_charset (name);
1280   if (!NILP (charset))
1281     signal_simple_error ("Cannot redefine existing charset", name);
1282
1283   EXTERNAL_PROPERTY_LIST_LOOP (rest, keyword, value, props)
1284     {
1285       if (EQ (keyword, Qshort_name))
1286         {
1287           CHECK_STRING (value);
1288           short_name = value;
1289         }
1290
1291       if (EQ (keyword, Qlong_name))
1292         {
1293           CHECK_STRING (value);
1294           long_name = value;
1295         }
1296
1297       else if (EQ (keyword, Qdimension))
1298         {
1299           CHECK_INT (value);
1300           dimension = XINT (value);
1301           if (dimension < 1 || dimension > 2)
1302             signal_simple_error ("Invalid value for 'dimension", value);
1303         }
1304
1305       else if (EQ (keyword, Qchars))
1306         {
1307           CHECK_INT (value);
1308           chars = XINT (value);
1309           if (chars != 94 && chars != 96)
1310             signal_simple_error ("Invalid value for 'chars", value);
1311         }
1312
1313       else if (EQ (keyword, Qcolumns))
1314         {
1315           CHECK_INT (value);
1316           columns = XINT (value);
1317           if (columns != 1 && columns != 2)
1318             signal_simple_error ("Invalid value for 'columns", value);
1319         }
1320
1321       else if (EQ (keyword, Qgraphic))
1322         {
1323           CHECK_INT (value);
1324           graphic = XINT (value);
1325 #ifdef UTF2000
1326           if (graphic < 0 || graphic > 2)
1327 #else
1328           if (graphic < 0 || graphic > 1)
1329 #endif
1330             signal_simple_error ("Invalid value for 'graphic", value);
1331         }
1332
1333       else if (EQ (keyword, Qregistry))
1334         {
1335           CHECK_STRING (value);
1336           registry = value;
1337         }
1338
1339       else if (EQ (keyword, Qdirection))
1340         {
1341           if (EQ (value, Ql2r))
1342             direction = CHARSET_LEFT_TO_RIGHT;
1343           else if (EQ (value, Qr2l))
1344             direction = CHARSET_RIGHT_TO_LEFT;
1345           else
1346             signal_simple_error ("Invalid value for 'direction", value);
1347         }
1348
1349       else if (EQ (keyword, Qfinal))
1350         {
1351           CHECK_CHAR_COERCE_INT (value);
1352           final = XCHAR (value);
1353           if (final < '0' || final > '~')
1354             signal_simple_error ("Invalid value for 'final", value);
1355         }
1356
1357       else if (EQ (keyword, Qccl_program))
1358         {
1359           CHECK_VECTOR (value);
1360           ccl_program = value;
1361         }
1362
1363       else
1364         signal_simple_error ("Unrecognized property", keyword);
1365     }
1366
1367   if (!final)
1368     error ("'final must be specified");
1369   if (dimension == 2 && final > 0x5F)
1370     signal_simple_error
1371       ("Final must be in the range 0x30 - 0x5F for dimension == 2",
1372        make_char (final));
1373
1374   if (dimension == 1)
1375     type = (chars == 94) ? CHARSET_TYPE_94    : CHARSET_TYPE_96;
1376   else
1377     type = (chars == 94) ? CHARSET_TYPE_94X94 : CHARSET_TYPE_96X96;
1378
1379   if (!NILP (CHARSET_BY_ATTRIBUTES (type, final, CHARSET_LEFT_TO_RIGHT)) ||
1380       !NILP (CHARSET_BY_ATTRIBUTES (type, final, CHARSET_RIGHT_TO_LEFT)))
1381     error
1382       ("Character set already defined for this DIMENSION/CHARS/FINAL combo");
1383
1384   id = get_unallocated_leading_byte (dimension);
1385
1386   if (NILP (doc_string))
1387     doc_string = build_string ("");
1388
1389   if (NILP (registry))
1390     registry = build_string ("");
1391
1392   if (NILP (short_name))
1393     XSETSTRING (short_name, XSYMBOL (name)->name);
1394
1395   if (NILP (long_name))
1396     long_name = doc_string;
1397
1398   if (columns == -1)
1399     columns = dimension;
1400   charset = make_charset (id, name, type, columns, graphic,
1401                           final, direction, short_name, long_name,
1402                           doc_string, registry,
1403                           Qnil, 0, 0, 0, byte_offset);
1404   if (!NILP (ccl_program))
1405     XCHARSET_CCL_PROGRAM (charset) = ccl_program;
1406   return charset;
1407 }
1408
1409 DEFUN ("make-reverse-direction-charset", Fmake_reverse_direction_charset,
1410        2, 2, 0, /*
1411 Make a charset equivalent to CHARSET but which goes in the opposite direction.
1412 NEW-NAME is the name of the new charset.  Return the new charset.
1413 */
1414        (charset, new_name))
1415 {
1416   Lisp_Object new_charset = Qnil;
1417   int id, dimension, columns, graphic, final;
1418   int direction, type;
1419   Lisp_Object registry, doc_string, short_name, long_name;
1420   struct Lisp_Charset *cs;
1421
1422   charset = Fget_charset (charset);
1423   if (!NILP (XCHARSET_REVERSE_DIRECTION_CHARSET (charset)))
1424     signal_simple_error ("Charset already has reverse-direction charset",
1425                          charset);
1426
1427   CHECK_SYMBOL (new_name);
1428   if (!NILP (Ffind_charset (new_name)))
1429     signal_simple_error ("Cannot redefine existing charset", new_name);
1430
1431   cs = XCHARSET (charset);
1432
1433   type      = CHARSET_TYPE      (cs);
1434   columns   = CHARSET_COLUMNS   (cs);
1435   dimension = CHARSET_DIMENSION (cs);
1436   id = get_unallocated_leading_byte (dimension);
1437
1438   graphic = CHARSET_GRAPHIC (cs);
1439   final = CHARSET_FINAL (cs);
1440   direction = CHARSET_RIGHT_TO_LEFT;
1441   if (CHARSET_DIRECTION (cs) == CHARSET_RIGHT_TO_LEFT)
1442     direction = CHARSET_LEFT_TO_RIGHT;
1443   doc_string = CHARSET_DOC_STRING (cs);
1444   short_name = CHARSET_SHORT_NAME (cs);
1445   long_name = CHARSET_LONG_NAME (cs);
1446   registry = CHARSET_REGISTRY (cs);
1447
1448   new_charset = make_charset (id, new_name, type, columns,
1449                               graphic, final, direction, short_name, long_name,
1450                               doc_string, registry,
1451 #ifdef UTF2000
1452                               CHARSET_DECODING_TABLE(cs),
1453                               CHARSET_UCS_MIN(cs),
1454                               CHARSET_UCS_MAX(cs),
1455                               CHARSET_CODE_OFFSET(cs),
1456                               CHARSET_BYTE_OFFSET(cs)
1457 #else
1458                               Qnil, 0, 0, 0, 0
1459 #endif
1460 );
1461
1462   CHARSET_REVERSE_DIRECTION_CHARSET (cs) = new_charset;
1463   XCHARSET_REVERSE_DIRECTION_CHARSET (new_charset) = charset;
1464
1465   return new_charset;
1466 }
1467
1468 DEFUN ("define-charset-alias", Fdefine_charset_alias, 2, 2, 0, /*
1469 Define symbol ALIAS as an alias for CHARSET.
1470 */
1471        (alias, charset))
1472 {
1473   CHECK_SYMBOL (alias);
1474   charset = Fget_charset (charset);
1475   return Fputhash (alias, charset, Vcharset_hash_table);
1476 }
1477
1478 /* #### Reverse direction charsets not yet implemented.  */
1479 #if 0
1480 DEFUN ("charset-reverse-direction-charset", Fcharset_reverse_direction_charset,
1481        1, 1, 0, /*
1482 Return the reverse-direction charset parallel to CHARSET, if any.
1483 This is the charset with the same properties (in particular, the same
1484 dimension, number of characters per dimension, and final byte) as
1485 CHARSET but whose characters are displayed in the opposite direction.
1486 */
1487        (charset))
1488 {
1489   charset = Fget_charset (charset);
1490   return XCHARSET_REVERSE_DIRECTION_CHARSET (charset);
1491 }
1492 #endif
1493
1494 DEFUN ("charset-from-attributes", Fcharset_from_attributes, 3, 4, 0, /*
1495 Return a charset with the given DIMENSION, CHARS, FINAL, and DIRECTION.
1496 If DIRECTION is omitted, both directions will be checked (left-to-right
1497 will be returned if character sets exist for both directions).
1498 */
1499        (dimension, chars, final, direction))
1500 {
1501   int dm, ch, fi, di = -1;
1502   int type;
1503   Lisp_Object obj = Qnil;
1504
1505   CHECK_INT (dimension);
1506   dm = XINT (dimension);
1507   if (dm < 1 || dm > 2)
1508     signal_simple_error ("Invalid value for DIMENSION", dimension);
1509
1510   CHECK_INT (chars);
1511   ch = XINT (chars);
1512   if (ch != 94 && ch != 96)
1513     signal_simple_error ("Invalid value for CHARS", chars);
1514
1515   CHECK_CHAR_COERCE_INT (final);
1516   fi = XCHAR (final);
1517   if (fi < '0' || fi > '~')
1518     signal_simple_error ("Invalid value for FINAL", final);
1519
1520   if (EQ (direction, Ql2r))
1521     di = CHARSET_LEFT_TO_RIGHT;
1522   else if (EQ (direction, Qr2l))
1523     di = CHARSET_RIGHT_TO_LEFT;
1524   else if (!NILP (direction))
1525     signal_simple_error ("Invalid value for DIRECTION", direction);
1526
1527   if (dm == 2 && fi > 0x5F)
1528     signal_simple_error
1529       ("Final must be in the range 0x30 - 0x5F for dimension == 2", final);
1530
1531   if (dm == 1)
1532     type = (ch == 94) ? CHARSET_TYPE_94    : CHARSET_TYPE_96;
1533   else
1534     type = (ch == 94) ? CHARSET_TYPE_94X94 : CHARSET_TYPE_96X96;
1535
1536   if (di == -1)
1537     {
1538       obj = CHARSET_BY_ATTRIBUTES (type, fi, CHARSET_LEFT_TO_RIGHT);
1539       if (NILP (obj))
1540         obj = CHARSET_BY_ATTRIBUTES (type, fi, CHARSET_RIGHT_TO_LEFT);
1541     }
1542   else
1543     obj = CHARSET_BY_ATTRIBUTES (type, fi, di);
1544
1545   if (CHARSETP (obj))
1546     return XCHARSET_NAME (obj);
1547   return obj;
1548 }
1549
1550 DEFUN ("charset-short-name", Fcharset_short_name, 1, 1, 0, /*
1551 Return short name of CHARSET.
1552 */
1553        (charset))
1554 {
1555   return XCHARSET_SHORT_NAME (Fget_charset (charset));
1556 }
1557
1558 DEFUN ("charset-long-name", Fcharset_long_name, 1, 1, 0, /*
1559 Return long name of CHARSET.
1560 */
1561        (charset))
1562 {
1563   return XCHARSET_LONG_NAME (Fget_charset (charset));
1564 }
1565
1566 DEFUN ("charset-description", Fcharset_description, 1, 1, 0, /*
1567 Return description of CHARSET.
1568 */
1569        (charset))
1570 {
1571   return XCHARSET_DOC_STRING (Fget_charset (charset));
1572 }
1573
1574 DEFUN ("charset-dimension", Fcharset_dimension, 1, 1, 0, /*
1575 Return dimension of CHARSET.
1576 */
1577        (charset))
1578 {
1579   return make_int (XCHARSET_DIMENSION (Fget_charset (charset)));
1580 }
1581
1582 DEFUN ("charset-property", Fcharset_property, 2, 2, 0, /*
1583 Return property PROP of CHARSET.
1584 Recognized properties are those listed in `make-charset', as well as
1585 'name and 'doc-string.
1586 */
1587        (charset, prop))
1588 {
1589   struct Lisp_Charset *cs;
1590
1591   charset = Fget_charset (charset);
1592   cs = XCHARSET (charset);
1593
1594   CHECK_SYMBOL (prop);
1595   if (EQ (prop, Qname))        return CHARSET_NAME (cs);
1596   if (EQ (prop, Qshort_name))  return CHARSET_SHORT_NAME (cs);
1597   if (EQ (prop, Qlong_name))   return CHARSET_LONG_NAME (cs);
1598   if (EQ (prop, Qdoc_string))  return CHARSET_DOC_STRING (cs);
1599   if (EQ (prop, Qdimension))   return make_int (CHARSET_DIMENSION (cs));
1600   if (EQ (prop, Qcolumns))     return make_int (CHARSET_COLUMNS (cs));
1601   if (EQ (prop, Qgraphic))     return make_int (CHARSET_GRAPHIC (cs));
1602   if (EQ (prop, Qfinal))       return make_char (CHARSET_FINAL (cs));
1603   if (EQ (prop, Qchars))       return make_int (CHARSET_CHARS (cs));
1604   if (EQ (prop, Qregistry))    return CHARSET_REGISTRY (cs);
1605   if (EQ (prop, Qccl_program)) return CHARSET_CCL_PROGRAM (cs);
1606   if (EQ (prop, Qdirection))
1607     return CHARSET_DIRECTION (cs) == CHARSET_LEFT_TO_RIGHT ? Ql2r : Qr2l;
1608   if (EQ (prop, Qreverse_direction_charset))
1609     {
1610       Lisp_Object obj = CHARSET_REVERSE_DIRECTION_CHARSET (cs);
1611       if (NILP (obj))
1612         return Qnil;
1613       else
1614         return XCHARSET_NAME (obj);
1615     }
1616   signal_simple_error ("Unrecognized charset property name", prop);
1617   return Qnil; /* not reached */
1618 }
1619
1620 DEFUN ("charset-id", Fcharset_id, 1, 1, 0, /*
1621 Return charset identification number of CHARSET.
1622 */
1623         (charset))
1624 {
1625   return make_int(XCHARSET_LEADING_BYTE (Fget_charset (charset)));
1626 }
1627
1628 /* #### We need to figure out which properties we really want to
1629    allow to be set. */
1630
1631 DEFUN ("set-charset-ccl-program", Fset_charset_ccl_program, 2, 2, 0, /*
1632 Set the 'ccl-program property of CHARSET to CCL-PROGRAM.
1633 */
1634        (charset, ccl_program))
1635 {
1636   charset = Fget_charset (charset);
1637   CHECK_VECTOR (ccl_program);
1638   XCHARSET_CCL_PROGRAM (charset) = ccl_program;
1639   return Qnil;
1640 }
1641
1642 static void
1643 invalidate_charset_font_caches (Lisp_Object charset)
1644 {
1645   /* Invalidate font cache entries for charset on all devices. */
1646   Lisp_Object devcons, concons, hash_table;
1647   DEVICE_LOOP_NO_BREAK (devcons, concons)
1648     {
1649       struct device *d = XDEVICE (XCAR (devcons));
1650       hash_table = Fgethash (charset, d->charset_font_cache, Qunbound);
1651       if (!UNBOUNDP (hash_table))
1652         Fclrhash (hash_table);
1653     }
1654 }
1655
1656 DEFUN ("set-charset-registry", Fset_charset_registry, 2, 2, 0, /*
1657 Set the 'registry property of CHARSET to REGISTRY.
1658 */
1659        (charset, registry))
1660 {
1661   charset = Fget_charset (charset);
1662   CHECK_STRING (registry);
1663   XCHARSET_REGISTRY (charset) = registry;
1664   invalidate_charset_font_caches (charset);
1665   face_property_was_changed (Vdefault_face, Qfont, Qglobal);
1666   return Qnil;
1667 }
1668
1669 #ifdef UTF2000
1670 DEFUN ("charset-mapping-table", Fcharset_mapping_table, 1, 1, 0, /*
1671 Return mapping-table of CHARSET.
1672 */
1673        (charset))
1674 {
1675   return XCHARSET_DECODING_TABLE (Fget_charset (charset));
1676 }
1677
1678 DEFUN ("set-charset-mapping-table", Fset_charset_mapping_table, 2, 2, 0, /*
1679 Set mapping-table of CHARSET to TABLE.
1680 */
1681        (charset, table))
1682 {
1683   struct Lisp_Charset *cs;
1684   Lisp_Object old_table;
1685   size_t i;
1686
1687   charset = Fget_charset (charset);
1688   cs = XCHARSET (charset);
1689
1690   if (EQ (table, Qnil))
1691     {
1692       CHARSET_DECODING_TABLE(cs) = table;
1693       CHARSET_ENCODING_TABLE(cs) = Qnil;
1694       return table;
1695     }
1696   else if (VECTORP (table))
1697     {
1698       if (XVECTOR_LENGTH (table) > CHARSET_CHARS (cs))
1699         args_out_of_range (table, make_int (CHARSET_CHARS (cs)));
1700       old_table = CHARSET_ENCODING_TABLE(cs);
1701       CHARSET_DECODING_TABLE(cs) = table;
1702     }
1703   else
1704     signal_error (Qwrong_type_argument,
1705                   list2 (build_translated_string ("vector-or-nil-p"),
1706                          table));
1707   /* signal_simple_error ("Wrong type argument: vector-or-nil-p", table); */
1708
1709   switch (CHARSET_DIMENSION (cs))
1710     {
1711     case 1:
1712       CHARSET_ENCODING_TABLE(cs) = make_char_code_table (Qnil);
1713       for (i = 0; i < XVECTOR_LENGTH (table); i++)
1714         {
1715           Lisp_Object c = XVECTOR_DATA(table)[i];
1716
1717           if (CHARP (c))
1718             {
1719               put_char_code_table (XCHAR (c),
1720                                    make_int (i + CHARSET_BYTE_OFFSET (cs)),
1721                                    CHARSET_ENCODING_TABLE(cs));
1722               Fput_char_attribute (c, charset,
1723                                    list1
1724                                    (make_int (i + CHARSET_BYTE_OFFSET (cs))));
1725             }
1726         }
1727       break;
1728     case 2:
1729       CHARSET_ENCODING_TABLE(cs) = make_char_code_table (Qnil);
1730       for (i = 0; i < XVECTOR_LENGTH (table); i++)
1731         {
1732           Lisp_Object v = XVECTOR_DATA(table)[i];
1733
1734           if (VECTORP (v))
1735             {
1736               size_t j;
1737
1738               if (XVECTOR_LENGTH (v) > CHARSET_CHARS (cs))
1739                 {
1740                   CHARSET_DECODING_TABLE(cs) = old_table;
1741                   args_out_of_range (v, make_int (CHARSET_CHARS (cs)));
1742                 }
1743               for (j = 0; j < XVECTOR_LENGTH (v); j++)
1744                 {
1745                   Lisp_Object c = XVECTOR_DATA(v)[j];
1746
1747                   if (CHARP (c))
1748                     {
1749                       put_char_code_table
1750                         (XCHAR (c),
1751                          make_int (( (i + CHARSET_BYTE_OFFSET (cs)) << 8)
1752                                    | (j + CHARSET_BYTE_OFFSET (cs))),
1753                          CHARSET_ENCODING_TABLE(cs));
1754                       Fput_char_attribute (c, charset,
1755                                            list2
1756                                            (make_int
1757                                             (i + CHARSET_BYTE_OFFSET (cs)),
1758                                             make_int
1759                                             (j + CHARSET_BYTE_OFFSET (cs))));
1760                     }
1761                 }
1762             }
1763           else if (CHARP (v))
1764             {
1765               put_char_code_table (XCHAR (v),
1766                                    make_int (i + CHARSET_BYTE_OFFSET (cs)),
1767                                    CHARSET_ENCODING_TABLE(cs));
1768               Fput_char_attribute (v, charset,
1769                                    list1
1770                                    (make_int (i + CHARSET_BYTE_OFFSET (cs))));
1771             }
1772         }
1773       break;
1774     }
1775   return table;
1776 }
1777 #endif
1778
1779 \f
1780 /************************************************************************/
1781 /*              Lisp primitives for working with characters             */
1782 /************************************************************************/
1783
1784 DEFUN ("make-char", Fmake_char, 2, 3, 0, /*
1785 Make a character from CHARSET and octets ARG1 and ARG2.
1786 ARG2 is required only for characters from two-dimensional charsets.
1787 For example, (make-char 'latin-iso8859-2 185) will return the Latin 2
1788 character s with caron.
1789 */
1790        (charset, arg1, arg2))
1791 {
1792   struct Lisp_Charset *cs;
1793   int a1, a2;
1794   int lowlim, highlim;
1795
1796   charset = Fget_charset (charset);
1797   cs = XCHARSET (charset);
1798
1799   if      (EQ (charset, Vcharset_ascii))     lowlim =  0, highlim = 127;
1800   else if (EQ (charset, Vcharset_control_1)) lowlim =  0, highlim =  31;
1801 #ifdef UTF2000
1802   else if (CHARSET_CHARS (cs) == 256)        lowlim =  0, highlim = 255;
1803 #endif
1804   else if (CHARSET_CHARS (cs) == 94)         lowlim = 33, highlim = 126;
1805   else  /* CHARSET_CHARS (cs) == 96) */      lowlim = 32, highlim = 127;
1806
1807   CHECK_INT (arg1);
1808   /* It is useful (and safe, according to Olivier Galibert) to strip
1809      the 8th bit off ARG1 and ARG2 becaue it allows programmers to
1810      write (make-char 'latin-iso8859-2 CODE) where code is the actual
1811      Latin 2 code of the character.  */
1812 #ifdef UTF2000
1813   a1 = XINT (arg1);
1814   if (highlim < 128)
1815     a1 &= 0x7f;
1816 #else
1817   a1 = XINT (arg1);
1818 #endif
1819   if (a1 < lowlim || a1 > highlim)
1820     args_out_of_range_3 (arg1, make_int (lowlim), make_int (highlim));
1821
1822   if (CHARSET_DIMENSION (cs) == 1)
1823     {
1824       if (!NILP (arg2))
1825         signal_simple_error
1826           ("Charset is of dimension one; second octet must be nil", arg2);
1827       return make_char (MAKE_CHAR (charset, a1, 0));
1828     }
1829
1830   CHECK_INT (arg2);
1831 #ifdef UTF2000
1832   a2 = XINT (arg2);
1833   if (highlim < 128)
1834     a2 &= 0x7f;
1835 #else
1836   a2 = XINT (arg2) & 0x7f;
1837 #endif
1838   if (a2 < lowlim || a2 > highlim)
1839     args_out_of_range_3 (arg2, make_int (lowlim), make_int (highlim));
1840
1841   return make_char (MAKE_CHAR (charset, a1, a2));
1842 }
1843
1844 DEFUN ("char-charset", Fchar_charset, 1, 1, 0, /*
1845 Return the character set of char CH.
1846 */
1847        (ch))
1848 {
1849   CHECK_CHAR_COERCE_INT (ch);
1850
1851   return XCHARSET_NAME (CHAR_CHARSET (XCHAR (ch)));
1852 }
1853
1854 DEFUN ("split-char", Fsplit_char, 1, 1, 0, /*
1855 Return list of charset and one or two position-codes of CHAR.
1856 */
1857        (character))
1858 {
1859   /* This function can GC */
1860   struct gcpro gcpro1, gcpro2;
1861   Lisp_Object charset = Qnil;
1862   Lisp_Object rc = Qnil;
1863   int c1, c2;
1864
1865   GCPRO2 (charset, rc);
1866   CHECK_CHAR_COERCE_INT (character);
1867
1868   BREAKUP_CHAR (XCHAR (character), charset, c1, c2);
1869
1870   if (XCHARSET_DIMENSION (Fget_charset (charset)) == 2)
1871     {
1872       rc = list3 (XCHARSET_NAME (charset), make_int (c1), make_int (c2));
1873     }
1874   else
1875     {
1876       rc = list2 (XCHARSET_NAME (charset), make_int (c1));
1877     }
1878   UNGCPRO;
1879
1880   return rc;
1881 }
1882
1883 \f
1884 #ifdef ENABLE_COMPOSITE_CHARS
1885 /************************************************************************/
1886 /*                     composite character functions                    */
1887 /************************************************************************/
1888
1889 Emchar
1890 lookup_composite_char (Bufbyte *str, int len)
1891 {
1892   Lisp_Object lispstr = make_string (str, len);
1893   Lisp_Object ch = Fgethash (lispstr,
1894                              Vcomposite_char_string2char_hash_table,
1895                              Qunbound);
1896   Emchar emch;
1897
1898   if (UNBOUNDP (ch))
1899     {
1900       if (composite_char_row_next >= 128)
1901         signal_simple_error ("No more composite chars available", lispstr);
1902       emch = MAKE_CHAR (Vcharset_composite, composite_char_row_next,
1903                         composite_char_col_next);
1904       Fputhash (make_char (emch), lispstr,
1905                 Vcomposite_char_char2string_hash_table);
1906       Fputhash (lispstr, make_char (emch),
1907                 Vcomposite_char_string2char_hash_table);
1908       composite_char_col_next++;
1909       if (composite_char_col_next >= 128)
1910         {
1911           composite_char_col_next = 32;
1912           composite_char_row_next++;
1913         }
1914     }
1915   else
1916     emch = XCHAR (ch);
1917   return emch;
1918 }
1919
1920 Lisp_Object
1921 composite_char_string (Emchar ch)
1922 {
1923   Lisp_Object str = Fgethash (make_char (ch),
1924                               Vcomposite_char_char2string_hash_table,
1925                               Qunbound);
1926   assert (!UNBOUNDP (str));
1927   return str;
1928 }
1929
1930 xxDEFUN ("make-composite-char", Fmake_composite_char, 1, 1, 0, /*
1931 Convert a string into a single composite character.
1932 The character is the result of overstriking all the characters in
1933 the string.
1934 */
1935        (string))
1936 {
1937   CHECK_STRING (string);
1938   return make_char (lookup_composite_char (XSTRING_DATA (string),
1939                                            XSTRING_LENGTH (string)));
1940 }
1941
1942 xxDEFUN ("composite-char-string", Fcomposite_char_string, 1, 1, 0, /*
1943 Return a string of the characters comprising a composite character.
1944 */
1945        (ch))
1946 {
1947   Emchar emch;
1948
1949   CHECK_CHAR (ch);
1950   emch = XCHAR (ch);
1951   if (CHAR_LEADING_BYTE (emch) != LEADING_BYTE_COMPOSITE)
1952     signal_simple_error ("Must be composite char", ch);
1953   return composite_char_string (emch);
1954 }
1955 #endif /* ENABLE_COMPOSITE_CHARS */
1956
1957 \f
1958 /************************************************************************/
1959 /*                            initialization                            */
1960 /************************************************************************/
1961
1962 void
1963 syms_of_mule_charset (void)
1964 {
1965   DEFSUBR (Fcharsetp);
1966   DEFSUBR (Ffind_charset);
1967   DEFSUBR (Fget_charset);
1968   DEFSUBR (Fcharset_list);
1969   DEFSUBR (Fcharset_name);
1970   DEFSUBR (Fmake_charset);
1971   DEFSUBR (Fmake_reverse_direction_charset);
1972   /*  DEFSUBR (Freverse_direction_charset); */
1973   DEFSUBR (Fdefine_charset_alias);
1974   DEFSUBR (Fcharset_from_attributes);
1975   DEFSUBR (Fcharset_short_name);
1976   DEFSUBR (Fcharset_long_name);
1977   DEFSUBR (Fcharset_description);
1978   DEFSUBR (Fcharset_dimension);
1979   DEFSUBR (Fcharset_property);
1980   DEFSUBR (Fcharset_id);
1981   DEFSUBR (Fset_charset_ccl_program);
1982   DEFSUBR (Fset_charset_registry);
1983 #ifdef UTF2000
1984   DEFSUBR (Fchar_attribute_alist);
1985   DEFSUBR (Fget_char_attribute);
1986   DEFSUBR (Fput_char_attribute);
1987   DEFSUBR (Fcharset_mapping_table);
1988   DEFSUBR (Fset_charset_mapping_table);
1989 #endif
1990
1991   DEFSUBR (Fmake_char);
1992   DEFSUBR (Fchar_charset);
1993   DEFSUBR (Fsplit_char);
1994
1995 #ifdef ENABLE_COMPOSITE_CHARS
1996   DEFSUBR (Fmake_composite_char);
1997   DEFSUBR (Fcomposite_char_string);
1998 #endif
1999
2000   defsymbol (&Qcharsetp, "charsetp");
2001   defsymbol (&Qregistry, "registry");
2002   defsymbol (&Qfinal, "final");
2003   defsymbol (&Qgraphic, "graphic");
2004   defsymbol (&Qdirection, "direction");
2005   defsymbol (&Qreverse_direction_charset, "reverse-direction-charset");
2006   defsymbol (&Qshort_name, "short-name");
2007   defsymbol (&Qlong_name, "long-name");
2008
2009   defsymbol (&Ql2r, "l2r");
2010   defsymbol (&Qr2l, "r2l");
2011
2012   /* Charsets, compatible with FSF 20.3
2013      Naming convention is Script-Charset[-Edition] */
2014   defsymbol (&Qascii,                   "ascii");
2015   defsymbol (&Qcontrol_1,               "control-1");
2016   defsymbol (&Qlatin_iso8859_1,         "latin-iso8859-1");
2017   defsymbol (&Qlatin_iso8859_2,         "latin-iso8859-2");
2018   defsymbol (&Qlatin_iso8859_3,         "latin-iso8859-3");
2019   defsymbol (&Qlatin_iso8859_4,         "latin-iso8859-4");
2020   defsymbol (&Qthai_tis620,             "thai-tis620");
2021   defsymbol (&Qgreek_iso8859_7,         "greek-iso8859-7");
2022   defsymbol (&Qarabic_iso8859_6,        "arabic-iso8859-6");
2023   defsymbol (&Qhebrew_iso8859_8,        "hebrew-iso8859-8");
2024   defsymbol (&Qkatakana_jisx0201,       "katakana-jisx0201");
2025   defsymbol (&Qlatin_jisx0201,          "latin-jisx0201");
2026   defsymbol (&Qcyrillic_iso8859_5,      "cyrillic-iso8859-5");
2027   defsymbol (&Qlatin_iso8859_9,         "latin-iso8859-9");
2028   defsymbol (&Qjapanese_jisx0208_1978,  "japanese-jisx0208-1978");
2029   defsymbol (&Qchinese_gb2312,          "chinese-gb2312");
2030   defsymbol (&Qjapanese_jisx0208,       "japanese-jisx0208");
2031   defsymbol (&Qkorean_ksc5601,          "korean-ksc5601");
2032   defsymbol (&Qjapanese_jisx0212,       "japanese-jisx0212");
2033   defsymbol (&Qchinese_cns11643_1,      "chinese-cns11643-1");
2034   defsymbol (&Qchinese_cns11643_2,      "chinese-cns11643-2");
2035 #ifdef UTF2000
2036   defsymbol (&Qucs_bmp,                 "ucs-bmp");
2037   defsymbol (&Qlatin_viscii,            "latin-viscii");
2038   defsymbol (&Qlatin_viscii_lower,      "latin-viscii-lower");
2039   defsymbol (&Qlatin_viscii_upper,      "latin-viscii-upper");
2040   defsymbol (&Qvietnamese_viscii_lower, "vietnamese-viscii-lower");
2041   defsymbol (&Qvietnamese_viscii_upper, "vietnamese-viscii-upper");
2042   defsymbol (&Qhiragana_jisx0208,       "hiragana-jisx0208");
2043   defsymbol (&Qkatakana_jisx0208,       "katakana-jisx0208");
2044 #endif
2045   defsymbol (&Qchinese_big5_1,          "chinese-big5-1");
2046   defsymbol (&Qchinese_big5_2,          "chinese-big5-2");
2047
2048   defsymbol (&Qcomposite,               "composite");
2049 }
2050
2051 void
2052 vars_of_mule_charset (void)
2053 {
2054   int i, j;
2055 #ifndef UTF2000
2056   int k;
2057 #endif
2058
2059   /* Table of charsets indexed by leading byte. */
2060   for (i = 0; i < countof (charset_by_leading_byte); i++)
2061     charset_by_leading_byte[i] = Qnil;
2062
2063 #ifdef UTF2000
2064   /* Table of charsets indexed by type/final-byte. */
2065   for (i = 0; i < countof (charset_by_attributes); i++)
2066     for (j = 0; j < countof (charset_by_attributes[0]); j++)
2067         charset_by_attributes[i][j] = Qnil;
2068 #else
2069   /* Table of charsets indexed by type/final-byte/direction. */
2070   for (i = 0; i < countof (charset_by_attributes); i++)
2071     for (j = 0; j < countof (charset_by_attributes[0]); j++)
2072       for (k = 0; k < countof (charset_by_attributes[0][0]); k++)
2073         charset_by_attributes[i][j][k] = Qnil;
2074 #endif
2075
2076 #ifdef UTF2000
2077   next_allocated_leading_byte = MIN_LEADING_BYTE_PRIVATE;
2078 #else
2079   next_allocated_1_byte_leading_byte = MIN_LEADING_BYTE_PRIVATE_1;
2080   next_allocated_2_byte_leading_byte = MIN_LEADING_BYTE_PRIVATE_2;
2081 #endif
2082
2083 #ifndef UTF2000
2084   leading_code_private_11 = PRE_LEADING_BYTE_PRIVATE_1;
2085   DEFVAR_INT ("leading-code-private-11", &leading_code_private_11 /*
2086 Leading-code of private TYPE9N charset of column-width 1.
2087 */ );
2088   leading_code_private_11 = PRE_LEADING_BYTE_PRIVATE_1;
2089 #endif
2090
2091 #ifdef UTF2000
2092   Vutf_2000_version = build_string("0.10 (Yao)");
2093   DEFVAR_LISP ("utf-2000-version", &Vutf_2000_version /*
2094 Version number of UTF-2000.
2095 */ );
2096
2097   staticpro (&Vcharacter_attribute_table);
2098   Vcharacter_attribute_table = make_char_code_table (Qnil);
2099
2100   Vdefault_coded_charset_priority_list = Qnil;
2101   DEFVAR_LISP ("default-coded-charset-priority-list",
2102                &Vdefault_coded_charset_priority_list /*
2103 Default order of preferred coded-character-sets.
2104 */ );
2105 #endif
2106 }
2107
2108 void
2109 complex_vars_of_mule_charset (void)
2110 {
2111   staticpro (&Vcharset_hash_table);
2112   Vcharset_hash_table =
2113     make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
2114
2115   /* Predefined character sets.  We store them into variables for
2116      ease of access. */
2117
2118 #ifdef UTF2000
2119   Vcharset_ucs_bmp =
2120     make_charset (LEADING_BYTE_UCS_BMP, Qucs_bmp,
2121                   CHARSET_TYPE_256X256, 1, 2, 0,
2122                   CHARSET_LEFT_TO_RIGHT,
2123                   build_string ("BMP"),
2124                   build_string ("BMP"),
2125                   build_string ("ISO/IEC 10646 Group 0 Plane 0 (BMP)"),
2126                   build_string ("\\(ISO10646.*-1\\|UNICODE[23]?-0\\)"),
2127                   Qnil, 0, 0xFFFF, 0, 0);
2128 #else
2129 # define MIN_CHAR_THAI 0
2130 # define MAX_CHAR_THAI 0
2131 # define MIN_CHAR_GREEK 0
2132 # define MAX_CHAR_GREEK 0
2133 # define MIN_CHAR_HEBREW 0
2134 # define MAX_CHAR_HEBREW 0
2135 # define MIN_CHAR_HALFWIDTH_KATAKANA 0
2136 # define MAX_CHAR_HALFWIDTH_KATAKANA 0
2137 # define MIN_CHAR_CYRILLIC 0
2138 # define MAX_CHAR_CYRILLIC 0
2139 #endif
2140   Vcharset_ascii =
2141     make_charset (LEADING_BYTE_ASCII, Qascii,
2142                   CHARSET_TYPE_94, 1, 0, 'B',
2143                   CHARSET_LEFT_TO_RIGHT,
2144                   build_string ("ASCII"),
2145                   build_string ("ASCII)"),
2146                   build_string ("ASCII (ISO646 IRV)"),
2147                   build_string ("\\(iso8859-[0-9]*\\|-ascii\\)"),
2148                   Qnil, 0, 0x7F, 0, 0);
2149   Vcharset_control_1 =
2150     make_charset (LEADING_BYTE_CONTROL_1, Qcontrol_1,
2151                   CHARSET_TYPE_94, 1, 1, 0,
2152                   CHARSET_LEFT_TO_RIGHT,
2153                   build_string ("C1"),
2154                   build_string ("Control characters"),
2155                   build_string ("Control characters 128-191"),
2156                   build_string (""),
2157                   Qnil, 0x80, 0x9F, 0, 0);
2158   Vcharset_latin_iso8859_1 =
2159     make_charset (LEADING_BYTE_LATIN_ISO8859_1, Qlatin_iso8859_1,
2160                   CHARSET_TYPE_96, 1, 1, 'A',
2161                   CHARSET_LEFT_TO_RIGHT,
2162                   build_string ("Latin-1"),
2163                   build_string ("ISO8859-1 (Latin-1)"),
2164                   build_string ("ISO8859-1 (Latin-1)"),
2165                   build_string ("iso8859-1"),
2166                   Qnil, 0xA0, 0xFF, 0, 32);
2167   Vcharset_latin_iso8859_2 =
2168     make_charset (LEADING_BYTE_LATIN_ISO8859_2, Qlatin_iso8859_2,
2169                   CHARSET_TYPE_96, 1, 1, 'B',
2170                   CHARSET_LEFT_TO_RIGHT,
2171                   build_string ("Latin-2"),
2172                   build_string ("ISO8859-2 (Latin-2)"),
2173                   build_string ("ISO8859-2 (Latin-2)"),
2174                   build_string ("iso8859-2"),
2175                   Qnil, 0, 0, 0, 32);
2176   Vcharset_latin_iso8859_3 =
2177     make_charset (LEADING_BYTE_LATIN_ISO8859_3, Qlatin_iso8859_3,
2178                   CHARSET_TYPE_96, 1, 1, 'C',
2179                   CHARSET_LEFT_TO_RIGHT,
2180                   build_string ("Latin-3"),
2181                   build_string ("ISO8859-3 (Latin-3)"),
2182                   build_string ("ISO8859-3 (Latin-3)"),
2183                   build_string ("iso8859-3"),
2184                   Qnil, 0, 0, 0, 32);
2185   Vcharset_latin_iso8859_4 =
2186     make_charset (LEADING_BYTE_LATIN_ISO8859_4, Qlatin_iso8859_4,
2187                   CHARSET_TYPE_96, 1, 1, 'D',
2188                   CHARSET_LEFT_TO_RIGHT,
2189                   build_string ("Latin-4"),
2190                   build_string ("ISO8859-4 (Latin-4)"),
2191                   build_string ("ISO8859-4 (Latin-4)"),
2192                   build_string ("iso8859-4"),
2193                   Qnil, 0, 0, 0, 32);
2194   Vcharset_thai_tis620 =
2195     make_charset (LEADING_BYTE_THAI_TIS620, Qthai_tis620,
2196                   CHARSET_TYPE_96, 1, 1, 'T',
2197                   CHARSET_LEFT_TO_RIGHT,
2198                   build_string ("TIS620"),
2199                   build_string ("TIS620 (Thai)"),
2200                   build_string ("TIS620.2529 (Thai)"),
2201                   build_string ("tis620"),
2202                   Qnil, MIN_CHAR_THAI, MAX_CHAR_THAI, 0, 32);
2203   Vcharset_greek_iso8859_7 =
2204     make_charset (LEADING_BYTE_GREEK_ISO8859_7, Qgreek_iso8859_7,
2205                   CHARSET_TYPE_96, 1, 1, 'F',
2206                   CHARSET_LEFT_TO_RIGHT,
2207                   build_string ("ISO8859-7"),
2208                   build_string ("ISO8859-7 (Greek)"),
2209                   build_string ("ISO8859-7 (Greek)"),
2210                   build_string ("iso8859-7"),
2211                   Qnil, MIN_CHAR_GREEK, MAX_CHAR_GREEK, 0, 32);
2212   Vcharset_arabic_iso8859_6 =
2213     make_charset (LEADING_BYTE_ARABIC_ISO8859_6, Qarabic_iso8859_6,
2214                   CHARSET_TYPE_96, 1, 1, 'G',
2215                   CHARSET_RIGHT_TO_LEFT,
2216                   build_string ("ISO8859-6"),
2217                   build_string ("ISO8859-6 (Arabic)"),
2218                   build_string ("ISO8859-6 (Arabic)"),
2219                   build_string ("iso8859-6"),
2220                   Qnil, 0, 0, 0, 32);
2221   Vcharset_hebrew_iso8859_8 =
2222     make_charset (LEADING_BYTE_HEBREW_ISO8859_8, Qhebrew_iso8859_8,
2223                   CHARSET_TYPE_96, 1, 1, 'H',
2224                   CHARSET_RIGHT_TO_LEFT,
2225                   build_string ("ISO8859-8"),
2226                   build_string ("ISO8859-8 (Hebrew)"),
2227                   build_string ("ISO8859-8 (Hebrew)"),
2228                   build_string ("iso8859-8"),
2229                   Qnil, MIN_CHAR_HEBREW, MAX_CHAR_HEBREW, 0, 32);
2230   Vcharset_katakana_jisx0201 =
2231     make_charset (LEADING_BYTE_KATAKANA_JISX0201, Qkatakana_jisx0201,
2232                   CHARSET_TYPE_94, 1, 1, 'I',
2233                   CHARSET_LEFT_TO_RIGHT,
2234                   build_string ("JISX0201 Kana"),
2235                   build_string ("JISX0201.1976 (Japanese Kana)"),
2236                   build_string ("JISX0201.1976 Japanese Kana"),
2237                   build_string ("jisx0201\\.1976"),
2238                   Qnil,
2239                   MIN_CHAR_HALFWIDTH_KATAKANA,
2240                   MAX_CHAR_HALFWIDTH_KATAKANA, 0, 33);
2241   Vcharset_latin_jisx0201 =
2242     make_charset (LEADING_BYTE_LATIN_JISX0201, Qlatin_jisx0201,
2243                   CHARSET_TYPE_94, 1, 0, 'J',
2244                   CHARSET_LEFT_TO_RIGHT,
2245                   build_string ("JISX0201 Roman"),
2246                   build_string ("JISX0201.1976 (Japanese Roman)"),
2247                   build_string ("JISX0201.1976 Japanese Roman"),
2248                   build_string ("jisx0201\\.1976"),
2249                   Qnil, 0, 0, 0, 33);
2250   Vcharset_cyrillic_iso8859_5 =
2251     make_charset (LEADING_BYTE_CYRILLIC_ISO8859_5, Qcyrillic_iso8859_5,
2252                   CHARSET_TYPE_96, 1, 1, 'L',
2253                   CHARSET_LEFT_TO_RIGHT,
2254                   build_string ("ISO8859-5"),
2255                   build_string ("ISO8859-5 (Cyrillic)"),
2256                   build_string ("ISO8859-5 (Cyrillic)"),
2257                   build_string ("iso8859-5"),
2258                   Qnil, MIN_CHAR_CYRILLIC, MAX_CHAR_CYRILLIC, 0, 32);
2259   Vcharset_latin_iso8859_9 =
2260     make_charset (LEADING_BYTE_LATIN_ISO8859_9, Qlatin_iso8859_9,
2261                   CHARSET_TYPE_96, 1, 1, 'M',
2262                   CHARSET_LEFT_TO_RIGHT,
2263                   build_string ("Latin-5"),
2264                   build_string ("ISO8859-9 (Latin-5)"),
2265                   build_string ("ISO8859-9 (Latin-5)"),
2266                   build_string ("iso8859-9"),
2267                   Qnil, 0, 0, 0, 32);
2268   Vcharset_japanese_jisx0208_1978 =
2269     make_charset (LEADING_BYTE_JAPANESE_JISX0208_1978, Qjapanese_jisx0208_1978,
2270                   CHARSET_TYPE_94X94, 2, 0, '@',
2271                   CHARSET_LEFT_TO_RIGHT,
2272                   build_string ("JIS X0208:1978"),
2273                   build_string ("JIS X0208:1978 (Japanese)"),
2274                   build_string
2275                   ("JIS X0208:1978 Japanese Kanji (so called \"old JIS\")"),
2276                   build_string ("\\(jisx0208\\|jisc6226\\)\\.1978"),
2277                   Qnil, 0, 0, 0, 33);
2278   Vcharset_chinese_gb2312 =
2279     make_charset (LEADING_BYTE_CHINESE_GB2312, Qchinese_gb2312,
2280                   CHARSET_TYPE_94X94, 2, 0, 'A',
2281                   CHARSET_LEFT_TO_RIGHT,
2282                   build_string ("GB2312"),
2283                   build_string ("GB2312)"),
2284                   build_string ("GB2312 Chinese simplified"),
2285                   build_string ("gb2312"),
2286                   Qnil, 0, 0, 0, 33);
2287   Vcharset_japanese_jisx0208 =
2288     make_charset (LEADING_BYTE_JAPANESE_JISX0208, Qjapanese_jisx0208,
2289                   CHARSET_TYPE_94X94, 2, 0, 'B',
2290                   CHARSET_LEFT_TO_RIGHT,
2291                   build_string ("JISX0208"),
2292                   build_string ("JIS X0208:1983 (Japanese)"),
2293                   build_string ("JIS X0208:1983 Japanese Kanji"),
2294                   build_string ("jisx0208\\.1983"),
2295                   Qnil, 0, 0, 0, 33);
2296   Vcharset_korean_ksc5601 =
2297     make_charset (LEADING_BYTE_KOREAN_KSC5601, Qkorean_ksc5601,
2298                   CHARSET_TYPE_94X94, 2, 0, 'C',
2299                   CHARSET_LEFT_TO_RIGHT,
2300                   build_string ("KSC5601"),
2301                   build_string ("KSC5601 (Korean"),
2302                   build_string ("KSC5601 Korean Hangul and Hanja"),
2303                   build_string ("ksc5601"),
2304                   Qnil, 0, 0, 0, 33);
2305   Vcharset_japanese_jisx0212 =
2306     make_charset (LEADING_BYTE_JAPANESE_JISX0212, Qjapanese_jisx0212,
2307                   CHARSET_TYPE_94X94, 2, 0, 'D',
2308                   CHARSET_LEFT_TO_RIGHT,
2309                   build_string ("JISX0212"),
2310                   build_string ("JISX0212 (Japanese)"),
2311                   build_string ("JISX0212 Japanese Supplement"),
2312                   build_string ("jisx0212"),
2313                   Qnil, 0, 0, 0, 33);
2314
2315 #define CHINESE_CNS_PLANE_RE(n) "cns11643[.-]\\(.*[.-]\\)?" n "$"
2316   Vcharset_chinese_cns11643_1 =
2317     make_charset (LEADING_BYTE_CHINESE_CNS11643_1, Qchinese_cns11643_1,
2318                   CHARSET_TYPE_94X94, 2, 0, 'G',
2319                   CHARSET_LEFT_TO_RIGHT,
2320                   build_string ("CNS11643-1"),
2321                   build_string ("CNS11643-1 (Chinese traditional)"),
2322                   build_string
2323                   ("CNS 11643 Plane 1 Chinese traditional"),
2324                   build_string (CHINESE_CNS_PLANE_RE("1")),
2325                   Qnil, 0, 0, 0, 33);
2326   Vcharset_chinese_cns11643_2 =
2327     make_charset (LEADING_BYTE_CHINESE_CNS11643_2, Qchinese_cns11643_2,
2328                   CHARSET_TYPE_94X94, 2, 0, 'H',
2329                   CHARSET_LEFT_TO_RIGHT,
2330                   build_string ("CNS11643-2"),
2331                   build_string ("CNS11643-2 (Chinese traditional)"),
2332                   build_string
2333                   ("CNS 11643 Plane 2 Chinese traditional"),
2334                   build_string (CHINESE_CNS_PLANE_RE("2")),
2335                   Qnil, 0, 0, 0, 33);
2336 #ifdef UTF2000
2337   Vcharset_latin_viscii_lower =
2338     make_charset (LEADING_BYTE_LATIN_VISCII_LOWER, Qlatin_viscii_lower,
2339                   CHARSET_TYPE_96, 1, 1, '1',
2340                   CHARSET_LEFT_TO_RIGHT,
2341                   build_string ("VISCII lower"),
2342                   build_string ("VISCII lower (Vietnamese)"),
2343                   build_string ("VISCII lower (Vietnamese)"),
2344                   build_string ("MULEVISCII-LOWER"),
2345                   Qnil, 0, 0, 0, 32);
2346   Vcharset_latin_viscii_upper =
2347     make_charset (LEADING_BYTE_LATIN_VISCII_UPPER, Qlatin_viscii_upper,
2348                   CHARSET_TYPE_96, 1, 1, '2',
2349                   CHARSET_LEFT_TO_RIGHT,
2350                   build_string ("VISCII upper"),
2351                   build_string ("VISCII upper (Vietnamese)"),
2352                   build_string ("VISCII upper (Vietnamese)"),
2353                   build_string ("MULEVISCII-UPPER"),
2354                   Qnil, 0, 0, 0, 32);
2355   Vcharset_latin_viscii =
2356     make_charset (LEADING_BYTE_LATIN_VISCII, Qlatin_viscii,
2357                   CHARSET_TYPE_256, 1, 2, 0,
2358                   CHARSET_LEFT_TO_RIGHT,
2359                   build_string ("VISCII"),
2360                   build_string ("VISCII 1.1 (Vietnamese)"),
2361                   build_string ("VISCII 1.1 (Vietnamese)"),
2362                   build_string ("VISCII1\\.1"),
2363                   Qnil, 0, 0, 0, 0);
2364   Vcharset_hiragana_jisx0208 =
2365     make_charset (LEADING_BYTE_HIRAGANA_JISX0208, Qhiragana_jisx0208,
2366                   CHARSET_TYPE_94X94, 2, 0, 'B',
2367                   CHARSET_LEFT_TO_RIGHT,
2368                   build_string ("Hiragana"),
2369                   build_string ("Hiragana of JIS X0208"),
2370                   build_string ("Japanese Hiragana of JIS X0208"),
2371                   build_string ("jisx0208\\.19\\(78\\|83\\|90\\)"),
2372                   Qnil, MIN_CHAR_HIRAGANA, MAX_CHAR_HIRAGANA,
2373                   (0x24 - 33) * 94 + (0x21 - 33), 33);
2374   Vcharset_katakana_jisx0208 =
2375     make_charset (LEADING_BYTE_KATAKANA_JISX0208, Qkatakana_jisx0208,
2376                   CHARSET_TYPE_94X94, 2, 0, 'B',
2377                   CHARSET_LEFT_TO_RIGHT,
2378                   build_string ("Katakana"),
2379                   build_string ("Katakana of JIS X0208"),
2380                   build_string ("Japanese Katakana of JIS X0208"),
2381                   build_string ("jisx0208\\.19\\(78\\|83\\|90\\)"),
2382                   Qnil, MIN_CHAR_KATAKANA, MAX_CHAR_KATAKANA,
2383                   (0x25 - 33) * 94 + (0x21 - 33), 33);
2384 #endif
2385   Vcharset_chinese_big5_1 =
2386     make_charset (LEADING_BYTE_CHINESE_BIG5_1, Qchinese_big5_1,
2387                   CHARSET_TYPE_94X94, 2, 0, '0',
2388                   CHARSET_LEFT_TO_RIGHT,
2389                   build_string ("Big5"),
2390                   build_string ("Big5 (Level-1)"),
2391                   build_string
2392                   ("Big5 Level-1 Chinese traditional"),
2393                   build_string ("big5"),
2394                   Qnil, 0, 0, 0, 33);
2395   Vcharset_chinese_big5_2 =
2396     make_charset (LEADING_BYTE_CHINESE_BIG5_2, Qchinese_big5_2,
2397                   CHARSET_TYPE_94X94, 2, 0, '1',
2398                   CHARSET_LEFT_TO_RIGHT,
2399                   build_string ("Big5"),
2400                   build_string ("Big5 (Level-2)"),
2401                   build_string
2402                   ("Big5 Level-2 Chinese traditional"),
2403                   build_string ("big5"),
2404                   Qnil, 0, 0, 0, 33);
2405
2406 #ifdef ENABLE_COMPOSITE_CHARS
2407   /* #### For simplicity, we put composite chars into a 96x96 charset.
2408      This is going to lead to problems because you can run out of
2409      room, esp. as we don't yet recycle numbers. */
2410   Vcharset_composite =
2411     make_charset (LEADING_BYTE_COMPOSITE, Qcomposite,
2412                   CHARSET_TYPE_96X96, 2, 0, 0,
2413                   CHARSET_LEFT_TO_RIGHT,
2414                   build_string ("Composite"),
2415                   build_string ("Composite characters"),
2416                   build_string ("Composite characters"),
2417                   build_string (""));
2418
2419   composite_char_row_next = 32;
2420   composite_char_col_next = 32;
2421
2422   Vcomposite_char_string2char_hash_table =
2423     make_lisp_hash_table (500, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL);
2424   Vcomposite_char_char2string_hash_table =
2425     make_lisp_hash_table (500, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
2426   staticpro (&Vcomposite_char_string2char_hash_table);
2427   staticpro (&Vcomposite_char_char2string_hash_table);
2428 #endif /* ENABLE_COMPOSITE_CHARS */
2429
2430 }