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

   1 /* Functions to handle multilingual characters.
   2    Copyright (C) 1992, 1995 Free Software Foundation, Inc.
   3    Copyright (C) 1995 Sun Microsystems, Inc.
   4    Copyright (C) 1999,2000,2001,2002,2003,2004 MORIOKA Tomohiko
   5
   6 This file is part of XEmacs.
   7
   8 XEmacs is free software; you can redistribute it and/or modify it
   9 under the terms of the GNU General Public License as published by the
  10 Free Software Foundation; either version 2, or (at your option) any
  11 later version.
  12
  13 XEmacs is distributed in the hope that it will be useful, but WITHOUT
  14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  15 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  16 for more details.
  17
  18 You should have received a copy of the GNU General Public License
  19 along with XEmacs; see the file COPYING.  If not, write to
  20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  21 Boston, MA 02111-1307, USA.  */
  22
  23 /* Rewritten by Ben Wing <ben@xemacs.org>. */
  24
  25 /* Rewritten by MORIOKA Tomohiko <tomo@m17n.org> for XEmacs CHISE. */
  26
  27 #include <config.h>
  28 #ifdef HAVE_LIBCHISE
  29 #include <chise.h>
  30 #endif
  31 #ifdef UTF2000
  32 #include <limits.h>
  33 #endif
  34 #include "lisp.h"
  35
  36 #include "buffer.h"
  37 #include "chartab.h"
  38 #include "elhash.h"
  39 #include "lstream.h"
  40 #include "device.h"
  41 #include "faces.h"
  42 #include "mule-ccl.h"
  43
  44 /* The various pre-defined charsets. */
  45
  46 Lisp_Object Vcharset_ascii;
  47 Lisp_Object Vcharset_control_1;
  48 Lisp_Object Vcharset_latin_iso8859_1;
  49 Lisp_Object Vcharset_latin_iso8859_2;
  50 Lisp_Object Vcharset_latin_iso8859_3;
  51 Lisp_Object Vcharset_latin_iso8859_4;
  52 Lisp_Object Vcharset_thai_tis620;
  53 Lisp_Object Vcharset_greek_iso8859_7;
  54 Lisp_Object Vcharset_arabic_iso8859_6;
  55 Lisp_Object Vcharset_hebrew_iso8859_8;
  56 Lisp_Object Vcharset_katakana_jisx0201;
  57 Lisp_Object Vcharset_latin_jisx0201;
  58 Lisp_Object Vcharset_cyrillic_iso8859_5;
  59 Lisp_Object Vcharset_latin_iso8859_9;
  60 Lisp_Object Vcharset_japanese_jisx0208_1978;
  61 Lisp_Object Vcharset_chinese_gb2312;
  62 Lisp_Object Vcharset_chinese_gb12345;
  63 Lisp_Object Vcharset_japanese_jisx0208;
  64 Lisp_Object Vcharset_japanese_jisx0208_1990;
  65 Lisp_Object Vcharset_korean_ksc5601;
  66 Lisp_Object Vcharset_japanese_jisx0212;
  67 Lisp_Object Vcharset_chinese_cns11643_1;
  68 Lisp_Object Vcharset_chinese_cns11643_2;
  69 #ifdef UTF2000
  70 Lisp_Object Vcharset_system_char_id;
  71 Lisp_Object Vcharset_ucs;
  72 Lisp_Object Vcharset_ucs_bmp;
  73 Lisp_Object Vcharset_ucs_smp;
  74 Lisp_Object Vcharset_ucs_sip;
  75 Lisp_Object Vcharset_latin_viscii;
  76 Lisp_Object Vcharset_latin_tcvn5712;
  77 Lisp_Object Vcharset_latin_viscii_lower;
  78 Lisp_Object Vcharset_latin_viscii_upper;
  79 Lisp_Object Vcharset_jis_x0208;
  80 Lisp_Object Vcharset_chinese_big5;
  81 Lisp_Object Vcharset_ethiopic_ucs;
  82 #endif
  83 Lisp_Object Vcharset_chinese_big5_1;
  84 Lisp_Object Vcharset_chinese_big5_2;
  85
  86 #ifdef ENABLE_COMPOSITE_CHARS
  87 Lisp_Object Vcharset_composite;
  88
  89 /* Hash tables for composite chars.  One maps string representing
  90    composed chars to their equivalent chars; one goes the
  91    other way. */
  92 Lisp_Object Vcomposite_char_char2string_hash_table;
  93 Lisp_Object Vcomposite_char_string2char_hash_table;
  94
  95 static int composite_char_row_next;
  96 static int composite_char_col_next;
  97
  98 #endif /* ENABLE_COMPOSITE_CHARS */
  99
 100 struct charset_lookup *chlook;
 101
 102 static const struct lrecord_description charset_lookup_description_1[] = {
 103   { XD_LISP_OBJECT_ARRAY, offsetof (struct charset_lookup, charset_by_leading_byte),
 104 #ifdef UTF2000
 105     NUM_LEADING_BYTES+4*128
 106 #else
 107     128+4*128*2
 108 #endif
 109   }, { XD_END }
 110 };
 111
 112 static const struct struct_description charset_lookup_description = {
 113   sizeof (struct charset_lookup),
 114   charset_lookup_description_1
 115 };
 116
 117 #ifndef UTF2000
 118 /* Table of number of bytes in the string representation of a character
 119    indexed by the first byte of that representation.
 120
 121    rep_bytes_by_first_byte(c) is more efficient than the equivalent
 122    canonical computation:
 123
 124    XCHARSET_REP_BYTES (CHARSET_BY_LEADING_BYTE (c)) */
 125
 126 const Bytecount rep_bytes_by_first_byte[0xA0] =
 127 { /* 0x00 - 0x7f are for straight ASCII */
 128   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
 129   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
 130   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
 131   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
 132   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
 133   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
 134   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
 135   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
 136   /* 0x80 - 0x8f are for Dimension-1 official charsets */
 137 #ifdef CHAR_IS_UCS4
 138   2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3,
 139 #else
 140   2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
 141 #endif
 142   /* 0x90 - 0x9d are for Dimension-2 official charsets */
 143   /* 0x9e is for Dimension-1 private charsets */
 144   /* 0x9f is for Dimension-2 private charsets */
 145   3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4
 146 };
 147 #endif
 148
 149 #ifdef UTF2000
 150
 151 int decoding_table_check_elements (Lisp_Object v, int dim, int ccs_len);
 152 int
 153 decoding_table_check_elements (Lisp_Object v, int dim, int ccs_len)
 154 {
 155   int i;
 156
 157   if (XVECTOR_LENGTH (v) > ccs_len)
 158     return -1;
 159
 160   for (i = 0; i < XVECTOR_LENGTH (v); i++)
 161     {
 162       Lisp_Object c = XVECTOR_DATA(v)[i];
 163
 164       if (!NILP (c) && !CHARP (c))
 165         {
 166           if (VECTORP (c))
 167             {
 168               int ret = decoding_table_check_elements (c, dim - 1, ccs_len);
 169               if (ret)
 170                 return ret;
 171             }
 172           else
 173             return -2;
 174         }
 175     }
 176   return 0;
 177 }
 178
 179 Lisp_Object
 180 put_char_ccs_code_point (Lisp_Object character,
 181                          Lisp_Object ccs, Lisp_Object value)
 182 {
 183   if (!EQ (XCHARSET_NAME (ccs), Qmap_ucs)
 184       || !INTP (value)
 185       || (XCHAR (character) != XINT (value)))
 186     {
 187       Lisp_Object v = XCHARSET_DECODING_TABLE (ccs);
 188       int code_point;
 189
 190       if (CONSP (value))
 191         { /* obsolete representation: value must be a list of bytes */
 192           Lisp_Object ret = Fcar (value);
 193           Lisp_Object rest;
 194
 195           if (!INTP (ret))
 196             signal_simple_error ("Invalid value for coded-charset", value);
 197           code_point = XINT (ret);
 198           if (XCHARSET_GRAPHIC (ccs) == 1)
 199             code_point &= 0x7F;
 200           rest = Fcdr (value);
 201           while (!NILP (rest))
 202             {
 203               int j;
 204
 205               if (!CONSP (rest))
 206                 signal_simple_error ("Invalid value for coded-charset",
 207                                      value);
 208               ret = Fcar (rest);
 209               if (!INTP (ret))
 210                 signal_simple_error ("Invalid value for coded-charset",
 211                                      value);
 212               j = XINT (ret);
 213               if (XCHARSET_GRAPHIC (ccs) == 1)
 214                 j &= 0x7F;
 215               code_point = (code_point << 8) | j;
 216               rest = Fcdr (rest);
 217             }
 218           value = make_int (code_point);
 219         }
 220       else if (INTP (value))
 221         {
 222           code_point = XINT (value);
 223           if (XCHARSET_GRAPHIC (ccs) == 1)
 224             {
 225               code_point &= 0x7F7F7F7F;
 226               value = make_int (code_point);
 227             }
 228         }
 229       else
 230         signal_simple_error ("Invalid value for coded-charset", value);
 231
 232       if (VECTORP (v))
 233         {
 234           Lisp_Object cpos = Fget_char_attribute (character, ccs, Qnil);
 235           if (INTP (cpos))
 236             {
 237               decoding_table_remove_char (ccs, XINT (cpos));
 238             }
 239         }
 240       decoding_table_put_char (ccs, code_point, character);
 241     }
 242   return value;
 243 }
 244
 245 Lisp_Object
 246 remove_char_ccs (Lisp_Object character, Lisp_Object ccs)
 247 {
 248   Lisp_Object decoding_table = XCHARSET_DECODING_TABLE (ccs);
 249   Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (ccs);
 250
 251   if (VECTORP (decoding_table))
 252     {
 253       Lisp_Object cpos = Fget_char_attribute (character, ccs, Qnil);
 254
 255       if (!NILP (cpos))
 256         {
 257           decoding_table_remove_char (ccs, XINT (cpos));
 258         }
 259     }
 260   if (CHAR_TABLEP (encoding_table))
 261     {
 262       put_char_id_table (XCHAR_TABLE(encoding_table), character, Qunbound);
 263     }
 264   return Qt;
 265 }
 266
 267 #endif
 268
 269 #ifndef UTF2000
 270 int leading_code_private_11;
 271 #endif
 272
 273 Lisp_Object Qcharsetp;
 274
 275 /* Qdoc_string, Qdimension, Qchars defined in general.c */
 276 Lisp_Object Qregistry, Qfinal, Qgraphic;
 277 Lisp_Object Qdirection;
 278 Lisp_Object Qreverse_direction_charset;
 279 Lisp_Object Qleading_byte;
 280 Lisp_Object Qshort_name, Qlong_name;
 281 Lisp_Object Qiso_ir;
 282 #ifdef UTF2000
 283 Lisp_Object Qmin_code, Qmax_code, Qcode_offset;
 284 Lisp_Object Qmother, Qconversion, Q94x60, Q94x94x60, Qbig5_1, Qbig5_2;
 285 #endif
 286
 287 Lisp_Object Qascii,
 288   Qcontrol_1,
 289   Qlatin_iso8859_1,
 290   Qlatin_iso8859_2,
 291   Qlatin_iso8859_3,
 292   Qlatin_iso8859_4,
 293   Qthai_tis620,
 294   Qgreek_iso8859_7,
 295   Qarabic_iso8859_6,
 296   Qhebrew_iso8859_8,
 297   Qkatakana_jisx0201,
 298   Qlatin_jisx0201,
 299   Qcyrillic_iso8859_5,
 300   Qlatin_iso8859_9,
 301   Qmap_jis_x0208_1978,
 302   Qmap_gb2312,
 303   Qmap_gb12345,
 304   Qmap_jis_x0208_1983,
 305   Qmap_ks_x1001,
 306   Qmap_jis_x0212,
 307   Qmap_cns11643_1,
 308   Qmap_cns11643_2,
 309 #ifdef UTF2000
 310   Qmap_ucs, Qucs,
 311   Qucs_bmp,
 312   Qucs_smp,
 313   Qucs_sip,
 314   Qlatin_viscii,
 315   Qlatin_tcvn5712,
 316   Qlatin_viscii_lower,
 317   Qlatin_viscii_upper,
 318   Qvietnamese_viscii_lower,
 319   Qvietnamese_viscii_upper,
 320   Qmap_jis_x0208,
 321   Qmap_jis_x0208_1990,
 322   Qmap_big5,
 323   Qethiopic_ucs,
 324 #endif
 325   Qchinese_big5_1,
 326   Qchinese_big5_2,
 327   Qcomposite;
 328
 329 Lisp_Object Ql2r, Qr2l;
 330
 331 Lisp_Object Vcharset_hash_table;
 332
 333 /* Composite characters are characters constructed by overstriking two
 334    or more regular characters.
 335
 336    1) The old Mule implementation involves storing composite characters
 337       in a buffer as a tag followed by all of the actual characters
 338       used to make up the composite character.  I think this is a bad
 339       idea; it greatly complicates code that wants to handle strings
 340       one character at a time because it has to deal with the possibility
 341       of great big ungainly characters.  It's much more reasonable to
 342       simply store an index into a table of composite characters.
 343
 344    2) The current implementation only allows for 16,384 separate
 345       composite characters over the lifetime of the XEmacs process.
 346       This could become a potential problem if the user
 347       edited lots of different files that use composite characters.
 348       Due to FSF bogosity, increasing the number of allowable
 349       composite characters under Mule would decrease the number
 350       of possible faces that can exist.  Mule already has shrunk
 351       this to 2048, and further shrinkage would become uncomfortable.
 352       No such problems exist in XEmacs.
 353
 354       Composite characters could be represented as 0x80 C1 C2 C3,
 355       where each C[1-3] is in the range 0xA0 - 0xFF.  This allows
 356       for slightly under 2^20 (one million) composite characters
 357       over the XEmacs process lifetime, and you only need to
 358       increase the size of a Mule character from 19 to 21 bits.
 359       Or you could use 0x80 C1 C2 C3 C4, allowing for about
 360       85 million (slightly over 2^26) composite characters. */
 361
 362 \f
 363 /************************************************************************/
 364 /*                       Basic Emchar functions                         */
 365 /************************************************************************/
 366
 367 /* Convert a non-ASCII Mule character C into a one-character Mule-encoded
 368    string in STR.  Returns the number of bytes stored.
 369    Do not call this directly.  Use the macro set_charptr_emchar() instead.
 370  */
 371
 372 Bytecount
 373 non_ascii_set_charptr_emchar (Bufbyte *str, Emchar c)
 374 {
 375   Bufbyte *p;
 376 #ifndef UTF2000
 377   Charset_ID lb;
 378   int c1, c2;
 379   Lisp_Object charset;
 380 #endif
 381
 382   p = str;
 383 #ifdef UTF2000
 384   if ( c <= 0x7f )
 385     {
 386       *p++ = c;
 387     }
 388   else if ( c <= 0x7ff )
 389     {
 390       *p++ = (c >> 6) | 0xc0;
 391       *p++ = (c & 0x3f) | 0x80;
 392     }
 393   else if ( c <= 0xffff )
 394     {
 395       *p++ =  (c >> 12) | 0xe0;
 396       *p++ = ((c >>  6) & 0x3f) | 0x80;
 397       *p++ =  (c        & 0x3f) | 0x80;
 398     }
 399   else if ( c <= 0x1fffff )
 400     {
 401       *p++ =  (c >> 18) | 0xf0;
 402       *p++ = ((c >> 12) & 0x3f) | 0x80;
 403       *p++ = ((c >>  6) & 0x3f) | 0x80;
 404       *p++ =  (c        & 0x3f) | 0x80;
 405     }
 406   else if ( c <= 0x3ffffff )
 407     {
 408       *p++ =  (c >> 24) | 0xf8;
 409       *p++ = ((c >> 18) & 0x3f) | 0x80;
 410       *p++ = ((c >> 12) & 0x3f) | 0x80;
 411       *p++ = ((c >>  6) & 0x3f) | 0x80;
 412       *p++ =  (c        & 0x3f) | 0x80;
 413     }
 414   else
 415     {
 416       *p++ =  (c >> 30) | 0xfc;
 417       *p++ = ((c >> 24) & 0x3f) | 0x80;
 418       *p++ = ((c >> 18) & 0x3f) | 0x80;
 419       *p++ = ((c >> 12) & 0x3f) | 0x80;
 420       *p++ = ((c >>  6) & 0x3f) | 0x80;
 421       *p++ =  (c        & 0x3f) | 0x80;
 422     }
 423 #else
 424   BREAKUP_CHAR (c, charset, c1, c2);
 425   lb = CHAR_LEADING_BYTE (c);
 426   if (LEADING_BYTE_PRIVATE_P (lb))
 427     *p++ = PRIVATE_LEADING_BYTE_PREFIX (lb);
 428   *p++ = lb;
 429   if (EQ (charset, Vcharset_control_1))
 430     c1 += 0x20;
 431   *p++ = c1 | 0x80;
 432   if (c2)
 433     *p++ = c2 | 0x80;
 434 #endif
 435   return (p - str);
 436 }
 437
 438 /* Return the first character from a Mule-encoded string in STR,
 439    assuming it's non-ASCII.  Do not call this directly.
 440    Use the macro charptr_emchar() instead. */
 441
 442 Emchar
 443 non_ascii_charptr_emchar (const Bufbyte *str)
 444 {
 445 #ifdef UTF2000
 446   Bufbyte b;
 447   Emchar ch;
 448   int len;
 449
 450   b = *str++;
 451   if ( b >= 0xfc )
 452     {
 453       ch = (b & 0x01);
 454       len = 5;
 455     }
 456   else if ( b >= 0xf8 )
 457     {
 458       ch = b & 0x03;
 459       len = 4;
 460     }
 461   else if ( b >= 0xf0 )
 462     {
 463       ch = b & 0x07;
 464       len = 3;
 465     }
 466   else if ( b >= 0xe0 )
 467     {
 468       ch = b & 0x0f;
 469       len = 2;
 470     }
 471   else if ( b >= 0xc0 )
 472     {
 473       ch = b & 0x1f;
 474       len = 1;
 475     }
 476   else
 477     {
 478       ch = b;
 479       len = 0;
 480     }
 481   for( ; len > 0; len-- )
 482     {
 483       b = *str++;
 484       ch = ( ch << 6 ) | ( b & 0x3f );
 485     }
 486   return ch;
 487 #else
 488   Bufbyte i0 = *str, i1, i2 = 0;
 489   Lisp_Object charset;
 490
 491   if (i0 == LEADING_BYTE_CONTROL_1)
 492     return (Emchar) (*++str - 0x20);
 493
 494   if (LEADING_BYTE_PREFIX_P (i0))
 495     i0 = *++str;
 496
 497   i1 = *++str & 0x7F;
 498
 499   charset = CHARSET_BY_LEADING_BYTE (i0);
 500   if (XCHARSET_DIMENSION (charset) == 2)
 501     i2 = *++str & 0x7F;
 502
 503   return MAKE_CHAR (charset, i1, i2);
 504 #endif
 505 }
 506
 507 /* Return whether CH is a valid Emchar, assuming it's non-ASCII.
 508    Do not call this directly.  Use the macro valid_char_p() instead. */
 509
 510 #ifndef UTF2000
 511 int
 512 non_ascii_valid_char_p (Emchar ch)
 513 {
 514   int f1, f2, f3;
 515
 516   /* Must have only lowest 19 bits set */
 517   if (ch & ~0x7FFFF)
 518     return 0;
 519
 520   f1 = CHAR_FIELD1 (ch);
 521   f2 = CHAR_FIELD2 (ch);
 522   f3 = CHAR_FIELD3 (ch);
 523
 524   if (f1 == 0)
 525     {
 526       Lisp_Object charset;
 527
 528       if (f2 < MIN_CHAR_FIELD2_OFFICIAL ||
 529           (f2 > MAX_CHAR_FIELD2_OFFICIAL && f2 < MIN_CHAR_FIELD2_PRIVATE) ||
 530            f2 > MAX_CHAR_FIELD2_PRIVATE)
 531         return 0;
 532       if (f3 < 0x20)
 533         return 0;
 534
 535       if (f3 != 0x20 && f3 != 0x7F && !(f2 >= MIN_CHAR_FIELD2_PRIVATE &&
 536                                         f2 <= MAX_CHAR_FIELD2_PRIVATE))
 537         return 1;
 538
 539       /*
 540          NOTE: This takes advantage of the fact that
 541          FIELD2_TO_OFFICIAL_LEADING_BYTE and
 542          FIELD2_TO_PRIVATE_LEADING_BYTE are the same.
 543          */
 544       charset = CHARSET_BY_LEADING_BYTE (f2 + FIELD2_TO_OFFICIAL_LEADING_BYTE);
 545       if (EQ (charset, Qnil))
 546         return 0;
 547       return (XCHARSET_CHARS (charset) == 96);
 548     }
 549   else
 550     {
 551       Lisp_Object charset;
 552
 553       if (f1 < MIN_CHAR_FIELD1_OFFICIAL ||
 554           (f1 > MAX_CHAR_FIELD1_OFFICIAL && f1 < MIN_CHAR_FIELD1_PRIVATE) ||
 555           f1 > MAX_CHAR_FIELD1_PRIVATE)
 556         return 0;
 557       if (f2 < 0x20 || f3 < 0x20)
 558         return 0;
 559
 560 #ifdef ENABLE_COMPOSITE_CHARS
 561       if (f1 + FIELD1_TO_OFFICIAL_LEADING_BYTE == LEADING_BYTE_COMPOSITE)
 562         {
 563           if (UNBOUNDP (Fgethash (make_int (ch),
 564                                   Vcomposite_char_char2string_hash_table,
 565                                   Qunbound)))
 566             return 0;
 567           return 1;
 568         }
 569 #endif /* ENABLE_COMPOSITE_CHARS */
 570
 571       if (f2 != 0x20 && f2 != 0x7F && f3 != 0x20 && f3 != 0x7F
 572           && !(f1 >= MIN_CHAR_FIELD1_PRIVATE && f1 <= MAX_CHAR_FIELD1_PRIVATE))
 573         return 1;
 574
 575       if (f1 <= MAX_CHAR_FIELD1_OFFICIAL)
 576         charset =
 577           CHARSET_BY_LEADING_BYTE (f1 + FIELD1_TO_OFFICIAL_LEADING_BYTE);
 578       else
 579         charset =
 580           CHARSET_BY_LEADING_BYTE (f1 + FIELD1_TO_PRIVATE_LEADING_BYTE);
 581
 582       if (EQ (charset, Qnil))
 583         return 0;
 584       return (XCHARSET_CHARS (charset) == 96);
 585     }
 586 }
 587 #endif
 588
 589 \f
 590 /************************************************************************/
 591 /*                       Basic string functions                         */
 592 /************************************************************************/
 593
 594 /* Copy the character pointed to by SRC into DST.  Do not call this
 595    directly.  Use the macro charptr_copy_char() instead.
 596    Return the number of bytes copied.  */
 597
 598 Bytecount
 599 non_ascii_charptr_copy_char (const Bufbyte *src, Bufbyte *dst)
 600 {
 601   unsigned int bytes = REP_BYTES_BY_FIRST_BYTE (*src);
 602   unsigned int i;
 603   for (i = bytes; i; i--, dst++, src++)
 604     *dst = *src;
 605   return bytes;
 606 }
 607
 608 \f
 609 /************************************************************************/
 610 /*                        streams of Emchars                            */
 611 /************************************************************************/
 612
 613 /* Treat a stream as a stream of Emchar's rather than a stream of bytes.
 614    The functions below are not meant to be called directly; use
 615    the macros in insdel.h. */
 616
 617 Emchar
 618 Lstream_get_emchar_1 (Lstream *stream, int ch)
 619 {
 620   Bufbyte str[MAX_EMCHAR_LEN];
 621   Bufbyte *strptr = str;
 622   unsigned int bytes;
 623
 624   str[0] = (Bufbyte) ch;
 625
 626   for (bytes = REP_BYTES_BY_FIRST_BYTE (ch) - 1; bytes; bytes--)
 627     {
 628       int c = Lstream_getc (stream);
 629       bufpos_checking_assert (c >= 0);
 630       *++strptr = (Bufbyte) c;
 631     }
 632   return charptr_emchar (str);
 633 }
 634
 635 int
 636 Lstream_fput_emchar (Lstream *stream, Emchar ch)
 637 {
 638   Bufbyte str[MAX_EMCHAR_LEN];
 639   Bytecount len = set_charptr_emchar (str, ch);
 640   return Lstream_write (stream, str, len);
 641 }
 642
 643 void
 644 Lstream_funget_emchar (Lstream *stream, Emchar ch)
 645 {
 646   Bufbyte str[MAX_EMCHAR_LEN];
 647   Bytecount len = set_charptr_emchar (str, ch);
 648   Lstream_unread (stream, str, len);
 649 }
 650
 651 \f
 652 /************************************************************************/
 653 /*                            charset object                            */
 654 /************************************************************************/
 655
 656 static Lisp_Object
 657 mark_charset (Lisp_Object obj)
 658 {
 659   Lisp_Charset *cs = XCHARSET (obj);
 660
 661   mark_object (cs->short_name);
 662   mark_object (cs->long_name);
 663   mark_object (cs->doc_string);
 664   mark_object (cs->registry);
 665   mark_object (cs->ccl_program);
 666 #ifdef UTF2000
 667   mark_object (cs->decoding_table);
 668   mark_object (cs->mother);
 669 #endif
 670   return cs->name;
 671 }
 672
 673 static void
 674 print_charset (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
 675 {
 676   Lisp_Charset *cs = XCHARSET (obj);
 677   char buf[200];
 678
 679   if (print_readably)
 680     error ("printing unreadable object #<charset %s 0x%x>",
 681            string_data (XSYMBOL (CHARSET_NAME (cs))->name),
 682            cs->header.uid);
 683
 684   write_c_string ("#<charset ", printcharfun);
 685   print_internal (CHARSET_NAME (cs), printcharfun, 0);
 686   write_c_string (" ", printcharfun);
 687   print_internal (CHARSET_SHORT_NAME (cs), printcharfun, 1);
 688   write_c_string (" ", printcharfun);
 689   print_internal (CHARSET_LONG_NAME (cs), printcharfun, 1);
 690   write_c_string (" ", printcharfun);
 691   print_internal (CHARSET_DOC_STRING (cs), printcharfun, 1);
 692   sprintf (buf, " %d^%d %s cols=%d g%d final='%c' reg=",
 693            CHARSET_CHARS (cs),
 694            CHARSET_DIMENSION (cs),
 695            CHARSET_DIRECTION (cs) == CHARSET_LEFT_TO_RIGHT ? "l2r" : "r2l",
 696            CHARSET_COLUMNS (cs),
 697            CHARSET_GRAPHIC (cs),
 698            CHARSET_FINAL (cs));
 699   write_c_string (buf, printcharfun);
 700   print_internal (CHARSET_REGISTRY (cs), printcharfun, 0);
 701   sprintf (buf, " 0x%x>", cs->header.uid);
 702   write_c_string (buf, printcharfun);
 703 }
 704
 705 static const struct lrecord_description charset_description[] = {
 706   { XD_LISP_OBJECT, offsetof (Lisp_Charset, name) },
 707   { XD_LISP_OBJECT, offsetof (Lisp_Charset, doc_string) },
 708   { XD_LISP_OBJECT, offsetof (Lisp_Charset, registry) },
 709   { XD_LISP_OBJECT, offsetof (Lisp_Charset, short_name) },
 710   { XD_LISP_OBJECT, offsetof (Lisp_Charset, long_name) },
 711   { XD_LISP_OBJECT, offsetof (Lisp_Charset, reverse_direction_charset) },
 712   { XD_LISP_OBJECT, offsetof (Lisp_Charset, ccl_program) },
 713 #ifdef UTF2000
 714   { XD_LISP_OBJECT, offsetof (Lisp_Charset, decoding_table) },
 715   { XD_LISP_OBJECT, offsetof (Lisp_Charset, mother) },
 716 #endif
 717   { XD_END }
 718 };
 719
 720 DEFINE_LRECORD_IMPLEMENTATION ("charset", charset,
 721                                mark_charset, print_charset, 0, 0, 0,
 722                                charset_description,
 723                                Lisp_Charset);
 724
 725 /* Make a new charset. */
 726 /* #### SJT Should generic properties be allowed? */
 727 static Lisp_Object
 728 make_charset (Charset_ID id, Lisp_Object name,
 729               unsigned short chars, unsigned char dimension,
 730               unsigned char columns, unsigned char graphic,
 731               Bufbyte final, unsigned char direction, Lisp_Object short_name,
 732               Lisp_Object long_name, Lisp_Object doc,
 733               Lisp_Object reg,
 734               Lisp_Object decoding_table,
 735               Emchar min_code, Emchar max_code,
 736               Emchar code_offset, unsigned char byte_offset,
 737               Lisp_Object mother, unsigned char conversion)
 738 {
 739   Lisp_Object obj;
 740   Lisp_Charset *cs = alloc_lcrecord_type (Lisp_Charset, &lrecord_charset);
 741
 742   zero_lcrecord (cs);
 743
 744   XSETCHARSET (obj, cs);
 745
 746   CHARSET_ID            (cs) = id;
 747   CHARSET_NAME          (cs) = name;
 748   CHARSET_SHORT_NAME    (cs) = short_name;
 749   CHARSET_LONG_NAME     (cs) = long_name;
 750   CHARSET_CHARS         (cs) = chars;
 751   CHARSET_DIMENSION     (cs) = dimension;
 752   CHARSET_DIRECTION     (cs) = direction;
 753   CHARSET_COLUMNS       (cs) = columns;
 754   CHARSET_GRAPHIC       (cs) = graphic;
 755   CHARSET_FINAL         (cs) = final;
 756   CHARSET_DOC_STRING    (cs) = doc;
 757   CHARSET_REGISTRY      (cs) = reg;
 758   CHARSET_CCL_PROGRAM   (cs) = Qnil;
 759   CHARSET_REVERSE_DIRECTION_CHARSET (cs) = Qnil;
 760 #ifdef UTF2000
 761   CHARSET_DECODING_TABLE(cs) = Qunbound;
 762   CHARSET_MIN_CODE      (cs) = min_code;
 763   CHARSET_MAX_CODE      (cs) = max_code;
 764   CHARSET_CODE_OFFSET   (cs) = code_offset;
 765   CHARSET_BYTE_OFFSET   (cs) = byte_offset;
 766   CHARSET_MOTHER        (cs) = mother;
 767   CHARSET_CONVERSION    (cs) = conversion;
 768 #endif
 769
 770 #ifndef UTF2000
 771   if (id == LEADING_BYTE_ASCII)
 772     CHARSET_REP_BYTES (cs) = 1;
 773   else if (id < 0xA0)
 774     CHARSET_REP_BYTES (cs) = CHARSET_DIMENSION (cs) + 1;
 775   else
 776     CHARSET_REP_BYTES (cs) = CHARSET_DIMENSION (cs) + 2;
 777 #endif
 778
 779   if (final)
 780     {
 781       /* some charsets do not have final characters.  This includes
 782          ASCII, Control-1, Composite, and the two faux private
 783          charsets. */
 784       unsigned char iso2022_type
 785         = (dimension == 1 ? 0 : 2) + (chars == 94 ? 0 : 1);
 786 #if UTF2000
 787       if (code_offset == 0)
 788         {
 789           assert (NILP (chlook->charset_by_attributes[iso2022_type][final]));
 790           chlook->charset_by_attributes[iso2022_type][final] = obj;
 791         }
 792 #else
 793       assert (NILP
 794               (chlook->charset_by_attributes[iso2022_type][final][direction]));
 795       chlook->charset_by_attributes[iso2022_type][final][direction] = obj;
 796 #endif
 797     }
 798
 799   assert (NILP (chlook->charset_by_leading_byte[id - MIN_LEADING_BYTE]));
 800   chlook->charset_by_leading_byte[id - MIN_LEADING_BYTE] = obj;
 801
 802   /* Some charsets are "faux" and don't have names or really exist at
 803      all except in the leading-byte table. */
 804   if (!NILP (name))
 805     Fputhash (name, obj, Vcharset_hash_table);
 806   return obj;
 807 }
 808
 809 static int
 810 get_unallocated_leading_byte (int dimension)
 811 {
 812   Charset_ID lb;
 813
 814 #ifdef UTF2000
 815   if (chlook->next_allocated_leading_byte > MAX_LEADING_BYTE_PRIVATE)
 816     lb = 0;
 817   else
 818     lb = chlook->next_allocated_leading_byte++;
 819 #else
 820   if (dimension == 1)
 821     {
 822       if (chlook->next_allocated_1_byte_leading_byte > MAX_LEADING_BYTE_PRIVATE_1)
 823         lb = 0;
 824       else
 825         lb = chlook->next_allocated_1_byte_leading_byte++;
 826     }
 827   else
 828     {
 829       if (chlook->next_allocated_2_byte_leading_byte > MAX_LEADING_BYTE_PRIVATE_2)
 830         lb = 0;
 831       else
 832         lb = chlook->next_allocated_2_byte_leading_byte++;
 833     }
 834 #endif
 835
 836   if (!lb)
 837     signal_simple_error
 838       ("No more character sets free for this dimension",
 839        make_int (dimension));
 840
 841   return lb;
 842 }
 843
 844 #ifdef UTF2000
 845 /* Number of Big5 characters which have the same code in 1st byte.  */
 846
 847 #define BIG5_SAME_ROW (0xFF - 0xA1 + 0x7F - 0x40)
 848
 849 static int
 850 decode_ccs_conversion (int conv_type, int code_point)
 851 {
 852   if ( conv_type == CONVERSION_IDENTICAL )
 853     {
 854       return code_point;
 855     }
 856   if ( conv_type == CONVERSION_94x60 )
 857     {
 858       int row = code_point >> 8;
 859       int cell = code_point & 255;
 860
 861       if (row < 16 + 32)
 862         return -1;
 863       else if (row < 16 + 32 + 30)
 864         return (row - (16 + 32)) * 94 + cell - 33;
 865       else if (row < 18 + 32 + 30)
 866         return -1;
 867       else if (row < 18 + 32 + 60)
 868         return (row - (18 + 32)) * 94 + cell - 33;
 869     }
 870   else if ( conv_type == CONVERSION_94x94x60 )
 871     {
 872       int plane = code_point >> 16;
 873       int row = (code_point >> 8) & 255;
 874       int cell = code_point & 255;
 875
 876       if (row < 16 + 32)
 877         return -1;
 878       else if (row < 16 + 32 + 30)
 879         return
 880           (plane - 33) * 94 * 60
 881           + (row - (16 + 32)) * 94
 882           + cell - 33;
 883       else if (row < 18 + 32 + 30)
 884         return -1;
 885       else if (row < 18 + 32 + 60)
 886         return
 887           (plane - 33) * 94 * 60
 888           + (row - (18 + 32)) * 94
 889           + cell - 33;
 890     }
 891   else if ( conv_type == CONVERSION_BIG5_1 )
 892     {
 893       unsigned int I
 894         = (((code_point >> 8) & 0x7F) - 33) * 94
 895         + (( code_point       & 0x7F) - 33);
 896       unsigned char b1 = I / (0xFF - 0xA1 + 0x7F - 0x40) + 0xA1;
 897       unsigned char b2 = I % (0xFF - 0xA1 + 0x7F - 0x40);
 898
 899       b2 += b2 < 0x3F ? 0x40 : 0x62;
 900       return (b1 << 8) | b2;
 901     }
 902   else if ( conv_type == CONVERSION_BIG5_2 )
 903     {
 904       unsigned int I
 905         = (((code_point >> 8) & 0x7F) - 33) * 94
 906         + (( code_point       & 0x7F) - 33)
 907         + BIG5_SAME_ROW * (0xC9 - 0xA1);
 908       unsigned char b1 = I / (0xFF - 0xA1 + 0x7F - 0x40) + 0xA1;
 909       unsigned char b2 = I % (0xFF - 0xA1 + 0x7F - 0x40);
 910
 911       b2 += b2 < 0x3F ? 0x40 : 0x62;
 912       return (b1 << 8) | b2;
 913     }
 914   return -1;
 915 }
 916
 917 Emchar
 918 decode_defined_char (Lisp_Object ccs, int code_point, int without_inheritance)
 919 {
 920   int dim = XCHARSET_DIMENSION (ccs);
 921   Lisp_Object decoding_table = XCHARSET_DECODING_TABLE (ccs);
 922   Emchar char_id = -1;
 923   Lisp_Object mother;
 924
 925   while (dim > 0)
 926     {
 927       dim--;
 928       decoding_table
 929         = get_ccs_octet_table (decoding_table, ccs,
 930                                (code_point >> (dim * 8)) & 255);
 931     }
 932   if (CHARP (decoding_table))
 933     return XCHAR (decoding_table);
 934 #ifdef HAVE_CHISE
 935   if (EQ (decoding_table, Qunloaded))
 936     {
 937       char_id = load_char_decoding_entry_maybe (ccs, code_point);
 938     }
 939 #endif /* HAVE_CHISE */
 940   if (char_id >= 0)
 941     return char_id;
 942   else if ( !without_inheritance
 943             && CHARSETP (mother = XCHARSET_MOTHER (ccs)) )
 944     {
 945       int code
 946         = decode_ccs_conversion (XCHARSET_CONVERSION (ccs), code_point);
 947
 948       if (code >= 0)
 949         {
 950           code += XCHARSET_CODE_OFFSET(ccs);
 951           if ( EQ (mother, Vcharset_ucs) )
 952             return DECODE_CHAR (mother, code, without_inheritance);
 953           else
 954             return decode_defined_char (mother, code,
 955                                         without_inheritance);
 956         }
 957     }
 958   return -1;
 959 }
 960
 961 Emchar
 962 decode_builtin_char (Lisp_Object charset, int code_point)
 963 {
 964   Lisp_Object mother = XCHARSET_MOTHER (charset);
 965   int final;
 966
 967   if ( XCHARSET_MAX_CODE (charset) > 0 )
 968     {
 969       if ( CHARSETP (mother) )
 970         {
 971           int code
 972             = decode_ccs_conversion (XCHARSET_CONVERSION (charset),
 973                                      code_point);
 974
 975           if (code >= 0)
 976             return
 977               decode_builtin_char (mother,
 978                                    code + XCHARSET_CODE_OFFSET(charset));
 979           else
 980             return -1;
 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, 4, 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 WITHOUT_INHERITANCE is non-nil, inherited character is not returned.
2377 If corresponding character is not found, nil is returned.
2378 */
2379        (charset, code, defined_only, without_inheritance))
2380 {
2381   int c;
2382
2383   charset = Fget_charset (charset);
2384   CHECK_INT (code);
2385   c = XINT (code);
2386   if (XCHARSET_GRAPHIC (charset) == 1)
2387     c &= 0x7F7F7F7F;
2388   if (NILP (defined_only))
2389     c = DECODE_CHAR (charset, c, !NILP (without_inheritance));
2390   else
2391     c = decode_defined_char (charset, c, !NILP (without_inheritance));
2392   return c >= 0 ? make_char (c) : Qnil;
2393 }
2394
2395 DEFUN ("decode-builtin-char", Fdecode_builtin_char, 2, 2, 0, /*
2396 Make a builtin character from CHARSET and code-point CODE.
2397 */
2398        (charset, code))
2399 {
2400   int c;
2401
2402   charset = Fget_charset (charset);
2403   CHECK_INT (code);
2404   if (EQ (charset, Vcharset_latin_viscii))
2405     {
2406       Lisp_Object chr = Fdecode_char (charset, code, Qnil, Qnil);
2407       Lisp_Object ret;
2408
2409       if (!NILP (chr))
2410         {
2411           if (!NILP
2412               (ret = Fget_char_attribute (chr,
2413                                           Vcharset_latin_viscii_lower,
2414                                           Qnil)))
2415             {
2416               charset = Vcharset_latin_viscii_lower;
2417               code = ret;
2418             }
2419           else if (!NILP
2420                    (ret = Fget_char_attribute (chr,
2421                                                Vcharset_latin_viscii_upper,
2422                                                Qnil)))
2423             {
2424               charset = Vcharset_latin_viscii_upper;
2425               code = ret;
2426             }
2427         }
2428     }
2429   c = XINT (code);
2430 #if 0
2431   if (XCHARSET_GRAPHIC (charset) == 1)
2432     c &= 0x7F7F7F7F;
2433 #endif
2434   c = decode_builtin_char (charset, c);
2435   return
2436     c >= 0 ? make_char (c) : Fdecode_char (charset, code, Qnil, Qnil);
2437 }
2438 #endif
2439
2440 DEFUN ("make-char", Fmake_char, 2, 3, 0, /*
2441 Make a character from CHARSET and octets ARG1 and ARG2.
2442 ARG2 is required only for characters from two-dimensional charsets.
2443 For example, (make-char 'latin-iso8859-2 185) will return the Latin 2
2444 character s with caron.
2445 */
2446        (charset, arg1, arg2))
2447 {
2448   Lisp_Charset *cs;
2449   int a1, a2;
2450   int lowlim, highlim;
2451
2452   charset = Fget_charset (charset);
2453   cs = XCHARSET (charset);
2454
2455   if      (EQ (charset, Vcharset_ascii))     lowlim =  0, highlim = 127;
2456   else if (EQ (charset, Vcharset_control_1)) lowlim =  0, highlim =  31;
2457 #ifdef UTF2000
2458   else if (CHARSET_CHARS (cs) == 256)        lowlim =  0, highlim = 255;
2459 #endif
2460   else if (CHARSET_CHARS (cs) == 94)         lowlim = 33, highlim = 126;
2461   else  /* CHARSET_CHARS (cs) == 96) */      lowlim = 32, highlim = 127;
2462
2463   CHECK_INT (arg1);
2464   /* It is useful (and safe, according to Olivier Galibert) to strip
2465      the 8th bit off ARG1 and ARG2 because it allows programmers to
2466      write (make-char 'latin-iso8859-2 CODE) where code is the actual
2467      Latin 2 code of the character.  */
2468 #ifdef UTF2000
2469   a1 = XINT (arg1);
2470   if (highlim < 128)
2471     a1 &= 0x7f;
2472 #else
2473   a1 = XINT (arg1);
2474 #endif
2475   if (a1 < lowlim || a1 > highlim)
2476     args_out_of_range_3 (arg1, make_int (lowlim), make_int (highlim));
2477
2478   if (CHARSET_DIMENSION (cs) == 1)
2479     {
2480       if (!NILP (arg2))
2481         signal_simple_error
2482           ("Charset is of dimension one; second octet must be nil", arg2);
2483       return make_char (MAKE_CHAR (charset, a1, 0));
2484     }
2485
2486   CHECK_INT (arg2);
2487 #ifdef UTF2000
2488   a2 = XINT (arg2);
2489   if (highlim < 128)
2490     a2 &= 0x7f;
2491 #else
2492   a2 = XINT (arg2) & 0x7f;
2493 #endif
2494   if (a2 < lowlim || a2 > highlim)
2495     args_out_of_range_3 (arg2, make_int (lowlim), make_int (highlim));
2496
2497   return make_char (MAKE_CHAR (charset, a1, a2));
2498 }
2499
2500 DEFUN ("char-charset", Fchar_charset, 1, 1, 0, /*
2501 Return the character set of CHARACTER.
2502 */
2503        (character))
2504 {
2505   CHECK_CHAR_COERCE_INT (character);
2506
2507   return XCHARSET_NAME (CHAR_CHARSET (XCHAR (character)));
2508 }
2509
2510 DEFUN ("char-octet", Fchar_octet, 1, 2, 0, /*
2511 Return the octet numbered N (should be 0 or 1) of CHARACTER.
2512 N defaults to 0 if omitted.
2513 */
2514        (character, n))
2515 {
2516   Lisp_Object charset;
2517   int octet0, octet1;
2518
2519   CHECK_CHAR_COERCE_INT (character);
2520
2521   BREAKUP_CHAR (XCHAR (character), charset, octet0, octet1);
2522
2523   if (NILP (n) || EQ (n, Qzero))
2524     return make_int (octet0);
2525   else if (EQ (n, make_int (1)))
2526     return make_int (octet1);
2527   else
2528     signal_simple_error ("Octet number must be 0 or 1", n);
2529 }
2530
2531 #ifdef UTF2000
2532 DEFUN ("encode-char", Fencode_char, 2, 3, 0, /*
2533 Return code-point of CHARACTER in specified CHARSET.
2534 */
2535        (character, charset, defined_only))
2536 {
2537   int code_point;
2538
2539   CHECK_CHAR_COERCE_INT (character);
2540   charset = Fget_charset (charset);
2541   code_point = charset_code_point (charset, XCHAR (character),
2542                                    !NILP (defined_only));
2543   if (code_point >= 0)
2544     return make_int (code_point);
2545   else
2546     return Qnil;
2547 }
2548 #endif
2549
2550 DEFUN ("split-char", Fsplit_char, 1, 1, 0, /*
2551 Return list of charset and one or two position-codes of CHARACTER.
2552 */
2553        (character))
2554 {
2555   /* This function can GC */
2556   struct gcpro gcpro1, gcpro2;
2557   Lisp_Object charset = Qnil;
2558   Lisp_Object rc = Qnil;
2559 #ifdef UTF2000
2560   int code_point;
2561   int dimension;
2562 #else
2563   int c1, c2;
2564 #endif
2565
2566   GCPRO2 (charset, rc);
2567   CHECK_CHAR_COERCE_INT (character);
2568
2569 #ifdef UTF2000
2570   code_point = ENCODE_CHAR (XCHAR (character), charset);
2571   dimension = XCHARSET_DIMENSION (charset);
2572   while (dimension > 0)
2573     {
2574       rc = Fcons (make_int (code_point & 255), rc);
2575       code_point >>= 8;
2576       dimension--;
2577     }
2578   rc = Fcons (XCHARSET_NAME (charset), rc);
2579 #else
2580   BREAKUP_CHAR (XCHAR (character), charset, c1, c2);
2581
2582   if (XCHARSET_DIMENSION (Fget_charset (charset)) == 2)
2583     {
2584       rc = list3 (XCHARSET_NAME (charset), make_int (c1), make_int (c2));
2585     }
2586   else
2587     {
2588       rc = list2 (XCHARSET_NAME (charset), make_int (c1));
2589     }
2590 #endif
2591   UNGCPRO;
2592
2593   return rc;
2594 }
2595
2596 \f
2597 #ifdef ENABLE_COMPOSITE_CHARS
2598 /************************************************************************/
2599 /*                     composite character functions                    */
2600 /************************************************************************/
2601
2602 Emchar
2603 lookup_composite_char (Bufbyte *str, int len)
2604 {
2605   Lisp_Object lispstr = make_string (str, len);
2606   Lisp_Object ch = Fgethash (lispstr,
2607                              Vcomposite_char_string2char_hash_table,
2608                              Qunbound);
2609   Emchar emch;
2610
2611   if (UNBOUNDP (ch))
2612     {
2613       if (composite_char_row_next >= 128)
2614         signal_simple_error ("No more composite chars available", lispstr);
2615       emch = MAKE_CHAR (Vcharset_composite, composite_char_row_next,
2616                         composite_char_col_next);
2617       Fputhash (make_char (emch), lispstr,
2618                 Vcomposite_char_char2string_hash_table);
2619       Fputhash (lispstr, make_char (emch),
2620                 Vcomposite_char_string2char_hash_table);
2621       composite_char_col_next++;
2622       if (composite_char_col_next >= 128)
2623         {
2624           composite_char_col_next = 32;
2625           composite_char_row_next++;
2626         }
2627     }
2628   else
2629     emch = XCHAR (ch);
2630   return emch;
2631 }
2632
2633 Lisp_Object
2634 composite_char_string (Emchar ch)
2635 {
2636   Lisp_Object str = Fgethash (make_char (ch),
2637                               Vcomposite_char_char2string_hash_table,
2638                               Qunbound);
2639   assert (!UNBOUNDP (str));
2640   return str;
2641 }
2642
2643 xxDEFUN ("make-composite-char", Fmake_composite_char, 1, 1, 0, /*
2644 Convert a string into a single composite character.
2645 The character is the result of overstriking all the characters in
2646 the string.
2647 */
2648        (string))
2649 {
2650   CHECK_STRING (string);
2651   return make_char (lookup_composite_char (XSTRING_DATA (string),
2652                                            XSTRING_LENGTH (string)));
2653 }
2654
2655 xxDEFUN ("composite-char-string", Fcomposite_char_string, 1, 1, 0, /*
2656 Return a string of the characters comprising a composite character.
2657 */
2658        (ch))
2659 {
2660   Emchar emch;
2661
2662   CHECK_CHAR (ch);
2663   emch = XCHAR (ch);
2664   if (CHAR_LEADING_BYTE (emch) != LEADING_BYTE_COMPOSITE)
2665     signal_simple_error ("Must be composite char", ch);
2666   return composite_char_string (emch);
2667 }
2668 #endif /* ENABLE_COMPOSITE_CHARS */
2669
2670 \f
2671 /************************************************************************/
2672 /*                            initialization                            */
2673 /************************************************************************/
2674
2675 void
2676 syms_of_mule_charset (void)
2677 {
2678   INIT_LRECORD_IMPLEMENTATION (charset);
2679
2680   DEFSUBR (Fcharsetp);
2681   DEFSUBR (Ffind_charset);
2682   DEFSUBR (Fget_charset);
2683   DEFSUBR (Fcharset_list);
2684   DEFSUBR (Fcharset_name);
2685   DEFSUBR (Fmake_charset);
2686   DEFSUBR (Fmake_reverse_direction_charset);
2687   /*  DEFSUBR (Freverse_direction_charset); */
2688   DEFSUBR (Fdefine_charset_alias);
2689   DEFSUBR (Fcharset_from_attributes);
2690   DEFSUBR (Fcharset_short_name);
2691   DEFSUBR (Fcharset_long_name);
2692   DEFSUBR (Fcharset_description);
2693   DEFSUBR (Fcharset_dimension);
2694   DEFSUBR (Fcharset_property);
2695   DEFSUBR (Fcharset_id);
2696   DEFSUBR (Fset_charset_ccl_program);
2697   DEFSUBR (Fset_charset_registry);
2698
2699 #ifdef UTF2000
2700   DEFSUBR (Fcharset_mapping_table);
2701   DEFSUBR (Fset_charset_mapping_table);
2702 #ifdef HAVE_CHISE
2703   DEFSUBR (Fsave_charset_mapping_table);
2704   DEFSUBR (Freset_charset_mapping_table);
2705 #endif /* HAVE_CHISE */
2706   DEFSUBR (Fdecode_char);
2707   DEFSUBR (Fdecode_builtin_char);
2708   DEFSUBR (Fencode_char);
2709 #endif
2710
2711   DEFSUBR (Fmake_char);
2712   DEFSUBR (Fchar_charset);
2713   DEFSUBR (Fchar_octet);
2714   DEFSUBR (Fsplit_char);
2715
2716 #ifdef ENABLE_COMPOSITE_CHARS
2717   DEFSUBR (Fmake_composite_char);
2718   DEFSUBR (Fcomposite_char_string);
2719 #endif
2720
2721   defsymbol (&Qcharsetp, "charsetp");
2722   defsymbol (&Qregistry, "registry");
2723   defsymbol (&Qfinal, "final");
2724   defsymbol (&Qgraphic, "graphic");
2725   defsymbol (&Qdirection, "direction");
2726   defsymbol (&Qreverse_direction_charset, "reverse-direction-charset");
2727   defsymbol (&Qshort_name, "short-name");
2728   defsymbol (&Qlong_name, "long-name");
2729   defsymbol (&Qiso_ir, "iso-ir");
2730 #ifdef UTF2000
2731   defsymbol (&Qmother, "mother");
2732   defsymbol (&Qmin_code, "min-code");
2733   defsymbol (&Qmax_code, "max-code");
2734   defsymbol (&Qcode_offset, "code-offset");
2735   defsymbol (&Qconversion, "conversion");
2736   defsymbol (&Q94x60, "94x60");
2737   defsymbol (&Q94x94x60, "94x94x60");
2738   defsymbol (&Qbig5_1, "big5-1");
2739   defsymbol (&Qbig5_2, "big5-2");
2740 #endif
2741
2742   defsymbol (&Ql2r, "l2r");
2743   defsymbol (&Qr2l, "r2l");
2744
2745   /* Charsets, compatible with FSF 20.3
2746      Naming convention is Script-Charset[-Edition] */
2747   defsymbol (&Qascii,                   "ascii");
2748   defsymbol (&Qcontrol_1,               "control-1");
2749   defsymbol (&Qlatin_iso8859_1,         "latin-iso8859-1");
2750   defsymbol (&Qlatin_iso8859_2,         "latin-iso8859-2");
2751   defsymbol (&Qlatin_iso8859_3,         "latin-iso8859-3");
2752   defsymbol (&Qlatin_iso8859_4,         "latin-iso8859-4");
2753   defsymbol (&Qthai_tis620,             "thai-tis620");
2754   defsymbol (&Qgreek_iso8859_7,         "greek-iso8859-7");
2755   defsymbol (&Qarabic_iso8859_6,        "arabic-iso8859-6");
2756   defsymbol (&Qhebrew_iso8859_8,        "hebrew-iso8859-8");
2757   defsymbol (&Qkatakana_jisx0201,       "katakana-jisx0201");
2758   defsymbol (&Qlatin_jisx0201,          "latin-jisx0201");
2759   defsymbol (&Qcyrillic_iso8859_5,      "cyrillic-iso8859-5");
2760   defsymbol (&Qlatin_iso8859_9,         "latin-iso8859-9");
2761   defsymbol (&Qmap_jis_x0208_1978,      "=jis-x0208-1978");
2762   defsymbol (&Qmap_gb2312,              "=gb2312");
2763   defsymbol (&Qmap_gb12345,             "=gb12345");
2764   defsymbol (&Qmap_jis_x0208_1983,      "=jis-x0208-1983");
2765   defsymbol (&Qmap_ks_x1001,            "=ks-x1001");
2766   defsymbol (&Qmap_jis_x0212,           "=jis-x0212");
2767   defsymbol (&Qmap_cns11643_1,          "=cns11643-1");
2768   defsymbol (&Qmap_cns11643_2,          "=cns11643-2");
2769 #ifdef UTF2000
2770   defsymbol (&Qsystem_char_id,          "system-char-id");
2771   defsymbol (&Qmap_ucs,                 "=ucs");
2772   defsymbol (&Qucs,                     "ucs");
2773   defsymbol (&Qucs_bmp,                 "ucs-bmp");
2774   defsymbol (&Qucs_smp,                 "ucs-smp");
2775   defsymbol (&Qucs_sip,                 "ucs-sip");
2776   defsymbol (&Qlatin_viscii,            "latin-viscii");
2777   defsymbol (&Qlatin_tcvn5712,          "latin-tcvn5712");
2778   defsymbol (&Qlatin_viscii_lower,      "latin-viscii-lower");
2779   defsymbol (&Qlatin_viscii_upper,      "latin-viscii-upper");
2780   defsymbol (&Qvietnamese_viscii_lower, "vietnamese-viscii-lower");
2781   defsymbol (&Qvietnamese_viscii_upper, "vietnamese-viscii-upper");
2782   defsymbol (&Qmap_jis_x0208,           "=jis-x0208");
2783   defsymbol (&Qmap_jis_x0208_1990,      "=jis-x0208-1990");
2784   defsymbol (&Qmap_big5,                "=big5");
2785   defsymbol (&Qethiopic_ucs,            "ethiopic-ucs");
2786 #endif
2787   defsymbol (&Qchinese_big5_1,          "chinese-big5-1");
2788   defsymbol (&Qchinese_big5_2,          "chinese-big5-2");
2789
2790   defsymbol (&Qcomposite,               "composite");
2791 }
2792
2793 void
2794 vars_of_mule_charset (void)
2795 {
2796   int i, j;
2797 #ifndef UTF2000
2798   int k;
2799 #endif
2800
2801   chlook = xnew_and_zero (struct charset_lookup); /* zero for Purify. */
2802   dump_add_root_struct_ptr (&chlook, &charset_lookup_description);
2803
2804   /* Table of charsets indexed by leading byte. */
2805   for (i = 0; i < countof (chlook->charset_by_leading_byte); i++)
2806     chlook->charset_by_leading_byte[i] = Qnil;
2807
2808 #ifdef UTF2000
2809   /* Table of charsets indexed by type/final-byte. */
2810   for (i = 0; i < countof (chlook->charset_by_attributes); i++)
2811     for (j = 0; j < countof (chlook->charset_by_attributes[0]); j++)
2812       chlook->charset_by_attributes[i][j] = Qnil;
2813 #else
2814   /* Table of charsets indexed by type/final-byte/direction. */
2815   for (i = 0; i < countof (chlook->charset_by_attributes); i++)
2816     for (j = 0; j < countof (chlook->charset_by_attributes[0]); j++)
2817       for (k = 0; k < countof (chlook->charset_by_attributes[0][0]); k++)
2818         chlook->charset_by_attributes[i][j][k] = Qnil;
2819 #endif
2820
2821 #ifdef UTF2000
2822   chlook->next_allocated_leading_byte = MIN_LEADING_BYTE_PRIVATE;
2823 #else
2824   chlook->next_allocated_1_byte_leading_byte = MIN_LEADING_BYTE_PRIVATE_1;
2825   chlook->next_allocated_2_byte_leading_byte = MIN_LEADING_BYTE_PRIVATE_2;
2826 #endif
2827
2828 #ifndef UTF2000
2829   leading_code_private_11 = PRE_LEADING_BYTE_PRIVATE_1;
2830   DEFVAR_INT ("leading-code-private-11", &leading_code_private_11 /*
2831 Leading-code of private TYPE9N charset of column-width 1.
2832 */ );
2833   leading_code_private_11 = PRE_LEADING_BYTE_PRIVATE_1;
2834 #endif
2835
2836 #ifdef UTF2000
2837   Vdefault_coded_charset_priority_list = Qnil;
2838   DEFVAR_LISP ("default-coded-charset-priority-list",
2839                &Vdefault_coded_charset_priority_list /*
2840 Default order of preferred coded-character-sets.
2841 */ );
2842 #endif
2843 }
2844
2845 void
2846 complex_vars_of_mule_charset (void)
2847 {
2848   staticpro (&Vcharset_hash_table);
2849   Vcharset_hash_table =
2850     make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
2851
2852   /* Predefined character sets.  We store them into variables for
2853      ease of access. */
2854
2855 #ifdef UTF2000
2856   staticpro (&Vcharset_system_char_id);
2857   Vcharset_system_char_id =
2858     make_charset (LEADING_BYTE_SYSTEM_CHAR_ID, Qsystem_char_id, 256, 4,
2859                   1, 2, 0, CHARSET_LEFT_TO_RIGHT,
2860                   build_string ("SCID"),
2861                   build_string ("CHAR-ID"),
2862                   build_string ("System char-id"),
2863                   build_string (""),
2864                   Qnil, 0, 0x7FFFFFFF, 0, 0, Qnil, CONVERSION_IDENTICAL);
2865   staticpro (&Vcharset_ucs);
2866   Vcharset_ucs =
2867     make_charset (LEADING_BYTE_UCS, Qmap_ucs, 256, 4,
2868                   1, 2, 0, CHARSET_LEFT_TO_RIGHT,
2869                   build_string ("UCS"),
2870                   build_string ("UCS"),
2871                   build_string ("ISO/IEC 10646"),
2872                   build_string (""),
2873                   Qnil, 0, 0xEFFFF, 0, 0, Qnil, CONVERSION_IDENTICAL);
2874   staticpro (&Vcharset_ucs_bmp);
2875   Vcharset_ucs_bmp =
2876     make_charset (LEADING_BYTE_UCS_BMP, Qucs_bmp, 256, 2,
2877                   1, 2, 0, CHARSET_LEFT_TO_RIGHT,
2878                   build_string ("BMP"),
2879                   build_string ("UCS-BMP"),
2880                   build_string ("ISO/IEC 10646 Group 0 Plane 0 (BMP)"),
2881                   build_string
2882                   ("\\(ISO10646.*-[01]\\|UCS00-0\\|UNICODE[23]?-0\\)"),
2883                   Qnil, 0, 0xFFFF, 0, 0, Qnil, CONVERSION_IDENTICAL);
2884   staticpro (&Vcharset_ucs_smp);
2885   Vcharset_ucs_smp =
2886     make_charset (LEADING_BYTE_UCS_SMP, Qucs_smp, 256, 2,
2887                   1, 2, 0, CHARSET_LEFT_TO_RIGHT,
2888                   build_string ("SMP"),
2889                   build_string ("UCS-SMP"),
2890                   build_string ("ISO/IEC 10646 Group 0 Plane 1 (SMP)"),
2891                   build_string ("UCS00-1"),
2892                   Qnil, MIN_CHAR_SMP, MAX_CHAR_SMP,
2893                   MIN_CHAR_SMP, 0, Qnil, CONVERSION_IDENTICAL);
2894   staticpro (&Vcharset_ucs_sip);
2895   Vcharset_ucs_sip =
2896     make_charset (LEADING_BYTE_UCS_SIP, Qucs_sip, 256, 2,
2897                   2, 2, 0, CHARSET_LEFT_TO_RIGHT,
2898                   build_string ("SIP"),
2899                   build_string ("UCS-SIP"),
2900                   build_string ("ISO/IEC 10646 Group 0 Plane 2 (SIP)"),
2901                   build_string ("\\(ISO10646.*-2\\|UCS00-2\\)"),
2902                   Qnil, MIN_CHAR_SIP, MAX_CHAR_SIP,
2903                   MIN_CHAR_SIP, 0, Qnil, CONVERSION_IDENTICAL);
2904 #else
2905 # define MIN_CHAR_THAI 0
2906 # define MAX_CHAR_THAI 0
2907   /* # define MIN_CHAR_HEBREW 0 */
2908   /* # define MAX_CHAR_HEBREW 0 */
2909 # define MIN_CHAR_HALFWIDTH_KATAKANA 0
2910 # define MAX_CHAR_HALFWIDTH_KATAKANA 0
2911 #endif
2912   staticpro (&Vcharset_ascii);
2913   Vcharset_ascii =
2914     make_charset (LEADING_BYTE_ASCII, Qascii, 94, 1,
2915                   1, 0, 'B', CHARSET_LEFT_TO_RIGHT,
2916                   build_string ("ASCII"),
2917                   build_string ("ASCII)"),
2918                   build_string ("ASCII (ISO646 IRV)"),
2919                   build_string ("\\(iso8859-[0-9]*\\|-ascii\\)"),
2920                   Qnil, 0, 0x7F, 0, 0, Qnil, CONVERSION_IDENTICAL);
2921   staticpro (&Vcharset_control_1);
2922   Vcharset_control_1 =
2923     make_charset (LEADING_BYTE_CONTROL_1, Qcontrol_1, 94, 1,
2924                   1, 1, 0, CHARSET_LEFT_TO_RIGHT,
2925                   build_string ("C1"),
2926                   build_string ("Control characters"),
2927                   build_string ("Control characters 128-191"),
2928                   build_string (""),
2929                   Qnil, 0x80, 0x9F, 0x80, 0, Qnil, CONVERSION_IDENTICAL);
2930   staticpro (&Vcharset_latin_iso8859_1);
2931   Vcharset_latin_iso8859_1 =
2932     make_charset (LEADING_BYTE_LATIN_ISO8859_1, Qlatin_iso8859_1, 96, 1,
2933                   1, 1, 'A', CHARSET_LEFT_TO_RIGHT,
2934                   build_string ("Latin-1"),
2935                   build_string ("ISO8859-1 (Latin-1)"),
2936                   build_string ("ISO8859-1 (Latin-1)"),
2937                   build_string ("iso8859-1"),
2938                   Qnil, 0, 0, 0, 32, Qnil, CONVERSION_IDENTICAL);
2939   staticpro (&Vcharset_latin_iso8859_2);
2940   Vcharset_latin_iso8859_2 =
2941     make_charset (LEADING_BYTE_LATIN_ISO8859_2, Qlatin_iso8859_2, 96, 1,
2942                   1, 1, 'B', CHARSET_LEFT_TO_RIGHT,
2943                   build_string ("Latin-2"),
2944                   build_string ("ISO8859-2 (Latin-2)"),
2945                   build_string ("ISO8859-2 (Latin-2)"),
2946                   build_string ("iso8859-2"),
2947                   Qnil, 0, 0, 0, 32, Qnil, CONVERSION_IDENTICAL);
2948   staticpro (&Vcharset_latin_iso8859_3);
2949   Vcharset_latin_iso8859_3 =
2950     make_charset (LEADING_BYTE_LATIN_ISO8859_3, Qlatin_iso8859_3, 96, 1,
2951                   1, 1, 'C', CHARSET_LEFT_TO_RIGHT,
2952                   build_string ("Latin-3"),
2953                   build_string ("ISO8859-3 (Latin-3)"),
2954                   build_string ("ISO8859-3 (Latin-3)"),
2955                   build_string ("iso8859-3"),
2956                   Qnil, 0, 0, 0, 32, Qnil, CONVERSION_IDENTICAL);
2957   staticpro (&Vcharset_latin_iso8859_4);
2958   Vcharset_latin_iso8859_4 =
2959     make_charset (LEADING_BYTE_LATIN_ISO8859_4, Qlatin_iso8859_4, 96, 1,
2960                   1, 1, 'D', CHARSET_LEFT_TO_RIGHT,
2961                   build_string ("Latin-4"),
2962                   build_string ("ISO8859-4 (Latin-4)"),
2963                   build_string ("ISO8859-4 (Latin-4)"),
2964                   build_string ("iso8859-4"),
2965                   Qnil, 0, 0, 0, 32, Qnil, CONVERSION_IDENTICAL);
2966   staticpro (&Vcharset_thai_tis620);
2967   Vcharset_thai_tis620 =
2968     make_charset (LEADING_BYTE_THAI_TIS620, Qthai_tis620, 96, 1,
2969                   1, 1, 'T', CHARSET_LEFT_TO_RIGHT,
2970                   build_string ("TIS620"),
2971                   build_string ("TIS620 (Thai)"),
2972                   build_string ("TIS620.2529 (Thai)"),
2973                   build_string ("tis620"),
2974                   Qnil, 0, 0, 0, 32, Qnil, CONVERSION_IDENTICAL);
2975   staticpro (&Vcharset_greek_iso8859_7);
2976   Vcharset_greek_iso8859_7 =
2977     make_charset (LEADING_BYTE_GREEK_ISO8859_7, Qgreek_iso8859_7, 96, 1,
2978                   1, 1, 'F', CHARSET_LEFT_TO_RIGHT,
2979                   build_string ("ISO8859-7"),
2980                   build_string ("ISO8859-7 (Greek)"),
2981                   build_string ("ISO8859-7 (Greek)"),
2982                   build_string ("iso8859-7"),
2983                   Qnil, 0, 0, 0, 32, Qnil, CONVERSION_IDENTICAL);
2984   staticpro (&Vcharset_arabic_iso8859_6);
2985   Vcharset_arabic_iso8859_6 =
2986     make_charset (LEADING_BYTE_ARABIC_ISO8859_6, Qarabic_iso8859_6, 96, 1,
2987                   1, 1, 'G', CHARSET_RIGHT_TO_LEFT,
2988                   build_string ("ISO8859-6"),
2989                   build_string ("ISO8859-6 (Arabic)"),
2990                   build_string ("ISO8859-6 (Arabic)"),
2991                   build_string ("iso8859-6"),
2992                   Qnil, 0, 0, 0, 32, Qnil, CONVERSION_IDENTICAL);
2993   staticpro (&Vcharset_hebrew_iso8859_8);
2994   Vcharset_hebrew_iso8859_8 =
2995     make_charset (LEADING_BYTE_HEBREW_ISO8859_8, Qhebrew_iso8859_8, 96, 1,
2996                   1, 1, 'H', CHARSET_RIGHT_TO_LEFT,
2997                   build_string ("ISO8859-8"),
2998                   build_string ("ISO8859-8 (Hebrew)"),
2999                   build_string ("ISO8859-8 (Hebrew)"),
3000                   build_string ("iso8859-8"),
3001                   Qnil,
3002                   0 /* MIN_CHAR_HEBREW */,
3003                   0 /* MAX_CHAR_HEBREW */, 0, 32,
3004                   Qnil, CONVERSION_IDENTICAL);
3005   staticpro (&Vcharset_katakana_jisx0201);
3006   Vcharset_katakana_jisx0201 =
3007     make_charset (LEADING_BYTE_KATAKANA_JISX0201, Qkatakana_jisx0201, 94, 1,
3008                   1, 1, 'I', CHARSET_LEFT_TO_RIGHT,
3009                   build_string ("JISX0201 Kana"),
3010                   build_string ("JISX0201.1976 (Japanese Kana)"),
3011                   build_string ("JISX0201.1976 Japanese Kana"),
3012                   build_string ("jisx0201\\.1976"),
3013                   Qnil, 0, 0, 0, 33, Qnil, CONVERSION_IDENTICAL);
3014   staticpro (&Vcharset_latin_jisx0201);
3015   Vcharset_latin_jisx0201 =
3016     make_charset (LEADING_BYTE_LATIN_JISX0201, Qlatin_jisx0201, 94, 1,
3017                   1, 0, 'J', CHARSET_LEFT_TO_RIGHT,
3018                   build_string ("JISX0201 Roman"),
3019                   build_string ("JISX0201.1976 (Japanese Roman)"),
3020                   build_string ("JISX0201.1976 Japanese Roman"),
3021                   build_string ("jisx0201\\.1976"),
3022                   Qnil, 0, 0, 0, 33, Qnil, CONVERSION_IDENTICAL);
3023   staticpro (&Vcharset_cyrillic_iso8859_5);
3024   Vcharset_cyrillic_iso8859_5 =
3025     make_charset (LEADING_BYTE_CYRILLIC_ISO8859_5, Qcyrillic_iso8859_5, 96, 1,
3026                   1, 1, 'L', CHARSET_LEFT_TO_RIGHT,
3027                   build_string ("ISO8859-5"),
3028                   build_string ("ISO8859-5 (Cyrillic)"),
3029                   build_string ("ISO8859-5 (Cyrillic)"),
3030                   build_string ("iso8859-5"),
3031                   Qnil, 0, 0, 0, 32, Qnil, CONVERSION_IDENTICAL);
3032   staticpro (&Vcharset_latin_iso8859_9);
3033   Vcharset_latin_iso8859_9 =
3034     make_charset (LEADING_BYTE_LATIN_ISO8859_9, Qlatin_iso8859_9, 96, 1,
3035                   1, 1, 'M', CHARSET_LEFT_TO_RIGHT,
3036                   build_string ("Latin-5"),
3037                   build_string ("ISO8859-9 (Latin-5)"),
3038                   build_string ("ISO8859-9 (Latin-5)"),
3039                   build_string ("iso8859-9"),
3040                   Qnil, 0, 0, 0, 32, Qnil, CONVERSION_IDENTICAL);
3041 #ifdef UTF2000
3042   staticpro (&Vcharset_jis_x0208);
3043   Vcharset_jis_x0208 =
3044     make_charset (LEADING_BYTE_JIS_X0208,
3045                   Qmap_jis_x0208, 94, 2,
3046                   2, 0, 'B', CHARSET_LEFT_TO_RIGHT,
3047                   build_string ("JIS X0208"),
3048                   build_string ("JIS X0208 Common"),
3049                   build_string ("JIS X0208 Common part"),
3050                   build_string ("jisx0208\\.1990"),
3051                   Qnil,
3052                   MIN_CHAR_JIS_X0208_1990,
3053                   MAX_CHAR_JIS_X0208_1990, MIN_CHAR_JIS_X0208_1990, 33,
3054                   Qnil, CONVERSION_94x94);
3055 #endif
3056   staticpro (&Vcharset_japanese_jisx0208_1978);
3057   Vcharset_japanese_jisx0208_1978 =
3058     make_charset (LEADING_BYTE_JAPANESE_JISX0208_1978,
3059                   Qmap_jis_x0208_1978, 94, 2,
3060                   2, 0, '@', CHARSET_LEFT_TO_RIGHT,
3061                   build_string ("JIS X0208:1978"),
3062                   build_string ("JIS X0208:1978 (Japanese)"),
3063                   build_string
3064                   ("JIS X0208:1978 Japanese Kanji (so called \"old JIS\")"),
3065                   build_string ("\\(jisx0208\\|jisc6226\\)\\.1978"),
3066                   Qnil, 0, 0, 0, 33,
3067 #ifdef UTF2000
3068                   Vcharset_jis_x0208,
3069 #else
3070                   Qnil,
3071 #endif
3072                   CONVERSION_IDENTICAL);
3073   staticpro (&Vcharset_chinese_gb2312);
3074   Vcharset_chinese_gb2312 =
3075     make_charset (LEADING_BYTE_CHINESE_GB2312, Qmap_gb2312, 94, 2,
3076                   2, 0, 'A', CHARSET_LEFT_TO_RIGHT,
3077                   build_string ("GB2312"),
3078                   build_string ("GB2312)"),
3079                   build_string ("GB2312 Chinese simplified"),
3080                   build_string ("gb2312"),
3081                   Qnil, 0, 0, 0, 33, Qnil, CONVERSION_IDENTICAL);
3082   staticpro (&Vcharset_chinese_gb12345);
3083   Vcharset_chinese_gb12345 =
3084     make_charset (LEADING_BYTE_CHINESE_GB12345, Qmap_gb12345, 94, 2,
3085                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3086                   build_string ("G1"),
3087                   build_string ("GB 12345)"),
3088                   build_string ("GB 12345-1990"),
3089                   build_string ("GB12345\\(\\.1990\\)?-0"),
3090                   Qnil, 0, 0, 0, 33, Qnil, CONVERSION_IDENTICAL);
3091   staticpro (&Vcharset_japanese_jisx0208);
3092   Vcharset_japanese_jisx0208 =
3093     make_charset (LEADING_BYTE_JAPANESE_JISX0208, Qmap_jis_x0208_1983, 94, 2,
3094                   2, 0, 'B', CHARSET_LEFT_TO_RIGHT,
3095                   build_string ("JISX0208"),
3096                   build_string ("JIS X0208:1983 (Japanese)"),
3097                   build_string ("JIS X0208:1983 Japanese Kanji"),
3098                   build_string ("jisx0208\\.1983"),
3099                   Qnil, 0, 0, 0, 33,
3100 #ifdef UTF2000
3101                   Vcharset_jis_x0208,
3102 #else
3103                   Qnil,
3104 #endif
3105                   CONVERSION_IDENTICAL);
3106 #ifdef UTF2000
3107   staticpro (&Vcharset_japanese_jisx0208_1990);
3108   Vcharset_japanese_jisx0208_1990 =
3109     make_charset (LEADING_BYTE_JAPANESE_JISX0208_1990,
3110                   Qmap_jis_x0208_1990, 94, 2,
3111                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3112                   build_string ("JISX0208-1990"),
3113                   build_string ("JIS X0208:1990 (Japanese)"),
3114                   build_string ("JIS X0208:1990 Japanese Kanji"),
3115                   build_string ("jisx0208\\.1990"),
3116                   Qnil,
3117                   0x2121 /* MIN_CHAR_JIS_X0208_1990 */,
3118                   0x7426 /* MAX_CHAR_JIS_X0208_1990 */,
3119                   0 /* MIN_CHAR_JIS_X0208_1990 */, 33,
3120                   Vcharset_jis_x0208 /* Qnil */,
3121                   CONVERSION_IDENTICAL /* CONVERSION_94x94 */);
3122 #endif
3123   staticpro (&Vcharset_korean_ksc5601);
3124   Vcharset_korean_ksc5601 =
3125     make_charset (LEADING_BYTE_KOREAN_KSC5601, Qmap_ks_x1001, 94, 2,
3126                   2, 0, 'C', CHARSET_LEFT_TO_RIGHT,
3127                   build_string ("KSC5601"),
3128                   build_string ("KSC5601 (Korean"),
3129                   build_string ("KSC5601 Korean Hangul and Hanja"),
3130                   build_string ("ksc5601"),
3131                   Qnil, 0, 0, 0, 33, Qnil, CONVERSION_IDENTICAL);
3132   staticpro (&Vcharset_japanese_jisx0212);
3133   Vcharset_japanese_jisx0212 =
3134     make_charset (LEADING_BYTE_JAPANESE_JISX0212, Qmap_jis_x0212, 94, 2,
3135                   2, 0, 'D', CHARSET_LEFT_TO_RIGHT,
3136                   build_string ("JISX0212"),
3137                   build_string ("JISX0212 (Japanese)"),
3138                   build_string ("JISX0212 Japanese Supplement"),
3139                   build_string ("jisx0212"),
3140                   Qnil, 0, 0, 0, 33, Qnil, CONVERSION_IDENTICAL);
3141
3142 #define CHINESE_CNS_PLANE_RE(n) "cns11643[.-]\\(.*[.-]\\)?" n "$"
3143   staticpro (&Vcharset_chinese_cns11643_1);
3144   Vcharset_chinese_cns11643_1 =
3145     make_charset (LEADING_BYTE_CHINESE_CNS11643_1, Qmap_cns11643_1, 94, 2,
3146                   2, 0, 'G', CHARSET_LEFT_TO_RIGHT,
3147                   build_string ("CNS11643-1"),
3148                   build_string ("CNS11643-1 (Chinese traditional)"),
3149                   build_string
3150                   ("CNS 11643 Plane 1 Chinese traditional"),
3151                   build_string (CHINESE_CNS_PLANE_RE("1")),
3152                   Qnil, 0, 0, 0, 33, Qnil, CONVERSION_IDENTICAL);
3153   staticpro (&Vcharset_chinese_cns11643_2);
3154   Vcharset_chinese_cns11643_2 =
3155     make_charset (LEADING_BYTE_CHINESE_CNS11643_2, Qmap_cns11643_2, 94, 2,
3156                   2, 0, 'H', CHARSET_LEFT_TO_RIGHT,
3157                   build_string ("CNS11643-2"),
3158                   build_string ("CNS11643-2 (Chinese traditional)"),
3159                   build_string
3160                   ("CNS 11643 Plane 2 Chinese traditional"),
3161                   build_string (CHINESE_CNS_PLANE_RE("2")),
3162                   Qnil, 0, 0, 0, 33, Qnil, CONVERSION_IDENTICAL);
3163 #ifdef UTF2000
3164   staticpro (&Vcharset_latin_tcvn5712);
3165   Vcharset_latin_tcvn5712 =
3166     make_charset (LEADING_BYTE_LATIN_TCVN5712, Qlatin_tcvn5712, 96, 1,
3167                   1, 1, 'Z', CHARSET_LEFT_TO_RIGHT,
3168                   build_string ("TCVN 5712"),
3169                   build_string ("TCVN 5712 (VSCII-2)"),
3170                   build_string ("Vietnamese TCVN 5712:1983 (VSCII-2)"),
3171                   build_string ("tcvn5712\\(\\.1993\\)?-1"),
3172                   Qnil, 0, 0, 0, 32, Qnil, CONVERSION_IDENTICAL);
3173   staticpro (&Vcharset_latin_viscii_lower);
3174   Vcharset_latin_viscii_lower =
3175     make_charset (LEADING_BYTE_LATIN_VISCII_LOWER, Qlatin_viscii_lower, 96, 1,
3176                   1, 1, '1', CHARSET_LEFT_TO_RIGHT,
3177                   build_string ("VISCII lower"),
3178                   build_string ("VISCII lower (Vietnamese)"),
3179                   build_string ("VISCII lower (Vietnamese)"),
3180                   build_string ("MULEVISCII-LOWER"),
3181                   Qnil, 0, 0, 0, 32, Qnil, CONVERSION_IDENTICAL);
3182   staticpro (&Vcharset_latin_viscii_upper);
3183   Vcharset_latin_viscii_upper =
3184     make_charset (LEADING_BYTE_LATIN_VISCII_UPPER, Qlatin_viscii_upper, 96, 1,
3185                   1, 1, '2', CHARSET_LEFT_TO_RIGHT,
3186                   build_string ("VISCII upper"),
3187                   build_string ("VISCII upper (Vietnamese)"),
3188                   build_string ("VISCII upper (Vietnamese)"),
3189                   build_string ("MULEVISCII-UPPER"),
3190                   Qnil, 0, 0, 0, 32, Qnil, CONVERSION_IDENTICAL);
3191   staticpro (&Vcharset_latin_viscii);
3192   Vcharset_latin_viscii =
3193     make_charset (LEADING_BYTE_LATIN_VISCII, Qlatin_viscii, 256, 1,
3194                   1, 2, 0, CHARSET_LEFT_TO_RIGHT,
3195                   build_string ("VISCII"),
3196                   build_string ("VISCII 1.1 (Vietnamese)"),
3197                   build_string ("VISCII 1.1 (Vietnamese)"),
3198                   build_string ("VISCII1\\.1"),
3199                   Qnil, 0, 0, 0, 0, Qnil, CONVERSION_IDENTICAL);
3200   staticpro (&Vcharset_chinese_big5);
3201   Vcharset_chinese_big5 =
3202     make_charset (LEADING_BYTE_CHINESE_BIG5, Qmap_big5, 256, 2,
3203                   2, 2, 0, CHARSET_LEFT_TO_RIGHT,
3204                   build_string ("Big5"),
3205                   build_string ("Big5"),
3206                   build_string ("Big5 Chinese traditional"),
3207                   build_string ("big5-0"),
3208                   Qnil,
3209                   MIN_CHAR_BIG5_CDP, MAX_CHAR_BIG5_CDP,
3210                   MIN_CHAR_BIG5_CDP, 0, Qnil, CONVERSION_IDENTICAL);
3211
3212   staticpro (&Vcharset_ethiopic_ucs);
3213   Vcharset_ethiopic_ucs =
3214     make_charset (LEADING_BYTE_ETHIOPIC_UCS, Qethiopic_ucs, 256, 2,
3215                   2, 2, 0, CHARSET_LEFT_TO_RIGHT,
3216                   build_string ("Ethiopic (UCS)"),
3217                   build_string ("Ethiopic (UCS)"),
3218                   build_string ("Ethiopic of UCS"),
3219                   build_string ("Ethiopic-Unicode"),
3220                   Qnil, 0x1200, 0x137F, 0, 0,
3221                   Qnil, CONVERSION_IDENTICAL);
3222 #endif
3223   staticpro (&Vcharset_chinese_big5_1);
3224   Vcharset_chinese_big5_1 =
3225     make_charset (LEADING_BYTE_CHINESE_BIG5_1, Qchinese_big5_1, 94, 2,
3226                   2, 0, '0', CHARSET_LEFT_TO_RIGHT,
3227                   build_string ("Big5"),
3228                   build_string ("Big5 (Level-1)"),
3229                   build_string
3230                   ("Big5 Level-1 Chinese traditional"),
3231                   build_string ("big5"),
3232                   Qnil, 0, 0, 0, 33, /* Qnil, CONVERSION_IDENTICAL */
3233                   Vcharset_chinese_big5, CONVERSION_BIG5_1);
3234   staticpro (&Vcharset_chinese_big5_2);
3235   Vcharset_chinese_big5_2 =
3236     make_charset (LEADING_BYTE_CHINESE_BIG5_2, Qchinese_big5_2, 94, 2,
3237                   2, 0, '1', CHARSET_LEFT_TO_RIGHT,
3238                   build_string ("Big5"),
3239                   build_string ("Big5 (Level-2)"),
3240                   build_string
3241                   ("Big5 Level-2 Chinese traditional"),
3242                   build_string ("big5"),
3243                   Qnil, 0, 0, 0, 33, /* Qnil, CONVERSION_IDENTICAL */
3244                   Vcharset_chinese_big5, CONVERSION_BIG5_2);
3245
3246 #ifdef ENABLE_COMPOSITE_CHARS
3247   /* #### For simplicity, we put composite chars into a 96x96 charset.
3248      This is going to lead to problems because you can run out of
3249      room, esp. as we don't yet recycle numbers. */
3250   staticpro (&Vcharset_composite);
3251   Vcharset_composite =
3252     make_charset (LEADING_BYTE_COMPOSITE, Qcomposite, 96, 2,
3253                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3254                   build_string ("Composite"),
3255                   build_string ("Composite characters"),
3256                   build_string ("Composite characters"),
3257                   build_string (""));
3258
3259   /* #### not dumped properly */
3260   composite_char_row_next = 32;
3261   composite_char_col_next = 32;
3262
3263   Vcomposite_char_string2char_hash_table =
3264     make_lisp_hash_table (500, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL);
3265   Vcomposite_char_char2string_hash_table =
3266     make_lisp_hash_table (500, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
3267   staticpro (&Vcomposite_char_string2char_hash_table);
3268   staticpro (&Vcomposite_char_char2string_hash_table);
3269 #endif /* ENABLE_COMPOSITE_CHARS */
3270
3271 }