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

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