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

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