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