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