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