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

   1 /* Functions to handle multilingual characters.
   2    Copyright (C) 1992, 1995 Free Software Foundation, Inc.
   3    Copyright (C) 1995 Sun Microsystems, Inc.
   4
   5 This file is part of XEmacs.
   6
   7 XEmacs is free software; you can redistribute it and/or modify it
   8 under the terms of the GNU General Public License as published by the
   9 Free Software Foundation; either version 2, or (at your option) any
  10 later version.
  11
  12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
  13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  14 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  15 for more details.
  16
  17 You should have received a copy of the GNU General Public License
  18 along with XEmacs; see the file COPYING.  If not, write to
  19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  20 Boston, MA 02111-1307, USA.  */
  21
  22 /* Synched up with: Mule 2.3.  Not in FSF. */
  23
  24 /* Rewritten by Ben Wing <ben@xemacs.org>. */
  25
  26 #include <config.h>
  27 #include "lisp.h"
  28
  29 #include "buffer.h"
  30 #include "chartab.h"
  31 #include "elhash.h"
  32 #include "lstream.h"
  33 #include "device.h"
  34 #include "faces.h"
  35
  36 /* The various pre-defined charsets. */
  37
  38 Lisp_Object Vcharset_ascii;
  39 Lisp_Object Vcharset_control_1;
  40 Lisp_Object Vcharset_latin_iso8859_1;
  41 Lisp_Object Vcharset_latin_iso8859_2;
  42 Lisp_Object Vcharset_latin_iso8859_3;
  43 Lisp_Object Vcharset_latin_iso8859_4;
  44 Lisp_Object Vcharset_cyrillic_iso8859_5;
  45 Lisp_Object Vcharset_arabic_iso8859_6;
  46 Lisp_Object Vcharset_greek_iso8859_7;
  47 Lisp_Object Vcharset_hebrew_iso8859_8;
  48 Lisp_Object Vcharset_latin_iso8859_9;
  49 Lisp_Object Vcharset_thai_tis620;
  50 Lisp_Object Vcharset_katakana_jisx0201;
  51 Lisp_Object Vcharset_latin_jisx0201;
  52 Lisp_Object Vcharset_japanese_jisx0208_1978;
  53 Lisp_Object Vcharset_japanese_jisx0208;
  54 Lisp_Object Vcharset_japanese_jisx0212;
  55 Lisp_Object Vcharset_chinese_gb2312;
  56 Lisp_Object Vcharset_chinese_big5_1;
  57 Lisp_Object Vcharset_chinese_big5_2;
  58 Lisp_Object Vcharset_chinese_cns11643_1;
  59 Lisp_Object Vcharset_chinese_cns11643_2;
  60 Lisp_Object Vcharset_korean_ksc5601;
  61 Lisp_Object Vcharset_composite;
  62
  63 /* Hash tables for composite chars.  One maps string representing
  64    composed chars to their equivalent chars; one goes the
  65    other way. */
  66 Lisp_Object Vcomposite_char_char2string_hash_table;
  67 Lisp_Object Vcomposite_char_string2char_hash_table;
  68
  69 /* Table of charsets indexed by leading byte. */
  70 Lisp_Object charset_by_leading_byte[128];
  71
  72 /* Table of charsets indexed by type/final-byte/direction. */
  73 Lisp_Object charset_by_attributes[4][128][2];
  74
  75 static int composite_char_row_next;
  76 static int composite_char_col_next;
  77
  78 /* Table of number of bytes in the string representation of a character
  79    indexed by the first byte of that representation.
  80
  81    rep_bytes_by_first_byte(c) is more efficient than the equivalent
  82    canonical computation:
  83
  84    (BYTE_ASCII_P (c) ? 1 : XCHARSET_REP_BYTES (CHARSET_BY_LEADING_BYTE (c))) */
  85
  86 Bytecount rep_bytes_by_first_byte[0xA0] =
  87 { /* 0x00 - 0x7f are for straight ASCII */
  88   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
  89   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
  90   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
  91   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
  92   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
  93   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
  94   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
  95   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
  96   /* 0x80 - 0x8f are for Dimension-1 official charsets */
  97   2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
  98   /* 0x90 - 0x9d are for Dimension-2 official charsets */
  99   /* 0x9e is for Dimension-1 private charsets */
 100   /* 0x9f is for Dimension-2 private charsets */
 101   3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4
 102 };
 103
 104 Lisp_Object Qcharsetp;
 105
 106 /* Qdoc_string, Qdimension, Qchars defined in general.c */
 107 Lisp_Object Qregistry, Qfinal, Qgraphic;
 108 Lisp_Object Qdirection;
 109 Lisp_Object Qreverse_direction_charset;
 110 Lisp_Object Qccl_program;
 111 Lisp_Object Qleading_byte;
 112
 113 Lisp_Object Qascii, Qcontrol_1,
 114
 115   Qlatin_iso8859_1,
 116   Qlatin_iso8859_2,
 117   Qlatin_iso8859_3,
 118   Qlatin_iso8859_4,
 119   Qcyrillic_iso8859_5,
 120   Qarabic_iso8859_6,
 121   Qgreek_iso8859_7,
 122   Qhebrew_iso8859_8,
 123   Qlatin_iso8859_9,
 124
 125   Qthai_tis620,
 126
 127   Qkatakana_jisx0201, Qlatin_jisx0201,
 128   Qjapanese_jisx0208_1978,
 129   Qjapanese_jisx0208,
 130   Qjapanese_jisx0212,
 131
 132   Qchinese_gb2312,
 133   Qchinese_big5_1, Qchinese_big5_2,
 134   Qchinese_cns11643_1, Qchinese_cns11643_2,
 135
 136   Qkorean_ksc5601, Qcomposite;
 137
 138 Lisp_Object Ql2r, Qr2l;
 139
 140 Lisp_Object Vcharset_hash_table;
 141
 142 static Bufbyte next_allocated_1_byte_leading_byte;
 143 static Bufbyte next_allocated_2_byte_leading_byte;
 144
 145 /* Composite characters are characters constructed by overstriking two
 146    or more regular characters.
 147
 148    1) The old Mule implementation involves storing composite characters
 149       in a buffer as a tag followed by all of the actual characters
 150       used to make up the composite character.  I think this is a bad
 151       idea; it greatly complicates code that wants to handle strings
 152       one character at a time because it has to deal with the possibility
 153       of great big ungainly characters.  It's much more reasonable to
 154       simply store an index into a table of composite characters.
 155
 156    2) The current implementation only allows for 16,384 separate
 157       composite characters over the lifetime of the XEmacs process.
 158       This could become a potential problem if the user
 159       edited lots of different files that use composite characters.
 160       Due to FSF bogosity, increasing the number of allowable
 161       composite characters under Mule would decrease the number
 162       of possible faces that can exist.  Mule already has shrunk
 163       this to 2048, and further shrinkage would become uncomfortable.
 164       No such problems exist in XEmacs.
 165
 166       Composite characters could be represented as 0x80 C1 C2 C3,
 167       where each C[1-3] is in the range 0xA0 - 0xFF.  This allows
 168       for slightly under 2^20 (one million) composite characters
 169       over the XEmacs process lifetime, and you only need to
 170       increase the size of a Mule character from 19 to 21 bits.
 171       Or you could use 0x80 C1 C2 C3 C4, allowing for about
 172       85 million (slightly over 2^26) composite characters. */
 173
 174 \f
 175 /************************************************************************/
 176 /*                       Basic Emchar functions                         */
 177 /************************************************************************/
 178
 179 /* Convert a non-ASCII Mule character C into a one-character Mule-encoded
 180    string in STR.  Returns the number of bytes stored.
 181    Do not call this directly.  Use the macro set_charptr_emchar() instead.
 182  */
 183
 184 Bytecount
 185 non_ascii_set_charptr_emchar (Bufbyte *str, Emchar c)
 186 {
 187   Bufbyte *p;
 188   Bufbyte lb;
 189   int c1, c2;
 190   Lisp_Object charset;
 191
 192   p = str;
 193   BREAKUP_CHAR (c, charset, c1, c2);
 194   lb = CHAR_LEADING_BYTE (c);
 195   if (LEADING_BYTE_PRIVATE_P (lb))
 196     *p++ = PRIVATE_LEADING_BYTE_PREFIX (lb);
 197   *p++ = lb;
 198   if (EQ (charset, Vcharset_control_1))
 199     c1 += 0x20;
 200   *p++ = c1 | 0x80;
 201   if (c2)
 202     *p++ = c2 | 0x80;
 203
 204   return (p - str);
 205 }
 206
 207 /* Return the first character from a Mule-encoded string in STR,
 208    assuming it's non-ASCII.  Do not call this directly.
 209    Use the macro charptr_emchar() instead. */
 210
 211 Emchar
 212 non_ascii_charptr_emchar (CONST Bufbyte *str)
 213 {
 214   Bufbyte i0 = *str, i1, i2 = 0;
 215   Lisp_Object charset;
 216
 217   if (i0 == LEADING_BYTE_CONTROL_1)
 218     return (Emchar) (*++str - 0x20);
 219
 220   if (LEADING_BYTE_PREFIX_P (i0))
 221     i0 = *++str;
 222
 223   i1 = *++str & 0x7F;
 224
 225   charset = CHARSET_BY_LEADING_BYTE (i0);
 226   if (XCHARSET_DIMENSION (charset) == 2)
 227     i2 = *++str & 0x7F;
 228
 229   return MAKE_CHAR (charset, i1, i2);
 230 }
 231
 232 /* Return whether CH is a valid Emchar, assuming it's non-ASCII.
 233    Do not call this directly.  Use the macro valid_char_p() instead. */
 234
 235 int
 236 non_ascii_valid_char_p (Emchar ch)
 237 {
 238   int f1, f2, f3;
 239
 240   /* Must have only lowest 19 bits set */
 241   if (ch & ~0x7FFFF)
 242     return 0;
 243
 244   f1 = CHAR_FIELD1 (ch);
 245   f2 = CHAR_FIELD2 (ch);
 246   f3 = CHAR_FIELD3 (ch);
 247
 248   if (f1 == 0)
 249     {
 250       Lisp_Object charset;
 251
 252       if (f2 < MIN_CHAR_FIELD2_OFFICIAL ||
 253           (f2 > MAX_CHAR_FIELD2_OFFICIAL && f2 < MIN_CHAR_FIELD2_PRIVATE) ||
 254            f2 > MAX_CHAR_FIELD2_PRIVATE)
 255         return 0;
 256       if (f3 < 0x20)
 257         return 0;
 258
 259       if (f3 != 0x20 && f3 != 0x7F)
 260         return 1;
 261
 262       /*
 263          NOTE: This takes advantage of the fact that
 264          FIELD2_TO_OFFICIAL_LEADING_BYTE and
 265          FIELD2_TO_PRIVATE_LEADING_BYTE are the same.
 266          */
 267       charset = CHARSET_BY_LEADING_BYTE (f2 + FIELD2_TO_OFFICIAL_LEADING_BYTE);
 268       return (XCHARSET_CHARS (charset) == 96);
 269     }
 270   else
 271     {
 272       Lisp_Object charset;
 273
 274       if (f1 < MIN_CHAR_FIELD1_OFFICIAL ||
 275           (f1 > MAX_CHAR_FIELD1_OFFICIAL && f1 < MIN_CHAR_FIELD1_PRIVATE) ||
 276           f1 > MAX_CHAR_FIELD1_PRIVATE)
 277         return 0;
 278       if (f2 < 0x20 || f3 < 0x20)
 279         return 0;
 280
 281       if (f1 + FIELD1_TO_OFFICIAL_LEADING_BYTE == LEADING_BYTE_COMPOSITE)
 282         {
 283           if (UNBOUNDP (Fgethash (make_int (ch),
 284                                   Vcomposite_char_char2string_hash_table,
 285                                   Qunbound)))
 286             return 0;
 287           return 1;
 288         }
 289
 290       if (f2 != 0x20 && f2 != 0x7F && f3 != 0x20 && f3 != 0x7F)
 291         return 1;
 292
 293       if (f1 <= MAX_CHAR_FIELD1_OFFICIAL)
 294         charset =
 295           CHARSET_BY_LEADING_BYTE (f1 + FIELD1_TO_OFFICIAL_LEADING_BYTE);
 296       else
 297         charset =
 298           CHARSET_BY_LEADING_BYTE (f1 + FIELD1_TO_PRIVATE_LEADING_BYTE);
 299
 300       return (XCHARSET_CHARS (charset) == 96);
 301     }
 302 }
 303
 304 \f
 305 /************************************************************************/
 306 /*                       Basic string functions                         */
 307 /************************************************************************/
 308
 309 /* Copy the character pointed to by PTR into STR, assuming it's
 310    non-ASCII.  Do not call this directly.  Use the macro
 311    charptr_copy_char() instead. */
 312
 313 Bytecount
 314 non_ascii_charptr_copy_char (CONST Bufbyte *ptr, Bufbyte *str)
 315 {
 316   Bufbyte *strptr = str;
 317   *strptr = *ptr++;
 318   switch (REP_BYTES_BY_FIRST_BYTE (*strptr))
 319     {
 320       /* Notice fallthrough. */
 321     case 4: *++strptr = *ptr++;
 322     case 3: *++strptr = *ptr++;
 323     case 2: *++strptr = *ptr;
 324       break;
 325     default:
 326       abort ();
 327     }
 328   return strptr + 1 - str;
 329 }
 330
 331 \f
 332 /************************************************************************/
 333 /*                        streams of Emchars                            */
 334 /************************************************************************/
 335
 336 /* Treat a stream as a stream of Emchar's rather than a stream of bytes.
 337    The functions below are not meant to be called directly; use
 338    the macros in insdel.h. */
 339
 340 Emchar
 341 Lstream_get_emchar_1 (Lstream *stream, int ch)
 342 {
 343   Bufbyte str[MAX_EMCHAR_LEN];
 344   Bufbyte *strptr = str;
 345
 346   str[0] = (Bufbyte) ch;
 347   switch (REP_BYTES_BY_FIRST_BYTE (ch))
 348     {
 349       /* Notice fallthrough. */
 350     case 4:
 351       ch = Lstream_getc (stream);
 352       assert (ch >= 0);
 353       *++strptr = (Bufbyte) ch;
 354     case 3:
 355       ch = Lstream_getc (stream);
 356       assert (ch >= 0);
 357       *++strptr = (Bufbyte) ch;
 358     case 2:
 359       ch = Lstream_getc (stream);
 360       assert (ch >= 0);
 361       *++strptr = (Bufbyte) ch;
 362       break;
 363     default:
 364       abort ();
 365     }
 366   return charptr_emchar (str);
 367 }
 368
 369 int
 370 Lstream_fput_emchar (Lstream *stream, Emchar ch)
 371 {
 372   Bufbyte str[MAX_EMCHAR_LEN];
 373   Bytecount len = set_charptr_emchar (str, ch);
 374   return Lstream_write (stream, str, len);
 375 }
 376
 377 void
 378 Lstream_funget_emchar (Lstream *stream, Emchar ch)
 379 {
 380   Bufbyte str[MAX_EMCHAR_LEN];
 381   Bytecount len = set_charptr_emchar (str, ch);
 382   Lstream_unread (stream, str, len);
 383 }
 384
 385 \f
 386 /************************************************************************/
 387 /*                            charset object                            */
 388 /************************************************************************/
 389
 390 static Lisp_Object
 391 mark_charset (Lisp_Object obj, void (*markobj) (Lisp_Object))
 392 {
 393   struct Lisp_Charset *cs = XCHARSET (obj);
 394
 395   markobj (cs->doc_string);
 396   markobj (cs->registry);
 397   markobj (cs->ccl_program);
 398   return cs->name;
 399 }
 400
 401 static void
 402 print_charset (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
 403 {
 404   struct Lisp_Charset *cs = XCHARSET (obj);
 405   char buf[200];
 406
 407   if (print_readably)
 408     error ("printing unreadable object #<charset %s 0x%x>",
 409            string_data (XSYMBOL (CHARSET_NAME (cs))->name),
 410            cs->header.uid);
 411
 412   write_c_string ("#<charset ", printcharfun);
 413   print_internal (CHARSET_NAME (cs), printcharfun, 0);
 414   write_c_string (" ", printcharfun);
 415   print_internal (CHARSET_DOC_STRING (cs), printcharfun, 1);
 416   sprintf (buf, " %s %s cols=%d g%d final='%c' reg=",
 417            CHARSET_TYPE (cs) == CHARSET_TYPE_94    ? "94" :
 418            CHARSET_TYPE (cs) == CHARSET_TYPE_96    ? "96" :
 419            CHARSET_TYPE (cs) == CHARSET_TYPE_94X94 ? "94x94" :
 420            "96x96",
 421            CHARSET_DIRECTION (cs) == CHARSET_LEFT_TO_RIGHT ? "l2r" : "r2l",
 422            CHARSET_COLUMNS (cs),
 423            CHARSET_GRAPHIC (cs),
 424            CHARSET_FINAL (cs));
 425   write_c_string (buf, printcharfun);
 426   print_internal (CHARSET_REGISTRY (cs), printcharfun, 0);
 427   sprintf (buf, " 0x%x>", cs->header.uid);
 428   write_c_string (buf, printcharfun);
 429 }
 430
 431 DEFINE_LRECORD_IMPLEMENTATION ("charset", charset,
 432                                mark_charset, print_charset, 0, 0, 0,
 433                                struct Lisp_Charset);
 434 /* Make a new charset. */
 435
 436 static Lisp_Object
 437 make_charset (int id, Lisp_Object name, Bufbyte leading_byte, unsigned char rep_bytes,
 438               unsigned char type, unsigned char columns, unsigned char graphic,
 439               Bufbyte final, unsigned char direction, Lisp_Object doc,
 440               Lisp_Object reg)
 441 {
 442   Lisp_Object obj;
 443   struct Lisp_Charset *cs =
 444     alloc_lcrecord_type (struct Lisp_Charset, lrecord_charset);
 445   XSETCHARSET (obj, cs);
 446
 447   CHARSET_ID            (cs) = id;
 448   CHARSET_NAME          (cs) = name;
 449   CHARSET_LEADING_BYTE  (cs) = leading_byte;
 450   CHARSET_REP_BYTES     (cs) = rep_bytes;
 451   CHARSET_DIRECTION     (cs) = direction;
 452   CHARSET_TYPE          (cs) = type;
 453   CHARSET_COLUMNS       (cs) = columns;
 454   CHARSET_GRAPHIC       (cs) = graphic;
 455   CHARSET_FINAL         (cs) = final;
 456   CHARSET_DOC_STRING    (cs) = doc;
 457   CHARSET_REGISTRY      (cs) = reg;
 458   CHARSET_CCL_PROGRAM   (cs) = Qnil;
 459   CHARSET_REVERSE_DIRECTION_CHARSET (cs) = Qnil;
 460
 461   CHARSET_DIMENSION     (cs) = (CHARSET_TYPE (cs) == CHARSET_TYPE_94 ||
 462                                 CHARSET_TYPE (cs) == CHARSET_TYPE_96) ? 1 : 2;
 463   CHARSET_CHARS         (cs) = (CHARSET_TYPE (cs) == CHARSET_TYPE_94 ||
 464                                 CHARSET_TYPE (cs) == CHARSET_TYPE_94X94) ? 94 : 96;
 465
 466   if (final)
 467     {
 468       /* some charsets do not have final characters.  This includes
 469          ASCII, Control-1, Composite, and the two faux private
 470          charsets. */
 471       assert (NILP (charset_by_attributes[type][final][direction]));
 472       charset_by_attributes[type][final][direction] = obj;
 473     }
 474
 475   assert (NILP (charset_by_leading_byte[leading_byte - 128]));
 476   charset_by_leading_byte[leading_byte - 128] = obj;
 477   if (leading_byte < 0xA0)
 478     /* official leading byte */
 479     rep_bytes_by_first_byte[leading_byte] = rep_bytes;
 480
 481   /* Some charsets are "faux" and don't have names or really exist at
 482      all except in the leading-byte table. */
 483   if (!NILP (name))
 484     Fputhash (name, obj, Vcharset_hash_table);
 485   return obj;
 486 }
 487
 488 static int
 489 get_unallocated_leading_byte (int dimension)
 490 {
 491   int lb;
 492
 493   if (dimension == 1)
 494     {
 495       if (next_allocated_1_byte_leading_byte > MAX_LEADING_BYTE_PRIVATE_1)
 496         lb = 0;
 497       else
 498         lb = next_allocated_1_byte_leading_byte++;
 499     }
 500   else
 501     {
 502       if (next_allocated_2_byte_leading_byte > MAX_LEADING_BYTE_PRIVATE_2)
 503         lb = 0;
 504       else
 505         lb = next_allocated_2_byte_leading_byte++;
 506     }
 507
 508   if (!lb)
 509     signal_simple_error
 510       ("No more character sets free for this dimension",
 511        make_int (dimension));
 512
 513   return lb;
 514 }
 515
 516 \f
 517 /************************************************************************/
 518 /*                      Basic charset Lisp functions                    */
 519 /************************************************************************/
 520
 521 DEFUN ("charsetp", Fcharsetp, 1, 1, 0, /*
 522 Return non-nil if OBJECT is a charset.
 523 */
 524        (object))
 525 {
 526   return CHARSETP (object) ? Qt : Qnil;
 527 }
 528
 529 DEFUN ("find-charset", Ffind_charset, 1, 1, 0, /*
 530 Retrieve the charset of the given name.
 531 If CHARSET-OR-NAME is a charset object, it is simply returned.
 532 Otherwise, CHARSET-OR-NAME should be a symbol.  If there is no such charset,
 533 nil is returned.  Otherwise the associated charset object is returned.
 534 */
 535        (charset_or_name))
 536 {
 537   if (CHARSETP (charset_or_name))
 538     return charset_or_name;
 539
 540   CHECK_SYMBOL (charset_or_name);
 541   return Fgethash (charset_or_name, Vcharset_hash_table, Qnil);
 542 }
 543
 544 DEFUN ("get-charset", Fget_charset, 1, 1, 0, /*
 545 Retrieve the charset of the given name.
 546 Same as `find-charset' except an error is signalled if there is no such
 547 charset instead of returning nil.
 548 */
 549        (name))
 550 {
 551   Lisp_Object charset = Ffind_charset (name);
 552
 553   if (NILP (charset))
 554     signal_simple_error ("No such charset", name);
 555   return charset;
 556 }
 557
 558 /* We store the charsets in hash tables with the names as the key and the
 559    actual charset object as the value.  Occasionally we need to use them
 560    in a list format.  These routines provide us with that. */
 561 struct charset_list_closure
 562 {
 563   Lisp_Object *charset_list;
 564 };
 565
 566 static int
 567 add_charset_to_list_mapper (Lisp_Object key, Lisp_Object value,
 568                             void *charset_list_closure)
 569 {
 570   /* This function can GC */
 571   struct charset_list_closure *chcl =
 572     (struct charset_list_closure*) charset_list_closure;
 573   Lisp_Object *charset_list = chcl->charset_list;
 574
 575   *charset_list = Fcons (XCHARSET_NAME (value), *charset_list);
 576   return 0;
 577 }
 578
 579 DEFUN ("charset-list", Fcharset_list, 0, 0, 0, /*
 580 Return a list of the names of all defined charsets.
 581 */
 582        ())
 583 {
 584   Lisp_Object charset_list = Qnil;
 585   struct gcpro gcpro1;
 586   struct charset_list_closure charset_list_closure;
 587
 588   GCPRO1 (charset_list);
 589   charset_list_closure.charset_list = &charset_list;
 590   elisp_maphash (add_charset_to_list_mapper, Vcharset_hash_table,
 591                  &charset_list_closure);
 592   UNGCPRO;
 593
 594   return charset_list;
 595 }
 596
 597 DEFUN ("charset-name", Fcharset_name, 1, 1, 0, /*
 598 Return the name of the given charset.
 599 */
 600        (charset))
 601 {
 602   return XCHARSET_NAME (Fget_charset (charset));
 603 }
 604
 605 DEFUN ("make-charset", Fmake_charset, 3, 3, 0, /*
 606 Define a new character set.
 607 This function is for use with Mule support.
 608 NAME is a symbol, the name by which the character set is normally referred.
 609 DOC-STRING is a string describing the character set.
 610 PROPS is a property list, describing the specific nature of the
 611 character set.  Recognized properties are:
 612
 613 'registry       A regular expression matching the font registry field for
 614                 this character set.
 615 'dimension      Number of octets used to index a character in this charset.
 616                 Either 1 or 2.  Defaults to 1.
 617 'columns        Number of columns used to display a character in this charset.
 618                 Only used in TTY mode. (Under X, the actual width of a
 619                 character can be derived from the font used to display the
 620                 characters.) If unspecified, defaults to the dimension
 621                 (this is almost always the correct value).
 622 'chars          Number of characters in each dimension (94 or 96).
 623                 Defaults to 94.  Note that if the dimension is 2, the
 624                 character set thus described is 94x94 or 96x96.
 625 'final          Final byte of ISO 2022 escape sequence.  Must be
 626                 supplied.  Each combination of (DIMENSION, CHARS) defines a
 627                 separate namespace for final bytes.  Note that ISO
 628                 2022 restricts the final byte to the range
 629                 0x30 - 0x7E if dimension == 1, and 0x30 - 0x5F if
 630                 dimension == 2.  Note also that final bytes in the range
 631                 0x30 - 0x3F are reserved for user-defined (not official)
 632                 character sets.
 633 'graphic        0 (use left half of font on output) or 1 (use right half
 634                 of font on output).  Defaults to 0.  For example, for
 635                 a font whose registry is ISO8859-1, the left half
 636                 (octets 0x20 - 0x7F) is the `ascii' character set, while
 637                 the right half (octets 0xA0 - 0xFF) is the `latin-1'
 638                 character set.  With 'graphic set to 0, the octets
 639                 will have their high bit cleared; with it set to 1,
 640                 the octets will have their high bit set.
 641 'direction      'l2r (left-to-right) or 'r2l (right-to-left).
 642                 Defaults to 'l2r.
 643 'ccl-program    A compiled CCL program used to convert a character in
 644                 this charset into an index into the font.  This is in
 645                 addition to the 'graphic property.  The CCL program
 646                 is passed the octets of the character, with the high
 647                 bit cleared and set depending upon whether the value
 648                 of the 'graphic property is 0 or 1.
 649 */
 650        (name, doc_string, props))
 651 {
 652   int lb, dimension = 1, chars = 94, graphic = 0, final = 0, columns = -1;
 653   int direction = CHARSET_LEFT_TO_RIGHT;
 654   int type;
 655   Lisp_Object registry = Qnil;
 656   Lisp_Object charset;
 657   Lisp_Object rest, keyword, value;
 658   Lisp_Object ccl_program = Qnil;
 659
 660   CHECK_SYMBOL (name);
 661   if (!NILP (doc_string))
 662     CHECK_STRING (doc_string);
 663
 664   charset = Ffind_charset (name);
 665   if (!NILP (charset))
 666     signal_simple_error ("Cannot redefine existing charset", name);
 667
 668   EXTERNAL_PROPERTY_LIST_LOOP (rest, keyword, value, props)
 669     {
 670       if (EQ (keyword, Qdimension))
 671         {
 672           CHECK_INT (value);
 673           dimension = XINT (value);
 674           if (dimension < 1 || dimension > 2)
 675             signal_simple_error ("Invalid value for 'dimension", value);
 676         }
 677
 678       else if (EQ (keyword, Qchars))
 679         {
 680           CHECK_INT (value);
 681           chars = XINT (value);
 682           if (chars != 94 && chars != 96)
 683             signal_simple_error ("Invalid value for 'chars", value);
 684         }
 685
 686       else if (EQ (keyword, Qcolumns))
 687         {
 688           CHECK_INT (value);
 689           columns = XINT (value);
 690           if (columns != 1 && columns != 2)
 691             signal_simple_error ("Invalid value for 'columns", value);
 692         }
 693
 694       else if (EQ (keyword, Qgraphic))
 695         {
 696           CHECK_INT (value);
 697           graphic = XINT (value);
 698           if (graphic < 0 || graphic > 1)
 699             signal_simple_error ("Invalid value for 'graphic", value);
 700         }
 701
 702       else if (EQ (keyword, Qregistry))
 703         {
 704           CHECK_STRING (value);
 705           registry = value;
 706         }
 707
 708       else if (EQ (keyword, Qdirection))
 709         {
 710           if (EQ (value, Ql2r))
 711             direction = CHARSET_LEFT_TO_RIGHT;
 712           else if (EQ (value, Qr2l))
 713             direction = CHARSET_RIGHT_TO_LEFT;
 714           else
 715             signal_simple_error ("Invalid value for 'direction", value);
 716         }
 717
 718       else if (EQ (keyword, Qfinal))
 719         {
 720           CHECK_CHAR_COERCE_INT (value);
 721           final = XCHAR (value);
 722           if (final < '0' || final > '~')
 723             signal_simple_error ("Invalid value for 'final", value);
 724         }
 725
 726       else if (EQ (keyword, Qccl_program))
 727         {
 728           CHECK_VECTOR (value);
 729           ccl_program = value;
 730         }
 731
 732       else
 733         signal_simple_error ("Unrecognized property", keyword);
 734     }
 735
 736   if (!final)
 737     error ("'final must be specified");
 738   if (dimension == 2 && final > 0x5F)
 739     signal_simple_error
 740       ("Final must be in the range 0x30 - 0x5F for dimension == 2",
 741        make_char (final));
 742
 743   if (dimension == 1)
 744     type = (chars == 94) ? CHARSET_TYPE_94    : CHARSET_TYPE_96;
 745   else
 746     type = (chars == 94) ? CHARSET_TYPE_94X94 : CHARSET_TYPE_96X96;
 747
 748   if (!NILP (CHARSET_BY_ATTRIBUTES (type, final, CHARSET_LEFT_TO_RIGHT)) ||
 749       !NILP (CHARSET_BY_ATTRIBUTES (type, final, CHARSET_RIGHT_TO_LEFT)))
 750     error
 751       ("Character set already defined for this DIMENSION/CHARS/FINAL combo");
 752
 753   lb = get_unallocated_leading_byte (dimension);
 754
 755   if (NILP (doc_string))
 756     doc_string = build_string ("");
 757
 758   if (NILP (registry))
 759     registry = build_string ("");
 760
 761   if (columns == -1)
 762     columns = dimension;
 763   charset = make_charset (-1, name, lb, dimension + 2, type, columns, graphic,
 764                           final, direction, doc_string, registry);
 765   if (!NILP (ccl_program))
 766     XCHARSET_CCL_PROGRAM (charset) = ccl_program;
 767   return charset;
 768 }
 769
 770 DEFUN ("make-reverse-direction-charset", Fmake_reverse_direction_charset,
 771        2, 2, 0, /*
 772 Make a charset equivalent to CHARSET but which goes in the opposite direction.
 773 NEW-NAME is the name of the new charset.  Return the new charset.
 774 */
 775        (charset, new_name))
 776 {
 777   Lisp_Object new_charset = Qnil;
 778   int lb, dimension, columns, graphic, final;
 779   int direction, type;
 780   Lisp_Object registry, doc_string;
 781   struct Lisp_Charset *cs;
 782
 783   charset = Fget_charset (charset);
 784   if (!NILP (XCHARSET_REVERSE_DIRECTION_CHARSET (charset)))
 785     signal_simple_error ("Charset already has reverse-direction charset",
 786                          charset);
 787
 788   CHECK_SYMBOL (new_name);
 789   if (!NILP (Ffind_charset (new_name)))
 790     signal_simple_error ("Cannot redefine existing charset", new_name);
 791
 792   cs = XCHARSET (charset);
 793
 794   type      = CHARSET_TYPE      (cs);
 795   columns   = CHARSET_COLUMNS   (cs);
 796   dimension = CHARSET_DIMENSION (cs);
 797   lb = get_unallocated_leading_byte (dimension);
 798
 799   graphic = CHARSET_GRAPHIC (cs);
 800   final = CHARSET_FINAL (cs);
 801   direction = CHARSET_RIGHT_TO_LEFT;
 802   if (CHARSET_DIRECTION (cs) == CHARSET_RIGHT_TO_LEFT)
 803     direction = CHARSET_LEFT_TO_RIGHT;
 804   doc_string = CHARSET_DOC_STRING (cs);
 805   registry = CHARSET_REGISTRY (cs);
 806
 807   new_charset = make_charset (-1, new_name, lb, dimension + 2, type, columns,
 808                               graphic, final, direction, doc_string, registry);
 809
 810   CHARSET_REVERSE_DIRECTION_CHARSET (cs) = new_charset;
 811   XCHARSET_REVERSE_DIRECTION_CHARSET (new_charset) = charset;
 812
 813   return new_charset;
 814 }
 815
 816 /* #### Reverse direction charsets not yet implemented.  */
 817 #if 0
 818 DEFUN ("charset-reverse-direction-charset", Fcharset_reverse_direction_charset,
 819        1, 1, 0, /*
 820 Return the reverse-direction charset parallel to CHARSET, if any.
 821 This is the charset with the same properties (in particular, the same
 822 dimension, number of characters per dimension, and final byte) as
 823 CHARSET but whose characters are displayed in the opposite direction.
 824 */
 825        (charset))
 826 {
 827   charset = Fget_charset (charset);
 828   return XCHARSET_REVERSE_DIRECTION_CHARSET (charset);
 829 }
 830 #endif
 831
 832 DEFUN ("charset-from-attributes", Fcharset_from_attributes, 3, 4, 0, /*
 833 Return a charset with the given DIMENSION, CHARS, FINAL, and DIRECTION.
 834 If DIRECTION is omitted, both directions will be checked (left-to-right
 835 will be returned if character sets exist for both directions).
 836 */
 837        (dimension, chars, final, direction))
 838 {
 839   int dm, ch, fi, di = -1;
 840   int type;
 841   Lisp_Object obj = Qnil;
 842
 843   CHECK_INT (dimension);
 844   dm = XINT (dimension);
 845   if (dm < 1 || dm > 2)
 846     signal_simple_error ("Invalid value for DIMENSION", dimension);
 847
 848   CHECK_INT (chars);
 849   ch = XINT (chars);
 850   if (ch != 94 && ch != 96)
 851     signal_simple_error ("Invalid value for CHARS", chars);
 852
 853   CHECK_CHAR_COERCE_INT (final);
 854   fi = XCHAR (final);
 855   if (fi < '0' || fi > '~')
 856     signal_simple_error ("Invalid value for FINAL", final);
 857
 858   if (EQ (direction, Ql2r))
 859     di = CHARSET_LEFT_TO_RIGHT;
 860   else if (EQ (direction, Qr2l))
 861     di = CHARSET_RIGHT_TO_LEFT;
 862   else if (!NILP (direction))
 863     signal_simple_error ("Invalid value for DIRECTION", direction);
 864
 865   if (dm == 2 && fi > 0x5F)
 866     signal_simple_error
 867       ("Final must be in the range 0x30 - 0x5F for dimension == 2", final);
 868
 869   if (dm == 1)
 870     type = (ch == 94) ? CHARSET_TYPE_94    : CHARSET_TYPE_96;
 871   else
 872     type = (ch == 94) ? CHARSET_TYPE_94X94 : CHARSET_TYPE_96X96;
 873
 874   if (di == -1)
 875     {
 876       obj = CHARSET_BY_ATTRIBUTES (type, fi, CHARSET_LEFT_TO_RIGHT);
 877       if (NILP (obj))
 878         obj = CHARSET_BY_ATTRIBUTES (type, fi, CHARSET_RIGHT_TO_LEFT);
 879     }
 880   else
 881     obj = CHARSET_BY_ATTRIBUTES (type, fi, di);
 882
 883   if (CHARSETP (obj))
 884     return XCHARSET_NAME (obj);
 885   return obj;
 886 }
 887
 888 DEFUN ("charset-doc-string", Fcharset_doc_string, 1, 1, 0, /*
 889 Return doc string of CHARSET.
 890 */
 891        (charset))
 892 {
 893   return XCHARSET_DOC_STRING (Fget_charset (charset));
 894 }
 895
 896 DEFUN ("charset-dimension", Fcharset_dimension, 1, 1, 0, /*
 897 Return dimension of CHARSET.
 898 */
 899        (charset))
 900 {
 901   return make_int (XCHARSET_DIMENSION (Fget_charset (charset)));
 902 }
 903
 904 DEFUN ("charset-property", Fcharset_property, 2, 2, 0, /*
 905 Return property PROP of CHARSET.
 906 Recognized properties are those listed in `make-charset', as well as
 907 'name and 'doc-string.
 908 */
 909        (charset, prop))
 910 {
 911   struct Lisp_Charset *cs;
 912
 913   charset = Fget_charset (charset);
 914   cs = XCHARSET (charset);
 915
 916   CHECK_SYMBOL (prop);
 917   if (EQ (prop, Qname))        return CHARSET_NAME (cs);
 918   if (EQ (prop, Qdoc_string))  return CHARSET_DOC_STRING (cs);
 919   if (EQ (prop, Qdimension))   return make_int (CHARSET_DIMENSION (cs));
 920   if (EQ (prop, Qcolumns))     return make_int (CHARSET_COLUMNS (cs));
 921   if (EQ (prop, Qgraphic))     return make_int (CHARSET_GRAPHIC (cs));
 922   if (EQ (prop, Qfinal))       return make_char (CHARSET_FINAL (cs));
 923   if (EQ (prop, Qchars))       return make_int (CHARSET_CHARS (cs));
 924   if (EQ (prop, Qregistry))    return CHARSET_REGISTRY (cs);
 925   if (EQ (prop, Qccl_program)) return CHARSET_CCL_PROGRAM (cs);
 926   if (EQ (prop, Qleading_byte)) return make_char (CHARSET_LEADING_BYTE (cs));
 927   if (EQ (prop, Qdirection))
 928     return CHARSET_DIRECTION (cs) == CHARSET_LEFT_TO_RIGHT ? Ql2r : Qr2l;
 929   if (EQ (prop, Qreverse_direction_charset))
 930     {
 931       Lisp_Object obj = CHARSET_REVERSE_DIRECTION_CHARSET (cs);
 932       if (NILP (obj))
 933         return Qnil;
 934       else
 935         return XCHARSET_NAME (obj);
 936     }
 937   signal_simple_error ("Unrecognized charset property name", prop);
 938   return Qnil; /* not reached */
 939 }
 940
 941 DEFUN ("charset-id", Fcharset_id, 1, 1, 0, /*
 942 Return charset identification number of CHARSET.
 943 */
 944         (charset))
 945 {
 946   return make_int(XCHARSET_ID (Fget_charset (charset)));
 947 }
 948
 949 /* #### We need to figure out which properties we really want to
 950    allow to be set. */
 951
 952 DEFUN ("set-charset-ccl-program", Fset_charset_ccl_program, 2, 2, 0, /*
 953 Set the 'ccl-program property of CHARSET to CCL-PROGRAM.
 954 */
 955        (charset, ccl_program))
 956 {
 957   charset = Fget_charset (charset);
 958   CHECK_VECTOR (ccl_program);
 959   XCHARSET_CCL_PROGRAM (charset) = ccl_program;
 960   return Qnil;
 961 }
 962
 963 static void
 964 invalidate_charset_font_caches (Lisp_Object charset)
 965 {
 966   /* Invalidate font cache entries for charset on all devices. */
 967   Lisp_Object devcons, concons, hash_table;
 968   DEVICE_LOOP_NO_BREAK (devcons, concons)
 969     {
 970       struct device *d = XDEVICE (XCAR (devcons));
 971       hash_table = Fgethash (charset, d->charset_font_cache, Qunbound);
 972       if (!UNBOUNDP (hash_table))
 973         Fclrhash (hash_table);
 974     }
 975 }
 976
 977 /* Japanese folks may want to (set-charset-registry 'ascii "jisx0201") */
 978 DEFUN ("set-charset-registry", Fset_charset_registry, 2, 2, 0, /*
 979 Set the 'registry property of CHARSET to REGISTRY.
 980 */
 981        (charset, registry))
 982 {
 983   charset = Fget_charset (charset);
 984   CHECK_STRING (registry);
 985   XCHARSET_REGISTRY (charset) = registry;
 986   invalidate_charset_font_caches (charset);
 987   face_property_was_changed (Vdefault_face, Qfont, Qglobal);
 988   return Qnil;
 989 }
 990
 991 \f
 992 /************************************************************************/
 993 /*              Lisp primitives for working with characters             */
 994 /************************************************************************/
 995
 996 DEFUN ("make-char", Fmake_char, 2, 3, 0, /*
 997 Make a multi-byte character from CHARSET and octets ARG1 and ARG2.
 998 */
 999        (charset, arg1, arg2))
1000 {
1001   struct Lisp_Charset *cs;
1002   int a1, a2;
1003   int lowlim, highlim;
1004
1005   charset = Fget_charset (charset);
1006   cs = XCHARSET (charset);
1007
1008   if      (EQ (charset, Vcharset_ascii))     lowlim =  0, highlim = 127;
1009   else if (EQ (charset, Vcharset_control_1)) lowlim =  0, highlim =  31;
1010   else if (CHARSET_CHARS (cs) == 94)         lowlim = 33, highlim = 126;
1011   else  /* CHARSET_CHARS (cs) == 96) */      lowlim = 32, highlim = 127;
1012
1013   CHECK_INT (arg1);
1014   a1 = XINT (arg1);
1015   if (a1 < lowlim || a1 > highlim)
1016     args_out_of_range_3 (arg1, make_int (lowlim), make_int (highlim));
1017
1018   if (CHARSET_DIMENSION (cs) == 1)
1019     {
1020       if (!NILP (arg2))
1021         signal_simple_error
1022           ("Charset is of dimension one; second octet must be nil", arg2);
1023       return make_char (MAKE_CHAR (charset, a1, 0));
1024     }
1025
1026   CHECK_INT (arg2);
1027   a2 = XINT (arg2);
1028   if (a2 < lowlim || a2 > highlim)
1029     args_out_of_range_3 (arg2, make_int (lowlim), make_int (highlim));
1030
1031   return make_char (MAKE_CHAR (charset, a1, a2));
1032 }
1033
1034 DEFUN ("char-charset", Fchar_charset, 1, 1, 0, /*
1035 Return the character set of char CH.
1036 */
1037        (ch))
1038 {
1039   CHECK_CHAR_COERCE_INT (ch);
1040
1041   return XCHARSET_NAME (CHARSET_BY_LEADING_BYTE
1042                         (CHAR_LEADING_BYTE (XCHAR (ch))));
1043 }
1044
1045 DEFUN ("char-octet", Fchar_octet, 1, 2, 0, /*
1046 Return the octet numbered N (should be 0 or 1) of char CH.
1047 N defaults to 0 if omitted.
1048 */
1049        (ch, n))
1050 {
1051   Lisp_Object charset;
1052   int c1, c2, int_n;
1053
1054   CHECK_CHAR_COERCE_INT (ch);
1055   if (NILP (n))
1056     int_n = 0;
1057   else
1058     {
1059       CHECK_INT (n);
1060       int_n = XINT (n);
1061       if (int_n != 0 && int_n != 1)
1062         signal_simple_error ("Octet number must be 0 or 1", n);
1063     }
1064   BREAKUP_CHAR (XCHAR (ch), charset, c1, c2);
1065   return make_int (int_n == 0 ? c1 : c2);
1066 }
1067
1068 \f
1069 /************************************************************************/
1070 /*                     composite character functions                    */
1071 /************************************************************************/
1072
1073 Emchar
1074 lookup_composite_char (Bufbyte *str, int len)
1075 {
1076   Lisp_Object lispstr = make_string (str, len);
1077   Lisp_Object ch = Fgethash (lispstr,
1078                              Vcomposite_char_string2char_hash_table,
1079                              Qunbound);
1080   Emchar emch;
1081
1082   if (UNBOUNDP (ch))
1083     {
1084       if (composite_char_row_next >= 128)
1085         signal_simple_error ("No more composite chars available", lispstr);
1086       emch = MAKE_CHAR (Vcharset_composite, composite_char_row_next,
1087                         composite_char_col_next);
1088       Fputhash (make_char (emch), lispstr,
1089                 Vcomposite_char_char2string_hash_table);
1090       Fputhash (lispstr, make_char (emch),
1091                 Vcomposite_char_string2char_hash_table);
1092       composite_char_col_next++;
1093       if (composite_char_col_next >= 128)
1094         {
1095           composite_char_col_next = 32;
1096           composite_char_row_next++;
1097         }
1098     }
1099   else
1100     emch = XCHAR (ch);
1101   return emch;
1102 }
1103
1104 Lisp_Object
1105 composite_char_string (Emchar ch)
1106 {
1107   Lisp_Object str = Fgethash (make_char (ch),
1108                               Vcomposite_char_char2string_hash_table,
1109                               Qunbound);
1110   assert (!UNBOUNDP (str));
1111   return str;
1112 }
1113
1114 DEFUN ("make-composite-char", Fmake_composite_char, 1, 1, 0, /*
1115 Convert a string into a single composite character.
1116 The character is the result of overstriking all the characters in
1117 the string.
1118 */
1119        (string))
1120 {
1121   CHECK_STRING (string);
1122   return make_char (lookup_composite_char (XSTRING_DATA (string),
1123                                            XSTRING_LENGTH (string)));
1124 }
1125
1126 DEFUN ("composite-char-string", Fcomposite_char_string, 1, 1, 0, /*
1127 Return a string of the characters comprising a composite character.
1128 */
1129        (ch))
1130 {
1131   Emchar emch;
1132
1133   CHECK_CHAR (ch);
1134   emch = XCHAR (ch);
1135   if (CHAR_LEADING_BYTE (emch) != LEADING_BYTE_COMPOSITE)
1136     signal_simple_error ("Must be composite char", ch);
1137   return composite_char_string (emch);
1138 }
1139
1140 \f
1141 /************************************************************************/
1142 /*                            initialization                            */
1143 /************************************************************************/
1144
1145 void
1146 syms_of_mule_charset (void)
1147 {
1148   DEFSUBR (Fcharsetp);
1149   DEFSUBR (Ffind_charset);
1150   DEFSUBR (Fget_charset);
1151   DEFSUBR (Fcharset_list);
1152   DEFSUBR (Fcharset_name);
1153   DEFSUBR (Fmake_charset);
1154   DEFSUBR (Fmake_reverse_direction_charset);
1155   /*  DEFSUBR (Freverse_direction_charset); */
1156   DEFSUBR (Fcharset_from_attributes);
1157   DEFSUBR (Fcharset_doc_string);
1158   DEFSUBR (Fcharset_dimension);
1159   DEFSUBR (Fcharset_property);
1160   DEFSUBR (Fcharset_id);
1161   DEFSUBR (Fset_charset_ccl_program);
1162   DEFSUBR (Fset_charset_registry);
1163
1164   DEFSUBR (Fmake_char);
1165   DEFSUBR (Fchar_charset);
1166   DEFSUBR (Fchar_octet);
1167
1168   DEFSUBR (Fmake_composite_char);
1169   DEFSUBR (Fcomposite_char_string);
1170
1171   defsymbol (&Qcharsetp, "charsetp");
1172   defsymbol (&Qregistry, "registry");
1173   defsymbol (&Qfinal, "final");
1174   defsymbol (&Qgraphic, "graphic");
1175   defsymbol (&Qdirection, "direction");
1176   defsymbol (&Qreverse_direction_charset, "reverse-direction-charset");
1177   defsymbol (&Qccl_program, "ccl-program");
1178   defsymbol (&Qleading_byte, "leading-byte");
1179
1180   defsymbol (&Ql2r, "l2r");
1181   defsymbol (&Qr2l, "r2l");
1182
1183   /* Charsets, compatible with Emacs/Mule 19.33-delta
1184      Naming convention is Script-Charset[-Edition] */
1185   defsymbol (&Qascii,                   "ascii");
1186   defsymbol (&Qcontrol_1,               "control-1");
1187   defsymbol (&Qlatin_iso8859_1,         "latin-iso8859-1");
1188   defsymbol (&Qlatin_iso8859_2,         "latin-iso8859-2");
1189   defsymbol (&Qlatin_iso8859_3,         "latin-iso8859-3");
1190   defsymbol (&Qlatin_iso8859_4,         "latin-iso8859-4");
1191   defsymbol (&Qcyrillic_iso8859_5,      "cyrillic-iso8859-5");
1192   defsymbol (&Qarabic_iso8859_6,        "arabic-iso8859-6");
1193   defsymbol (&Qgreek_iso8859_7,         "greek-iso8859-7");
1194   defsymbol (&Qhebrew_iso8859_8,        "hebrew-iso8859-8");
1195   defsymbol (&Qlatin_iso8859_9,         "latin-iso8859-9");
1196   defsymbol (&Qthai_tis620,             "thai-tis620");
1197
1198   defsymbol (&Qkatakana_jisx0201,       "katakana-jisx0201");
1199   defsymbol (&Qlatin_jisx0201,          "latin-jisx0201");
1200   defsymbol (&Qjapanese_jisx0208_1978,  "japanese-jisx0208-1978");
1201   defsymbol (&Qjapanese_jisx0208,       "japanese-jisx0208");
1202   defsymbol (&Qjapanese_jisx0212,       "japanese-jisx0212");
1203
1204   defsymbol (&Qchinese_gb2312,          "chinese-gb2312");
1205   defsymbol (&Qchinese_big5_1,          "chinese-big5-1");
1206   defsymbol (&Qchinese_big5_2,          "chinese-big5-2");
1207   defsymbol (&Qchinese_cns11643_1,      "chinese-cns11643-1");
1208   defsymbol (&Qchinese_cns11643_2,      "chinese-cns11643-2");
1209
1210   defsymbol (&Qkorean_ksc5601,          "korean-ksc5601");
1211   defsymbol (&Qcomposite,               "composite");
1212 }
1213
1214 void
1215 vars_of_mule_charset (void)
1216 {
1217   int i, j, k;
1218
1219   /* Table of charsets indexed by leading byte. */
1220   for (i = 0; i < countof (charset_by_leading_byte); i++)
1221     charset_by_leading_byte[i] = Qnil;
1222
1223   /* Table of charsets indexed by type/final-byte/direction. */
1224   for (i = 0; i < countof (charset_by_attributes); i++)
1225     for (j = 0; j < countof (charset_by_attributes[0]); j++)
1226       for (k = 0; k < countof (charset_by_attributes[0][0]); k++)
1227         charset_by_attributes[i][j][k] = Qnil;
1228
1229   next_allocated_1_byte_leading_byte = MIN_LEADING_BYTE_PRIVATE_1;
1230   next_allocated_2_byte_leading_byte = MIN_LEADING_BYTE_PRIVATE_2;
1231 }
1232
1233 void
1234 complex_vars_of_mule_charset (void)
1235 {
1236   staticpro (&Vcharset_hash_table);
1237   Vcharset_hash_table =
1238     make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
1239
1240   /* Predefined character sets.  We store them into variables for
1241      ease of access. */
1242
1243   Vcharset_ascii =
1244     make_charset (0, Qascii, LEADING_BYTE_ASCII, 1,
1245                   CHARSET_TYPE_94, 1, 0, 'B',
1246                   CHARSET_LEFT_TO_RIGHT,
1247                   build_string ("ASCII (ISO 646 IRV)"),
1248                   build_string ("iso8859-1"));
1249   Vcharset_control_1 =
1250     make_charset (-1, Qcontrol_1, LEADING_BYTE_CONTROL_1, 2,
1251                   CHARSET_TYPE_94, 1, 1, 0,
1252                   CHARSET_LEFT_TO_RIGHT,
1253                   build_string ("Control characters"),
1254                   build_string (""));
1255   Vcharset_latin_iso8859_1 =
1256     make_charset (129, Qlatin_iso8859_1, LEADING_BYTE_LATIN_ISO8859_1, 2,
1257                   CHARSET_TYPE_96, 1, 1, 'A',
1258                   CHARSET_LEFT_TO_RIGHT,
1259                   build_string ("ISO 8859-1 (Latin-1)"),
1260                   build_string ("iso8859-1"));
1261   Vcharset_latin_iso8859_2 =
1262     make_charset (130, Qlatin_iso8859_2, LEADING_BYTE_LATIN_ISO8859_2, 2,
1263                   CHARSET_TYPE_96, 1, 1, 'B',
1264                   CHARSET_LEFT_TO_RIGHT,
1265                   build_string ("ISO 8859-2 (Latin-2)"),
1266                   build_string ("iso8859-2"));
1267   Vcharset_latin_iso8859_3 =
1268     make_charset (131, Qlatin_iso8859_3, LEADING_BYTE_LATIN_ISO8859_3, 2,
1269                   CHARSET_TYPE_96, 1, 1, 'C',
1270                   CHARSET_LEFT_TO_RIGHT,
1271                   build_string ("ISO 8859-3 (Latin-3)"),
1272                   build_string ("iso8859-3"));
1273   Vcharset_latin_iso8859_4 =
1274     make_charset (132, Qlatin_iso8859_4, LEADING_BYTE_LATIN_ISO8859_4, 2,
1275                   CHARSET_TYPE_96, 1, 1, 'D',
1276                   CHARSET_LEFT_TO_RIGHT,
1277                   build_string ("ISO 8859-4 (Latin-4)"),
1278                   build_string ("iso8859-4"));
1279   Vcharset_cyrillic_iso8859_5 =
1280     make_charset (140, Qcyrillic_iso8859_5, LEADING_BYTE_CYRILLIC_ISO8859_5, 2,
1281                   CHARSET_TYPE_96, 1, 1, 'L',
1282                   CHARSET_LEFT_TO_RIGHT,
1283                   build_string ("ISO 8859-5 (Cyrillic)"),
1284                   build_string ("iso8859-5"));
1285   Vcharset_arabic_iso8859_6 =
1286     make_charset (135, Qarabic_iso8859_6, LEADING_BYTE_ARABIC_ISO8859_6, 2,
1287                   CHARSET_TYPE_96, 1, 1, 'G',
1288                   CHARSET_RIGHT_TO_LEFT,
1289                   build_string ("ISO 8859-6 (Arabic)"),
1290                   build_string ("iso8859-6"));
1291   Vcharset_greek_iso8859_7 =
1292     make_charset (134, Qgreek_iso8859_7, LEADING_BYTE_GREEK_ISO8859_7, 2,
1293                   CHARSET_TYPE_96, 1, 1, 'F',
1294                   CHARSET_LEFT_TO_RIGHT,
1295                   build_string ("ISO 8859-7 (Greek)"),
1296                   build_string ("iso8859-7"));
1297   Vcharset_hebrew_iso8859_8 =
1298     make_charset (136, Qhebrew_iso8859_8, LEADING_BYTE_HEBREW_ISO8859_8, 2,
1299                   CHARSET_TYPE_96, 1, 1, 'H',
1300                   CHARSET_RIGHT_TO_LEFT,
1301                   build_string ("ISO 8859-8 (Hebrew)"),
1302                   build_string ("iso8859-8"));
1303   Vcharset_latin_iso8859_9 =
1304     make_charset (141, Qlatin_iso8859_9, LEADING_BYTE_LATIN_ISO8859_9, 2,
1305                   CHARSET_TYPE_96, 1, 1, 'M',
1306                   CHARSET_LEFT_TO_RIGHT,
1307                   build_string ("ISO 8859-9 (Latin-5)"),
1308                   build_string ("iso8859-9"));
1309   Vcharset_thai_tis620 =
1310     make_charset (133, Qthai_tis620, LEADING_BYTE_THAI_TIS620, 2,
1311                   CHARSET_TYPE_96, 1, 1, 'T',
1312                   CHARSET_LEFT_TO_RIGHT,
1313                   build_string ("TIS 620.2529 (Thai)"),
1314                   build_string ("tis620"));
1315
1316   /* Japanese */
1317   Vcharset_katakana_jisx0201 =
1318     make_charset (137, Qkatakana_jisx0201,
1319                   LEADING_BYTE_KATAKANA_JISX0201, 2,
1320                   CHARSET_TYPE_94, 1, 1, 'I',
1321                   CHARSET_LEFT_TO_RIGHT,
1322                   build_string ("JIS X0201-Katakana"),
1323                   build_string ("jisx0201.1976"));
1324   Vcharset_latin_jisx0201 =
1325     make_charset (138, Qlatin_jisx0201,
1326                   LEADING_BYTE_LATIN_JISX0201, 2,
1327                   CHARSET_TYPE_94, 1, 0, 'J',
1328                   CHARSET_LEFT_TO_RIGHT,
1329                   build_string ("JIS X0201-Latin"),
1330                   build_string ("jisx0201.1976"));
1331   Vcharset_japanese_jisx0208_1978 =
1332     make_charset (144, Qjapanese_jisx0208_1978,
1333                   LEADING_BYTE_JAPANESE_JISX0208_1978, 3,
1334                   CHARSET_TYPE_94X94, 2, 0, '@',
1335                   CHARSET_LEFT_TO_RIGHT,
1336                   build_string
1337                   ("JIS X0208-1978 (Japanese Kanji; Old Version)"),
1338                   build_string ("\\(jisx0208\\|jisc6226\\).19"));
1339   Vcharset_japanese_jisx0208 =
1340     make_charset (146, Qjapanese_jisx0208,
1341                   LEADING_BYTE_JAPANESE_JISX0208, 3,
1342                   CHARSET_TYPE_94X94, 2, 0, 'B',
1343                   CHARSET_LEFT_TO_RIGHT,
1344                   build_string ("JIS X0208-1983 (Japanese Kanji)"),
1345                   build_string ("jisx0208.19\\(83\\|90\\)"));
1346   Vcharset_japanese_jisx0212 =
1347     make_charset (148, Qjapanese_jisx0212,
1348                   LEADING_BYTE_JAPANESE_JISX0212, 3,
1349                   CHARSET_TYPE_94X94, 2, 0, 'D',
1350                   CHARSET_LEFT_TO_RIGHT,
1351                   build_string ("JIS X0212 (Japanese Supplement)"),
1352                   build_string ("jisx0212"));
1353
1354   /* Chinese */
1355   Vcharset_chinese_gb2312 =
1356     make_charset (145, Qchinese_gb2312, LEADING_BYTE_CHINESE_GB2312, 3,
1357                   CHARSET_TYPE_94X94, 2, 0, 'A',
1358                   CHARSET_LEFT_TO_RIGHT,
1359                   build_string ("GB 2312 (Simplified Chinese)"),
1360                   build_string ("gb2312"));
1361 #define CHINESE_CNS_PLANE_RE(n) "cns11643[.-]\\(.*[.-]\\)?" n "$"
1362   Vcharset_chinese_cns11643_1 =
1363     make_charset (149, Qchinese_cns11643_1,
1364                   LEADING_BYTE_CHINESE_CNS11643_1, 3,
1365                   CHARSET_TYPE_94X94, 2, 0, 'G',
1366                   CHARSET_LEFT_TO_RIGHT,
1367                   build_string
1368                   ("CNS 11643 Plane 1 (Traditional Chinese for daily use)"),
1369                   build_string (CHINESE_CNS_PLANE_RE("1")));
1370   Vcharset_chinese_cns11643_2 =
1371     make_charset (150, Qchinese_cns11643_2,
1372                   LEADING_BYTE_CHINESE_CNS11643_2, 3,
1373                   CHARSET_TYPE_94X94, 2, 0, 'H',
1374                   CHARSET_LEFT_TO_RIGHT,
1375                   build_string
1376                   ("CNS 11643 Plane 2 (Traditional Chinese for daily use)"),
1377                   build_string (CHINESE_CNS_PLANE_RE("2")));
1378   Vcharset_chinese_big5_1 =
1379     make_charset (152, Qchinese_big5_1, LEADING_BYTE_CHINESE_BIG5_1, 3,
1380                   CHARSET_TYPE_94X94, 2, 0, '0',
1381                   CHARSET_LEFT_TO_RIGHT,
1382                   build_string
1383                   ("Big5 Level 1 (Traditional Chinese for daily use)"),
1384                   build_string ("big5"));
1385   Vcharset_chinese_big5_2 =
1386     make_charset (153, Qchinese_big5_2, LEADING_BYTE_CHINESE_BIG5_2, 3,
1387                   CHARSET_TYPE_94X94, 2, 0, '1',
1388                   CHARSET_LEFT_TO_RIGHT,
1389                   build_string
1390                   ("Big5 Level 2 (Traditional Chinese for daily use)"),
1391                   build_string ("big5"));
1392
1393   Vcharset_korean_ksc5601 =
1394     make_charset (147, Qkorean_ksc5601, LEADING_BYTE_KOREAN_KSC5601, 3,
1395                   CHARSET_TYPE_94X94, 2, 0, 'C',
1396                   CHARSET_LEFT_TO_RIGHT,
1397                   build_string ("KS C5601 (Hangul and Korean Hanja)"),
1398                   build_string ("ksc5601"));
1399   /* #### For simplicity, we put composite chars into a 96x96 charset.
1400      This is going to lead to problems because you can run out of
1401      room, esp. as we don't yet recycle numbers. */
1402   Vcharset_composite =
1403     make_charset (-1, Qcomposite, LEADING_BYTE_COMPOSITE, 3,
1404                   CHARSET_TYPE_96X96, 2, 0, 0,
1405                   CHARSET_LEFT_TO_RIGHT,
1406                   build_string ("Composite characters"),
1407                   build_string (""));
1408
1409   composite_char_row_next = 32;
1410   composite_char_col_next = 32;
1411
1412   Vcomposite_char_string2char_hash_table =
1413     make_lisp_hash_table (500, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL);
1414   Vcomposite_char_char2string_hash_table =
1415     make_lisp_hash_table (500, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
1416   staticpro (&Vcomposite_char_string2char_hash_table);
1417   staticpro (&Vcomposite_char_char2string_hash_table);
1418
1419 }