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           && XCHAR (character) == XINT (value) )
 186        || !INTP (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           EMACS_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 DEFUN ("save-charset-properties", Fsave_charset_properties, 1, 1, 0, /*
2369 Save properties of CHARSET.
2370 */
2371        (charset))
2372 {
2373   struct Lisp_Charset *cs;
2374   CHISE_Property property;
2375   Lisp_Object ccs;
2376   unsigned char* feature_name;
2377
2378   ccs = Fget_charset (charset);
2379   cs = XCHARSET (ccs);
2380
2381   if ( open_chise_data_source_maybe () )
2382     return -1;
2383
2384   if ( SYMBOLP (charset) && !EQ (charset, XCHARSET_NAME (ccs)) )
2385     {
2386       property = chise_ds_get_property (default_chise_data_source,
2387                                         "true-name");
2388       feature_name = XSTRING_DATA (Fsymbol_name (charset));
2389       chise_feature_set_property_value
2390         (chise_ds_get_feature (default_chise_data_source, feature_name),
2391          property, XSTRING_DATA (Fprin1_to_string (CHARSET_NAME (cs),
2392                                                    Qnil)));
2393       chise_property_sync (property);
2394     }
2395   charset = XCHARSET_NAME (ccs);
2396   feature_name = XSTRING_DATA (Fsymbol_name (charset));
2397
2398   property = chise_ds_get_property (default_chise_data_source,
2399                                     "description");
2400   chise_feature_set_property_value
2401     (chise_ds_get_feature (default_chise_data_source, feature_name),
2402      property, XSTRING_DATA (Fprin1_to_string
2403                              (CHARSET_DOC_STRING (cs), Qnil)));
2404   chise_property_sync (property);
2405
2406   property = chise_ds_get_property (default_chise_data_source, "type");
2407   chise_feature_set_property_value
2408     (chise_ds_get_feature (default_chise_data_source, feature_name),
2409      property, "CCS");
2410   chise_property_sync (property);
2411
2412   property = chise_ds_get_property (default_chise_data_source, "chars");
2413   chise_feature_set_property_value
2414     (chise_ds_get_feature (default_chise_data_source, feature_name),
2415      property, XSTRING_DATA (Fprin1_to_string (make_int
2416                                                (CHARSET_CHARS (cs)),
2417                                                Qnil)));
2418   chise_property_sync (property);
2419
2420   property = chise_ds_get_property (default_chise_data_source, "dimension");
2421   chise_feature_set_property_value
2422     (chise_ds_get_feature (default_chise_data_source, feature_name),
2423      property, XSTRING_DATA (Fprin1_to_string (make_int
2424                                                (CHARSET_DIMENSION (cs)),
2425                                                Qnil)));
2426   chise_property_sync (property);
2427
2428   if ( CHARSET_FINAL (cs) != 0 )
2429     {
2430       property = chise_ds_get_property (default_chise_data_source,
2431                                         "final-byte");
2432       chise_feature_set_property_value
2433         (chise_ds_get_feature (default_chise_data_source, feature_name),
2434          property, XSTRING_DATA (Fprin1_to_string (make_int
2435                                                    (CHARSET_FINAL (cs)),
2436                                                    Qnil)));
2437       chise_property_sync (property);
2438     }
2439
2440   if ( !NILP (CHARSET_MOTHER (cs)) )
2441     {
2442       Lisp_Object mother = CHARSET_MOTHER (cs);
2443
2444       if ( CHARSETP (mother) )
2445         mother = XCHARSET_NAME (mother);
2446
2447       property = chise_ds_get_property (default_chise_data_source,
2448                                         "mother");
2449       chise_feature_set_property_value
2450         (chise_ds_get_feature (default_chise_data_source, feature_name),
2451          property, XSTRING_DATA (Fprin1_to_string (mother, Qnil)));
2452       chise_property_sync (property);
2453     }
2454
2455   if ( CHARSET_MAX_CODE (cs) != 0 )
2456     {
2457       char str[16];
2458
2459       property = chise_ds_get_property (default_chise_data_source,
2460                                         "mother-code-min");
2461       if ( CHARSET_MIN_CODE (cs) == 0 )
2462         chise_feature_set_property_value
2463           (chise_ds_get_feature (default_chise_data_source, feature_name),
2464            property, "0");
2465       else
2466         {
2467           sprintf (str, "#x%X", CHARSET_MIN_CODE (cs));
2468           chise_feature_set_property_value
2469             (chise_ds_get_feature (default_chise_data_source, feature_name),
2470              property, str);
2471         }
2472       chise_property_sync (property);
2473
2474       property = chise_ds_get_property (default_chise_data_source,
2475                                         "mother-code-max");
2476       sprintf (str, "#x%X", CHARSET_MAX_CODE (cs));
2477       chise_feature_set_property_value
2478         (chise_ds_get_feature (default_chise_data_source, feature_name),
2479          property, str);
2480       chise_property_sync (property);
2481
2482       property = chise_ds_get_property (default_chise_data_source,
2483                                         "mother-code-offset");
2484       if ( CHARSET_CODE_OFFSET (cs) == 0 )
2485         chise_feature_set_property_value
2486           (chise_ds_get_feature (default_chise_data_source, feature_name),
2487            property, "0");
2488       else
2489         {
2490           sprintf (str, "#x%X", CHARSET_CODE_OFFSET (cs));
2491           chise_feature_set_property_value
2492             (chise_ds_get_feature (default_chise_data_source, feature_name),
2493              property, str);
2494         }
2495       chise_property_sync (property);
2496
2497       property = chise_ds_get_property (default_chise_data_source,
2498                                         "mother-code-conversion");
2499       if ( CHARSET_CONVERSION (cs) == CONVERSION_IDENTICAL )
2500         chise_feature_set_property_value
2501           (chise_ds_get_feature (default_chise_data_source, feature_name),
2502            property, "identical");
2503       else
2504         {
2505           Lisp_Object sym = Qnil;
2506
2507           if ( CHARSET_CONVERSION (cs) == CONVERSION_94x60 )
2508             sym = Q94x60;
2509           else if ( CHARSET_CONVERSION (cs) == CONVERSION_94x94x60 )
2510             sym = Q94x94x60;
2511           else if ( CHARSET_CONVERSION (cs) == CONVERSION_BIG5_1 )
2512             sym = Qbig5_1;
2513           else if ( CHARSET_CONVERSION (cs) == CONVERSION_BIG5_2 )
2514             sym = Qbig5_2;
2515           if ( !NILP (sym) )
2516             chise_feature_set_property_value
2517               (chise_ds_get_feature (default_chise_data_source, feature_name),
2518                property, XSTRING_DATA (Fprin1_to_string (sym, Qnil)));
2519           else
2520             chise_feature_set_property_value
2521               (chise_ds_get_feature (default_chise_data_source, feature_name),
2522                property, "unknown");
2523         }
2524       chise_property_sync (property);
2525     }
2526   return Qnil;
2527 }
2528 #endif /* HAVE_LIBCHISE */
2529
2530 #endif /* HAVE_CHISE */
2531 #endif /* UTF2000 */
2532
2533 \f
2534 /************************************************************************/
2535 /*              Lisp primitives for working with characters             */
2536 /************************************************************************/
2537
2538 #ifdef UTF2000
2539 DEFUN ("decode-char", Fdecode_char, 2, 4, 0, /*
2540 Make a character from CHARSET and code-point CODE.
2541 If DEFINED_ONLY is non-nil, builtin character is not returned.
2542 If WITHOUT_INHERITANCE is non-nil, inherited character is not returned.
2543 If corresponding character is not found, nil is returned.
2544 */
2545        (charset, code, defined_only, without_inheritance))
2546 {
2547   int c;
2548
2549   charset = Fget_charset (charset);
2550   CHECK_INT (code);
2551   c = XINT (code);
2552   if (XCHARSET_GRAPHIC (charset) == 1)
2553     c &= 0x7F7F7F7F;
2554   if (NILP (defined_only))
2555     c = DECODE_CHAR (charset, c, !NILP (without_inheritance));
2556   else
2557     c = decode_defined_char (charset, c, !NILP (without_inheritance));
2558   return c >= 0 ? make_char (c) : Qnil;
2559 }
2560
2561 DEFUN ("decode-builtin-char", Fdecode_builtin_char, 2, 2, 0, /*
2562 Make a builtin character from CHARSET and code-point CODE.
2563 */
2564        (charset, code))
2565 {
2566   EMACS_INT c;
2567   Emchar ch;
2568
2569   charset = Fget_charset (charset);
2570   CHECK_INT (code);
2571   if (EQ (charset, Vcharset_latin_viscii))
2572     {
2573       Lisp_Object chr = Fdecode_char (charset, code, Qnil, Qnil);
2574       Lisp_Object ret;
2575
2576       if (!NILP (chr))
2577         {
2578           if (!NILP
2579               (ret = Fget_char_attribute (chr,
2580                                           Vcharset_latin_viscii_lower,
2581                                           Qnil)))
2582             {
2583               charset = Vcharset_latin_viscii_lower;
2584               code = ret;
2585             }
2586           else if (!NILP
2587                    (ret = Fget_char_attribute (chr,
2588                                                Vcharset_latin_viscii_upper,
2589                                                Qnil)))
2590             {
2591               charset = Vcharset_latin_viscii_upper;
2592               code = ret;
2593             }
2594         }
2595     }
2596   c = XINT (code);
2597 #if 0
2598   if (XCHARSET_GRAPHIC (charset) == 1)
2599     c &= 0x7F7F7F7F;
2600 #endif
2601   ch = decode_builtin_char (charset, c);
2602   return
2603     ch >= 0 ? make_char (ch) : Fdecode_char (charset, code, Qnil, Qnil);
2604 }
2605 #endif
2606
2607 DEFUN ("make-char", Fmake_char, 2, 3, 0, /*
2608 Make a character from CHARSET and octets ARG1 and ARG2.
2609 ARG2 is required only for characters from two-dimensional charsets.
2610 For example, (make-char 'latin-iso8859-2 185) will return the Latin 2
2611 character s with caron.
2612 */
2613        (charset, arg1, arg2))
2614 {
2615   Lisp_Charset *cs;
2616   int a1, a2;
2617   int lowlim, highlim;
2618
2619   charset = Fget_charset (charset);
2620   cs = XCHARSET (charset);
2621
2622   if      (EQ (charset, Vcharset_ascii))     lowlim =  0, highlim = 127;
2623   else if (EQ (charset, Vcharset_control_1)) lowlim =  0, highlim =  31;
2624 #ifdef UTF2000
2625   else if (CHARSET_CHARS (cs) == 256)        lowlim =  0, highlim = 255;
2626 #endif
2627   else if (CHARSET_CHARS (cs) == 94)         lowlim = 33, highlim = 126;
2628   else  /* CHARSET_CHARS (cs) == 96) */      lowlim = 32, highlim = 127;
2629
2630   CHECK_INT (arg1);
2631   /* It is useful (and safe, according to Olivier Galibert) to strip
2632      the 8th bit off ARG1 and ARG2 because it allows programmers to
2633      write (make-char 'latin-iso8859-2 CODE) where code is the actual
2634      Latin 2 code of the character.  */
2635 #ifdef UTF2000
2636   a1 = XINT (arg1);
2637   if (highlim < 128)
2638     a1 &= 0x7f;
2639 #else
2640   a1 = XINT (arg1);
2641 #endif
2642   if (a1 < lowlim || a1 > highlim)
2643     args_out_of_range_3 (arg1, make_int (lowlim), make_int (highlim));
2644
2645   if (CHARSET_DIMENSION (cs) == 1)
2646     {
2647       if (!NILP (arg2))
2648         signal_simple_error
2649           ("Charset is of dimension one; second octet must be nil", arg2);
2650       return make_char (MAKE_CHAR (charset, a1, 0));
2651     }
2652
2653   CHECK_INT (arg2);
2654 #ifdef UTF2000
2655   a2 = XINT (arg2);
2656   if (highlim < 128)
2657     a2 &= 0x7f;
2658 #else
2659   a2 = XINT (arg2) & 0x7f;
2660 #endif
2661   if (a2 < lowlim || a2 > highlim)
2662     args_out_of_range_3 (arg2, make_int (lowlim), make_int (highlim));
2663
2664   return make_char (MAKE_CHAR (charset, a1, a2));
2665 }
2666
2667 DEFUN ("char-charset", Fchar_charset, 1, 1, 0, /*
2668 Return the character set of CHARACTER.
2669 */
2670        (character))
2671 {
2672   CHECK_CHAR_COERCE_INT (character);
2673
2674   return XCHARSET_NAME (CHAR_CHARSET (XCHAR (character)));
2675 }
2676
2677 DEFUN ("char-octet", Fchar_octet, 1, 2, 0, /*
2678 Return the octet numbered N (should be 0 or 1) of CHARACTER.
2679 N defaults to 0 if omitted.
2680 */
2681        (character, n))
2682 {
2683   Lisp_Object charset;
2684   int octet0, octet1;
2685
2686   CHECK_CHAR_COERCE_INT (character);
2687
2688   BREAKUP_CHAR (XCHAR (character), charset, octet0, octet1);
2689
2690   if (NILP (n) || EQ (n, Qzero))
2691     return make_int (octet0);
2692   else if (EQ (n, make_int (1)))
2693     return make_int (octet1);
2694   else
2695     signal_simple_error ("Octet number must be 0 or 1", n);
2696 }
2697
2698 #ifdef UTF2000
2699 DEFUN ("encode-char", Fencode_char, 2, 3, 0, /*
2700 Return code-point of CHARACTER in specified CHARSET.
2701 */
2702        (character, charset, defined_only))
2703 {
2704   int code_point;
2705
2706   CHECK_CHAR_COERCE_INT (character);
2707   charset = Fget_charset (charset);
2708   code_point = charset_code_point (charset, XCHAR (character),
2709                                    !NILP (defined_only));
2710   if (code_point >= 0)
2711     return make_int (code_point);
2712   else
2713     return Qnil;
2714 }
2715 #endif
2716
2717 DEFUN ("split-char", Fsplit_char, 1, 1, 0, /*
2718 Return list of charset and one or two position-codes of CHARACTER.
2719 */
2720        (character))
2721 {
2722   /* This function can GC */
2723   struct gcpro gcpro1, gcpro2;
2724   Lisp_Object charset = Qnil;
2725   Lisp_Object rc = Qnil;
2726 #ifdef UTF2000
2727   int code_point;
2728   int dimension;
2729 #else
2730   int c1, c2;
2731 #endif
2732
2733   GCPRO2 (charset, rc);
2734   CHECK_CHAR_COERCE_INT (character);
2735
2736 #ifdef UTF2000
2737   code_point = ENCODE_CHAR (XCHAR (character), charset);
2738   dimension = XCHARSET_DIMENSION (charset);
2739   while (dimension > 0)
2740     {
2741       rc = Fcons (make_int (code_point & 255), rc);
2742       code_point >>= 8;
2743       dimension--;
2744     }
2745   rc = Fcons (XCHARSET_NAME (charset), rc);
2746 #else
2747   BREAKUP_CHAR (XCHAR (character), charset, c1, c2);
2748
2749   if (XCHARSET_DIMENSION (Fget_charset (charset)) == 2)
2750     {
2751       rc = list3 (XCHARSET_NAME (charset), make_int (c1), make_int (c2));
2752     }
2753   else
2754     {
2755       rc = list2 (XCHARSET_NAME (charset), make_int (c1));
2756     }
2757 #endif
2758   UNGCPRO;
2759
2760   return rc;
2761 }
2762
2763 \f
2764 #ifdef ENABLE_COMPOSITE_CHARS
2765 /************************************************************************/
2766 /*                     composite character functions                    */
2767 /************************************************************************/
2768
2769 Emchar
2770 lookup_composite_char (Bufbyte *str, int len)
2771 {
2772   Lisp_Object lispstr = make_string (str, len);
2773   Lisp_Object ch = Fgethash (lispstr,
2774                              Vcomposite_char_string2char_hash_table,
2775                              Qunbound);
2776   Emchar emch;
2777
2778   if (UNBOUNDP (ch))
2779     {
2780       if (composite_char_row_next >= 128)
2781         signal_simple_error ("No more composite chars available", lispstr);
2782       emch = MAKE_CHAR (Vcharset_composite, composite_char_row_next,
2783                         composite_char_col_next);
2784       Fputhash (make_char (emch), lispstr,
2785                 Vcomposite_char_char2string_hash_table);
2786       Fputhash (lispstr, make_char (emch),
2787                 Vcomposite_char_string2char_hash_table);
2788       composite_char_col_next++;
2789       if (composite_char_col_next >= 128)
2790         {
2791           composite_char_col_next = 32;
2792           composite_char_row_next++;
2793         }
2794     }
2795   else
2796     emch = XCHAR (ch);
2797   return emch;
2798 }
2799
2800 Lisp_Object
2801 composite_char_string (Emchar ch)
2802 {
2803   Lisp_Object str = Fgethash (make_char (ch),
2804                               Vcomposite_char_char2string_hash_table,
2805                               Qunbound);
2806   assert (!UNBOUNDP (str));
2807   return str;
2808 }
2809
2810 xxDEFUN ("make-composite-char", Fmake_composite_char, 1, 1, 0, /*
2811 Convert a string into a single composite character.
2812 The character is the result of overstriking all the characters in
2813 the string.
2814 */
2815        (string))
2816 {
2817   CHECK_STRING (string);
2818   return make_char (lookup_composite_char (XSTRING_DATA (string),
2819                                            XSTRING_LENGTH (string)));
2820 }
2821
2822 xxDEFUN ("composite-char-string", Fcomposite_char_string, 1, 1, 0, /*
2823 Return a string of the characters comprising a composite character.
2824 */
2825        (ch))
2826 {
2827   Emchar emch;
2828
2829   CHECK_CHAR (ch);
2830   emch = XCHAR (ch);
2831   if (CHAR_LEADING_BYTE (emch) != LEADING_BYTE_COMPOSITE)
2832     signal_simple_error ("Must be composite char", ch);
2833   return composite_char_string (emch);
2834 }
2835 #endif /* ENABLE_COMPOSITE_CHARS */
2836
2837 \f
2838 /************************************************************************/
2839 /*                            initialization                            */
2840 /************************************************************************/
2841
2842 void
2843 syms_of_mule_charset (void)
2844 {
2845   INIT_LRECORD_IMPLEMENTATION (charset);
2846
2847   DEFSUBR (Fcharsetp);
2848   DEFSUBR (Ffind_charset);
2849   DEFSUBR (Fget_charset);
2850   DEFSUBR (Fcharset_list);
2851   DEFSUBR (Fcharset_name);
2852   DEFSUBR (Fmake_charset);
2853   DEFSUBR (Fmake_reverse_direction_charset);
2854   /*  DEFSUBR (Freverse_direction_charset); */
2855   DEFSUBR (Fdefine_charset_alias);
2856   DEFSUBR (Fcharset_from_attributes);
2857   DEFSUBR (Fcharset_short_name);
2858   DEFSUBR (Fcharset_long_name);
2859   DEFSUBR (Fcharset_description);
2860   DEFSUBR (Fcharset_dimension);
2861   DEFSUBR (Fcharset_property);
2862   DEFSUBR (Fcharset_id);
2863   DEFSUBR (Fset_charset_ccl_program);
2864   DEFSUBR (Fset_charset_registry);
2865
2866 #ifdef UTF2000
2867   DEFSUBR (Fcharset_mapping_table);
2868   DEFSUBR (Fset_charset_mapping_table);
2869 #ifdef HAVE_CHISE
2870   DEFSUBR (Fsave_charset_mapping_table);
2871   DEFSUBR (Freset_charset_mapping_table);
2872 #ifdef HAVE_LIBCHISE
2873   DEFSUBR (Fsave_charset_properties);
2874 #endif /* HAVE_LIBCHISE */
2875 #endif /* HAVE_CHISE */
2876   DEFSUBR (Fdecode_char);
2877   DEFSUBR (Fdecode_builtin_char);
2878   DEFSUBR (Fencode_char);
2879 #endif
2880
2881   DEFSUBR (Fmake_char);
2882   DEFSUBR (Fchar_charset);
2883   DEFSUBR (Fchar_octet);
2884   DEFSUBR (Fsplit_char);
2885
2886 #ifdef ENABLE_COMPOSITE_CHARS
2887   DEFSUBR (Fmake_composite_char);
2888   DEFSUBR (Fcomposite_char_string);
2889 #endif
2890
2891   defsymbol (&Qcharsetp, "charsetp");
2892   defsymbol (&Qregistry, "registry");
2893   defsymbol (&Qfinal, "final");
2894   defsymbol (&Qgraphic, "graphic");
2895   defsymbol (&Qdirection, "direction");
2896   defsymbol (&Qreverse_direction_charset, "reverse-direction-charset");
2897   defsymbol (&Qshort_name, "short-name");
2898   defsymbol (&Qlong_name, "long-name");
2899   defsymbol (&Qiso_ir, "iso-ir");
2900 #ifdef UTF2000
2901   defsymbol (&Qmother, "mother");
2902   defsymbol (&Qmin_code, "min-code");
2903   defsymbol (&Qmax_code, "max-code");
2904   defsymbol (&Qcode_offset, "code-offset");
2905   defsymbol (&Qconversion, "conversion");
2906   defsymbol (&Q94x60, "94x60");
2907   defsymbol (&Q94x94x60, "94x94x60");
2908   defsymbol (&Qbig5_1, "big5-1");
2909   defsymbol (&Qbig5_2, "big5-2");
2910 #endif
2911
2912   defsymbol (&Ql2r, "l2r");
2913   defsymbol (&Qr2l, "r2l");
2914
2915   /* Charsets, compatible with FSF 20.3
2916      Naming convention is Script-Charset[-Edition] */
2917   defsymbol (&Qascii,                   "ascii");
2918   defsymbol (&Qcontrol_1,               "control-1");
2919   defsymbol (&Qlatin_iso8859_1,         "latin-iso8859-1");
2920   defsymbol (&Qlatin_iso8859_2,         "latin-iso8859-2");
2921   defsymbol (&Qlatin_iso8859_3,         "latin-iso8859-3");
2922   defsymbol (&Qlatin_iso8859_4,         "latin-iso8859-4");
2923   defsymbol (&Qthai_tis620,             "thai-tis620");
2924   defsymbol (&Qgreek_iso8859_7,         "greek-iso8859-7");
2925   defsymbol (&Qarabic_iso8859_6,        "arabic-iso8859-6");
2926   defsymbol (&Qhebrew_iso8859_8,        "hebrew-iso8859-8");
2927   defsymbol (&Qkatakana_jisx0201,       "katakana-jisx0201");
2928   defsymbol (&Qlatin_jisx0201,          "latin-jisx0201");
2929   defsymbol (&Qcyrillic_iso8859_5,      "cyrillic-iso8859-5");
2930   defsymbol (&Qlatin_iso8859_9,         "latin-iso8859-9");
2931   defsymbol (&Qmap_jis_x0208_1978,      "=jis-x0208@1978");
2932   defsymbol (&Qmap_gb2312,              "=gb2312");
2933   defsymbol (&Qmap_gb12345,             "=gb12345");
2934   defsymbol (&Qmap_jis_x0208_1983,      "=jis-x0208@1983");
2935   defsymbol (&Qmap_ks_x1001,            "=ks-x1001");
2936   defsymbol (&Qmap_jis_x0212,           "=jis-x0212");
2937   defsymbol (&Qmap_cns11643_1,          "=cns11643-1");
2938   defsymbol (&Qmap_cns11643_2,          "=cns11643-2");
2939 #ifdef UTF2000
2940   defsymbol (&Qsystem_char_id,          "system-char-id");
2941   defsymbol (&Qmap_ucs,                 "=ucs");
2942   defsymbol (&Qucs,                     "ucs");
2943   defsymbol (&Qucs_bmp,                 "ucs-bmp");
2944   defsymbol (&Qucs_smp,                 "ucs-smp");
2945   defsymbol (&Qucs_sip,                 "ucs-sip");
2946   defsymbol (&Qlatin_viscii,            "latin-viscii");
2947   defsymbol (&Qlatin_tcvn5712,          "latin-tcvn5712");
2948   defsymbol (&Qlatin_viscii_lower,      "latin-viscii-lower");
2949   defsymbol (&Qlatin_viscii_upper,      "latin-viscii-upper");
2950   defsymbol (&Qvietnamese_viscii_lower, "vietnamese-viscii-lower");
2951   defsymbol (&Qvietnamese_viscii_upper, "vietnamese-viscii-upper");
2952   defsymbol (&Qmap_jis_x0208,           "=jis-x0208");
2953   defsymbol (&Qmap_jis_x0208_1990,      "=jis-x0208@1990");
2954   defsymbol (&Qmap_big5,                "=big5");
2955   defsymbol (&Qethiopic_ucs,            "ethiopic-ucs");
2956 #endif
2957   defsymbol (&Qchinese_big5_1,          "chinese-big5-1");
2958   defsymbol (&Qchinese_big5_2,          "chinese-big5-2");
2959
2960   defsymbol (&Qcomposite,               "composite");
2961 }
2962
2963 void
2964 vars_of_mule_charset (void)
2965 {
2966   int i, j;
2967 #ifndef UTF2000
2968   int k;
2969 #endif
2970
2971   chlook = xnew_and_zero (struct charset_lookup); /* zero for Purify. */
2972   dump_add_root_struct_ptr (&chlook, &charset_lookup_description);
2973
2974   /* Table of charsets indexed by leading byte. */
2975   for (i = 0; i < countof (chlook->charset_by_leading_byte); i++)
2976     chlook->charset_by_leading_byte[i] = Qnil;
2977
2978 #ifdef UTF2000
2979   /* Table of charsets indexed by type/final-byte. */
2980   for (i = 0; i < countof (chlook->charset_by_attributes); i++)
2981     for (j = 0; j < countof (chlook->charset_by_attributes[0]); j++)
2982       chlook->charset_by_attributes[i][j] = Qnil;
2983 #else
2984   /* Table of charsets indexed by type/final-byte/direction. */
2985   for (i = 0; i < countof (chlook->charset_by_attributes); i++)
2986     for (j = 0; j < countof (chlook->charset_by_attributes[0]); j++)
2987       for (k = 0; k < countof (chlook->charset_by_attributes[0][0]); k++)
2988         chlook->charset_by_attributes[i][j][k] = Qnil;
2989 #endif
2990
2991 #ifdef UTF2000
2992   chlook->next_allocated_leading_byte = MIN_LEADING_BYTE_PRIVATE;
2993 #else
2994   chlook->next_allocated_1_byte_leading_byte = MIN_LEADING_BYTE_PRIVATE_1;
2995   chlook->next_allocated_2_byte_leading_byte = MIN_LEADING_BYTE_PRIVATE_2;
2996 #endif
2997
2998 #ifndef UTF2000
2999   leading_code_private_11 = PRE_LEADING_BYTE_PRIVATE_1;
3000   DEFVAR_INT ("leading-code-private-11", &leading_code_private_11 /*
3001 Leading-code of private TYPE9N charset of column-width 1.
3002 */ );
3003   leading_code_private_11 = PRE_LEADING_BYTE_PRIVATE_1;
3004 #endif
3005
3006 #ifdef UTF2000
3007   Vdefault_coded_charset_priority_list = Qnil;
3008   DEFVAR_LISP ("default-coded-charset-priority-list",
3009                &Vdefault_coded_charset_priority_list /*
3010 Default order of preferred coded-character-sets.
3011 */ );
3012 #endif
3013 }
3014
3015 void
3016 complex_vars_of_mule_charset (void)
3017 {
3018   staticpro (&Vcharset_hash_table);
3019   Vcharset_hash_table =
3020     make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
3021
3022   /* Predefined character sets.  We store them into variables for
3023      ease of access. */
3024
3025 #ifdef UTF2000
3026   staticpro (&Vcharset_system_char_id);
3027   Vcharset_system_char_id =
3028     make_charset (LEADING_BYTE_SYSTEM_CHAR_ID, Qsystem_char_id, 256, 4,
3029                   1, 2, 0, CHARSET_LEFT_TO_RIGHT,
3030                   build_string ("SCID"),
3031                   build_string ("CHAR-ID"),
3032                   build_string ("System char-id"),
3033                   build_string (""),
3034                   Qnil, 0, 0x7FFFFFFF, 0, 0, Qnil, CONVERSION_IDENTICAL);
3035   staticpro (&Vcharset_ucs);
3036   Vcharset_ucs =
3037     make_charset (LEADING_BYTE_UCS, Qmap_ucs, 256, 4,
3038                   1, 2, 0, CHARSET_LEFT_TO_RIGHT,
3039                   build_string ("UCS"),
3040                   build_string ("UCS"),
3041                   build_string ("ISO/IEC 10646"),
3042                   build_string (""),
3043                   Qnil, 0, 0xEFFFF, 0, 0, Qnil, CONVERSION_IDENTICAL);
3044   staticpro (&Vcharset_ucs_bmp);
3045   Vcharset_ucs_bmp =
3046     make_charset (LEADING_BYTE_UCS_BMP, Qucs_bmp, 256, 2,
3047                   1, 2, 0, CHARSET_LEFT_TO_RIGHT,
3048                   build_string ("BMP"),
3049                   build_string ("UCS-BMP"),
3050                   build_string ("ISO/IEC 10646 Group 0 Plane 0 (BMP)"),
3051                   build_string
3052                   ("\\(ISO10646.*-[01]\\|UCS00-0\\|UNICODE[23]?-0\\)"),
3053                   Qnil, 0, 0xFFFF, 0, 0, Qnil, CONVERSION_IDENTICAL);
3054   staticpro (&Vcharset_ucs_smp);
3055   Vcharset_ucs_smp =
3056     make_charset (LEADING_BYTE_UCS_SMP, Qucs_smp, 256, 2,
3057                   1, 2, 0, CHARSET_LEFT_TO_RIGHT,
3058                   build_string ("SMP"),
3059                   build_string ("UCS-SMP"),
3060                   build_string ("ISO/IEC 10646 Group 0 Plane 1 (SMP)"),
3061                   build_string ("UCS00-1"),
3062                   Qnil, MIN_CHAR_SMP, MAX_CHAR_SMP,
3063                   MIN_CHAR_SMP, 0, Qnil, CONVERSION_IDENTICAL);
3064   staticpro (&Vcharset_ucs_sip);
3065   Vcharset_ucs_sip =
3066     make_charset (LEADING_BYTE_UCS_SIP, Qucs_sip, 256, 2,
3067                   2, 2, 0, CHARSET_LEFT_TO_RIGHT,
3068                   build_string ("SIP"),
3069                   build_string ("UCS-SIP"),
3070                   build_string ("ISO/IEC 10646 Group 0 Plane 2 (SIP)"),
3071                   build_string ("\\(ISO10646.*-2\\|UCS00-2\\)"),
3072                   Qnil, MIN_CHAR_SIP, MAX_CHAR_SIP,
3073                   MIN_CHAR_SIP, 0, Qnil, CONVERSION_IDENTICAL);
3074 #else
3075 # define MIN_CHAR_THAI 0
3076 # define MAX_CHAR_THAI 0
3077   /* # define MIN_CHAR_HEBREW 0 */
3078   /* # define MAX_CHAR_HEBREW 0 */
3079 # define MIN_CHAR_HALFWIDTH_KATAKANA 0
3080 # define MAX_CHAR_HALFWIDTH_KATAKANA 0
3081 #endif
3082   staticpro (&Vcharset_ascii);
3083   Vcharset_ascii =
3084     make_charset (LEADING_BYTE_ASCII, Qascii, 94, 1,
3085                   1, 0, 'B', CHARSET_LEFT_TO_RIGHT,
3086                   build_string ("ASCII"),
3087                   build_string ("ASCII)"),
3088                   build_string ("ASCII (ISO646 IRV)"),
3089                   build_string ("\\(iso8859-[0-9]*\\|-ascii\\)"),
3090                   Qnil, 0, 0x7F, 0, 0, Qnil, CONVERSION_IDENTICAL);
3091   staticpro (&Vcharset_control_1);
3092   Vcharset_control_1 =
3093     make_charset (LEADING_BYTE_CONTROL_1, Qcontrol_1, 94, 1,
3094                   1, 1, 0, CHARSET_LEFT_TO_RIGHT,
3095                   build_string ("C1"),
3096                   build_string ("Control characters"),
3097                   build_string ("Control characters 128-191"),
3098                   build_string (""),
3099                   Qnil, 0x80, 0x9F, 0x80, 0, Qnil, CONVERSION_IDENTICAL);
3100   staticpro (&Vcharset_latin_iso8859_1);
3101   Vcharset_latin_iso8859_1 =
3102     make_charset (LEADING_BYTE_LATIN_ISO8859_1, Qlatin_iso8859_1, 96, 1,
3103                   1, 1, 'A', CHARSET_LEFT_TO_RIGHT,
3104                   build_string ("Latin-1"),
3105                   build_string ("ISO8859-1 (Latin-1)"),
3106                   build_string ("ISO8859-1 (Latin-1)"),
3107                   build_string ("iso8859-1"),
3108                   Qnil, 0, 0, 0, 32, Qnil, CONVERSION_IDENTICAL);
3109   staticpro (&Vcharset_latin_iso8859_2);
3110   Vcharset_latin_iso8859_2 =
3111     make_charset (LEADING_BYTE_LATIN_ISO8859_2, Qlatin_iso8859_2, 96, 1,
3112                   1, 1, 'B', CHARSET_LEFT_TO_RIGHT,
3113                   build_string ("Latin-2"),
3114                   build_string ("ISO8859-2 (Latin-2)"),
3115                   build_string ("ISO8859-2 (Latin-2)"),
3116                   build_string ("iso8859-2"),
3117                   Qnil, 0, 0, 0, 32, Qnil, CONVERSION_IDENTICAL);
3118   staticpro (&Vcharset_latin_iso8859_3);
3119   Vcharset_latin_iso8859_3 =
3120     make_charset (LEADING_BYTE_LATIN_ISO8859_3, Qlatin_iso8859_3, 96, 1,
3121                   1, 1, 'C', CHARSET_LEFT_TO_RIGHT,
3122                   build_string ("Latin-3"),
3123                   build_string ("ISO8859-3 (Latin-3)"),
3124                   build_string ("ISO8859-3 (Latin-3)"),
3125                   build_string ("iso8859-3"),
3126                   Qnil, 0, 0, 0, 32, Qnil, CONVERSION_IDENTICAL);
3127   staticpro (&Vcharset_latin_iso8859_4);
3128   Vcharset_latin_iso8859_4 =
3129     make_charset (LEADING_BYTE_LATIN_ISO8859_4, Qlatin_iso8859_4, 96, 1,
3130                   1, 1, 'D', CHARSET_LEFT_TO_RIGHT,
3131                   build_string ("Latin-4"),
3132                   build_string ("ISO8859-4 (Latin-4)"),
3133                   build_string ("ISO8859-4 (Latin-4)"),
3134                   build_string ("iso8859-4"),
3135                   Qnil, 0, 0, 0, 32, Qnil, CONVERSION_IDENTICAL);
3136   staticpro (&Vcharset_thai_tis620);
3137   Vcharset_thai_tis620 =
3138     make_charset (LEADING_BYTE_THAI_TIS620, Qthai_tis620, 96, 1,
3139                   1, 1, 'T', CHARSET_LEFT_TO_RIGHT,
3140                   build_string ("TIS620"),
3141                   build_string ("TIS620 (Thai)"),
3142                   build_string ("TIS620.2529 (Thai)"),
3143                   build_string ("tis620"),
3144                   Qnil, 0, 0, 0, 32, Qnil, CONVERSION_IDENTICAL);
3145   staticpro (&Vcharset_greek_iso8859_7);
3146   Vcharset_greek_iso8859_7 =
3147     make_charset (LEADING_BYTE_GREEK_ISO8859_7, Qgreek_iso8859_7, 96, 1,
3148                   1, 1, 'F', CHARSET_LEFT_TO_RIGHT,
3149                   build_string ("ISO8859-7"),
3150                   build_string ("ISO8859-7 (Greek)"),
3151                   build_string ("ISO8859-7 (Greek)"),
3152                   build_string ("iso8859-7"),
3153                   Qnil, 0, 0, 0, 32, Qnil, CONVERSION_IDENTICAL);
3154   staticpro (&Vcharset_arabic_iso8859_6);
3155   Vcharset_arabic_iso8859_6 =
3156     make_charset (LEADING_BYTE_ARABIC_ISO8859_6, Qarabic_iso8859_6, 96, 1,
3157                   1, 1, 'G', CHARSET_RIGHT_TO_LEFT,
3158                   build_string ("ISO8859-6"),
3159                   build_string ("ISO8859-6 (Arabic)"),
3160                   build_string ("ISO8859-6 (Arabic)"),
3161                   build_string ("iso8859-6"),
3162                   Qnil, 0, 0, 0, 32, Qnil, CONVERSION_IDENTICAL);
3163   staticpro (&Vcharset_hebrew_iso8859_8);
3164   Vcharset_hebrew_iso8859_8 =
3165     make_charset (LEADING_BYTE_HEBREW_ISO8859_8, Qhebrew_iso8859_8, 96, 1,
3166                   1, 1, 'H', CHARSET_RIGHT_TO_LEFT,
3167                   build_string ("ISO8859-8"),
3168                   build_string ("ISO8859-8 (Hebrew)"),
3169                   build_string ("ISO8859-8 (Hebrew)"),
3170                   build_string ("iso8859-8"),
3171                   Qnil,
3172                   0 /* MIN_CHAR_HEBREW */,
3173                   0 /* MAX_CHAR_HEBREW */, 0, 32,
3174                   Qnil, CONVERSION_IDENTICAL);
3175   staticpro (&Vcharset_katakana_jisx0201);
3176   Vcharset_katakana_jisx0201 =
3177     make_charset (LEADING_BYTE_KATAKANA_JISX0201, Qkatakana_jisx0201, 94, 1,
3178                   1, 1, 'I', CHARSET_LEFT_TO_RIGHT,
3179                   build_string ("JISX0201 Kana"),
3180                   build_string ("JISX0201.1976 (Japanese Kana)"),
3181                   build_string ("JISX0201.1976 Japanese Kana"),
3182                   build_string ("jisx0201\\.1976"),
3183                   Qnil, 0, 0, 0, 33, Qnil, CONVERSION_IDENTICAL);
3184   staticpro (&Vcharset_latin_jisx0201);
3185   Vcharset_latin_jisx0201 =
3186     make_charset (LEADING_BYTE_LATIN_JISX0201, Qlatin_jisx0201, 94, 1,
3187                   1, 0, 'J', CHARSET_LEFT_TO_RIGHT,
3188                   build_string ("JISX0201 Roman"),
3189                   build_string ("JISX0201.1976 (Japanese Roman)"),
3190                   build_string ("JISX0201.1976 Japanese Roman"),
3191                   build_string ("jisx0201\\.1976"),
3192                   Qnil, 0, 0, 0, 33, Qnil, CONVERSION_IDENTICAL);
3193   staticpro (&Vcharset_cyrillic_iso8859_5);
3194   Vcharset_cyrillic_iso8859_5 =
3195     make_charset (LEADING_BYTE_CYRILLIC_ISO8859_5, Qcyrillic_iso8859_5, 96, 1,
3196                   1, 1, 'L', CHARSET_LEFT_TO_RIGHT,
3197                   build_string ("ISO8859-5"),
3198                   build_string ("ISO8859-5 (Cyrillic)"),
3199                   build_string ("ISO8859-5 (Cyrillic)"),
3200                   build_string ("iso8859-5"),
3201                   Qnil, 0, 0, 0, 32, Qnil, CONVERSION_IDENTICAL);
3202   staticpro (&Vcharset_latin_iso8859_9);
3203   Vcharset_latin_iso8859_9 =
3204     make_charset (LEADING_BYTE_LATIN_ISO8859_9, Qlatin_iso8859_9, 96, 1,
3205                   1, 1, 'M', CHARSET_LEFT_TO_RIGHT,
3206                   build_string ("Latin-5"),
3207                   build_string ("ISO8859-9 (Latin-5)"),
3208                   build_string ("ISO8859-9 (Latin-5)"),
3209                   build_string ("iso8859-9"),
3210                   Qnil, 0, 0, 0, 32, Qnil, CONVERSION_IDENTICAL);
3211 #ifdef UTF2000
3212   staticpro (&Vcharset_jis_x0208);
3213   Vcharset_jis_x0208 =
3214     make_charset (LEADING_BYTE_JIS_X0208,
3215                   Qmap_jis_x0208, 94, 2,
3216                   2, 0, 'B', CHARSET_LEFT_TO_RIGHT,
3217                   build_string ("JIS X0208"),
3218                   build_string ("JIS X0208 Common"),
3219                   build_string ("JIS X0208 Common part"),
3220                   build_string ("jisx0208\\.1990"),
3221                   Qnil,
3222                   MIN_CHAR_JIS_X0208_1990,
3223                   MAX_CHAR_JIS_X0208_1990, MIN_CHAR_JIS_X0208_1990, 33,
3224                   Qnil, CONVERSION_94x94);
3225 #endif
3226   staticpro (&Vcharset_japanese_jisx0208_1978);
3227   Vcharset_japanese_jisx0208_1978 =
3228     make_charset (LEADING_BYTE_JAPANESE_JISX0208_1978,
3229                   Qmap_jis_x0208_1978, 94, 2,
3230                   2, 0, '@', CHARSET_LEFT_TO_RIGHT,
3231                   build_string ("JIS X0208:1978"),
3232                   build_string ("JIS X0208:1978 (Japanese)"),
3233                   build_string
3234                   ("JIS X0208:1978 Japanese Kanji (so called \"old JIS\")"),
3235                   build_string ("\\(jisx0208\\|jisc6226\\)\\.1978"),
3236                   Qnil, 0, 0, 0, 33,
3237 #ifdef UTF2000
3238                   Vcharset_jis_x0208,
3239 #else
3240                   Qnil,
3241 #endif
3242                   CONVERSION_IDENTICAL);
3243   staticpro (&Vcharset_chinese_gb2312);
3244   Vcharset_chinese_gb2312 =
3245     make_charset (LEADING_BYTE_CHINESE_GB2312, Qmap_gb2312, 94, 2,
3246                   2, 0, 'A', CHARSET_LEFT_TO_RIGHT,
3247                   build_string ("GB2312"),
3248                   build_string ("GB2312)"),
3249                   build_string ("GB2312 Chinese simplified"),
3250                   build_string ("gb2312"),
3251                   Qnil, 0, 0, 0, 33, Qnil, CONVERSION_IDENTICAL);
3252   staticpro (&Vcharset_chinese_gb12345);
3253   Vcharset_chinese_gb12345 =
3254     make_charset (LEADING_BYTE_CHINESE_GB12345, Qmap_gb12345, 94, 2,
3255                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3256                   build_string ("G1"),
3257                   build_string ("GB 12345)"),
3258                   build_string ("GB 12345-1990"),
3259                   build_string ("GB12345\\(\\.1990\\)?-0"),
3260                   Qnil, 0, 0, 0, 33, Qnil, CONVERSION_IDENTICAL);
3261   staticpro (&Vcharset_japanese_jisx0208);
3262   Vcharset_japanese_jisx0208 =
3263     make_charset (LEADING_BYTE_JAPANESE_JISX0208, Qmap_jis_x0208_1983, 94, 2,
3264                   2, 0, 'B', CHARSET_LEFT_TO_RIGHT,
3265                   build_string ("JISX0208"),
3266                   build_string ("JIS X0208:1983 (Japanese)"),
3267                   build_string ("JIS X0208:1983 Japanese Kanji"),
3268                   build_string ("jisx0208\\.1983"),
3269                   Qnil, 0, 0, 0, 33,
3270 #ifdef UTF2000
3271                   Vcharset_jis_x0208,
3272 #else
3273                   Qnil,
3274 #endif
3275                   CONVERSION_IDENTICAL);
3276 #ifdef UTF2000
3277   staticpro (&Vcharset_japanese_jisx0208_1990);
3278   Vcharset_japanese_jisx0208_1990 =
3279     make_charset (LEADING_BYTE_JAPANESE_JISX0208_1990,
3280                   Qmap_jis_x0208_1990, 94, 2,
3281                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3282                   build_string ("JISX0208-1990"),
3283                   build_string ("JIS X0208:1990 (Japanese)"),
3284                   build_string ("JIS X0208:1990 Japanese Kanji"),
3285                   build_string ("jisx0208\\.1990"),
3286                   Qnil,
3287                   0x2121 /* MIN_CHAR_JIS_X0208_1990 */,
3288                   0x7426 /* MAX_CHAR_JIS_X0208_1990 */,
3289                   0 /* MIN_CHAR_JIS_X0208_1990 */, 33,
3290                   Vcharset_jis_x0208 /* Qnil */,
3291                   CONVERSION_IDENTICAL /* CONVERSION_94x94 */);
3292 #endif
3293   staticpro (&Vcharset_korean_ksc5601);
3294   Vcharset_korean_ksc5601 =
3295     make_charset (LEADING_BYTE_KOREAN_KSC5601, Qmap_ks_x1001, 94, 2,
3296                   2, 0, 'C', CHARSET_LEFT_TO_RIGHT,
3297                   build_string ("KSC5601"),
3298                   build_string ("KSC5601 (Korean"),
3299                   build_string ("KSC5601 Korean Hangul and Hanja"),
3300                   build_string ("ksc5601"),
3301                   Qnil, 0, 0, 0, 33, Qnil, CONVERSION_IDENTICAL);
3302   staticpro (&Vcharset_japanese_jisx0212);
3303   Vcharset_japanese_jisx0212 =
3304     make_charset (LEADING_BYTE_JAPANESE_JISX0212, Qmap_jis_x0212, 94, 2,
3305                   2, 0, 'D', CHARSET_LEFT_TO_RIGHT,
3306                   build_string ("JISX0212"),
3307                   build_string ("JISX0212 (Japanese)"),
3308                   build_string ("JISX0212 Japanese Supplement"),
3309                   build_string ("jisx0212"),
3310                   Qnil, 0, 0, 0, 33, Qnil, CONVERSION_IDENTICAL);
3311
3312 #define CHINESE_CNS_PLANE_RE(n) "cns11643[.-]\\(.*[.-]\\)?" n "$"
3313   staticpro (&Vcharset_chinese_cns11643_1);
3314   Vcharset_chinese_cns11643_1 =
3315     make_charset (LEADING_BYTE_CHINESE_CNS11643_1, Qmap_cns11643_1, 94, 2,
3316                   2, 0, 'G', CHARSET_LEFT_TO_RIGHT,
3317                   build_string ("CNS11643-1"),
3318                   build_string ("CNS11643-1 (Chinese traditional)"),
3319                   build_string
3320                   ("CNS 11643 Plane 1 Chinese traditional"),
3321                   build_string (CHINESE_CNS_PLANE_RE("1")),
3322                   Qnil, 0, 0, 0, 33, Qnil, CONVERSION_IDENTICAL);
3323   staticpro (&Vcharset_chinese_cns11643_2);
3324   Vcharset_chinese_cns11643_2 =
3325     make_charset (LEADING_BYTE_CHINESE_CNS11643_2, Qmap_cns11643_2, 94, 2,
3326                   2, 0, 'H', CHARSET_LEFT_TO_RIGHT,
3327                   build_string ("CNS11643-2"),
3328                   build_string ("CNS11643-2 (Chinese traditional)"),
3329                   build_string
3330                   ("CNS 11643 Plane 2 Chinese traditional"),
3331                   build_string (CHINESE_CNS_PLANE_RE("2")),
3332                   Qnil, 0, 0, 0, 33, Qnil, CONVERSION_IDENTICAL);
3333 #ifdef UTF2000
3334   staticpro (&Vcharset_latin_tcvn5712);
3335   Vcharset_latin_tcvn5712 =
3336     make_charset (LEADING_BYTE_LATIN_TCVN5712, Qlatin_tcvn5712, 96, 1,
3337                   1, 1, 'Z', CHARSET_LEFT_TO_RIGHT,
3338                   build_string ("TCVN 5712"),
3339                   build_string ("TCVN 5712 (VSCII-2)"),
3340                   build_string ("Vietnamese TCVN 5712:1983 (VSCII-2)"),
3341                   build_string ("tcvn5712\\(\\.1993\\)?-1"),
3342                   Qnil, 0, 0, 0, 32, Qnil, CONVERSION_IDENTICAL);
3343   staticpro (&Vcharset_latin_viscii_lower);
3344   Vcharset_latin_viscii_lower =
3345     make_charset (LEADING_BYTE_LATIN_VISCII_LOWER, Qlatin_viscii_lower, 96, 1,
3346                   1, 1, '1', CHARSET_LEFT_TO_RIGHT,
3347                   build_string ("VISCII lower"),
3348                   build_string ("VISCII lower (Vietnamese)"),
3349                   build_string ("VISCII lower (Vietnamese)"),
3350                   build_string ("MULEVISCII-LOWER"),
3351                   Qnil, 0, 0, 0, 32, Qnil, CONVERSION_IDENTICAL);
3352   staticpro (&Vcharset_latin_viscii_upper);
3353   Vcharset_latin_viscii_upper =
3354     make_charset (LEADING_BYTE_LATIN_VISCII_UPPER, Qlatin_viscii_upper, 96, 1,
3355                   1, 1, '2', CHARSET_LEFT_TO_RIGHT,
3356                   build_string ("VISCII upper"),
3357                   build_string ("VISCII upper (Vietnamese)"),
3358                   build_string ("VISCII upper (Vietnamese)"),
3359                   build_string ("MULEVISCII-UPPER"),
3360                   Qnil, 0, 0, 0, 32, Qnil, CONVERSION_IDENTICAL);
3361   staticpro (&Vcharset_latin_viscii);
3362   Vcharset_latin_viscii =
3363     make_charset (LEADING_BYTE_LATIN_VISCII, Qlatin_viscii, 256, 1,
3364                   1, 2, 0, CHARSET_LEFT_TO_RIGHT,
3365                   build_string ("VISCII"),
3366                   build_string ("VISCII 1.1 (Vietnamese)"),
3367                   build_string ("VISCII 1.1 (Vietnamese)"),
3368                   build_string ("VISCII1\\.1"),
3369                   Qnil, 0, 0, 0, 0, Qnil, CONVERSION_IDENTICAL);
3370   staticpro (&Vcharset_chinese_big5);
3371   Vcharset_chinese_big5 =
3372     make_charset (LEADING_BYTE_CHINESE_BIG5, Qmap_big5, 256, 2,
3373                   2, 2, 0, CHARSET_LEFT_TO_RIGHT,
3374                   build_string ("Big5"),
3375                   build_string ("Big5"),
3376                   build_string ("Big5 Chinese traditional"),
3377                   build_string ("big5-0"),
3378                   Qnil,
3379                   MIN_CHAR_BIG5_CDP, MAX_CHAR_BIG5_CDP,
3380                   MIN_CHAR_BIG5_CDP, 0, Qnil, CONVERSION_IDENTICAL);
3381
3382   staticpro (&Vcharset_ethiopic_ucs);
3383   Vcharset_ethiopic_ucs =
3384     make_charset (LEADING_BYTE_ETHIOPIC_UCS, Qethiopic_ucs, 256, 2,
3385                   2, 2, 0, CHARSET_LEFT_TO_RIGHT,
3386                   build_string ("Ethiopic (UCS)"),
3387                   build_string ("Ethiopic (UCS)"),
3388                   build_string ("Ethiopic of UCS"),
3389                   build_string ("Ethiopic-Unicode"),
3390                   Qnil, 0x1200, 0x137F, 0, 0,
3391                   Qnil, CONVERSION_IDENTICAL);
3392 #endif
3393   staticpro (&Vcharset_chinese_big5_1);
3394   Vcharset_chinese_big5_1 =
3395     make_charset (LEADING_BYTE_CHINESE_BIG5_1, Qchinese_big5_1, 94, 2,
3396                   2, 0, '0', CHARSET_LEFT_TO_RIGHT,
3397                   build_string ("Big5"),
3398                   build_string ("Big5 (Level-1)"),
3399                   build_string
3400                   ("Big5 Level-1 Chinese traditional"),
3401                   build_string ("big5"),
3402                   Qnil, 0, 0, 0, 33, /* Qnil, CONVERSION_IDENTICAL */
3403                   Vcharset_chinese_big5, CONVERSION_BIG5_1);
3404   staticpro (&Vcharset_chinese_big5_2);
3405   Vcharset_chinese_big5_2 =
3406     make_charset (LEADING_BYTE_CHINESE_BIG5_2, Qchinese_big5_2, 94, 2,
3407                   2, 0, '1', CHARSET_LEFT_TO_RIGHT,
3408                   build_string ("Big5"),
3409                   build_string ("Big5 (Level-2)"),
3410                   build_string
3411                   ("Big5 Level-2 Chinese traditional"),
3412                   build_string ("big5"),
3413                   Qnil, 0, 0, 0, 33, /* Qnil, CONVERSION_IDENTICAL */
3414                   Vcharset_chinese_big5, CONVERSION_BIG5_2);
3415
3416 #ifdef ENABLE_COMPOSITE_CHARS
3417   /* #### For simplicity, we put composite chars into a 96x96 charset.
3418      This is going to lead to problems because you can run out of
3419      room, esp. as we don't yet recycle numbers. */
3420   staticpro (&Vcharset_composite);
3421   Vcharset_composite =
3422     make_charset (LEADING_BYTE_COMPOSITE, Qcomposite, 96, 2,
3423                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3424                   build_string ("Composite"),
3425                   build_string ("Composite characters"),
3426                   build_string ("Composite characters"),
3427                   build_string (""));
3428
3429   /* #### not dumped properly */
3430   composite_char_row_next = 32;
3431   composite_char_col_next = 32;
3432
3433   Vcomposite_char_string2char_hash_table =
3434     make_lisp_hash_table (500, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL);
3435   Vcomposite_char_char2string_hash_table =
3436     make_lisp_hash_table (500, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
3437   staticpro (&Vcomposite_char_string2char_hash_table);
3438   staticpro (&Vcomposite_char_char2string_hash_table);
3439 #endif /* ENABLE_COMPOSITE_CHARS */
3440
3441 }