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    Copyright (C) 1999,2000,2001,2002,2003 MORIOKA Tomohiko
   5
   6 This file is part of XEmacs.
   7
   8 XEmacs is free software; you can redistribute it and/or modify it
   9 under the terms of the GNU General Public License as published by the
  10 Free Software Foundation; either version 2, or (at your option) any
  11 later version.
  12
  13 XEmacs is distributed in the hope that it will be useful, but WITHOUT
  14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  15 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  16 for more details.
  17
  18 You should have received a copy of the GNU General Public License
  19 along with XEmacs; see the file COPYING.  If not, write to
  20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  21 Boston, MA 02111-1307, USA.  */
  22
  23 /* Rewritten by Ben Wing <ben@xemacs.org>. */
  24
  25 /* Rewritten by MORIOKA Tomohiko <tomo@m17n.org> for XEmacs CHISE. */
  26
  27 #include <config.h>
  28 #ifdef CHISE
  29 #include <chise.h>
  30 #endif
  31 #ifdef UTF2000
  32 #include <limits.h>
  33 #endif
  34 #include "lisp.h"
  35
  36 #include "buffer.h"
  37 #include "chartab.h"
  38 #include "elhash.h"
  39 #include "lstream.h"
  40 #include "device.h"
  41 #include "faces.h"
  42 #include "mule-ccl.h"
  43
  44 /* The various pre-defined charsets. */
  45
  46 Lisp_Object Vcharset_ascii;
  47 Lisp_Object Vcharset_control_1;
  48 Lisp_Object Vcharset_latin_iso8859_1;
  49 Lisp_Object Vcharset_latin_iso8859_2;
  50 Lisp_Object Vcharset_latin_iso8859_3;
  51 Lisp_Object Vcharset_latin_iso8859_4;
  52 Lisp_Object Vcharset_thai_tis620;
  53 Lisp_Object Vcharset_greek_iso8859_7;
  54 Lisp_Object Vcharset_arabic_iso8859_6;
  55 Lisp_Object Vcharset_hebrew_iso8859_8;
  56 Lisp_Object Vcharset_katakana_jisx0201;
  57 Lisp_Object Vcharset_latin_jisx0201;
  58 Lisp_Object Vcharset_cyrillic_iso8859_5;
  59 Lisp_Object Vcharset_latin_iso8859_9;
  60 Lisp_Object Vcharset_japanese_jisx0208_1978;
  61 Lisp_Object Vcharset_chinese_gb2312;
  62 Lisp_Object Vcharset_chinese_gb12345;
  63 Lisp_Object Vcharset_japanese_jisx0208;
  64 Lisp_Object Vcharset_japanese_jisx0208_1990;
  65 Lisp_Object Vcharset_korean_ksc5601;
  66 Lisp_Object Vcharset_japanese_jisx0212;
  67 Lisp_Object Vcharset_chinese_cns11643_1;
  68 Lisp_Object Vcharset_chinese_cns11643_2;
  69 #ifdef UTF2000
  70 Lisp_Object Vcharset_ucs;
  71 Lisp_Object Vcharset_ucs_bmp;
  72 Lisp_Object Vcharset_ucs_smp;
  73 Lisp_Object Vcharset_ucs_sip;
  74 Lisp_Object Vcharset_latin_viscii;
  75 Lisp_Object Vcharset_latin_tcvn5712;
  76 Lisp_Object Vcharset_latin_viscii_lower;
  77 Lisp_Object Vcharset_latin_viscii_upper;
  78 Lisp_Object Vcharset_jis_x0208;
  79 Lisp_Object Vcharset_chinese_big5;
  80 Lisp_Object Vcharset_ethiopic_ucs;
  81 #endif
  82 Lisp_Object Vcharset_chinese_big5_1;
  83 Lisp_Object Vcharset_chinese_big5_2;
  84
  85 #ifdef ENABLE_COMPOSITE_CHARS
  86 Lisp_Object Vcharset_composite;
  87
  88 /* Hash tables for composite chars.  One maps string representing
  89    composed chars to their equivalent chars; one goes the
  90    other way. */
  91 Lisp_Object Vcomposite_char_char2string_hash_table;
  92 Lisp_Object Vcomposite_char_string2char_hash_table;
  93
  94 static int composite_char_row_next;
  95 static int composite_char_col_next;
  96
  97 #endif /* ENABLE_COMPOSITE_CHARS */
  98
  99 struct charset_lookup *chlook;
 100
 101 static const struct lrecord_description charset_lookup_description_1[] = {
 102   { XD_LISP_OBJECT_ARRAY, offsetof (struct charset_lookup, charset_by_leading_byte),
 103 #ifdef UTF2000
 104     NUM_LEADING_BYTES+4*128
 105 #else
 106     128+4*128*2
 107 #endif
 108   }, { XD_END }
 109 };
 110
 111 static const struct struct_description charset_lookup_description = {
 112   sizeof (struct charset_lookup),
 113   charset_lookup_description_1
 114 };
 115
 116 #ifndef UTF2000
 117 /* Table of number of bytes in the string representation of a character
 118    indexed by the first byte of that representation.
 119
 120    rep_bytes_by_first_byte(c) is more efficient than the equivalent
 121    canonical computation:
 122
 123    XCHARSET_REP_BYTES (CHARSET_BY_LEADING_BYTE (c)) */
 124
 125 const Bytecount rep_bytes_by_first_byte[0xA0] =
 126 { /* 0x00 - 0x7f are for straight ASCII */
 127   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
 128   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
 129   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
 130   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
 131   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
 132   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
 133   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
 134   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
 135   /* 0x80 - 0x8f are for Dimension-1 official charsets */
 136 #ifdef CHAR_IS_UCS4
 137   2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3,
 138 #else
 139   2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
 140 #endif
 141   /* 0x90 - 0x9d are for Dimension-2 official charsets */
 142   /* 0x9e is for Dimension-1 private charsets */
 143   /* 0x9f is for Dimension-2 private charsets */
 144   3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4
 145 };
 146 #endif
 147
 148 #ifdef UTF2000
 149
 150 int decoding_table_check_elements (Lisp_Object v, int dim, int ccs_len);
 151 int
 152 decoding_table_check_elements (Lisp_Object v, int dim, int ccs_len)
 153 {
 154   int i;
 155
 156   if (XVECTOR_LENGTH (v) > ccs_len)
 157     return -1;
 158
 159   for (i = 0; i < XVECTOR_LENGTH (v); i++)
 160     {
 161       Lisp_Object c = XVECTOR_DATA(v)[i];
 162
 163       if (!NILP (c) && !CHARP (c))
 164         {
 165           if (VECTORP (c))
 166             {
 167               int ret = decoding_table_check_elements (c, dim - 1, ccs_len);
 168               if (ret)
 169                 return ret;
 170             }
 171           else
 172             return -2;
 173         }
 174     }
 175   return 0;
 176 }
 177
 178 Lisp_Object
 179 put_char_ccs_code_point (Lisp_Object character,
 180                          Lisp_Object ccs, Lisp_Object value)
 181 {
 182   if (!EQ (XCHARSET_NAME (ccs), Qmap_ucs)
 183       || !INTP (value)
 184       || (XCHAR (character) != XINT (value)))
 185     {
 186       Lisp_Object v = XCHARSET_DECODING_TABLE (ccs);
 187       int code_point;
 188
 189       if (CONSP (value))
 190         { /* obsolete representation: value must be a list of bytes */
 191           Lisp_Object ret = Fcar (value);
 192           Lisp_Object rest;
 193
 194           if (!INTP (ret))
 195             signal_simple_error ("Invalid value for coded-charset", value);
 196           code_point = XINT (ret);
 197           if (XCHARSET_GRAPHIC (ccs) == 1)
 198             code_point &= 0x7F;
 199           rest = Fcdr (value);
 200           while (!NILP (rest))
 201             {
 202               int j;
 203
 204               if (!CONSP (rest))
 205                 signal_simple_error ("Invalid value for coded-charset",
 206                                      value);
 207               ret = Fcar (rest);
 208               if (!INTP (ret))
 209                 signal_simple_error ("Invalid value for coded-charset",
 210                                      value);
 211               j = XINT (ret);
 212               if (XCHARSET_GRAPHIC (ccs) == 1)
 213                 j &= 0x7F;
 214               code_point = (code_point << 8) | j;
 215               rest = Fcdr (rest);
 216             }
 217           value = make_int (code_point);
 218         }
 219       else if (INTP (value))
 220         {
 221           code_point = XINT (value);
 222           if (XCHARSET_GRAPHIC (ccs) == 1)
 223             {
 224               code_point &= 0x7F7F7F7F;
 225               value = make_int (code_point);
 226             }
 227         }
 228       else
 229         signal_simple_error ("Invalid value for coded-charset", value);
 230
 231       if (VECTORP (v))
 232         {
 233           Lisp_Object cpos = Fget_char_attribute (character, ccs, Qnil);
 234           if (INTP (cpos))
 235             {
 236               decoding_table_remove_char (ccs, XINT (cpos));
 237             }
 238         }
 239       decoding_table_put_char (ccs, code_point, character);
 240     }
 241   return value;
 242 }
 243
 244 Lisp_Object
 245 remove_char_ccs (Lisp_Object character, Lisp_Object ccs)
 246 {
 247   Lisp_Object decoding_table = XCHARSET_DECODING_TABLE (ccs);
 248   Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (ccs);
 249
 250   if (VECTORP (decoding_table))
 251     {
 252       Lisp_Object cpos = Fget_char_attribute (character, ccs, Qnil);
 253
 254       if (!NILP (cpos))
 255         {
 256           decoding_table_remove_char (ccs, XINT (cpos));
 257         }
 258     }
 259   if (CHAR_TABLEP (encoding_table))
 260     {
 261       put_char_id_table (XCHAR_TABLE(encoding_table), character, Qunbound);
 262     }
 263   return Qt;
 264 }
 265
 266 #endif
 267
 268 #ifndef UTF2000
 269 int leading_code_private_11;
 270 #endif
 271
 272 Lisp_Object Qcharsetp;
 273
 274 /* Qdoc_string, Qdimension, Qchars defined in general.c */
 275 Lisp_Object Qregistry, Qfinal, Qgraphic;
 276 Lisp_Object Qdirection;
 277 Lisp_Object Qreverse_direction_charset;
 278 Lisp_Object Qleading_byte;
 279 Lisp_Object Qshort_name, Qlong_name;
 280 Lisp_Object Qiso_ir;
 281 #ifdef UTF2000
 282 Lisp_Object Qmin_code, Qmax_code, Qcode_offset;
 283 Lisp_Object Qmother, Qconversion, Q94x60, Q94x94x60, Qbig5_1, Qbig5_2;
 284 #endif
 285
 286 Lisp_Object Qascii,
 287   Qcontrol_1,
 288   Qlatin_iso8859_1,
 289   Qlatin_iso8859_2,
 290   Qlatin_iso8859_3,
 291   Qlatin_iso8859_4,
 292   Qthai_tis620,
 293   Qgreek_iso8859_7,
 294   Qarabic_iso8859_6,
 295   Qhebrew_iso8859_8,
 296   Qkatakana_jisx0201,
 297   Qlatin_jisx0201,
 298   Qcyrillic_iso8859_5,
 299   Qlatin_iso8859_9,
 300   Qmap_jis_x0208_1978,
 301   Qmap_gb2312,
 302   Qmap_gb12345,
 303   Qmap_jis_x0208_1983,
 304   Qmap_ks_x1001,
 305   Qmap_jis_x0212,
 306   Qmap_cns11643_1,
 307   Qmap_cns11643_2,
 308 #ifdef UTF2000
 309   Qmap_ucs, Qucs,
 310   Qucs_bmp,
 311   Qucs_smp,
 312   Qucs_sip,
 313   Qlatin_viscii,
 314   Qlatin_tcvn5712,
 315   Qlatin_viscii_lower,
 316   Qlatin_viscii_upper,
 317   Qvietnamese_viscii_lower,
 318   Qvietnamese_viscii_upper,
 319   Qmap_jis_x0208,
 320   Qmap_jis_x0208_1990,
 321   Qmap_big5,
 322   Qethiopic_ucs,
 323 #endif
 324   Qchinese_big5_1,
 325   Qchinese_big5_2,
 326   Qcomposite;
 327
 328 Lisp_Object Ql2r, Qr2l;
 329
 330 Lisp_Object Vcharset_hash_table;
 331
 332 /* Composite characters are characters constructed by overstriking two
 333    or more regular characters.
 334
 335    1) The old Mule implementation involves storing composite characters
 336       in a buffer as a tag followed by all of the actual characters
 337       used to make up the composite character.  I think this is a bad
 338       idea; it greatly complicates code that wants to handle strings
 339       one character at a time because it has to deal with the possibility
 340       of great big ungainly characters.  It's much more reasonable to
 341       simply store an index into a table of composite characters.
 342
 343    2) The current implementation only allows for 16,384 separate
 344       composite characters over the lifetime of the XEmacs process.
 345       This could become a potential problem if the user
 346       edited lots of different files that use composite characters.
 347       Due to FSF bogosity, increasing the number of allowable
 348       composite characters under Mule would decrease the number
 349       of possible faces that can exist.  Mule already has shrunk
 350       this to 2048, and further shrinkage would become uncomfortable.
 351       No such problems exist in XEmacs.
 352
 353       Composite characters could be represented as 0x80 C1 C2 C3,
 354       where each C[1-3] is in the range 0xA0 - 0xFF.  This allows
 355       for slightly under 2^20 (one million) composite characters
 356       over the XEmacs process lifetime, and you only need to
 357       increase the size of a Mule character from 19 to 21 bits.
 358       Or you could use 0x80 C1 C2 C3 C4, allowing for about
 359       85 million (slightly over 2^26) composite characters. */
 360
 361 \f
 362 /************************************************************************/
 363 /*                       Basic Emchar functions                         */
 364 /************************************************************************/
 365
 366 /* Convert a non-ASCII Mule character C into a one-character Mule-encoded
 367    string in STR.  Returns the number of bytes stored.
 368    Do not call this directly.  Use the macro set_charptr_emchar() instead.
 369  */
 370
 371 Bytecount
 372 non_ascii_set_charptr_emchar (Bufbyte *str, Emchar c)
 373 {
 374   Bufbyte *p;
 375 #ifndef UTF2000
 376   Charset_ID lb;
 377   int c1, c2;
 378   Lisp_Object charset;
 379 #endif
 380
 381   p = str;
 382 #ifdef UTF2000
 383   if ( c <= 0x7f )
 384     {
 385       *p++ = c;
 386     }
 387   else if ( c <= 0x7ff )
 388     {
 389       *p++ = (c >> 6) | 0xc0;
 390       *p++ = (c & 0x3f) | 0x80;
 391     }
 392   else if ( c <= 0xffff )
 393     {
 394       *p++ =  (c >> 12) | 0xe0;
 395       *p++ = ((c >>  6) & 0x3f) | 0x80;
 396       *p++ =  (c        & 0x3f) | 0x80;
 397     }
 398   else if ( c <= 0x1fffff )
 399     {
 400       *p++ =  (c >> 18) | 0xf0;
 401       *p++ = ((c >> 12) & 0x3f) | 0x80;
 402       *p++ = ((c >>  6) & 0x3f) | 0x80;
 403       *p++ =  (c        & 0x3f) | 0x80;
 404     }
 405   else if ( c <= 0x3ffffff )
 406     {
 407       *p++ =  (c >> 24) | 0xf8;
 408       *p++ = ((c >> 18) & 0x3f) | 0x80;
 409       *p++ = ((c >> 12) & 0x3f) | 0x80;
 410       *p++ = ((c >>  6) & 0x3f) | 0x80;
 411       *p++ =  (c        & 0x3f) | 0x80;
 412     }
 413   else
 414     {
 415       *p++ =  (c >> 30) | 0xfc;
 416       *p++ = ((c >> 24) & 0x3f) | 0x80;
 417       *p++ = ((c >> 18) & 0x3f) | 0x80;
 418       *p++ = ((c >> 12) & 0x3f) | 0x80;
 419       *p++ = ((c >>  6) & 0x3f) | 0x80;
 420       *p++ =  (c        & 0x3f) | 0x80;
 421     }
 422 #else
 423   BREAKUP_CHAR (c, charset, c1, c2);
 424   lb = CHAR_LEADING_BYTE (c);
 425   if (LEADING_BYTE_PRIVATE_P (lb))
 426     *p++ = PRIVATE_LEADING_BYTE_PREFIX (lb);
 427   *p++ = lb;
 428   if (EQ (charset, Vcharset_control_1))
 429     c1 += 0x20;
 430   *p++ = c1 | 0x80;
 431   if (c2)
 432     *p++ = c2 | 0x80;
 433 #endif
 434   return (p - str);
 435 }
 436
 437 /* Return the first character from a Mule-encoded string in STR,
 438    assuming it's non-ASCII.  Do not call this directly.
 439    Use the macro charptr_emchar() instead. */
 440
 441 Emchar
 442 non_ascii_charptr_emchar (const Bufbyte *str)
 443 {
 444 #ifdef UTF2000
 445   Bufbyte b;
 446   Emchar ch;
 447   int len;
 448
 449   b = *str++;
 450   if ( b >= 0xfc )
 451     {
 452       ch = (b & 0x01);
 453       len = 5;
 454     }
 455   else if ( b >= 0xf8 )
 456     {
 457       ch = b & 0x03;
 458       len = 4;
 459     }
 460   else if ( b >= 0xf0 )
 461     {
 462       ch = b & 0x07;
 463       len = 3;
 464     }
 465   else if ( b >= 0xe0 )
 466     {
 467       ch = b & 0x0f;
 468       len = 2;
 469     }
 470   else if ( b >= 0xc0 )
 471     {
 472       ch = b & 0x1f;
 473       len = 1;
 474     }
 475   else
 476     {
 477       ch = b;
 478       len = 0;
 479     }
 480   for( ; len > 0; len-- )
 481     {
 482       b = *str++;
 483       ch = ( ch << 6 ) | ( b & 0x3f );
 484     }
 485   return ch;
 486 #else
 487   Bufbyte i0 = *str, i1, i2 = 0;
 488   Lisp_Object charset;
 489
 490   if (i0 == LEADING_BYTE_CONTROL_1)
 491     return (Emchar) (*++str - 0x20);
 492
 493   if (LEADING_BYTE_PREFIX_P (i0))
 494     i0 = *++str;
 495
 496   i1 = *++str & 0x7F;
 497
 498   charset = CHARSET_BY_LEADING_BYTE (i0);
 499   if (XCHARSET_DIMENSION (charset) == 2)
 500     i2 = *++str & 0x7F;
 501
 502   return MAKE_CHAR (charset, i1, i2);
 503 #endif
 504 }
 505
 506 /* Return whether CH is a valid Emchar, assuming it's non-ASCII.
 507    Do not call this directly.  Use the macro valid_char_p() instead. */
 508
 509 #ifndef UTF2000
 510 int
 511 non_ascii_valid_char_p (Emchar ch)
 512 {
 513   int f1, f2, f3;
 514
 515   /* Must have only lowest 19 bits set */
 516   if (ch & ~0x7FFFF)
 517     return 0;
 518
 519   f1 = CHAR_FIELD1 (ch);
 520   f2 = CHAR_FIELD2 (ch);
 521   f3 = CHAR_FIELD3 (ch);
 522
 523   if (f1 == 0)
 524     {
 525       Lisp_Object charset;
 526
 527       if (f2 < MIN_CHAR_FIELD2_OFFICIAL ||
 528           (f2 > MAX_CHAR_FIELD2_OFFICIAL && f2 < MIN_CHAR_FIELD2_PRIVATE) ||
 529            f2 > MAX_CHAR_FIELD2_PRIVATE)
 530         return 0;
 531       if (f3 < 0x20)
 532         return 0;
 533
 534       if (f3 != 0x20 && f3 != 0x7F && !(f2 >= MIN_CHAR_FIELD2_PRIVATE &&
 535                                         f2 <= MAX_CHAR_FIELD2_PRIVATE))
 536         return 1;
 537
 538       /*
 539          NOTE: This takes advantage of the fact that
 540          FIELD2_TO_OFFICIAL_LEADING_BYTE and
 541          FIELD2_TO_PRIVATE_LEADING_BYTE are the same.
 542          */
 543       charset = CHARSET_BY_LEADING_BYTE (f2 + FIELD2_TO_OFFICIAL_LEADING_BYTE);
 544       if (EQ (charset, Qnil))
 545         return 0;
 546       return (XCHARSET_CHARS (charset) == 96);
 547     }
 548   else
 549     {
 550       Lisp_Object charset;
 551
 552       if (f1 < MIN_CHAR_FIELD1_OFFICIAL ||
 553           (f1 > MAX_CHAR_FIELD1_OFFICIAL && f1 < MIN_CHAR_FIELD1_PRIVATE) ||
 554           f1 > MAX_CHAR_FIELD1_PRIVATE)
 555         return 0;
 556       if (f2 < 0x20 || f3 < 0x20)
 557         return 0;
 558
 559 #ifdef ENABLE_COMPOSITE_CHARS
 560       if (f1 + FIELD1_TO_OFFICIAL_LEADING_BYTE == LEADING_BYTE_COMPOSITE)
 561         {
 562           if (UNBOUNDP (Fgethash (make_int (ch),
 563                                   Vcomposite_char_char2string_hash_table,
 564                                   Qunbound)))
 565             return 0;
 566           return 1;
 567         }
 568 #endif /* ENABLE_COMPOSITE_CHARS */
 569
 570       if (f2 != 0x20 && f2 != 0x7F && f3 != 0x20 && f3 != 0x7F
 571           && !(f1 >= MIN_CHAR_FIELD1_PRIVATE && f1 <= MAX_CHAR_FIELD1_PRIVATE))
 572         return 1;
 573
 574       if (f1 <= MAX_CHAR_FIELD1_OFFICIAL)
 575         charset =
 576           CHARSET_BY_LEADING_BYTE (f1 + FIELD1_TO_OFFICIAL_LEADING_BYTE);
 577       else
 578         charset =
 579           CHARSET_BY_LEADING_BYTE (f1 + FIELD1_TO_PRIVATE_LEADING_BYTE);
 580
 581       if (EQ (charset, Qnil))
 582         return 0;
 583       return (XCHARSET_CHARS (charset) == 96);
 584     }
 585 }
 586 #endif
 587
 588 \f
 589 /************************************************************************/
 590 /*                       Basic string functions                         */
 591 /************************************************************************/
 592
 593 /* Copy the character pointed to by SRC into DST.  Do not call this
 594    directly.  Use the macro charptr_copy_char() instead.
 595    Return the number of bytes copied.  */
 596
 597 Bytecount
 598 non_ascii_charptr_copy_char (const Bufbyte *src, Bufbyte *dst)
 599 {
 600   unsigned int bytes = REP_BYTES_BY_FIRST_BYTE (*src);
 601   unsigned int i;
 602   for (i = bytes; i; i--, dst++, src++)
 603     *dst = *src;
 604   return bytes;
 605 }
 606
 607 \f
 608 /************************************************************************/
 609 /*                        streams of Emchars                            */
 610 /************************************************************************/
 611
 612 /* Treat a stream as a stream of Emchar's rather than a stream of bytes.
 613    The functions below are not meant to be called directly; use
 614    the macros in insdel.h. */
 615
 616 Emchar
 617 Lstream_get_emchar_1 (Lstream *stream, int ch)
 618 {
 619   Bufbyte str[MAX_EMCHAR_LEN];
 620   Bufbyte *strptr = str;
 621   unsigned int bytes;
 622
 623   str[0] = (Bufbyte) ch;
 624
 625   for (bytes = REP_BYTES_BY_FIRST_BYTE (ch) - 1; bytes; bytes--)
 626     {
 627       int c = Lstream_getc (stream);
 628       bufpos_checking_assert (c >= 0);
 629       *++strptr = (Bufbyte) c;
 630     }
 631   return charptr_emchar (str);
 632 }
 633
 634 int
 635 Lstream_fput_emchar (Lstream *stream, Emchar ch)
 636 {
 637   Bufbyte str[MAX_EMCHAR_LEN];
 638   Bytecount len = set_charptr_emchar (str, ch);
 639   return Lstream_write (stream, str, len);
 640 }
 641
 642 void
 643 Lstream_funget_emchar (Lstream *stream, Emchar ch)
 644 {
 645   Bufbyte str[MAX_EMCHAR_LEN];
 646   Bytecount len = set_charptr_emchar (str, ch);
 647   Lstream_unread (stream, str, len);
 648 }
 649
 650 \f
 651 /************************************************************************/
 652 /*                            charset object                            */
 653 /************************************************************************/
 654
 655 static Lisp_Object
 656 mark_charset (Lisp_Object obj)
 657 {
 658   Lisp_Charset *cs = XCHARSET (obj);
 659
 660   mark_object (cs->short_name);
 661   mark_object (cs->long_name);
 662   mark_object (cs->doc_string);
 663   mark_object (cs->registry);
 664   mark_object (cs->ccl_program);
 665 #ifdef UTF2000
 666   mark_object (cs->decoding_table);
 667   mark_object (cs->mother);
 668 #endif
 669   return cs->name;
 670 }
 671
 672 static void
 673 print_charset (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
 674 {
 675   Lisp_Charset *cs = XCHARSET (obj);
 676   char buf[200];
 677
 678   if (print_readably)
 679     error ("printing unreadable object #<charset %s 0x%x>",
 680            string_data (XSYMBOL (CHARSET_NAME (cs))->name),
 681            cs->header.uid);
 682
 683   write_c_string ("#<charset ", printcharfun);
 684   print_internal (CHARSET_NAME (cs), printcharfun, 0);
 685   write_c_string (" ", printcharfun);
 686   print_internal (CHARSET_SHORT_NAME (cs), printcharfun, 1);
 687   write_c_string (" ", printcharfun);
 688   print_internal (CHARSET_LONG_NAME (cs), printcharfun, 1);
 689   write_c_string (" ", printcharfun);
 690   print_internal (CHARSET_DOC_STRING (cs), printcharfun, 1);
 691   sprintf (buf, " %d^%d %s cols=%d g%d final='%c' reg=",
 692            CHARSET_CHARS (cs),
 693            CHARSET_DIMENSION (cs),
 694            CHARSET_DIRECTION (cs) == CHARSET_LEFT_TO_RIGHT ? "l2r" : "r2l",
 695            CHARSET_COLUMNS (cs),
 696            CHARSET_GRAPHIC (cs),
 697            CHARSET_FINAL (cs));
 698   write_c_string (buf, printcharfun);
 699   print_internal (CHARSET_REGISTRY (cs), printcharfun, 0);
 700   sprintf (buf, " 0x%x>", cs->header.uid);
 701   write_c_string (buf, printcharfun);
 702 }
 703
 704 static const struct lrecord_description charset_description[] = {
 705   { XD_LISP_OBJECT, offsetof (Lisp_Charset, name) },
 706   { XD_LISP_OBJECT, offsetof (Lisp_Charset, doc_string) },
 707   { XD_LISP_OBJECT, offsetof (Lisp_Charset, registry) },
 708   { XD_LISP_OBJECT, offsetof (Lisp_Charset, short_name) },
 709   { XD_LISP_OBJECT, offsetof (Lisp_Charset, long_name) },
 710   { XD_LISP_OBJECT, offsetof (Lisp_Charset, reverse_direction_charset) },
 711   { XD_LISP_OBJECT, offsetof (Lisp_Charset, ccl_program) },
 712 #ifdef UTF2000
 713   { XD_LISP_OBJECT, offsetof (Lisp_Charset, decoding_table) },
 714   { XD_LISP_OBJECT, offsetof (Lisp_Charset, mother) },
 715 #endif
 716   { XD_END }
 717 };
 718
 719 DEFINE_LRECORD_IMPLEMENTATION ("charset", charset,
 720                                mark_charset, print_charset, 0, 0, 0,
 721                                charset_description,
 722                                Lisp_Charset);
 723
 724 /* Make a new charset. */
 725 /* #### SJT Should generic properties be allowed? */
 726 static Lisp_Object
 727 make_charset (Charset_ID id, Lisp_Object name,
 728               unsigned short chars, unsigned char dimension,
 729               unsigned char columns, unsigned char graphic,
 730               Bufbyte final, unsigned char direction, Lisp_Object short_name,
 731               Lisp_Object long_name, Lisp_Object doc,
 732               Lisp_Object reg,
 733               Lisp_Object decoding_table,
 734               Emchar min_code, Emchar max_code,
 735               Emchar code_offset, unsigned char byte_offset,
 736               Lisp_Object mother, unsigned char conversion)
 737 {
 738   Lisp_Object obj;
 739   Lisp_Charset *cs = alloc_lcrecord_type (Lisp_Charset, &lrecord_charset);
 740
 741   zero_lcrecord (cs);
 742
 743   XSETCHARSET (obj, cs);
 744
 745   CHARSET_ID            (cs) = id;
 746   CHARSET_NAME          (cs) = name;
 747   CHARSET_SHORT_NAME    (cs) = short_name;
 748   CHARSET_LONG_NAME     (cs) = long_name;
 749   CHARSET_CHARS         (cs) = chars;
 750   CHARSET_DIMENSION     (cs) = dimension;
 751   CHARSET_DIRECTION     (cs) = direction;
 752   CHARSET_COLUMNS       (cs) = columns;
 753   CHARSET_GRAPHIC       (cs) = graphic;
 754   CHARSET_FINAL         (cs) = final;
 755   CHARSET_DOC_STRING    (cs) = doc;
 756   CHARSET_REGISTRY      (cs) = reg;
 757   CHARSET_CCL_PROGRAM   (cs) = Qnil;
 758   CHARSET_REVERSE_DIRECTION_CHARSET (cs) = Qnil;
 759 #ifdef UTF2000
 760   CHARSET_DECODING_TABLE(cs) = Qunbound;
 761   CHARSET_MIN_CODE      (cs) = min_code;
 762   CHARSET_MAX_CODE      (cs) = max_code;
 763   CHARSET_CODE_OFFSET   (cs) = code_offset;
 764   CHARSET_BYTE_OFFSET   (cs) = byte_offset;
 765   CHARSET_MOTHER        (cs) = mother;
 766   CHARSET_CONVERSION    (cs) = conversion;
 767 #endif
 768
 769 #ifndef UTF2000
 770   if (id == LEADING_BYTE_ASCII)
 771     CHARSET_REP_BYTES (cs) = 1;
 772   else if (id < 0xA0)
 773     CHARSET_REP_BYTES (cs) = CHARSET_DIMENSION (cs) + 1;
 774   else
 775     CHARSET_REP_BYTES (cs) = CHARSET_DIMENSION (cs) + 2;
 776 #endif
 777
 778   if (final)
 779     {
 780       /* some charsets do not have final characters.  This includes
 781          ASCII, Control-1, Composite, and the two faux private
 782          charsets. */
 783       unsigned char iso2022_type
 784         = (dimension == 1 ? 0 : 2) + (chars == 94 ? 0 : 1);
 785 #if UTF2000
 786       if (code_offset == 0)
 787         {
 788           assert (NILP (chlook->charset_by_attributes[iso2022_type][final]));
 789           chlook->charset_by_attributes[iso2022_type][final] = obj;
 790         }
 791 #else
 792       assert (NILP
 793               (chlook->charset_by_attributes[iso2022_type][final][direction]));
 794       chlook->charset_by_attributes[iso2022_type][final][direction] = obj;
 795 #endif
 796     }
 797
 798   assert (NILP (chlook->charset_by_leading_byte[id - MIN_LEADING_BYTE]));
 799   chlook->charset_by_leading_byte[id - MIN_LEADING_BYTE] = obj;
 800
 801   /* Some charsets are "faux" and don't have names or really exist at
 802      all except in the leading-byte table. */
 803   if (!NILP (name))
 804     Fputhash (name, obj, Vcharset_hash_table);
 805   return obj;
 806 }
 807
 808 static int
 809 get_unallocated_leading_byte (int dimension)
 810 {
 811   Charset_ID lb;
 812
 813 #ifdef UTF2000
 814   if (chlook->next_allocated_leading_byte > MAX_LEADING_BYTE_PRIVATE)
 815     lb = 0;
 816   else
 817     lb = chlook->next_allocated_leading_byte++;
 818 #else
 819   if (dimension == 1)
 820     {
 821       if (chlook->next_allocated_1_byte_leading_byte > MAX_LEADING_BYTE_PRIVATE_1)
 822         lb = 0;
 823       else
 824         lb = chlook->next_allocated_1_byte_leading_byte++;
 825     }
 826   else
 827     {
 828       if (chlook->next_allocated_2_byte_leading_byte > MAX_LEADING_BYTE_PRIVATE_2)
 829         lb = 0;
 830       else
 831         lb = chlook->next_allocated_2_byte_leading_byte++;
 832     }
 833 #endif
 834
 835   if (!lb)
 836     signal_simple_error
 837       ("No more character sets free for this dimension",
 838        make_int (dimension));
 839
 840   return lb;
 841 }
 842
 843 #ifdef UTF2000
 844 /* Number of Big5 characters which have the same code in 1st byte.  */
 845
 846 #define BIG5_SAME_ROW (0xFF - 0xA1 + 0x7F - 0x40)
 847
 848 Emchar
 849 decode_defined_char (Lisp_Object ccs, int code_point)
 850 {
 851   int dim = XCHARSET_DIMENSION (ccs);
 852   Lisp_Object decoding_table = XCHARSET_DECODING_TABLE (ccs);
 853   Emchar char_id = -1;
 854   Lisp_Object mother;
 855
 856   while (dim > 0)
 857     {
 858       dim--;
 859       decoding_table
 860         = get_ccs_octet_table (decoding_table, ccs,
 861                                (code_point >> (dim * 8)) & 255);
 862     }
 863   if (CHARP (decoding_table))
 864     return XCHAR (decoding_table);
 865 #ifdef HAVE_CHISE_CLIENT
 866   if (EQ (decoding_table, Qunloaded))
 867     {
 868       char_id = load_char_decoding_entry_maybe (ccs, code_point);
 869     }
 870 #endif
 871   if (char_id >= 0)
 872     return char_id;
 873   else if ( CHARSETP (mother = XCHARSET_MOTHER (ccs)) )
 874     {
 875       if ( XCHARSET_CONVERSION (ccs) == CONVERSION_IDENTICAL )
 876         {
 877           if ( EQ (mother, Vcharset_ucs) )
 878             return DECODE_CHAR (mother, code_point);
 879           else
 880             return decode_defined_char (mother, code_point);
 881         }
 882       else if ( XCHARSET_CONVERSION (ccs) == CONVERSION_BIG5_1 )
 883         {
 884           unsigned int I
 885             = (((code_point >> 8) & 0x7F) - 33) * 94
 886             + (( code_point       & 0x7F) - 33);
 887           unsigned char b1 = I / (0xFF - 0xA1 + 0x7F - 0x40) + 0xA1;
 888           unsigned char b2 = I % (0xFF - 0xA1 + 0x7F - 0x40);
 889
 890           b2 += b2 < 0x3F ? 0x40 : 0x62;
 891           return decode_defined_char (mother, (b1 << 8) | b2);
 892         }
 893       else if ( XCHARSET_CONVERSION (ccs) == CONVERSION_BIG5_2 )
 894         {
 895           unsigned int I
 896             = (((code_point >> 8) & 0x7F) - 33) * 94
 897             + (( code_point       & 0x7F) - 33)
 898             + BIG5_SAME_ROW * (0xC9 - 0xA1);
 899           unsigned char b1 = I / (0xFF - 0xA1 + 0x7F - 0x40) + 0xA1;
 900           unsigned char b2 = I % (0xFF - 0xA1 + 0x7F - 0x40);
 901
 902           b2 += b2 < 0x3F ? 0x40 : 0x62;
 903           return decode_defined_char (mother, (b1 << 8) | b2);
 904         }
 905     }
 906   return -1;
 907 }
 908
 909 Emchar
 910 decode_builtin_char (Lisp_Object charset, int code_point)
 911 {
 912   Lisp_Object mother = XCHARSET_MOTHER (charset);
 913   int final;
 914
 915   if ( XCHARSET_MAX_CODE (charset) > 0 )
 916     {
 917       if ( CHARSETP (mother) )
 918         {
 919           int code = code_point;
 920
 921           if ( XCHARSET_CONVERSION (charset) == CONVERSION_94x60 )
 922             {
 923               int row = code_point >> 8;
 924               int cell = code_point & 255;
 925
 926               if (row < 16 + 32)
 927                 return -1;
 928               else if (row < 16 + 32 + 30)
 929                 code = (row - (16 + 32)) * 94 + cell - 33;
 930               else if (row < 18 + 32 + 30)
 931                 return -1;
 932               else if (row < 18 + 32 + 60)
 933                 code = (row - (18 + 32)) * 94 + cell - 33;
 934             }
 935           else if ( XCHARSET_CONVERSION (charset) == CONVERSION_94x94x60 )
 936             {
 937               int plane = code_point >> 16;
 938               int row = (code_point >> 8) & 255;
 939               int cell = code_point & 255;
 940
 941               if (row < 16 + 32)
 942                 return -1;
 943               else if (row < 16 + 32 + 30)
 944                 code
 945                   = (plane - 33) * 94 * 60
 946                   + (row - (16 + 32)) * 94
 947                   + cell - 33;
 948               else if (row < 18 + 32 + 30)
 949                 return -1;
 950               else if (row < 18 + 32 + 60)
 951                 code
 952                   = (plane - 33) * 94 * 60
 953                   + (row - (18 + 32)) * 94
 954                   + cell - 33;
 955             }
 956           else if ( XCHARSET_CONVERSION (charset) == CONVERSION_BIG5_1 )
 957             {
 958               unsigned int I
 959                 = (((code_point >> 8) & 0x7F) - 33) * 94
 960                 + (( code_point       & 0x7F) - 33);
 961               unsigned char b1 = I / (0xFF - 0xA1 + 0x7F - 0x40) + 0xA1;
 962               unsigned char b2 = I % (0xFF - 0xA1 + 0x7F - 0x40);
 963
 964               b2 += b2 < 0x3F ? 0x40 : 0x62;
 965               code = (b1 << 8) | b2;
 966             }
 967           else if ( XCHARSET_CONVERSION (charset) == CONVERSION_BIG5_2 )
 968             {
 969               unsigned int I
 970                 = (((code_point >> 8) & 0x7F) - 33) * 94
 971                 + (( code_point       & 0x7F) - 33)
 972                 + BIG5_SAME_ROW * (0xC9 - 0xA1);
 973               unsigned char b1 = I / (0xFF - 0xA1 + 0x7F - 0x40) + 0xA1;
 974               unsigned char b2 = I % (0xFF - 0xA1 + 0x7F - 0x40);
 975
 976               b2 += b2 < 0x3F ? 0x40 : 0x62;
 977               code = (b1 << 8) | b2;
 978             }
 979           return
 980             decode_builtin_char (mother, code + XCHARSET_CODE_OFFSET(charset));
 981         }
 982       else
 983         {
 984           Emchar cid
 985             = (XCHARSET_DIMENSION (charset) == 1
 986                ?
 987                code_point - XCHARSET_BYTE_OFFSET (charset)
 988                :
 989                ((code_point >> 8) - XCHARSET_BYTE_OFFSET (charset))
 990                * XCHARSET_CHARS (charset)
 991                + (code_point & 0xFF) - XCHARSET_BYTE_OFFSET (charset))
 992             + XCHARSET_CODE_OFFSET (charset);
 993           if ((cid < XCHARSET_MIN_CODE (charset))
 994               || (XCHARSET_MAX_CODE (charset) < cid))
 995             return -1;
 996           return cid;
 997         }
 998     }
 999   else if ((final = XCHARSET_FINAL (charset)) >= '0')
1000     {
1001       if (XCHARSET_DIMENSION (charset) == 1)
1002         {
1003           switch (XCHARSET_CHARS (charset))
1004             {
1005             case 94:
1006               return MIN_CHAR_94
1007                 + (final - '0') * 94 + ((code_point & 0x7F) - 33);
1008             case 96:
1009               return MIN_CHAR_96
1010                 + (final - '0') * 96 + ((code_point & 0x7F) - 32);
1011             default:
1012               abort ();
1013               return -1;
1014             }
1015         }
1016       else
1017         {
1018           switch (XCHARSET_CHARS (charset))
1019             {
1020             case 94:
1021               return MIN_CHAR_94x94
1022                 + (final - '0') * 94 * 94
1023                 + (((code_point >> 8) & 0x7F) - 33) * 94
1024                 + ((code_point & 0x7F) - 33);
1025             case 96:
1026               return MIN_CHAR_96x96
1027                 + (final - '0') * 96 * 96
1028                 + (((code_point >> 8) & 0x7F) - 32) * 96
1029                 + ((code_point & 0x7F) - 32);
1030             default:
1031               abort ();
1032               return -1;
1033             }
1034         }
1035     }
1036   else
1037     return -1;
1038 }
1039
1040 int
1041 charset_code_point (Lisp_Object charset, Emchar ch, int defined_only)
1042 {
1043   Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (charset);
1044   Lisp_Object ret;
1045
1046   if ( CHAR_TABLEP (encoding_table)
1047        && INTP (ret = get_char_id_table (XCHAR_TABLE(encoding_table),
1048                                          ch)) )
1049     return XINT (ret);
1050   else
1051     {
1052       Lisp_Object mother = XCHARSET_MOTHER (charset);
1053       int min = XCHARSET_MIN_CODE (charset);
1054       int max = XCHARSET_MAX_CODE (charset);
1055       int code = -1;
1056
1057       if ( CHARSETP (mother) )
1058         {
1059           if (XCHARSET_FINAL (charset) >= '0')
1060             code = charset_code_point (mother, ch, 1);
1061           else
1062             code = charset_code_point (mother, ch, defined_only);
1063         }
1064       else if (defined_only)
1065         return -1;
1066       else if ( ((max == 0) && CHARSETP (mother)
1067                  && (XCHARSET_FINAL (charset) == 0))
1068                 || ((min <= ch) && (ch <= max)) )
1069         code = ch;
1070       if ( ((max == 0) && CHARSETP (mother) && (code >= 0))
1071            || ((min <= code) && (code <= max)) )
1072         {
1073           int d = code - XCHARSET_CODE_OFFSET (charset);
1074
1075           if ( XCHARSET_CONVERSION (charset) == CONVERSION_IDENTICAL )
1076             return d;
1077           else if ( XCHARSET_CONVERSION (charset) == CONVERSION_94 )
1078             return d + 33;
1079           else if ( XCHARSET_CONVERSION (charset) == CONVERSION_96 )
1080             return d + 32;
1081           else if ( XCHARSET_CONVERSION (charset) == CONVERSION_94x60 )
1082             {
1083               int row  = d / 94;
1084               int cell = d % 94 + 33;
1085
1086               if (row < 30)
1087                 row += 16 + 32;
1088               else
1089                 row += 18 + 32;
1090               return (row << 8) | cell;
1091             }
1092           else if ( XCHARSET_CONVERSION (charset) == CONVERSION_BIG5_1 )
1093             {
1094               int B1 = d >> 8, B2 = d & 0xFF;
1095               unsigned int I
1096                 = (B1 - 0xA1) * BIG5_SAME_ROW + B2
1097                 - (B2 < 0x7F ? 0x40 : 0x62);
1098
1099               if (B1 < 0xC9)
1100                 {
1101                   return ((I / 94 + 33) << 8) | (I % 94 + 33);
1102                 }
1103             }
1104           else if ( XCHARSET_CONVERSION (charset) == CONVERSION_BIG5_2 )
1105             {
1106               int B1 = d >> 8, B2 = d & 0xFF;
1107               unsigned int I
1108                 = (B1 - 0xA1) * BIG5_SAME_ROW + B2
1109                 - (B2 < 0x7F ? 0x40 : 0x62);
1110
1111               if (B1 >= 0xC9)
1112                 {
1113                   I -= (BIG5_SAME_ROW) * (0xC9 - 0xA1);
1114                   return ((I / 94 + 33) << 8) | (I % 94 + 33);
1115                 }
1116             }
1117           else if ( XCHARSET_CONVERSION (charset) == CONVERSION_94x94 )
1118             return ((d / 94 + 33) << 8) | (d % 94 + 33);
1119           else if ( XCHARSET_CONVERSION (charset) == CONVERSION_96x96 )
1120             return ((d / 96 + 32) << 8) | (d % 96 + 32);
1121           else if ( XCHARSET_CONVERSION (charset) == CONVERSION_94x94x60 )
1122             {
1123               int plane =  d / (94 * 60) + 33;
1124               int row   = (d % (94 * 60)) / 94;
1125               int cell  =  d %  94 + 33;
1126
1127               if (row < 30)
1128                 row += 16 + 32;
1129               else
1130                 row += 18 + 32;
1131               return (plane << 16) | (row << 8) | cell;
1132             }
1133           else if ( XCHARSET_CONVERSION (charset) == CONVERSION_94x94x94 )
1134             return
1135               (   (d / (94 * 94) + 33) << 16)
1136               |  ((d / 94 % 94   + 33) <<  8)
1137               |   (d % 94        + 33);
1138           else if ( XCHARSET_CONVERSION (charset) == CONVERSION_96x96x96 )
1139             return
1140               (   (d / (96 * 96) + 32) << 16)
1141               |  ((d / 96 % 96   + 32) <<  8)
1142               |   (d % 96        + 32);
1143           else if ( XCHARSET_CONVERSION (charset) == CONVERSION_94x94x94x94 )
1144             return
1145               (  (d / (94 * 94 * 94) + 33) << 24)
1146               | ((d / (94 * 94) % 94 + 33) << 16)
1147               | ((d / 94 % 94        + 33) <<  8)
1148               |  (d % 94             + 33);
1149           else if ( XCHARSET_CONVERSION (charset) == CONVERSION_96x96x96x96 )
1150             return
1151               (  (d / (96 * 96 * 96) + 32) << 24)
1152               | ((d / (96 * 96) % 96 + 32) << 16)
1153               | ((d / 96 % 96        + 32) <<  8)
1154               |  (d % 96             + 32);
1155           else
1156             {
1157               printf ("Unknown CCS-conversion %d is specified!",
1158                       XCHARSET_CONVERSION (charset));
1159               exit (-1);
1160             }
1161         }
1162       else if (defined_only)
1163         return -1;
1164       else if ( ( XCHARSET_FINAL (charset) >= '0' ) &&
1165                 ( XCHARSET_MIN_CODE (charset) == 0 )
1166                /*
1167                 (XCHARSET_CODE_OFFSET (charset) == 0) ||
1168                 (XCHARSET_CODE_OFFSET (charset)
1169                  == XCHARSET_MIN_CODE (charset))
1170                */ )
1171         {
1172           int d;
1173
1174           if (XCHARSET_DIMENSION (charset) == 1)
1175             {
1176               if (XCHARSET_CHARS (charset) == 94)
1177                 {
1178                   if (((d = ch - (MIN_CHAR_94
1179                                   + (XCHARSET_FINAL (charset) - '0') * 94))
1180                        >= 0)
1181                       && (d < 94))
1182                     return d + 33;
1183                 }
1184               else if (XCHARSET_CHARS (charset) == 96)
1185                 {
1186                   if (((d = ch - (MIN_CHAR_96
1187                                   + (XCHARSET_FINAL (charset) - '0') * 96))
1188                        >= 0)
1189                       && (d < 96))
1190                     return d + 32;
1191                 }
1192               else
1193                 return -1;
1194             }
1195           else if (XCHARSET_DIMENSION (charset) == 2)
1196             {
1197               if (XCHARSET_CHARS (charset) == 94)
1198                 {
1199                   if (((d = ch - (MIN_CHAR_94x94
1200                                   +
1201                                   (XCHARSET_FINAL (charset) - '0') * 94 * 94))
1202                        >= 0)
1203                       && (d < 94 * 94))
1204                     return (((d / 94) + 33) << 8) | (d % 94 + 33);
1205                 }
1206               else if (XCHARSET_CHARS (charset) == 96)
1207                 {
1208                   if (((d = ch - (MIN_CHAR_96x96
1209                                   +
1210                                   (XCHARSET_FINAL (charset) - '0') * 96 * 96))
1211                        >= 0)
1212                       && (d < 96 * 96))
1213                     return (((d / 96) + 32) << 8) | (d % 96 + 32);
1214                 }
1215               else
1216                 return -1;
1217             }
1218         }
1219     }
1220   return -1;
1221 }
1222
1223 int
1224 encode_builtin_char_1 (Emchar c, Lisp_Object* charset)
1225 {
1226   if (c <= MAX_CHAR_BASIC_LATIN)
1227     {
1228       *charset = Vcharset_ascii;
1229       return c;
1230     }
1231   else if (c < 0xA0)
1232     {
1233       *charset = Vcharset_control_1;
1234       return c & 0x7F;
1235     }
1236   else if (c <= 0xff)
1237     {
1238       *charset = Vcharset_latin_iso8859_1;
1239       return c & 0x7F;
1240     }
1241   /*
1242   else if ((MIN_CHAR_HEBREW <= c) && (c <= MAX_CHAR_HEBREW))
1243     {
1244       *charset = Vcharset_hebrew_iso8859_8;
1245       return c - MIN_CHAR_HEBREW + 0x20;
1246     }
1247   */
1248   else if ((MIN_CHAR_THAI <= c) && (c <= MAX_CHAR_THAI))
1249     {
1250       *charset = Vcharset_thai_tis620;
1251       return c - MIN_CHAR_THAI + 0x20;
1252     }
1253   /*
1254   else if ((MIN_CHAR_HALFWIDTH_KATAKANA <= c)
1255            && (c <= MAX_CHAR_HALFWIDTH_KATAKANA))
1256     {
1257       return list2 (Vcharset_katakana_jisx0201,
1258                     make_int (c - MIN_CHAR_HALFWIDTH_KATAKANA + 33));
1259     }
1260   */
1261   else if (c <= MAX_CHAR_BMP)
1262     {
1263       *charset = Vcharset_ucs_bmp;
1264       return c;
1265     }
1266   else if (c <= MAX_CHAR_SMP)
1267     {
1268       *charset = Vcharset_ucs_smp;
1269       return c - MIN_CHAR_SMP;
1270     }
1271   else if (c <= MAX_CHAR_SIP)
1272     {
1273       *charset = Vcharset_ucs_sip;
1274       return c - MIN_CHAR_SIP;
1275     }
1276   else if (c < MIN_CHAR_94)
1277     {
1278       *charset = Vcharset_ucs;
1279       return c;
1280     }
1281   else if (c <= MAX_CHAR_94)
1282     {
1283       *charset = CHARSET_BY_ATTRIBUTES (94, 1,
1284                                         ((c - MIN_CHAR_94) / 94) + '0',
1285                                         CHARSET_LEFT_TO_RIGHT);
1286       if (!NILP (*charset))
1287         return ((c - MIN_CHAR_94) % 94) + 33;
1288       else
1289         {
1290           *charset = Vcharset_ucs;
1291           return c;
1292         }
1293     }
1294   else if (c <= MAX_CHAR_96)
1295     {
1296       *charset = CHARSET_BY_ATTRIBUTES (96, 1,
1297                                         ((c - MIN_CHAR_96) / 96) + '0',
1298                                         CHARSET_LEFT_TO_RIGHT);
1299       if (!NILP (*charset))
1300         return ((c - MIN_CHAR_96) % 96) + 32;
1301       else
1302         {
1303           *charset = Vcharset_ucs;
1304           return c;
1305         }
1306     }
1307   else if (c <= MAX_CHAR_94x94)
1308     {
1309       *charset
1310         = CHARSET_BY_ATTRIBUTES (94, 2,
1311                                  ((c - MIN_CHAR_94x94) / (94 * 94)) + '0',
1312                                  CHARSET_LEFT_TO_RIGHT);
1313       if (!NILP (*charset))
1314         return (((((c - MIN_CHAR_94x94) / 94) % 94) + 33) << 8)
1315           | (((c - MIN_CHAR_94x94) % 94) + 33);
1316       else
1317         {
1318           *charset = Vcharset_ucs;
1319           return c;
1320         }
1321     }
1322   else if (c <= MAX_CHAR_96x96)
1323     {
1324       *charset
1325         = CHARSET_BY_ATTRIBUTES (96, 2,
1326                                  ((c - MIN_CHAR_96x96) / (96 * 96)) + '0',
1327                                  CHARSET_LEFT_TO_RIGHT);
1328       if (!NILP (*charset))
1329         return ((((c - MIN_CHAR_96x96) / 96) % 96) + 32) << 8
1330           | (((c - MIN_CHAR_96x96) % 96) + 32);
1331       else
1332         {
1333           *charset = Vcharset_ucs;
1334           return c;
1335         }
1336     }
1337   else
1338     {
1339       *charset = Vcharset_ucs;
1340       return c;
1341     }
1342 }
1343
1344 Lisp_Object Vdefault_coded_charset_priority_list;
1345 #endif
1346
1347 \f
1348 /************************************************************************/
1349 /*                      Basic charset Lisp functions                    */
1350 /************************************************************************/
1351
1352 DEFUN ("charsetp", Fcharsetp, 1, 1, 0, /*
1353 Return non-nil if OBJECT is a charset.
1354 */
1355        (object))
1356 {
1357   return CHARSETP (object) ? Qt : Qnil;
1358 }
1359
1360 DEFUN ("find-charset", Ffind_charset, 1, 1, 0, /*
1361 Retrieve the charset of the given name.
1362 If CHARSET-OR-NAME is a charset object, it is simply returned.
1363 Otherwise, CHARSET-OR-NAME should be a symbol.  If there is no such charset,
1364 nil is returned.  Otherwise the associated charset object is returned.
1365 */
1366        (charset_or_name))
1367 {
1368   if (CHARSETP (charset_or_name))
1369     return charset_or_name;
1370
1371   CHECK_SYMBOL (charset_or_name);
1372   return Fgethash (charset_or_name, Vcharset_hash_table, Qnil);
1373 }
1374
1375 DEFUN ("get-charset", Fget_charset, 1, 1, 0, /*
1376 Retrieve the charset of the given name.
1377 Same as `find-charset' except an error is signalled if there is no such
1378 charset instead of returning nil.
1379 */
1380        (name))
1381 {
1382   Lisp_Object charset = Ffind_charset (name);
1383
1384   if (NILP (charset))
1385     signal_simple_error ("No such charset", name);
1386   return charset;
1387 }
1388
1389 /* We store the charsets in hash tables with the names as the key and the
1390    actual charset object as the value.  Occasionally we need to use them
1391    in a list format.  These routines provide us with that. */
1392 struct charset_list_closure
1393 {
1394   Lisp_Object *charset_list;
1395 };
1396
1397 static int
1398 add_charset_to_list_mapper (Lisp_Object key, Lisp_Object value,
1399                             void *charset_list_closure)
1400 {
1401   /* This function can GC */
1402   struct charset_list_closure *chcl =
1403     (struct charset_list_closure*) charset_list_closure;
1404   Lisp_Object *charset_list = chcl->charset_list;
1405
1406   *charset_list = Fcons (key /* XCHARSET_NAME (value) */, *charset_list);
1407   return 0;
1408 }
1409
1410 DEFUN ("charset-list", Fcharset_list, 0, 0, 0, /*
1411 Return a list of the names of all defined charsets.
1412 */
1413        ())
1414 {
1415   Lisp_Object charset_list = Qnil;
1416   struct gcpro gcpro1;
1417   struct charset_list_closure charset_list_closure;
1418
1419   GCPRO1 (charset_list);
1420   charset_list_closure.charset_list = &charset_list;
1421   elisp_maphash (add_charset_to_list_mapper, Vcharset_hash_table,
1422                  &charset_list_closure);
1423   UNGCPRO;
1424
1425   return charset_list;
1426 }
1427
1428 DEFUN ("charset-name", Fcharset_name, 1, 1, 0, /*
1429 Return the name of charset CHARSET.
1430 */
1431        (charset))
1432 {
1433   return XCHARSET_NAME (Fget_charset (charset));
1434 }
1435
1436 /* #### SJT Should generic properties be allowed? */
1437 DEFUN ("make-charset", Fmake_charset, 3, 3, 0, /*
1438 Define a new character set.
1439 This function is for use with Mule support.
1440 NAME is a symbol, the name by which the character set is normally referred.
1441 DOC-STRING is a string describing the character set.
1442 PROPS is a property list, describing the specific nature of the
1443 character set.  Recognized properties are:
1444
1445 'short-name     Short version of the charset name (ex: Latin-1)
1446 'long-name      Long version of the charset name (ex: ISO8859-1 (Latin-1))
1447 'registry       A regular expression matching the font registry field for
1448                 this character set.
1449 'dimension      Number of octets used to index a character in this charset.
1450                 Either 1 or 2.  Defaults to 1.
1451                 If UTF-2000 feature is enabled, 3 or 4 are also available.
1452 'columns        Number of columns used to display a character in this charset.
1453                 Only used in TTY mode. (Under X, the actual width of a
1454                 character can be derived from the font used to display the
1455                 characters.) If unspecified, defaults to the dimension
1456                 (this is almost always the correct value).
1457 'chars          Number of characters in each dimension (94 or 96).
1458                 Defaults to 94.  Note that if the dimension is 2, the
1459                 character set thus described is 94x94 or 96x96.
1460                 If UTF-2000 feature is enabled, 128 or 256 are also available.
1461 'final          Final byte of ISO 2022 escape sequence.  Must be
1462                 supplied.  Each combination of (DIMENSION, CHARS) defines a
1463                 separate namespace for final bytes.  Note that ISO
1464                 2022 restricts the final byte to the range
1465                 0x30 - 0x7E if dimension == 1, and 0x30 - 0x5F if
1466                 dimension == 2.  Note also that final bytes in the range
1467                 0x30 - 0x3F are reserved for user-defined (not official)
1468                 character sets.
1469 'graphic        0 (use left half of font on output) or 1 (use right half
1470                 of font on output).  Defaults to 0.  For example, for
1471                 a font whose registry is ISO8859-1, the left half
1472                 (octets 0x20 - 0x7F) is the `ascii' character set, while
1473                 the right half (octets 0xA0 - 0xFF) is the `latin-1'
1474                 character set.  With 'graphic set to 0, the octets
1475                 will have their high bit cleared; with it set to 1,
1476                 the octets will have their high bit set.
1477 'direction      'l2r (left-to-right) or 'r2l (right-to-left).
1478                 Defaults to 'l2r.
1479 'ccl-program    A compiled CCL program used to convert a character in
1480                 this charset into an index into the font.  This is in
1481                 addition to the 'graphic property.  The CCL program
1482                 is passed the octets of the character, with the high
1483                 bit cleared and set depending upon whether the value
1484                 of the 'graphic property is 0 or 1.
1485 'mother         [UTF-2000 only] Base coded-charset.
1486 'code-min       [UTF-2000 only] Minimum code-point of a base coded-charset.
1487 'code-max       [UTF-2000 only] Maximum code-point of a base coded-charset.
1488 'code-offset    [UTF-2000 only] Offset for a code-point of a base
1489                 coded-charset.
1490 'conversion     [UTF-2000 only] Conversion for a code-point of a base
1491                 coded-charset (94x60, 94x94x60, big5-1 or big5-2).
1492 */
1493        (name, doc_string, props))
1494 {
1495   int id = 0, dimension = 1, chars = 94, graphic = 0, final = 0, columns = -1;
1496   int direction = CHARSET_LEFT_TO_RIGHT;
1497   Lisp_Object registry = Qnil;
1498   Lisp_Object charset;
1499   Lisp_Object ccl_program = Qnil;
1500   Lisp_Object short_name = Qnil, long_name = Qnil;
1501   Lisp_Object mother = Qnil;
1502   int min_code = 0, max_code = 0, code_offset = 0;
1503   int byte_offset = -1;
1504   int conversion = 0;
1505
1506   CHECK_SYMBOL (name);
1507   if (!NILP (doc_string))
1508     CHECK_STRING (doc_string);
1509
1510   charset = Ffind_charset (name);
1511   if (!NILP (charset))
1512     signal_simple_error ("Cannot redefine existing charset", name);
1513
1514   {
1515     EXTERNAL_PROPERTY_LIST_LOOP_3 (keyword, value, props)
1516       {
1517         if (EQ (keyword, Qshort_name))
1518           {
1519             CHECK_STRING (value);
1520             short_name = value;
1521           }
1522
1523         else if (EQ (keyword, Qlong_name))
1524           {
1525             CHECK_STRING (value);
1526             long_name = value;
1527           }
1528
1529         else if (EQ (keyword, Qiso_ir))
1530           {
1531 #ifdef UTF2000
1532             CHECK_INT (value);
1533             id = - XINT (value);
1534 #endif
1535           }
1536
1537         else if (EQ (keyword, Qdimension))
1538           {
1539             CHECK_INT (value);
1540             dimension = XINT (value);
1541             if (dimension < 1 ||
1542 #ifdef UTF2000
1543                 dimension > 4
1544 #else
1545                 dimension > 2
1546 #endif
1547                 )
1548               signal_simple_error ("Invalid value for 'dimension", value);
1549           }
1550
1551         else if (EQ (keyword, Qchars))
1552           {
1553             CHECK_INT (value);
1554             chars = XINT (value);
1555             if (chars != 94 && chars != 96
1556 #ifdef UTF2000
1557                 && chars != 128 && chars != 256
1558 #endif
1559                 )
1560               signal_simple_error ("Invalid value for 'chars", value);
1561           }
1562
1563         else if (EQ (keyword, Qcolumns))
1564           {
1565             CHECK_INT (value);
1566             columns = XINT (value);
1567             if (columns != 1 && columns != 2)
1568               signal_simple_error ("Invalid value for 'columns", value);
1569           }
1570
1571         else if (EQ (keyword, Qgraphic))
1572           {
1573             CHECK_INT (value);
1574             graphic = XINT (value);
1575             if (graphic < 0 ||
1576 #ifdef UTF2000
1577                 graphic > 2
1578 #else
1579                 graphic > 1
1580 #endif
1581                 )
1582               signal_simple_error ("Invalid value for 'graphic", value);
1583           }
1584
1585         else if (EQ (keyword, Qregistry))
1586           {
1587             CHECK_STRING (value);
1588             registry = value;
1589           }
1590
1591         else if (EQ (keyword, Qdirection))
1592           {
1593             if (EQ (value, Ql2r))
1594               direction = CHARSET_LEFT_TO_RIGHT;
1595             else if (EQ (value, Qr2l))
1596               direction = CHARSET_RIGHT_TO_LEFT;
1597             else
1598               signal_simple_error ("Invalid value for 'direction", value);
1599           }
1600
1601         else if (EQ (keyword, Qfinal))
1602           {
1603             CHECK_CHAR_COERCE_INT (value);
1604             final = XCHAR (value);
1605             if (final < '0' || final > '~')
1606               signal_simple_error ("Invalid value for 'final", value);
1607           }
1608
1609 #ifdef UTF2000
1610         else if (EQ (keyword, Qmother))
1611           {
1612             mother = Fget_charset (value);
1613           }
1614
1615         else if (EQ (keyword, Qmin_code))
1616           {
1617             CHECK_INT (value);
1618             min_code = XUINT (value);
1619           }
1620
1621         else if (EQ (keyword, Qmax_code))
1622           {
1623             CHECK_INT (value);
1624             max_code = XUINT (value);
1625           }
1626
1627         else if (EQ (keyword, Qcode_offset))
1628           {
1629             CHECK_INT (value);
1630             code_offset = XUINT (value);
1631           }
1632
1633         else if (EQ (keyword, Qconversion))
1634           {
1635             if (EQ (value, Q94x60))
1636               conversion = CONVERSION_94x60;
1637             else if (EQ (value, Q94x94x60))
1638               conversion = CONVERSION_94x94x60;
1639             else if (EQ (value, Qbig5_1))
1640               conversion = CONVERSION_BIG5_1;
1641             else if (EQ (value, Qbig5_2))
1642               conversion = CONVERSION_BIG5_2;
1643             else
1644               signal_simple_error ("Unrecognized conversion", value);
1645           }
1646
1647 #endif
1648         else if (EQ (keyword, Qccl_program))
1649           {
1650             struct ccl_program test_ccl;
1651
1652             if (setup_ccl_program (&test_ccl, value) < 0)
1653               signal_simple_error ("Invalid value for 'ccl-program", value);
1654             ccl_program = value;
1655           }
1656
1657         else
1658           signal_simple_error ("Unrecognized property", keyword);
1659       }
1660   }
1661
1662 #ifndef UTF2000
1663   if (!final)
1664     error ("'final must be specified");
1665 #endif
1666   if (dimension == 2 && final > 0x5F)
1667     signal_simple_error
1668       ("Final must be in the range 0x30 - 0x5F for dimension == 2",
1669        make_char (final));
1670
1671   if (!NILP (CHARSET_BY_ATTRIBUTES (chars, dimension, final,
1672                                     CHARSET_LEFT_TO_RIGHT)) ||
1673       !NILP (CHARSET_BY_ATTRIBUTES (chars, dimension, final,
1674                                     CHARSET_RIGHT_TO_LEFT)))
1675     error
1676       ("Character set already defined for this DIMENSION/CHARS/FINAL combo");
1677
1678   if (id == 0)
1679     id = get_unallocated_leading_byte (dimension);
1680
1681   if (NILP (doc_string))
1682     doc_string = build_string ("");
1683
1684   if (NILP (registry))
1685     registry = build_string ("");
1686
1687   if (NILP (short_name))
1688     XSETSTRING (short_name, XSYMBOL (name)->name);
1689
1690   if (NILP (long_name))
1691     long_name = doc_string;
1692
1693   if (columns == -1)
1694     columns = dimension;
1695
1696   if (byte_offset < 0)
1697     {
1698       if (chars == 94)
1699         byte_offset = 33;
1700       else if (chars == 96)
1701         byte_offset = 32;
1702       else
1703         byte_offset = 0;
1704     }
1705
1706   charset = make_charset (id, name, chars, dimension, columns, graphic,
1707                           final, direction, short_name, long_name,
1708                           doc_string, registry,
1709                           Qnil, min_code, max_code, code_offset, byte_offset,
1710                           mother, conversion);
1711   if (!NILP (ccl_program))
1712     XCHARSET_CCL_PROGRAM (charset) = ccl_program;
1713   return charset;
1714 }
1715
1716 DEFUN ("make-reverse-direction-charset", Fmake_reverse_direction_charset,
1717        2, 2, 0, /*
1718 Make a charset equivalent to CHARSET but which goes in the opposite direction.
1719 NEW-NAME is the name of the new charset.  Return the new charset.
1720 */
1721        (charset, new_name))
1722 {
1723   Lisp_Object new_charset = Qnil;
1724   int id, chars, dimension, columns, graphic, final;
1725   int direction;
1726   Lisp_Object registry, doc_string, short_name, long_name;
1727   Lisp_Charset *cs;
1728
1729   charset = Fget_charset (charset);
1730   if (!NILP (XCHARSET_REVERSE_DIRECTION_CHARSET (charset)))
1731     signal_simple_error ("Charset already has reverse-direction charset",
1732                          charset);
1733
1734   CHECK_SYMBOL (new_name);
1735   if (!NILP (Ffind_charset (new_name)))
1736     signal_simple_error ("Cannot redefine existing charset", new_name);
1737
1738   cs = XCHARSET (charset);
1739
1740   chars     = CHARSET_CHARS     (cs);
1741   dimension = CHARSET_DIMENSION (cs);
1742   columns   = CHARSET_COLUMNS   (cs);
1743   id = get_unallocated_leading_byte (dimension);
1744
1745   graphic = CHARSET_GRAPHIC (cs);
1746   final = CHARSET_FINAL (cs);
1747   direction = CHARSET_RIGHT_TO_LEFT;
1748   if (CHARSET_DIRECTION (cs) == CHARSET_RIGHT_TO_LEFT)
1749     direction = CHARSET_LEFT_TO_RIGHT;
1750   doc_string = CHARSET_DOC_STRING (cs);
1751   short_name = CHARSET_SHORT_NAME (cs);
1752   long_name = CHARSET_LONG_NAME (cs);
1753   registry = CHARSET_REGISTRY (cs);
1754
1755   new_charset = make_charset (id, new_name, chars, dimension, columns,
1756                               graphic, final, direction, short_name, long_name,
1757                               doc_string, registry,
1758 #ifdef UTF2000
1759                               CHARSET_DECODING_TABLE(cs),
1760                               CHARSET_MIN_CODE(cs),
1761                               CHARSET_MAX_CODE(cs),
1762                               CHARSET_CODE_OFFSET(cs),
1763                               CHARSET_BYTE_OFFSET(cs),
1764                               CHARSET_MOTHER(cs),
1765                               CHARSET_CONVERSION (cs)
1766 #else
1767                               Qnil, 0, 0, 0, 0, Qnil, 0
1768 #endif
1769 );
1770
1771   CHARSET_REVERSE_DIRECTION_CHARSET (cs) = new_charset;
1772   XCHARSET_REVERSE_DIRECTION_CHARSET (new_charset) = charset;
1773
1774   return new_charset;
1775 }
1776
1777 DEFUN ("define-charset-alias", Fdefine_charset_alias, 2, 2, 0, /*
1778 Define symbol ALIAS as an alias for CHARSET.
1779 */
1780        (alias, charset))
1781 {
1782   CHECK_SYMBOL (alias);
1783   charset = Fget_charset (charset);
1784   return Fputhash (alias, charset, Vcharset_hash_table);
1785 }
1786
1787 /* #### Reverse direction charsets not yet implemented.  */
1788 #if 0
1789 DEFUN ("charset-reverse-direction-charset", Fcharset_reverse_direction_charset,
1790        1, 1, 0, /*
1791 Return the reverse-direction charset parallel to CHARSET, if any.
1792 This is the charset with the same properties (in particular, the same
1793 dimension, number of characters per dimension, and final byte) as
1794 CHARSET but whose characters are displayed in the opposite direction.
1795 */
1796        (charset))
1797 {
1798   charset = Fget_charset (charset);
1799   return XCHARSET_REVERSE_DIRECTION_CHARSET (charset);
1800 }
1801 #endif
1802
1803 DEFUN ("charset-from-attributes", Fcharset_from_attributes, 3, 4, 0, /*
1804 Return a charset with the given DIMENSION, CHARS, FINAL, and DIRECTION.
1805 If DIRECTION is omitted, both directions will be checked (left-to-right
1806 will be returned if character sets exist for both directions).
1807 */
1808        (dimension, chars, final, direction))
1809 {
1810   int dm, ch, fi, di = -1;
1811   Lisp_Object obj = Qnil;
1812
1813   CHECK_INT (dimension);
1814   dm = XINT (dimension);
1815   if (dm < 1 || dm > 2)
1816     signal_simple_error ("Invalid value for DIMENSION", dimension);
1817
1818   CHECK_INT (chars);
1819   ch = XINT (chars);
1820   if (ch != 94 && ch != 96)
1821     signal_simple_error ("Invalid value for CHARS", chars);
1822
1823   CHECK_CHAR_COERCE_INT (final);
1824   fi = XCHAR (final);
1825   if (fi < '0' || fi > '~')
1826     signal_simple_error ("Invalid value for FINAL", final);
1827
1828   if (EQ (direction, Ql2r))
1829     di = CHARSET_LEFT_TO_RIGHT;
1830   else if (EQ (direction, Qr2l))
1831     di = CHARSET_RIGHT_TO_LEFT;
1832   else if (!NILP (direction))
1833     signal_simple_error ("Invalid value for DIRECTION", direction);
1834
1835   if (dm == 2 && fi > 0x5F)
1836     signal_simple_error
1837       ("Final must be in the range 0x30 - 0x5F for dimension == 2", final);
1838
1839     if (di == -1)
1840     {
1841       obj = CHARSET_BY_ATTRIBUTES (ch, dm, fi, CHARSET_LEFT_TO_RIGHT);
1842       if (NILP (obj))
1843         obj = CHARSET_BY_ATTRIBUTES (ch, dm, fi, CHARSET_RIGHT_TO_LEFT);
1844     }
1845   else
1846     obj = CHARSET_BY_ATTRIBUTES (ch, dm, fi, di);
1847
1848   if (CHARSETP (obj))
1849     return XCHARSET_NAME (obj);
1850   return obj;
1851 }
1852
1853 DEFUN ("charset-short-name", Fcharset_short_name, 1, 1, 0, /*
1854 Return short name of CHARSET.
1855 */
1856        (charset))
1857 {
1858   return XCHARSET_SHORT_NAME (Fget_charset (charset));
1859 }
1860
1861 DEFUN ("charset-long-name", Fcharset_long_name, 1, 1, 0, /*
1862 Return long name of CHARSET.
1863 */
1864        (charset))
1865 {
1866   return XCHARSET_LONG_NAME (Fget_charset (charset));
1867 }
1868
1869 DEFUN ("charset-description", Fcharset_description, 1, 1, 0, /*
1870 Return description of CHARSET.
1871 */
1872        (charset))
1873 {
1874   return XCHARSET_DOC_STRING (Fget_charset (charset));
1875 }
1876
1877 DEFUN ("charset-dimension", Fcharset_dimension, 1, 1, 0, /*
1878 Return dimension of CHARSET.
1879 */
1880        (charset))
1881 {
1882   return make_int (XCHARSET_DIMENSION (Fget_charset (charset)));
1883 }
1884
1885 DEFUN ("charset-property", Fcharset_property, 2, 2, 0, /*
1886 Return property PROP of CHARSET, a charset object or symbol naming a charset.
1887 Recognized properties are those listed in `make-charset', as well as
1888 'name and 'doc-string.
1889 */
1890        (charset, prop))
1891 {
1892   Lisp_Charset *cs;
1893
1894   charset = Fget_charset (charset);
1895   cs = XCHARSET (charset);
1896
1897   CHECK_SYMBOL (prop);
1898   if (EQ (prop, Qname))        return CHARSET_NAME (cs);
1899   if (EQ (prop, Qshort_name))  return CHARSET_SHORT_NAME (cs);
1900   if (EQ (prop, Qlong_name))   return CHARSET_LONG_NAME (cs);
1901   if (EQ (prop, Qdoc_string))  return CHARSET_DOC_STRING (cs);
1902   if (EQ (prop, Qdimension))   return make_int (CHARSET_DIMENSION (cs));
1903   if (EQ (prop, Qcolumns))     return make_int (CHARSET_COLUMNS (cs));
1904   if (EQ (prop, Qgraphic))     return make_int (CHARSET_GRAPHIC (cs));
1905   if (EQ (prop, Qfinal))       return CHARSET_FINAL (cs) == 0 ?
1906                                  Qnil : make_char (CHARSET_FINAL (cs));
1907   if (EQ (prop, Qchars))       return make_int (CHARSET_CHARS (cs));
1908   if (EQ (prop, Qregistry))    return CHARSET_REGISTRY (cs);
1909   if (EQ (prop, Qccl_program)) return CHARSET_CCL_PROGRAM (cs);
1910   if (EQ (prop, Qdirection))
1911     return CHARSET_DIRECTION (cs) == CHARSET_LEFT_TO_RIGHT ? Ql2r : Qr2l;
1912   if (EQ (prop, Qreverse_direction_charset))
1913     {
1914       Lisp_Object obj = CHARSET_REVERSE_DIRECTION_CHARSET (cs);
1915       /* #### Is this translation OK?  If so, error checking sufficient? */
1916       return CHARSETP (obj) ? XCHARSET_NAME (obj) : obj;
1917     }
1918 #ifdef UTF2000
1919   if (EQ (prop, Qmother))
1920     return CHARSET_MOTHER (cs);
1921   if (EQ (prop, Qmin_code))
1922     return make_int (CHARSET_MIN_CODE (cs));
1923   if (EQ (prop, Qmax_code))
1924     return make_int (CHARSET_MAX_CODE (cs));
1925 #endif
1926   signal_simple_error ("Unrecognized charset property name", prop);
1927   return Qnil; /* not reached */
1928 }
1929
1930 DEFUN ("charset-id", Fcharset_id, 1, 1, 0, /*
1931 Return charset identification number of CHARSET.
1932 */
1933         (charset))
1934 {
1935   return make_int(XCHARSET_LEADING_BYTE (Fget_charset (charset)));
1936 }
1937
1938 /* #### We need to figure out which properties we really want to
1939    allow to be set. */
1940
1941 DEFUN ("set-charset-ccl-program", Fset_charset_ccl_program, 2, 2, 0, /*
1942 Set the 'ccl-program property of CHARSET to CCL-PROGRAM.
1943 */
1944        (charset, ccl_program))
1945 {
1946   struct ccl_program test_ccl;
1947
1948   charset = Fget_charset (charset);
1949   if (setup_ccl_program (&test_ccl, ccl_program) < 0)
1950     signal_simple_error ("Invalid ccl-program", ccl_program);
1951   XCHARSET_CCL_PROGRAM (charset) = ccl_program;
1952   return Qnil;
1953 }
1954
1955 static void
1956 invalidate_charset_font_caches (Lisp_Object charset)
1957 {
1958   /* Invalidate font cache entries for charset on all devices. */
1959   Lisp_Object devcons, concons, hash_table;
1960   DEVICE_LOOP_NO_BREAK (devcons, concons)
1961     {
1962       struct device *d = XDEVICE (XCAR (devcons));
1963       hash_table = Fgethash (charset, d->charset_font_cache, Qunbound);
1964       if (!UNBOUNDP (hash_table))
1965         Fclrhash (hash_table);
1966     }
1967 }
1968
1969 DEFUN ("set-charset-registry", Fset_charset_registry, 2, 2, 0, /*
1970 Set the 'registry property of CHARSET to REGISTRY.
1971 */
1972        (charset, registry))
1973 {
1974   charset = Fget_charset (charset);
1975   CHECK_STRING (registry);
1976   XCHARSET_REGISTRY (charset) = registry;
1977   invalidate_charset_font_caches (charset);
1978   face_property_was_changed (Vdefault_face, Qfont, Qglobal);
1979   return Qnil;
1980 }
1981
1982 #ifdef UTF2000
1983 DEFUN ("charset-mapping-table", Fcharset_mapping_table, 1, 1, 0, /*
1984 Return mapping-table of CHARSET.
1985 */
1986        (charset))
1987 {
1988   return XCHARSET_DECODING_TABLE (Fget_charset (charset));
1989 }
1990
1991 DEFUN ("set-charset-mapping-table", Fset_charset_mapping_table, 2, 2, 0, /*
1992 Set mapping-table of CHARSET to TABLE.
1993 */
1994        (charset, table))
1995 {
1996   struct Lisp_Charset *cs;
1997   int i;
1998   int byte_offset;
1999
2000   charset = Fget_charset (charset);
2001   cs = XCHARSET (charset);
2002
2003   if (NILP (table))
2004     {
2005       CHARSET_DECODING_TABLE(cs) = Qnil;
2006       return table;
2007     }
2008   else if (VECTORP (table))
2009     {
2010       int ccs_len = CHARSET_BYTE_SIZE (cs);
2011       int ret = decoding_table_check_elements (table,
2012                                                CHARSET_DIMENSION (cs),
2013                                                ccs_len);
2014       if (ret)
2015         {
2016           if (ret == -1)
2017             signal_simple_error ("Too big table", table);
2018           else if (ret == -2)
2019             signal_simple_error ("Invalid element is found", table);
2020           else
2021             signal_simple_error ("Something wrong", table);
2022         }
2023       CHARSET_DECODING_TABLE(cs) = Qnil;
2024     }
2025   else
2026     signal_error (Qwrong_type_argument,
2027                   list2 (build_translated_string ("vector-or-nil-p"),
2028                          table));
2029
2030   byte_offset = CHARSET_BYTE_OFFSET (cs);
2031   switch (CHARSET_DIMENSION (cs))
2032     {
2033     case 1:
2034       for (i = 0; i < XVECTOR_LENGTH (table); i++)
2035         {
2036           Lisp_Object c = XVECTOR_DATA(table)[i];
2037
2038           if (CHARP (c))
2039             Fput_char_attribute (c, XCHARSET_NAME (charset),
2040                                  make_int (i + byte_offset));
2041         }
2042       break;
2043     case 2:
2044       for (i = 0; i < XVECTOR_LENGTH (table); i++)
2045         {
2046           Lisp_Object v = XVECTOR_DATA(table)[i];
2047
2048           if (VECTORP (v))
2049             {
2050               int j;
2051
2052               for (j = 0; j < XVECTOR_LENGTH (v); j++)
2053                 {
2054                   Lisp_Object c = XVECTOR_DATA(v)[j];
2055
2056                   if (CHARP (c))
2057                     Fput_char_attribute
2058                       (c, XCHARSET_NAME (charset),
2059                        make_int ( ( (i + byte_offset) << 8 )
2060                                   | (j + byte_offset)
2061                                   ) );
2062                 }
2063             }
2064           else if (CHARP (v))
2065             Fput_char_attribute (v, XCHARSET_NAME (charset),
2066                                  make_int (i + byte_offset));
2067         }
2068       break;
2069     }
2070   return table;
2071 }
2072
2073 #ifdef HAVE_CHISE_CLIENT
2074 DEFUN ("save-charset-mapping-table", Fsave_charset_mapping_table, 1, 1, 0, /*
2075 Save mapping-table of CHARSET.
2076 */
2077        (charset))
2078 {
2079   struct Lisp_Charset *cs;
2080   int byte_min, byte_max;
2081 #ifdef CHISE
2082   CHISE_Decoding_Table *dt_ccs;
2083   int modemask;
2084   int accessmask = 0;
2085   DBTYPE real_subtype;
2086 #else
2087   Lisp_Object db;
2088   Lisp_Object db_file;
2089 #endif
2090
2091   charset = Fget_charset (charset);
2092   cs = XCHARSET (charset);
2093
2094 #ifdef CHISE
2095   if ( open_chise_data_source_maybe () )
2096     return -1;
2097
2098   modemask = 0755;              /* rwxr-xr-x */
2099   real_subtype = DB_HASH;
2100   accessmask = DB_CREATE;
2101
2102   char_attribute_system_db_file (CHARSET_NAME (cs), Qsystem_char_id, 1);
2103   dt_ccs
2104     = chise_ds_open_decoding_table (default_chise_data_source,
2105                                     XSTRING_DATA (Fsymbol_name
2106                                                   (XCHARSET_NAME(charset))),
2107                                     real_subtype, accessmask, modemask);
2108   if (dt_ccs == NULL)
2109     {
2110       printf ("Can't open decoding-table %s\n",
2111               XSTRING_DATA (Fsymbol_name (XCHARSET_NAME(charset))));
2112       return -1;
2113     }
2114 #else
2115   db_file = char_attribute_system_db_file (CHARSET_NAME (cs),
2116                                            Qsystem_char_id, 1);
2117   db = Fopen_database (db_file, Qnil, Qnil, build_string ("w+"), Qnil);
2118 #endif
2119
2120   byte_min = CHARSET_BYTE_OFFSET (cs);
2121   byte_max = byte_min + CHARSET_BYTE_SIZE (cs);
2122   switch (CHARSET_DIMENSION (cs))
2123     {
2124     case 1:
2125       {
2126         Lisp_Object table_c = XCHARSET_DECODING_TABLE (charset);
2127         int cell;
2128
2129         for (cell = byte_min; cell < byte_max; cell++)
2130           {
2131             Lisp_Object c = get_ccs_octet_table (table_c, charset, cell);
2132
2133             if (CHARP (c))
2134               {
2135 #ifdef CHISE
2136                 chise_dt_put_char (dt_ccs, cell, XCHAR (c));
2137 #else
2138                 Fput_database (Fprin1_to_string (make_int (cell), Qnil),
2139                                Fprin1_to_string (c, Qnil),
2140                                db, Qt);
2141 #endif
2142               }
2143           }
2144       }
2145       break;
2146     case 2:
2147       {
2148         Lisp_Object table_r = XCHARSET_DECODING_TABLE (charset);
2149         int row;
2150
2151         for (row = byte_min; row < byte_max; row++)
2152           {
2153             Lisp_Object table_c = get_ccs_octet_table (table_r, charset, row);
2154             int cell;
2155
2156             for (cell = byte_min; cell < byte_max; cell++)
2157               {
2158                 Lisp_Object c = get_ccs_octet_table (table_c, charset, cell);
2159
2160                 if (CHARP (c))
2161                   {
2162 #ifdef CHISE
2163                     chise_dt_put_char (dt_ccs,
2164                                        (row << 8) | cell, XCHAR (c));
2165 #else
2166                     Fput_database (Fprin1_to_string (make_int ((row << 8)
2167                                                                | cell),
2168                                                      Qnil),
2169                                    Fprin1_to_string (c, Qnil),
2170                                    db, Qt);
2171 #endif
2172                   }
2173               }
2174           }
2175       }
2176       break;
2177     case 3:
2178       {
2179         Lisp_Object table_p = XCHARSET_DECODING_TABLE (charset);
2180         int plane;
2181
2182         for (plane = byte_min; plane < byte_max; plane++)
2183           {
2184             Lisp_Object table_r
2185               = get_ccs_octet_table (table_p, charset, plane);
2186             int row;
2187
2188             for (row = byte_min; row < byte_max; row++)
2189               {
2190                 Lisp_Object table_c
2191                   = get_ccs_octet_table (table_r, charset, row);
2192                 int cell;
2193
2194                 for (cell = byte_min; cell < byte_max; cell++)
2195                   {
2196                     Lisp_Object c = get_ccs_octet_table (table_c, charset,
2197                                                          cell);
2198
2199                     if (CHARP (c))
2200                       {
2201 #ifdef CHISE
2202                         chise_dt_put_char (dt_ccs,
2203                                            (plane << 16)
2204                                            | (row <<  8)
2205                                            | cell, XCHAR (c));
2206 #else
2207                         Fput_database (Fprin1_to_string
2208                                        (make_int ((plane << 16)
2209                                                   | (row <<  8)
2210                                                   | cell),
2211                                         Qnil),
2212                                        Fprin1_to_string (c, Qnil),
2213                                        db, Qt);
2214 #endif
2215                       }
2216                   }
2217               }
2218           }
2219       }
2220       break;
2221     default:
2222       {
2223         Lisp_Object table_g = XCHARSET_DECODING_TABLE (charset);
2224         int group;
2225
2226         for (group = byte_min; group < byte_max; group++)
2227           {
2228             Lisp_Object table_p
2229               = get_ccs_octet_table (table_g, charset, group);
2230             int plane;
2231
2232             for (plane = byte_min; plane < byte_max; plane++)
2233               {
2234                 Lisp_Object table_r
2235                   = get_ccs_octet_table (table_p, charset, plane);
2236                 int row;
2237
2238                 for (row = byte_min; row < byte_max; row++)
2239                   {
2240                     Lisp_Object table_c
2241                       = get_ccs_octet_table (table_r, charset, row);
2242                     int cell;
2243
2244                     for (cell = byte_min; cell < byte_max; cell++)
2245                       {
2246                         Lisp_Object c
2247                           = get_ccs_octet_table (table_c, charset, cell);
2248
2249                         if (CHARP (c))
2250                           {
2251 #ifdef CHISE
2252                             chise_dt_put_char (dt_ccs,
2253                                                (  group << 24)
2254                                                | (plane << 16)
2255                                                | (row   <<  8)
2256                                                |  cell, XCHAR (c));
2257 #else
2258                             Fput_database (Fprin1_to_string
2259                                            (make_int ((  group << 24)
2260                                                       | (plane << 16)
2261                                                       | (row   <<  8)
2262                                                       |  cell),
2263                                             Qnil),
2264                                            Fprin1_to_string (c, Qnil),
2265                                            db, Qt);
2266 #endif
2267                           }
2268                       }
2269                   }
2270               }
2271           }
2272       }
2273     }
2274 #ifdef CHISE
2275   chise_dt_close (dt_ccs);
2276   return Qnil;
2277 #else
2278   return Fclose_database (db);
2279 #endif
2280 }
2281
2282 DEFUN ("reset-charset-mapping-table", Freset_charset_mapping_table, 1, 1, 0, /*
2283 Reset mapping-table of CCS with database file.
2284 */
2285        (ccs))
2286 {
2287   Lisp_Object db_file;
2288
2289   ccs = Fget_charset (ccs);
2290   db_file = char_attribute_system_db_file (XCHARSET_NAME(ccs),
2291                                            Qsystem_char_id, 0);
2292
2293   if (!NILP (Ffile_exists_p (db_file)))
2294     {
2295       XCHARSET_DECODING_TABLE(ccs) = Qunloaded;
2296       return Qt;
2297     }
2298   return Qnil;
2299 }
2300
2301 Emchar
2302 load_char_decoding_entry_maybe (Lisp_Object ccs, int code_point)
2303 {
2304 #ifdef CHISE
2305   CHISE_Decoding_Table *dt_ccs;
2306   int modemask;
2307   int accessmask = 0;
2308   DBTYPE real_subtype;
2309   CHISE_Char_ID char_id;
2310
2311   if ( open_chise_data_source_maybe () )
2312     return -1;
2313
2314   modemask = 0755;              /* rwxr-xr-x */
2315   real_subtype = DB_HASH;
2316   accessmask = DB_RDONLY;
2317
2318   dt_ccs
2319     = chise_ds_open_decoding_table (default_chise_data_source,
2320                                     XSTRING_DATA (Fsymbol_name
2321                                                   (XCHARSET_NAME(ccs))),
2322                                     real_subtype, accessmask, modemask);
2323   if (dt_ccs == NULL)
2324     {
2325       printf ("Can't open decoding-table %s\n",
2326               XSTRING_DATA (Fsymbol_name (XCHARSET_NAME(ccs))));
2327       return -1;
2328     }
2329
2330   char_id = chise_dt_get_char (dt_ccs, code_point);
2331   /*
2332   printf ("%s's 0x%X (%d) => 0x%X\n",
2333           XSTRING_DATA (Fsymbol_name (XCHARSET_NAME(ccs))),
2334           code_point, code_point, char_id);
2335   */
2336   if (char_id >= 0)
2337     decoding_table_put_char (ccs, code_point, make_char (char_id));
2338   else
2339     decoding_table_put_char (ccs, code_point, Qnil);
2340
2341   chise_dt_close (dt_ccs);
2342   return char_id;
2343 #else
2344   Lisp_Object db;
2345   Lisp_Object db_file
2346     = char_attribute_system_db_file (XCHARSET_NAME(ccs), Qsystem_char_id,
2347                                      0);
2348
2349   db = Fopen_database (db_file, Qnil, Qnil, build_string ("r"), Qnil);
2350   if (!NILP (db))
2351     {
2352       Lisp_Object ret
2353         = Fget_database (Fprin1_to_string (make_int (code_point), Qnil),
2354                          db, Qnil);
2355       if (!NILP (ret))
2356         {
2357           ret = Fread (ret);
2358           if (CHARP (ret))
2359             {
2360               decoding_table_put_char (ccs, code_point, ret);
2361               Fclose_database (db);
2362               return XCHAR (ret);
2363             }
2364         }
2365       decoding_table_put_char (ccs, code_point, Qnil);
2366       Fclose_database (db);
2367     }
2368   return -1;
2369 #endif
2370 }
2371 #endif /* HAVE_CHISE_CLIENT */
2372 #endif /* UTF2000 */
2373
2374 \f
2375 /************************************************************************/
2376 /*              Lisp primitives for working with characters             */
2377 /************************************************************************/
2378
2379 #ifdef UTF2000
2380 DEFUN ("decode-char", Fdecode_char, 2, 3, 0, /*
2381 Make a character from CHARSET and code-point CODE.
2382 If DEFINED_ONLY is non-nil, builtin character is not returned.
2383 If corresponding character is not found, nil is returned.
2384 */
2385        (charset, code, defined_only))
2386 {
2387   int c;
2388
2389   charset = Fget_charset (charset);
2390   CHECK_INT (code);
2391   c = XINT (code);
2392   if (XCHARSET_GRAPHIC (charset) == 1)
2393     c &= 0x7F7F7F7F;
2394   if (NILP (defined_only))
2395     c = DECODE_CHAR (charset, c);
2396   else
2397     c = decode_defined_char (charset, c);
2398   return c >= 0 ? make_char (c) : Qnil;
2399 }
2400
2401 DEFUN ("decode-builtin-char", Fdecode_builtin_char, 2, 2, 0, /*
2402 Make a builtin character from CHARSET and code-point CODE.
2403 */
2404        (charset, code))
2405 {
2406   int c;
2407
2408   charset = Fget_charset (charset);
2409   CHECK_INT (code);
2410   if (EQ (charset, Vcharset_latin_viscii))
2411     {
2412       Lisp_Object chr = Fdecode_char (charset, code, Qnil);
2413       Lisp_Object ret;
2414
2415       if (!NILP (chr))
2416         {
2417           if (!NILP
2418               (ret = Fget_char_attribute (chr,
2419                                           Vcharset_latin_viscii_lower,
2420                                           Qnil)))
2421             {
2422               charset = Vcharset_latin_viscii_lower;
2423               code = ret;
2424             }
2425           else if (!NILP
2426                    (ret = Fget_char_attribute (chr,
2427                                                Vcharset_latin_viscii_upper,
2428                                                Qnil)))
2429             {
2430               charset = Vcharset_latin_viscii_upper;
2431               code = ret;
2432             }
2433         }
2434     }
2435   c = XINT (code);
2436 #if 0
2437   if (XCHARSET_GRAPHIC (charset) == 1)
2438     c &= 0x7F7F7F7F;
2439 #endif
2440   c = decode_builtin_char (charset, c);
2441   return c >= 0 ? make_char (c) : Fdecode_char (charset, code, Qnil);
2442 }
2443 #endif
2444
2445 DEFUN ("make-char", Fmake_char, 2, 3, 0, /*
2446 Make a character from CHARSET and octets ARG1 and ARG2.
2447 ARG2 is required only for characters from two-dimensional charsets.
2448 For example, (make-char 'latin-iso8859-2 185) will return the Latin 2
2449 character s with caron.
2450 */
2451        (charset, arg1, arg2))
2452 {
2453   Lisp_Charset *cs;
2454   int a1, a2;
2455   int lowlim, highlim;
2456
2457   charset = Fget_charset (charset);
2458   cs = XCHARSET (charset);
2459
2460   if      (EQ (charset, Vcharset_ascii))     lowlim =  0, highlim = 127;
2461   else if (EQ (charset, Vcharset_control_1)) lowlim =  0, highlim =  31;
2462 #ifdef UTF2000
2463   else if (CHARSET_CHARS (cs) == 256)        lowlim =  0, highlim = 255;
2464 #endif
2465   else if (CHARSET_CHARS (cs) == 94)         lowlim = 33, highlim = 126;
2466   else  /* CHARSET_CHARS (cs) == 96) */      lowlim = 32, highlim = 127;
2467
2468   CHECK_INT (arg1);
2469   /* It is useful (and safe, according to Olivier Galibert) to strip
2470      the 8th bit off ARG1 and ARG2 because it allows programmers to
2471      write (make-char 'latin-iso8859-2 CODE) where code is the actual
2472      Latin 2 code of the character.  */
2473 #ifdef UTF2000
2474   a1 = XINT (arg1);
2475   if (highlim < 128)
2476     a1 &= 0x7f;
2477 #else
2478   a1 = XINT (arg1);
2479 #endif
2480   if (a1 < lowlim || a1 > highlim)
2481     args_out_of_range_3 (arg1, make_int (lowlim), make_int (highlim));
2482
2483   if (CHARSET_DIMENSION (cs) == 1)
2484     {
2485       if (!NILP (arg2))
2486         signal_simple_error
2487           ("Charset is of dimension one; second octet must be nil", arg2);
2488       return make_char (MAKE_CHAR (charset, a1, 0));
2489     }
2490
2491   CHECK_INT (arg2);
2492 #ifdef UTF2000
2493   a2 = XINT (arg2);
2494   if (highlim < 128)
2495     a2 &= 0x7f;
2496 #else
2497   a2 = XINT (arg2) & 0x7f;
2498 #endif
2499   if (a2 < lowlim || a2 > highlim)
2500     args_out_of_range_3 (arg2, make_int (lowlim), make_int (highlim));
2501
2502   return make_char (MAKE_CHAR (charset, a1, a2));
2503 }
2504
2505 DEFUN ("char-charset", Fchar_charset, 1, 1, 0, /*
2506 Return the character set of CHARACTER.
2507 */
2508        (character))
2509 {
2510   CHECK_CHAR_COERCE_INT (character);
2511
2512   return XCHARSET_NAME (CHAR_CHARSET (XCHAR (character)));
2513 }
2514
2515 DEFUN ("char-octet", Fchar_octet, 1, 2, 0, /*
2516 Return the octet numbered N (should be 0 or 1) of CHARACTER.
2517 N defaults to 0 if omitted.
2518 */
2519        (character, n))
2520 {
2521   Lisp_Object charset;
2522   int octet0, octet1;
2523
2524   CHECK_CHAR_COERCE_INT (character);
2525
2526   BREAKUP_CHAR (XCHAR (character), charset, octet0, octet1);
2527
2528   if (NILP (n) || EQ (n, Qzero))
2529     return make_int (octet0);
2530   else if (EQ (n, make_int (1)))
2531     return make_int (octet1);
2532   else
2533     signal_simple_error ("Octet number must be 0 or 1", n);
2534 }
2535
2536 #ifdef UTF2000
2537 DEFUN ("encode-char", Fencode_char, 2, 3, 0, /*
2538 Return code-point of CHARACTER in specified CHARSET.
2539 */
2540        (character, charset, defined_only))
2541 {
2542   int code_point;
2543
2544   CHECK_CHAR_COERCE_INT (character);
2545   charset = Fget_charset (charset);
2546   code_point = charset_code_point (charset, XCHAR (character),
2547                                    !NILP (defined_only));
2548   if (code_point >= 0)
2549     return make_int (code_point);
2550   else
2551     return Qnil;
2552 }
2553 #endif
2554
2555 DEFUN ("split-char", Fsplit_char, 1, 1, 0, /*
2556 Return list of charset and one or two position-codes of CHARACTER.
2557 */
2558        (character))
2559 {
2560   /* This function can GC */
2561   struct gcpro gcpro1, gcpro2;
2562   Lisp_Object charset = Qnil;
2563   Lisp_Object rc = Qnil;
2564 #ifdef UTF2000
2565   int code_point;
2566   int dimension;
2567 #else
2568   int c1, c2;
2569 #endif
2570
2571   GCPRO2 (charset, rc);
2572   CHECK_CHAR_COERCE_INT (character);
2573
2574 #ifdef UTF2000
2575   code_point = ENCODE_CHAR (XCHAR (character), charset);
2576   dimension = XCHARSET_DIMENSION (charset);
2577   while (dimension > 0)
2578     {
2579       rc = Fcons (make_int (code_point & 255), rc);
2580       code_point >>= 8;
2581       dimension--;
2582     }
2583   rc = Fcons (XCHARSET_NAME (charset), rc);
2584 #else
2585   BREAKUP_CHAR (XCHAR (character), charset, c1, c2);
2586
2587   if (XCHARSET_DIMENSION (Fget_charset (charset)) == 2)
2588     {
2589       rc = list3 (XCHARSET_NAME (charset), make_int (c1), make_int (c2));
2590     }
2591   else
2592     {
2593       rc = list2 (XCHARSET_NAME (charset), make_int (c1));
2594     }
2595 #endif
2596   UNGCPRO;
2597
2598   return rc;
2599 }
2600
2601 \f
2602 #ifdef ENABLE_COMPOSITE_CHARS
2603 /************************************************************************/
2604 /*                     composite character functions                    */
2605 /************************************************************************/
2606
2607 Emchar
2608 lookup_composite_char (Bufbyte *str, int len)
2609 {
2610   Lisp_Object lispstr = make_string (str, len);
2611   Lisp_Object ch = Fgethash (lispstr,
2612                              Vcomposite_char_string2char_hash_table,
2613                              Qunbound);
2614   Emchar emch;
2615
2616   if (UNBOUNDP (ch))
2617     {
2618       if (composite_char_row_next >= 128)
2619         signal_simple_error ("No more composite chars available", lispstr);
2620       emch = MAKE_CHAR (Vcharset_composite, composite_char_row_next,
2621                         composite_char_col_next);
2622       Fputhash (make_char (emch), lispstr,
2623                 Vcomposite_char_char2string_hash_table);
2624       Fputhash (lispstr, make_char (emch),
2625                 Vcomposite_char_string2char_hash_table);
2626       composite_char_col_next++;
2627       if (composite_char_col_next >= 128)
2628         {
2629           composite_char_col_next = 32;
2630           composite_char_row_next++;
2631         }
2632     }
2633   else
2634     emch = XCHAR (ch);
2635   return emch;
2636 }
2637
2638 Lisp_Object
2639 composite_char_string (Emchar ch)
2640 {
2641   Lisp_Object str = Fgethash (make_char (ch),
2642                               Vcomposite_char_char2string_hash_table,
2643                               Qunbound);
2644   assert (!UNBOUNDP (str));
2645   return str;
2646 }
2647
2648 xxDEFUN ("make-composite-char", Fmake_composite_char, 1, 1, 0, /*
2649 Convert a string into a single composite character.
2650 The character is the result of overstriking all the characters in
2651 the string.
2652 */
2653        (string))
2654 {
2655   CHECK_STRING (string);
2656   return make_char (lookup_composite_char (XSTRING_DATA (string),
2657                                            XSTRING_LENGTH (string)));
2658 }
2659
2660 xxDEFUN ("composite-char-string", Fcomposite_char_string, 1, 1, 0, /*
2661 Return a string of the characters comprising a composite character.
2662 */
2663        (ch))
2664 {
2665   Emchar emch;
2666
2667   CHECK_CHAR (ch);
2668   emch = XCHAR (ch);
2669   if (CHAR_LEADING_BYTE (emch) != LEADING_BYTE_COMPOSITE)
2670     signal_simple_error ("Must be composite char", ch);
2671   return composite_char_string (emch);
2672 }
2673 #endif /* ENABLE_COMPOSITE_CHARS */
2674
2675 \f
2676 /************************************************************************/
2677 /*                            initialization                            */
2678 /************************************************************************/
2679
2680 void
2681 syms_of_mule_charset (void)
2682 {
2683   INIT_LRECORD_IMPLEMENTATION (charset);
2684
2685   DEFSUBR (Fcharsetp);
2686   DEFSUBR (Ffind_charset);
2687   DEFSUBR (Fget_charset);
2688   DEFSUBR (Fcharset_list);
2689   DEFSUBR (Fcharset_name);
2690   DEFSUBR (Fmake_charset);
2691   DEFSUBR (Fmake_reverse_direction_charset);
2692   /*  DEFSUBR (Freverse_direction_charset); */
2693   DEFSUBR (Fdefine_charset_alias);
2694   DEFSUBR (Fcharset_from_attributes);
2695   DEFSUBR (Fcharset_short_name);
2696   DEFSUBR (Fcharset_long_name);
2697   DEFSUBR (Fcharset_description);
2698   DEFSUBR (Fcharset_dimension);
2699   DEFSUBR (Fcharset_property);
2700   DEFSUBR (Fcharset_id);
2701   DEFSUBR (Fset_charset_ccl_program);
2702   DEFSUBR (Fset_charset_registry);
2703 #ifdef UTF2000
2704   DEFSUBR (Fcharset_mapping_table);
2705   DEFSUBR (Fset_charset_mapping_table);
2706 #ifdef HAVE_CHISE_CLIENT
2707   DEFSUBR (Fsave_charset_mapping_table);
2708   DEFSUBR (Freset_charset_mapping_table);
2709 #endif
2710
2711   DEFSUBR (Fdecode_char);
2712   DEFSUBR (Fdecode_builtin_char);
2713   DEFSUBR (Fencode_char);
2714 #endif
2715   DEFSUBR (Fmake_char);
2716   DEFSUBR (Fchar_charset);
2717   DEFSUBR (Fchar_octet);
2718   DEFSUBR (Fsplit_char);
2719
2720 #ifdef ENABLE_COMPOSITE_CHARS
2721   DEFSUBR (Fmake_composite_char);
2722   DEFSUBR (Fcomposite_char_string);
2723 #endif
2724
2725   defsymbol (&Qcharsetp, "charsetp");
2726   defsymbol (&Qregistry, "registry");
2727   defsymbol (&Qfinal, "final");
2728   defsymbol (&Qgraphic, "graphic");
2729   defsymbol (&Qdirection, "direction");
2730   defsymbol (&Qreverse_direction_charset, "reverse-direction-charset");
2731   defsymbol (&Qshort_name, "short-name");
2732   defsymbol (&Qlong_name, "long-name");
2733   defsymbol (&Qiso_ir, "iso-ir");
2734 #ifdef UTF2000
2735   defsymbol (&Qmother, "mother");
2736   defsymbol (&Qmin_code, "min-code");
2737   defsymbol (&Qmax_code, "max-code");
2738   defsymbol (&Qcode_offset, "code-offset");
2739   defsymbol (&Qconversion, "conversion");
2740   defsymbol (&Q94x60, "94x60");
2741   defsymbol (&Q94x94x60, "94x94x60");
2742   defsymbol (&Qbig5_1, "big5-1");
2743   defsymbol (&Qbig5_2, "big5-2");
2744 #endif
2745
2746   defsymbol (&Ql2r, "l2r");
2747   defsymbol (&Qr2l, "r2l");
2748
2749   /* Charsets, compatible with FSF 20.3
2750      Naming convention is Script-Charset[-Edition] */
2751   defsymbol (&Qascii,                   "ascii");
2752   defsymbol (&Qcontrol_1,               "control-1");
2753   defsymbol (&Qlatin_iso8859_1,         "latin-iso8859-1");
2754   defsymbol (&Qlatin_iso8859_2,         "latin-iso8859-2");
2755   defsymbol (&Qlatin_iso8859_3,         "latin-iso8859-3");
2756   defsymbol (&Qlatin_iso8859_4,         "latin-iso8859-4");
2757   defsymbol (&Qthai_tis620,             "thai-tis620");
2758   defsymbol (&Qgreek_iso8859_7,         "greek-iso8859-7");
2759   defsymbol (&Qarabic_iso8859_6,        "arabic-iso8859-6");
2760   defsymbol (&Qhebrew_iso8859_8,        "hebrew-iso8859-8");
2761   defsymbol (&Qkatakana_jisx0201,       "katakana-jisx0201");
2762   defsymbol (&Qlatin_jisx0201,          "latin-jisx0201");
2763   defsymbol (&Qcyrillic_iso8859_5,      "cyrillic-iso8859-5");
2764   defsymbol (&Qlatin_iso8859_9,         "latin-iso8859-9");
2765   defsymbol (&Qmap_jis_x0208_1978,      "=jis-x0208-1978");
2766   defsymbol (&Qmap_gb2312,              "=gb2312");
2767   defsymbol (&Qmap_gb12345,             "=gb12345");
2768   defsymbol (&Qmap_jis_x0208_1983,      "=jis-x0208-1983");
2769   defsymbol (&Qmap_ks_x1001,            "=ks-x1001");
2770   defsymbol (&Qmap_jis_x0212,           "=jis-x0212");
2771   defsymbol (&Qmap_cns11643_1,          "=cns11643-1");
2772   defsymbol (&Qmap_cns11643_2,          "=cns11643-2");
2773 #ifdef UTF2000
2774   defsymbol (&Qmap_ucs,                 "=ucs");
2775   defsymbol (&Qucs,                     "ucs");
2776   defsymbol (&Qucs_bmp,                 "ucs-bmp");
2777   defsymbol (&Qucs_smp,                 "ucs-smp");
2778   defsymbol (&Qucs_sip,                 "ucs-sip");
2779   defsymbol (&Qlatin_viscii,            "latin-viscii");
2780   defsymbol (&Qlatin_tcvn5712,          "latin-tcvn5712");
2781   defsymbol (&Qlatin_viscii_lower,      "latin-viscii-lower");
2782   defsymbol (&Qlatin_viscii_upper,      "latin-viscii-upper");
2783   defsymbol (&Qvietnamese_viscii_lower, "vietnamese-viscii-lower");
2784   defsymbol (&Qvietnamese_viscii_upper, "vietnamese-viscii-upper");
2785   defsymbol (&Qmap_jis_x0208,           "=jis-x0208");
2786   defsymbol (&Qmap_jis_x0208_1990,      "=jis-x0208-1990");
2787   defsymbol (&Qmap_big5,                "=big5");
2788   defsymbol (&Qethiopic_ucs,            "ethiopic-ucs");
2789 #endif
2790   defsymbol (&Qchinese_big5_1,          "chinese-big5-1");
2791   defsymbol (&Qchinese_big5_2,          "chinese-big5-2");
2792
2793   defsymbol (&Qcomposite,               "composite");
2794 }
2795
2796 void
2797 vars_of_mule_charset (void)
2798 {
2799   int i, j;
2800 #ifndef UTF2000
2801   int k;
2802 #endif
2803
2804   chlook = xnew_and_zero (struct charset_lookup); /* zero for Purify. */
2805   dump_add_root_struct_ptr (&chlook, &charset_lookup_description);
2806
2807   /* Table of charsets indexed by leading byte. */
2808   for (i = 0; i < countof (chlook->charset_by_leading_byte); i++)
2809     chlook->charset_by_leading_byte[i] = Qnil;
2810
2811 #ifdef UTF2000
2812   /* Table of charsets indexed by type/final-byte. */
2813   for (i = 0; i < countof (chlook->charset_by_attributes); i++)
2814     for (j = 0; j < countof (chlook->charset_by_attributes[0]); j++)
2815       chlook->charset_by_attributes[i][j] = Qnil;
2816 #else
2817   /* Table of charsets indexed by type/final-byte/direction. */
2818   for (i = 0; i < countof (chlook->charset_by_attributes); i++)
2819     for (j = 0; j < countof (chlook->charset_by_attributes[0]); j++)
2820       for (k = 0; k < countof (chlook->charset_by_attributes[0][0]); k++)
2821         chlook->charset_by_attributes[i][j][k] = Qnil;
2822 #endif
2823
2824 #ifdef UTF2000
2825   chlook->next_allocated_leading_byte = MIN_LEADING_BYTE_PRIVATE;
2826 #else
2827   chlook->next_allocated_1_byte_leading_byte = MIN_LEADING_BYTE_PRIVATE_1;
2828   chlook->next_allocated_2_byte_leading_byte = MIN_LEADING_BYTE_PRIVATE_2;
2829 #endif
2830
2831 #ifndef UTF2000
2832   leading_code_private_11 = PRE_LEADING_BYTE_PRIVATE_1;
2833   DEFVAR_INT ("leading-code-private-11", &leading_code_private_11 /*
2834 Leading-code of private TYPE9N charset of column-width 1.
2835 */ );
2836   leading_code_private_11 = PRE_LEADING_BYTE_PRIVATE_1;
2837 #endif
2838
2839 #ifdef UTF2000
2840   Vdefault_coded_charset_priority_list = Qnil;
2841   DEFVAR_LISP ("default-coded-charset-priority-list",
2842                &Vdefault_coded_charset_priority_list /*
2843 Default order of preferred coded-character-sets.
2844 */ );
2845 #endif
2846 }
2847
2848 void
2849 complex_vars_of_mule_charset (void)
2850 {
2851   staticpro (&Vcharset_hash_table);
2852   Vcharset_hash_table =
2853     make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
2854
2855   /* Predefined character sets.  We store them into variables for
2856      ease of access. */
2857
2858 #ifdef UTF2000
2859   staticpro (&Vcharset_ucs);
2860   Vcharset_ucs =
2861     make_charset (LEADING_BYTE_UCS, Qmap_ucs, 256, 4,
2862                   1, 2, 0, CHARSET_LEFT_TO_RIGHT,
2863                   build_string ("UCS"),
2864                   build_string ("UCS"),
2865                   build_string ("ISO/IEC 10646"),
2866                   build_string (""),
2867                   Qnil, 0, 0x7FFFFFFF, 0, 0, Qnil, CONVERSION_IDENTICAL);
2868   staticpro (&Vcharset_ucs_bmp);
2869   Vcharset_ucs_bmp =
2870     make_charset (LEADING_BYTE_UCS_BMP, Qucs_bmp, 256, 2,
2871                   1, 2, 0, CHARSET_LEFT_TO_RIGHT,
2872                   build_string ("BMP"),
2873                   build_string ("UCS-BMP"),
2874                   build_string ("ISO/IEC 10646 Group 0 Plane 0 (BMP)"),
2875                   build_string
2876                   ("\\(ISO10646.*-[01]\\|UCS00-0\\|UNICODE[23]?-0\\)"),
2877                   Qnil, 0, 0xFFFF, 0, 0, Qnil, CONVERSION_IDENTICAL);
2878   staticpro (&Vcharset_ucs_smp);
2879   Vcharset_ucs_smp =
2880     make_charset (LEADING_BYTE_UCS_SMP, Qucs_smp, 256, 2,
2881                   1, 2, 0, CHARSET_LEFT_TO_RIGHT,
2882                   build_string ("SMP"),
2883                   build_string ("UCS-SMP"),
2884                   build_string ("ISO/IEC 10646 Group 0 Plane 1 (SMP)"),
2885                   build_string ("UCS00-1"),
2886                   Qnil, MIN_CHAR_SMP, MAX_CHAR_SMP,
2887                   MIN_CHAR_SMP, 0, Qnil, CONVERSION_IDENTICAL);
2888   staticpro (&Vcharset_ucs_sip);
2889   Vcharset_ucs_sip =
2890     make_charset (LEADING_BYTE_UCS_SIP, Qucs_sip, 256, 2,
2891                   2, 2, 0, CHARSET_LEFT_TO_RIGHT,
2892                   build_string ("SIP"),
2893                   build_string ("UCS-SIP"),
2894                   build_string ("ISO/IEC 10646 Group 0 Plane 2 (SIP)"),
2895                   build_string ("\\(ISO10646.*-2\\|UCS00-2\\)"),
2896                   Qnil, MIN_CHAR_SIP, MAX_CHAR_SIP,
2897                   MIN_CHAR_SIP, 0, Qnil, CONVERSION_IDENTICAL);
2898 #else
2899 # define MIN_CHAR_THAI 0
2900 # define MAX_CHAR_THAI 0
2901   /* # define MIN_CHAR_HEBREW 0 */
2902   /* # define MAX_CHAR_HEBREW 0 */
2903 # define MIN_CHAR_HALFWIDTH_KATAKANA 0
2904 # define MAX_CHAR_HALFWIDTH_KATAKANA 0
2905 #endif
2906   staticpro (&Vcharset_ascii);
2907   Vcharset_ascii =
2908     make_charset (LEADING_BYTE_ASCII, Qascii, 94, 1,
2909                   1, 0, 'B', CHARSET_LEFT_TO_RIGHT,
2910                   build_string ("ASCII"),
2911                   build_string ("ASCII)"),
2912                   build_string ("ASCII (ISO646 IRV)"),
2913                   build_string ("\\(iso8859-[0-9]*\\|-ascii\\)"),
2914                   Qnil, 0, 0x7F, 0, 0, Qnil, CONVERSION_IDENTICAL);
2915   staticpro (&Vcharset_control_1);
2916   Vcharset_control_1 =
2917     make_charset (LEADING_BYTE_CONTROL_1, Qcontrol_1, 94, 1,
2918                   1, 1, 0, CHARSET_LEFT_TO_RIGHT,
2919                   build_string ("C1"),
2920                   build_string ("Control characters"),
2921                   build_string ("Control characters 128-191"),
2922                   build_string (""),
2923                   Qnil, 0x80, 0x9F, 0x80, 0, Qnil, CONVERSION_IDENTICAL);
2924   staticpro (&Vcharset_latin_iso8859_1);
2925   Vcharset_latin_iso8859_1 =
2926     make_charset (LEADING_BYTE_LATIN_ISO8859_1, Qlatin_iso8859_1, 96, 1,
2927                   1, 1, 'A', CHARSET_LEFT_TO_RIGHT,
2928                   build_string ("Latin-1"),
2929                   build_string ("ISO8859-1 (Latin-1)"),
2930                   build_string ("ISO8859-1 (Latin-1)"),
2931                   build_string ("iso8859-1"),
2932                   Qnil, 0, 0, 0, 32, Qnil, CONVERSION_IDENTICAL);
2933   staticpro (&Vcharset_latin_iso8859_2);
2934   Vcharset_latin_iso8859_2 =
2935     make_charset (LEADING_BYTE_LATIN_ISO8859_2, Qlatin_iso8859_2, 96, 1,
2936                   1, 1, 'B', CHARSET_LEFT_TO_RIGHT,
2937                   build_string ("Latin-2"),
2938                   build_string ("ISO8859-2 (Latin-2)"),
2939                   build_string ("ISO8859-2 (Latin-2)"),
2940                   build_string ("iso8859-2"),
2941                   Qnil, 0, 0, 0, 32, Qnil, CONVERSION_IDENTICAL);
2942   staticpro (&Vcharset_latin_iso8859_3);
2943   Vcharset_latin_iso8859_3 =
2944     make_charset (LEADING_BYTE_LATIN_ISO8859_3, Qlatin_iso8859_3, 96, 1,
2945                   1, 1, 'C', CHARSET_LEFT_TO_RIGHT,
2946                   build_string ("Latin-3"),
2947                   build_string ("ISO8859-3 (Latin-3)"),
2948                   build_string ("ISO8859-3 (Latin-3)"),
2949                   build_string ("iso8859-3"),
2950                   Qnil, 0, 0, 0, 32, Qnil, CONVERSION_IDENTICAL);
2951   staticpro (&Vcharset_latin_iso8859_4);
2952   Vcharset_latin_iso8859_4 =
2953     make_charset (LEADING_BYTE_LATIN_ISO8859_4, Qlatin_iso8859_4, 96, 1,
2954                   1, 1, 'D', CHARSET_LEFT_TO_RIGHT,
2955                   build_string ("Latin-4"),
2956                   build_string ("ISO8859-4 (Latin-4)"),
2957                   build_string ("ISO8859-4 (Latin-4)"),
2958                   build_string ("iso8859-4"),
2959                   Qnil, 0, 0, 0, 32, Qnil, CONVERSION_IDENTICAL);
2960   staticpro (&Vcharset_thai_tis620);
2961   Vcharset_thai_tis620 =
2962     make_charset (LEADING_BYTE_THAI_TIS620, Qthai_tis620, 96, 1,
2963                   1, 1, 'T', CHARSET_LEFT_TO_RIGHT,
2964                   build_string ("TIS620"),
2965                   build_string ("TIS620 (Thai)"),
2966                   build_string ("TIS620.2529 (Thai)"),
2967                   build_string ("tis620"),
2968                   Qnil, 0, 0, 0, 32, Qnil, CONVERSION_IDENTICAL);
2969   staticpro (&Vcharset_greek_iso8859_7);
2970   Vcharset_greek_iso8859_7 =
2971     make_charset (LEADING_BYTE_GREEK_ISO8859_7, Qgreek_iso8859_7, 96, 1,
2972                   1, 1, 'F', CHARSET_LEFT_TO_RIGHT,
2973                   build_string ("ISO8859-7"),
2974                   build_string ("ISO8859-7 (Greek)"),
2975                   build_string ("ISO8859-7 (Greek)"),
2976                   build_string ("iso8859-7"),
2977                   Qnil, 0, 0, 0, 32, Qnil, CONVERSION_IDENTICAL);
2978   staticpro (&Vcharset_arabic_iso8859_6);
2979   Vcharset_arabic_iso8859_6 =
2980     make_charset (LEADING_BYTE_ARABIC_ISO8859_6, Qarabic_iso8859_6, 96, 1,
2981                   1, 1, 'G', CHARSET_RIGHT_TO_LEFT,
2982                   build_string ("ISO8859-6"),
2983                   build_string ("ISO8859-6 (Arabic)"),
2984                   build_string ("ISO8859-6 (Arabic)"),
2985                   build_string ("iso8859-6"),
2986                   Qnil, 0, 0, 0, 32, Qnil, CONVERSION_IDENTICAL);
2987   staticpro (&Vcharset_hebrew_iso8859_8);
2988   Vcharset_hebrew_iso8859_8 =
2989     make_charset (LEADING_BYTE_HEBREW_ISO8859_8, Qhebrew_iso8859_8, 96, 1,
2990                   1, 1, 'H', CHARSET_RIGHT_TO_LEFT,
2991                   build_string ("ISO8859-8"),
2992                   build_string ("ISO8859-8 (Hebrew)"),
2993                   build_string ("ISO8859-8 (Hebrew)"),
2994                   build_string ("iso8859-8"),
2995                   Qnil,
2996                   0 /* MIN_CHAR_HEBREW */,
2997                   0 /* MAX_CHAR_HEBREW */, 0, 32,
2998                   Qnil, CONVERSION_IDENTICAL);
2999   staticpro (&Vcharset_katakana_jisx0201);
3000   Vcharset_katakana_jisx0201 =
3001     make_charset (LEADING_BYTE_KATAKANA_JISX0201, Qkatakana_jisx0201, 94, 1,
3002                   1, 1, 'I', CHARSET_LEFT_TO_RIGHT,
3003                   build_string ("JISX0201 Kana"),
3004                   build_string ("JISX0201.1976 (Japanese Kana)"),
3005                   build_string ("JISX0201.1976 Japanese Kana"),
3006                   build_string ("jisx0201\\.1976"),
3007                   Qnil, 0, 0, 0, 33, Qnil, CONVERSION_IDENTICAL);
3008   staticpro (&Vcharset_latin_jisx0201);
3009   Vcharset_latin_jisx0201 =
3010     make_charset (LEADING_BYTE_LATIN_JISX0201, Qlatin_jisx0201, 94, 1,
3011                   1, 0, 'J', CHARSET_LEFT_TO_RIGHT,
3012                   build_string ("JISX0201 Roman"),
3013                   build_string ("JISX0201.1976 (Japanese Roman)"),
3014                   build_string ("JISX0201.1976 Japanese Roman"),
3015                   build_string ("jisx0201\\.1976"),
3016                   Qnil, 0, 0, 0, 33, Qnil, CONVERSION_IDENTICAL);
3017   staticpro (&Vcharset_cyrillic_iso8859_5);
3018   Vcharset_cyrillic_iso8859_5 =
3019     make_charset (LEADING_BYTE_CYRILLIC_ISO8859_5, Qcyrillic_iso8859_5, 96, 1,
3020                   1, 1, 'L', CHARSET_LEFT_TO_RIGHT,
3021                   build_string ("ISO8859-5"),
3022                   build_string ("ISO8859-5 (Cyrillic)"),
3023                   build_string ("ISO8859-5 (Cyrillic)"),
3024                   build_string ("iso8859-5"),
3025                   Qnil, 0, 0, 0, 32, Qnil, CONVERSION_IDENTICAL);
3026   staticpro (&Vcharset_latin_iso8859_9);
3027   Vcharset_latin_iso8859_9 =
3028     make_charset (LEADING_BYTE_LATIN_ISO8859_9, Qlatin_iso8859_9, 96, 1,
3029                   1, 1, 'M', CHARSET_LEFT_TO_RIGHT,
3030                   build_string ("Latin-5"),
3031                   build_string ("ISO8859-9 (Latin-5)"),
3032                   build_string ("ISO8859-9 (Latin-5)"),
3033                   build_string ("iso8859-9"),
3034                   Qnil, 0, 0, 0, 32, Qnil, CONVERSION_IDENTICAL);
3035 #ifdef UTF2000
3036   staticpro (&Vcharset_jis_x0208);
3037   Vcharset_jis_x0208 =
3038     make_charset (LEADING_BYTE_JIS_X0208,
3039                   Qmap_jis_x0208, 94, 2,
3040                   2, 0, 'B', CHARSET_LEFT_TO_RIGHT,
3041                   build_string ("JIS X0208"),
3042                   build_string ("JIS X0208 Common"),
3043                   build_string ("JIS X0208 Common part"),
3044                   build_string ("jisx0208\\.1990"),
3045                   Qnil,
3046                   MIN_CHAR_JIS_X0208_1990,
3047                   MAX_CHAR_JIS_X0208_1990, MIN_CHAR_JIS_X0208_1990, 33,
3048                   Qnil, CONVERSION_94x94);
3049 #endif
3050   staticpro (&Vcharset_japanese_jisx0208_1978);
3051   Vcharset_japanese_jisx0208_1978 =
3052     make_charset (LEADING_BYTE_JAPANESE_JISX0208_1978,
3053                   Qmap_jis_x0208_1978, 94, 2,
3054                   2, 0, '@', CHARSET_LEFT_TO_RIGHT,
3055                   build_string ("JIS X0208:1978"),
3056                   build_string ("JIS X0208:1978 (Japanese)"),
3057                   build_string
3058                   ("JIS X0208:1978 Japanese Kanji (so called \"old JIS\")"),
3059                   build_string ("\\(jisx0208\\|jisc6226\\)\\.1978"),
3060                   Qnil, 0, 0, 0, 33,
3061 #ifdef UTF2000
3062                   Vcharset_jis_x0208,
3063 #else
3064                   Qnil,
3065 #endif
3066                   CONVERSION_IDENTICAL);
3067   staticpro (&Vcharset_chinese_gb2312);
3068   Vcharset_chinese_gb2312 =
3069     make_charset (LEADING_BYTE_CHINESE_GB2312, Qmap_gb2312, 94, 2,
3070                   2, 0, 'A', CHARSET_LEFT_TO_RIGHT,
3071                   build_string ("GB2312"),
3072                   build_string ("GB2312)"),
3073                   build_string ("GB2312 Chinese simplified"),
3074                   build_string ("gb2312"),
3075                   Qnil, 0, 0, 0, 33, Qnil, CONVERSION_IDENTICAL);
3076   staticpro (&Vcharset_chinese_gb12345);
3077   Vcharset_chinese_gb12345 =
3078     make_charset (LEADING_BYTE_CHINESE_GB12345, Qmap_gb12345, 94, 2,
3079                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3080                   build_string ("G1"),
3081                   build_string ("GB 12345)"),
3082                   build_string ("GB 12345-1990"),
3083                   build_string ("GB12345\\(\\.1990\\)?-0"),
3084                   Qnil, 0, 0, 0, 33, Qnil, CONVERSION_IDENTICAL);
3085   staticpro (&Vcharset_japanese_jisx0208);
3086   Vcharset_japanese_jisx0208 =
3087     make_charset (LEADING_BYTE_JAPANESE_JISX0208, Qmap_jis_x0208_1983, 94, 2,
3088                   2, 0, 'B', CHARSET_LEFT_TO_RIGHT,
3089                   build_string ("JISX0208"),
3090                   build_string ("JIS X0208:1983 (Japanese)"),
3091                   build_string ("JIS X0208:1983 Japanese Kanji"),
3092                   build_string ("jisx0208\\.1983"),
3093                   Qnil, 0, 0, 0, 33,
3094 #ifdef UTF2000
3095                   Vcharset_jis_x0208,
3096 #else
3097                   Qnil,
3098 #endif
3099                   CONVERSION_IDENTICAL);
3100 #ifdef UTF2000
3101   staticpro (&Vcharset_japanese_jisx0208_1990);
3102   Vcharset_japanese_jisx0208_1990 =
3103     make_charset (LEADING_BYTE_JAPANESE_JISX0208_1990,
3104                   Qmap_jis_x0208_1990, 94, 2,
3105                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3106                   build_string ("JISX0208-1990"),
3107                   build_string ("JIS X0208:1990 (Japanese)"),
3108                   build_string ("JIS X0208:1990 Japanese Kanji"),
3109                   build_string ("jisx0208\\.1990"),
3110                   Qnil,
3111                   0x2121 /* MIN_CHAR_JIS_X0208_1990 */,
3112                   0x7426 /* MAX_CHAR_JIS_X0208_1990 */,
3113                   0 /* MIN_CHAR_JIS_X0208_1990 */, 33,
3114                   Vcharset_jis_x0208 /* Qnil */,
3115                   CONVERSION_IDENTICAL /* CONVERSION_94x94 */);
3116 #endif
3117   staticpro (&Vcharset_korean_ksc5601);
3118   Vcharset_korean_ksc5601 =
3119     make_charset (LEADING_BYTE_KOREAN_KSC5601, Qmap_ks_x1001, 94, 2,
3120                   2, 0, 'C', CHARSET_LEFT_TO_RIGHT,
3121                   build_string ("KSC5601"),
3122                   build_string ("KSC5601 (Korean"),
3123                   build_string ("KSC5601 Korean Hangul and Hanja"),
3124                   build_string ("ksc5601"),
3125                   Qnil, 0, 0, 0, 33, Qnil, CONVERSION_IDENTICAL);
3126   staticpro (&Vcharset_japanese_jisx0212);
3127   Vcharset_japanese_jisx0212 =
3128     make_charset (LEADING_BYTE_JAPANESE_JISX0212, Qmap_jis_x0212, 94, 2,
3129                   2, 0, 'D', CHARSET_LEFT_TO_RIGHT,
3130                   build_string ("JISX0212"),
3131                   build_string ("JISX0212 (Japanese)"),
3132                   build_string ("JISX0212 Japanese Supplement"),
3133                   build_string ("jisx0212"),
3134                   Qnil, 0, 0, 0, 33, Qnil, CONVERSION_IDENTICAL);
3135
3136 #define CHINESE_CNS_PLANE_RE(n) "cns11643[.-]\\(.*[.-]\\)?" n "$"
3137   staticpro (&Vcharset_chinese_cns11643_1);
3138   Vcharset_chinese_cns11643_1 =
3139     make_charset (LEADING_BYTE_CHINESE_CNS11643_1, Qmap_cns11643_1, 94, 2,
3140                   2, 0, 'G', CHARSET_LEFT_TO_RIGHT,
3141                   build_string ("CNS11643-1"),
3142                   build_string ("CNS11643-1 (Chinese traditional)"),
3143                   build_string
3144                   ("CNS 11643 Plane 1 Chinese traditional"),
3145                   build_string (CHINESE_CNS_PLANE_RE("1")),
3146                   Qnil, 0, 0, 0, 33, Qnil, CONVERSION_IDENTICAL);
3147   staticpro (&Vcharset_chinese_cns11643_2);
3148   Vcharset_chinese_cns11643_2 =
3149     make_charset (LEADING_BYTE_CHINESE_CNS11643_2, Qmap_cns11643_2, 94, 2,
3150                   2, 0, 'H', CHARSET_LEFT_TO_RIGHT,
3151                   build_string ("CNS11643-2"),
3152                   build_string ("CNS11643-2 (Chinese traditional)"),
3153                   build_string
3154                   ("CNS 11643 Plane 2 Chinese traditional"),
3155                   build_string (CHINESE_CNS_PLANE_RE("2")),
3156                   Qnil, 0, 0, 0, 33, Qnil, CONVERSION_IDENTICAL);
3157 #ifdef UTF2000
3158   staticpro (&Vcharset_latin_tcvn5712);
3159   Vcharset_latin_tcvn5712 =
3160     make_charset (LEADING_BYTE_LATIN_TCVN5712, Qlatin_tcvn5712, 96, 1,
3161                   1, 1, 'Z', CHARSET_LEFT_TO_RIGHT,
3162                   build_string ("TCVN 5712"),
3163                   build_string ("TCVN 5712 (VSCII-2)"),
3164                   build_string ("Vietnamese TCVN 5712:1983 (VSCII-2)"),
3165                   build_string ("tcvn5712\\(\\.1993\\)?-1"),
3166                   Qnil, 0, 0, 0, 32, Qnil, CONVERSION_IDENTICAL);
3167   staticpro (&Vcharset_latin_viscii_lower);
3168   Vcharset_latin_viscii_lower =
3169     make_charset (LEADING_BYTE_LATIN_VISCII_LOWER, Qlatin_viscii_lower, 96, 1,
3170                   1, 1, '1', CHARSET_LEFT_TO_RIGHT,
3171                   build_string ("VISCII lower"),
3172                   build_string ("VISCII lower (Vietnamese)"),
3173                   build_string ("VISCII lower (Vietnamese)"),
3174                   build_string ("MULEVISCII-LOWER"),
3175                   Qnil, 0, 0, 0, 32, Qnil, CONVERSION_IDENTICAL);
3176   staticpro (&Vcharset_latin_viscii_upper);
3177   Vcharset_latin_viscii_upper =
3178     make_charset (LEADING_BYTE_LATIN_VISCII_UPPER, Qlatin_viscii_upper, 96, 1,
3179                   1, 1, '2', CHARSET_LEFT_TO_RIGHT,
3180                   build_string ("VISCII upper"),
3181                   build_string ("VISCII upper (Vietnamese)"),
3182                   build_string ("VISCII upper (Vietnamese)"),
3183                   build_string ("MULEVISCII-UPPER"),
3184                   Qnil, 0, 0, 0, 32, Qnil, CONVERSION_IDENTICAL);
3185   staticpro (&Vcharset_latin_viscii);
3186   Vcharset_latin_viscii =
3187     make_charset (LEADING_BYTE_LATIN_VISCII, Qlatin_viscii, 256, 1,
3188                   1, 2, 0, CHARSET_LEFT_TO_RIGHT,
3189                   build_string ("VISCII"),
3190                   build_string ("VISCII 1.1 (Vietnamese)"),
3191                   build_string ("VISCII 1.1 (Vietnamese)"),
3192                   build_string ("VISCII1\\.1"),
3193                   Qnil, 0, 0, 0, 0, Qnil, CONVERSION_IDENTICAL);
3194   staticpro (&Vcharset_chinese_big5);
3195   Vcharset_chinese_big5 =
3196     make_charset (LEADING_BYTE_CHINESE_BIG5, Qmap_big5, 256, 2,
3197                   2, 2, 0, CHARSET_LEFT_TO_RIGHT,
3198                   build_string ("Big5"),
3199                   build_string ("Big5"),
3200                   build_string ("Big5 Chinese traditional"),
3201                   build_string ("big5-0"),
3202                   Qnil,
3203                   MIN_CHAR_BIG5_CDP, MAX_CHAR_BIG5_CDP,
3204                   MIN_CHAR_BIG5_CDP, 0, Qnil, CONVERSION_IDENTICAL);
3205
3206   staticpro (&Vcharset_ethiopic_ucs);
3207   Vcharset_ethiopic_ucs =
3208     make_charset (LEADING_BYTE_ETHIOPIC_UCS, Qethiopic_ucs, 256, 2,
3209                   2, 2, 0, CHARSET_LEFT_TO_RIGHT,
3210                   build_string ("Ethiopic (UCS)"),
3211                   build_string ("Ethiopic (UCS)"),
3212                   build_string ("Ethiopic of UCS"),
3213                   build_string ("Ethiopic-Unicode"),
3214                   Qnil, 0x1200, 0x137F, 0, 0,
3215                   Qnil, CONVERSION_IDENTICAL);
3216 #endif
3217   staticpro (&Vcharset_chinese_big5_1);
3218   Vcharset_chinese_big5_1 =
3219     make_charset (LEADING_BYTE_CHINESE_BIG5_1, Qchinese_big5_1, 94, 2,
3220                   2, 0, '0', CHARSET_LEFT_TO_RIGHT,
3221                   build_string ("Big5"),
3222                   build_string ("Big5 (Level-1)"),
3223                   build_string
3224                   ("Big5 Level-1 Chinese traditional"),
3225                   build_string ("big5"),
3226                   Qnil, 0, 0, 0, 33, /* Qnil, CONVERSION_IDENTICAL */
3227                   Vcharset_chinese_big5, CONVERSION_BIG5_1);
3228   staticpro (&Vcharset_chinese_big5_2);
3229   Vcharset_chinese_big5_2 =
3230     make_charset (LEADING_BYTE_CHINESE_BIG5_2, Qchinese_big5_2, 94, 2,
3231                   2, 0, '1', CHARSET_LEFT_TO_RIGHT,
3232                   build_string ("Big5"),
3233                   build_string ("Big5 (Level-2)"),
3234                   build_string
3235                   ("Big5 Level-2 Chinese traditional"),
3236                   build_string ("big5"),
3237                   Qnil, 0, 0, 0, 33, /* Qnil, CONVERSION_IDENTICAL */
3238                   Vcharset_chinese_big5, CONVERSION_BIG5_2);
3239
3240 #ifdef ENABLE_COMPOSITE_CHARS
3241   /* #### For simplicity, we put composite chars into a 96x96 charset.
3242      This is going to lead to problems because you can run out of
3243      room, esp. as we don't yet recycle numbers. */
3244   staticpro (&Vcharset_composite);
3245   Vcharset_composite =
3246     make_charset (LEADING_BYTE_COMPOSITE, Qcomposite, 96, 2,
3247                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3248                   build_string ("Composite"),
3249                   build_string ("Composite characters"),
3250                   build_string ("Composite characters"),
3251                   build_string (""));
3252
3253   /* #### not dumped properly */
3254   composite_char_row_next = 32;
3255   composite_char_col_next = 32;
3256
3257   Vcomposite_char_string2char_hash_table =
3258     make_lisp_hash_table (500, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL);
3259   Vcomposite_char_char2string_hash_table =
3260     make_lisp_hash_table (500, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
3261   staticpro (&Vcomposite_char_string2char_hash_table);
3262   staticpro (&Vcomposite_char_char2string_hash_table);
3263 #endif /* ENABLE_COMPOSITE_CHARS */
3264
3265 }