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