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 character from CHARSET and octets ARG1 and ARG2.
1054 ARG2 is required only for characters from two-dimensional charsets.
1055 For example, (make-char 'latin-iso8859-2 185) will return the Latin 2
1056 character s with caron.
1057 */
1058        (charset, arg1, arg2))
1059 {
1060   struct Lisp_Charset *cs;
1061   int a1, a2;
1062   int lowlim, highlim;
1063
1064   charset = Fget_charset (charset);
1065   cs = XCHARSET (charset);
1066
1067   if      (EQ (charset, Vcharset_ascii))     lowlim =  0, highlim = 127;
1068   else if (EQ (charset, Vcharset_control_1)) lowlim =  0, highlim =  31;
1069   else if (CHARSET_CHARS (cs) == 94)         lowlim = 33, highlim = 126;
1070   else  /* CHARSET_CHARS (cs) == 96) */      lowlim = 32, highlim = 127;
1071
1072   CHECK_INT (arg1);
1073   /* It is useful (and safe, according to Olivier Galibert) to strip
1074      the 8th bit off ARG1 and ARG2 becaue it allows programmers to
1075      write (make-char 'latin-iso8859-2 CODE) where code is the actual
1076      Latin 2 code of the character.  */
1077   a1 = XINT (arg1) & 0x7f;
1078   if (a1 < lowlim || a1 > highlim)
1079     args_out_of_range_3 (arg1, make_int (lowlim), make_int (highlim));
1080
1081   if (CHARSET_DIMENSION (cs) == 1)
1082     {
1083       if (!NILP (arg2))
1084         signal_simple_error
1085           ("Charset is of dimension one; second octet must be nil", arg2);
1086       return make_char (MAKE_CHAR (charset, a1, 0));
1087     }
1088
1089   CHECK_INT (arg2);
1090   a2 = XINT (arg2) & 0x7f;
1091   if (a2 < lowlim || a2 > highlim)
1092     args_out_of_range_3 (arg2, make_int (lowlim), make_int (highlim));
1093
1094   return make_char (MAKE_CHAR (charset, a1, a2));
1095 }
1096
1097 DEFUN ("char-charset", Fchar_charset, 1, 1, 0, /*
1098 Return the character set of char CH.
1099 */
1100        (ch))
1101 {
1102   CHECK_CHAR_COERCE_INT (ch);
1103
1104   return XCHARSET_NAME (CHARSET_BY_LEADING_BYTE
1105                         (CHAR_LEADING_BYTE (XCHAR (ch))));
1106 }
1107
1108 DEFUN ("char-octet", Fchar_octet, 1, 2, 0, /*
1109 Return the octet numbered N (should be 0 or 1) of char CH.
1110 N defaults to 0 if omitted.
1111 */
1112        (ch, n))
1113 {
1114   Lisp_Object charset;
1115   int c1, c2, int_n;
1116
1117   CHECK_CHAR_COERCE_INT (ch);
1118   if (NILP (n))
1119     int_n = 0;
1120   else
1121     {
1122       CHECK_INT (n);
1123       int_n = XINT (n);
1124       if (int_n != 0 && int_n != 1)
1125         signal_simple_error ("Octet number must be 0 or 1", n);
1126     }
1127   BREAKUP_CHAR (XCHAR (ch), charset, c1, c2);
1128   return make_int (int_n == 0 ? c1 : c2);
1129 }
1130
1131 \f
1132 #ifdef ENABLE_COMPOSITE_CHARS
1133 /************************************************************************/
1134 /*                     composite character functions                    */
1135 /************************************************************************/
1136
1137 Emchar
1138 lookup_composite_char (Bufbyte *str, int len)
1139 {
1140   Lisp_Object lispstr = make_string (str, len);
1141   Lisp_Object ch = Fgethash (lispstr,
1142                              Vcomposite_char_string2char_hash_table,
1143                              Qunbound);
1144   Emchar emch;
1145
1146   if (UNBOUNDP (ch))
1147     {
1148       if (composite_char_row_next >= 128)
1149         signal_simple_error ("No more composite chars available", lispstr);
1150       emch = MAKE_CHAR (Vcharset_composite, composite_char_row_next,
1151                         composite_char_col_next);
1152       Fputhash (make_char (emch), lispstr,
1153                 Vcomposite_char_char2string_hash_table);
1154       Fputhash (lispstr, make_char (emch),
1155                 Vcomposite_char_string2char_hash_table);
1156       composite_char_col_next++;
1157       if (composite_char_col_next >= 128)
1158         {
1159           composite_char_col_next = 32;
1160           composite_char_row_next++;
1161         }
1162     }
1163   else
1164     emch = XCHAR (ch);
1165   return emch;
1166 }
1167
1168 Lisp_Object
1169 composite_char_string (Emchar ch)
1170 {
1171   Lisp_Object str = Fgethash (make_char (ch),
1172                               Vcomposite_char_char2string_hash_table,
1173                               Qunbound);
1174   assert (!UNBOUNDP (str));
1175   return str;
1176 }
1177
1178 xxDEFUN ("make-composite-char", Fmake_composite_char, 1, 1, 0, /*
1179 Convert a string into a single composite character.
1180 The character is the result of overstriking all the characters in
1181 the string.
1182 */
1183        (string))
1184 {
1185   CHECK_STRING (string);
1186   return make_char (lookup_composite_char (XSTRING_DATA (string),
1187                                            XSTRING_LENGTH (string)));
1188 }
1189
1190 xxDEFUN ("composite-char-string", Fcomposite_char_string, 1, 1, 0, /*
1191 Return a string of the characters comprising a composite character.
1192 */
1193        (ch))
1194 {
1195   Emchar emch;
1196
1197   CHECK_CHAR (ch);
1198   emch = XCHAR (ch);
1199   if (CHAR_LEADING_BYTE (emch) != LEADING_BYTE_COMPOSITE)
1200     signal_simple_error ("Must be composite char", ch);
1201   return composite_char_string (emch);
1202 }
1203 #endif /* ENABLE_COMPOSITE_CHARS */
1204
1205 \f
1206 /************************************************************************/
1207 /*                            initialization                            */
1208 /************************************************************************/
1209
1210 void
1211 syms_of_mule_charset (void)
1212 {
1213   DEFSUBR (Fcharsetp);
1214   DEFSUBR (Ffind_charset);
1215   DEFSUBR (Fget_charset);
1216   DEFSUBR (Fcharset_list);
1217   DEFSUBR (Fcharset_name);
1218   DEFSUBR (Fmake_charset);
1219   DEFSUBR (Fmake_reverse_direction_charset);
1220   /*  DEFSUBR (Freverse_direction_charset); */
1221   DEFSUBR (Fcharset_from_attributes);
1222   DEFSUBR (Fcharset_short_name);
1223   DEFSUBR (Fcharset_long_name);
1224   DEFSUBR (Fcharset_description);
1225   DEFSUBR (Fcharset_dimension);
1226   DEFSUBR (Fcharset_property);
1227   DEFSUBR (Fcharset_id);
1228   DEFSUBR (Fset_charset_ccl_program);
1229   DEFSUBR (Fset_charset_registry);
1230
1231   DEFSUBR (Fmake_char);
1232   DEFSUBR (Fchar_charset);
1233   DEFSUBR (Fchar_octet);
1234
1235 #ifdef ENABLE_COMPOSITE_CHARS
1236   DEFSUBR (Fmake_composite_char);
1237   DEFSUBR (Fcomposite_char_string);
1238 #endif
1239
1240   defsymbol (&Qcharsetp, "charsetp");
1241   defsymbol (&Qregistry, "registry");
1242   defsymbol (&Qfinal, "final");
1243   defsymbol (&Qgraphic, "graphic");
1244   defsymbol (&Qdirection, "direction");
1245   defsymbol (&Qreverse_direction_charset, "reverse-direction-charset");
1246   defsymbol (&Qccl_program, "ccl-program");
1247   defsymbol (&Qshort_name, "short-name");
1248   defsymbol (&Qlong_name, "long-name");
1249
1250   defsymbol (&Ql2r, "l2r");
1251   defsymbol (&Qr2l, "r2l");
1252
1253   /* Charsets, compatible with FSF 20.3
1254      Naming convention is Script-Charset[-Edition] */
1255   defsymbol (&Qascii,                   "ascii");
1256   defsymbol (&Qcontrol_1,               "control-1");
1257   defsymbol (&Qlatin_iso8859_1,         "latin-iso8859-1");
1258   defsymbol (&Qlatin_iso8859_2,         "latin-iso8859-2");
1259   defsymbol (&Qlatin_iso8859_3,         "latin-iso8859-3");
1260   defsymbol (&Qlatin_iso8859_4,         "latin-iso8859-4");
1261   defsymbol (&Qthai_tis620,             "thai-tis620");
1262   defsymbol (&Qgreek_iso8859_7,         "greek-iso8859-7");
1263   defsymbol (&Qarabic_iso8859_6,        "arabic-iso8859-6");
1264   defsymbol (&Qhebrew_iso8859_8,        "hebrew-iso8859-8");
1265   defsymbol (&Qkatakana_jisx0201,       "katakana-jisx0201");
1266   defsymbol (&Qlatin_jisx0201,          "latin-jisx0201");
1267   defsymbol (&Qcyrillic_iso8859_5,      "cyrillic-iso8859-5");
1268   defsymbol (&Qlatin_iso8859_9,         "latin-iso8859-9");
1269   defsymbol (&Qjapanese_jisx0208_1978,  "japanese-jisx0208-1978");
1270   defsymbol (&Qchinese_gb2312,          "chinese-gb2312");
1271   defsymbol (&Qjapanese_jisx0208,       "japanese-jisx0208");
1272   defsymbol (&Qkorean_ksc5601,          "korean-ksc5601");
1273   defsymbol (&Qjapanese_jisx0212,       "japanese-jisx0212");
1274   defsymbol (&Qchinese_cns11643_1,      "chinese-cns11643-1");
1275   defsymbol (&Qchinese_cns11643_2,      "chinese-cns11643-2");
1276   defsymbol (&Qchinese_big5_1,          "chinese-big5-1");
1277   defsymbol (&Qchinese_big5_2,          "chinese-big5-2");
1278
1279   defsymbol (&Qcomposite,               "composite");
1280 }
1281
1282 void
1283 vars_of_mule_charset (void)
1284 {
1285   int i, j, k;
1286
1287   /* Table of charsets indexed by leading byte. */
1288   for (i = 0; i < countof (charset_by_leading_byte); i++)
1289     charset_by_leading_byte[i] = Qnil;
1290
1291   /* Table of charsets indexed by type/final-byte/direction. */
1292   for (i = 0; i < countof (charset_by_attributes); i++)
1293     for (j = 0; j < countof (charset_by_attributes[0]); j++)
1294       for (k = 0; k < countof (charset_by_attributes[0][0]); k++)
1295         charset_by_attributes[i][j][k] = Qnil;
1296
1297   next_allocated_1_byte_leading_byte = MIN_LEADING_BYTE_PRIVATE_1;
1298   next_allocated_2_byte_leading_byte = MIN_LEADING_BYTE_PRIVATE_2;
1299 }
1300
1301 void
1302 complex_vars_of_mule_charset (void)
1303 {
1304   staticpro (&Vcharset_hash_table);
1305   Vcharset_hash_table =
1306     make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
1307
1308   /* Predefined character sets.  We store them into variables for
1309      ease of access. */
1310
1311   Vcharset_ascii =
1312     make_charset (LEADING_BYTE_ASCII, Qascii, 1,
1313                   CHARSET_TYPE_94, 1, 0, 'B',
1314                   CHARSET_LEFT_TO_RIGHT,
1315                   build_string ("ASCII"),
1316                   build_string ("ASCII)"),
1317                   build_string ("ASCII (ISO646 IRV)"),
1318                   build_string ("\\(iso8859-[0-9]*\\|-ascii\\)"));
1319   Vcharset_control_1 =
1320     make_charset (LEADING_BYTE_CONTROL_1, Qcontrol_1, 2,
1321                   CHARSET_TYPE_94, 1, 1, 0,
1322                   CHARSET_LEFT_TO_RIGHT,
1323                   build_string ("C1"),
1324                   build_string ("Control characters"),
1325                   build_string ("Control characters 128-191"),
1326                   build_string (""));
1327   Vcharset_latin_iso8859_1 =
1328     make_charset (LEADING_BYTE_LATIN_ISO8859_1, Qlatin_iso8859_1, 2,
1329                   CHARSET_TYPE_96, 1, 1, 'A',
1330                   CHARSET_LEFT_TO_RIGHT,
1331                   build_string ("Latin-1"),
1332                   build_string ("ISO8859-1 (Latin-1)"),
1333                   build_string ("ISO8859-1 (Latin-1)"),
1334                   build_string ("iso8859-1"));
1335   Vcharset_latin_iso8859_2 =
1336     make_charset (LEADING_BYTE_LATIN_ISO8859_2, Qlatin_iso8859_2, 2,
1337                   CHARSET_TYPE_96, 1, 1, 'B',
1338                   CHARSET_LEFT_TO_RIGHT,
1339                   build_string ("Latin-2"),
1340                   build_string ("ISO8859-2 (Latin-2)"),
1341                   build_string ("ISO8859-2 (Latin-2)"),
1342                   build_string ("iso8859-2"));
1343   Vcharset_latin_iso8859_3 =
1344     make_charset (LEADING_BYTE_LATIN_ISO8859_3, Qlatin_iso8859_3, 2,
1345                   CHARSET_TYPE_96, 1, 1, 'C',
1346                   CHARSET_LEFT_TO_RIGHT,
1347                   build_string ("Latin-3"),
1348                   build_string ("ISO8859-3 (Latin-3)"),
1349                   build_string ("ISO8859-3 (Latin-3)"),
1350                   build_string ("iso8859-3"));
1351   Vcharset_latin_iso8859_4 =
1352     make_charset (LEADING_BYTE_LATIN_ISO8859_4, Qlatin_iso8859_4, 2,
1353                   CHARSET_TYPE_96, 1, 1, 'D',
1354                   CHARSET_LEFT_TO_RIGHT,
1355                   build_string ("Latin-4"),
1356                   build_string ("ISO8859-4 (Latin-4)"),
1357                   build_string ("ISO8859-4 (Latin-4)"),
1358                   build_string ("iso8859-4"));
1359   Vcharset_thai_tis620 =
1360     make_charset (LEADING_BYTE_THAI_TIS620, Qthai_tis620, 2,
1361                   CHARSET_TYPE_96, 1, 1, 'T',
1362                   CHARSET_LEFT_TO_RIGHT,
1363                   build_string ("TIS620"),
1364                   build_string ("TIS620 (Thai)"),
1365                   build_string ("TIS620.2529 (Thai)"),
1366                   build_string ("tis620"));
1367   Vcharset_greek_iso8859_7 =
1368     make_charset (LEADING_BYTE_GREEK_ISO8859_7, Qgreek_iso8859_7, 2,
1369                   CHARSET_TYPE_96, 1, 1, 'F',
1370                   CHARSET_LEFT_TO_RIGHT,
1371                   build_string ("ISO8859-7"),
1372                   build_string ("ISO8859-7 (Greek)"),
1373                   build_string ("ISO8859-7 (Greek)"),
1374                   build_string ("iso8859-7"));
1375   Vcharset_arabic_iso8859_6 =
1376     make_charset (LEADING_BYTE_ARABIC_ISO8859_6, Qarabic_iso8859_6, 2,
1377                   CHARSET_TYPE_96, 1, 1, 'G',
1378                   CHARSET_RIGHT_TO_LEFT,
1379                   build_string ("ISO8859-6"),
1380                   build_string ("ISO8859-6 (Arabic)"),
1381                   build_string ("ISO8859-6 (Arabic)"),
1382                   build_string ("iso8859-6"));
1383   Vcharset_hebrew_iso8859_8 =
1384     make_charset (LEADING_BYTE_HEBREW_ISO8859_8, Qhebrew_iso8859_8, 2,
1385                   CHARSET_TYPE_96, 1, 1, 'H',
1386                   CHARSET_RIGHT_TO_LEFT,
1387                   build_string ("ISO8859-8"),
1388                   build_string ("ISO8859-8 (Hebrew)"),
1389                   build_string ("ISO8859-8 (Hebrew)"),
1390                   build_string ("iso8859-8"));
1391   Vcharset_katakana_jisx0201 =
1392     make_charset (LEADING_BYTE_KATAKANA_JISX0201, Qkatakana_jisx0201, 2,
1393                   CHARSET_TYPE_94, 1, 1, 'I',
1394                   CHARSET_LEFT_TO_RIGHT,
1395                   build_string ("JISX0201 Kana"),
1396                   build_string ("JISX0201.1976 (Japanese Kana)"),
1397                   build_string ("JISX0201.1976 Japanese Kana"),
1398                   build_string ("jisx0201.1976"));
1399   Vcharset_latin_jisx0201 =
1400     make_charset (LEADING_BYTE_LATIN_JISX0201, Qlatin_jisx0201, 2,
1401                   CHARSET_TYPE_94, 1, 0, 'J',
1402                   CHARSET_LEFT_TO_RIGHT,
1403                   build_string ("JISX0201 Roman"),
1404                   build_string ("JISX0201.1976 (Japanese Roman)"),
1405                   build_string ("JISX0201.1976 Japanese Roman"),
1406                   build_string ("jisx0201.1976"));
1407   Vcharset_cyrillic_iso8859_5 =
1408     make_charset (LEADING_BYTE_CYRILLIC_ISO8859_5, Qcyrillic_iso8859_5, 2,
1409                   CHARSET_TYPE_96, 1, 1, 'L',
1410                   CHARSET_LEFT_TO_RIGHT,
1411                   build_string ("ISO8859-5"),
1412                   build_string ("ISO8859-5 (Cyrillic)"),
1413                   build_string ("ISO8859-5 (Cyrillic)"),
1414                   build_string ("iso8859-5"));
1415   Vcharset_latin_iso8859_9 =
1416     make_charset (LEADING_BYTE_LATIN_ISO8859_9, Qlatin_iso8859_9, 2,
1417                   CHARSET_TYPE_96, 1, 1, 'M',
1418                   CHARSET_LEFT_TO_RIGHT,
1419                   build_string ("Latin-5"),
1420                   build_string ("ISO8859-9 (Latin-5)"),
1421                   build_string ("ISO8859-9 (Latin-5)"),
1422                   build_string ("iso8859-9"));
1423   Vcharset_japanese_jisx0208_1978 =
1424     make_charset (LEADING_BYTE_JAPANESE_JISX0208_1978, Qjapanese_jisx0208_1978, 3,
1425                   CHARSET_TYPE_94X94, 2, 0, '@',
1426                   CHARSET_LEFT_TO_RIGHT,
1427                   build_string ("JISX0208.1978"),
1428                   build_string ("JISX0208.1978 (Japanese)"),
1429                   build_string
1430                   ("JISX0208.1978 Japanese Kanji (so called \"old JIS\")"),
1431                   build_string ("\\(jisx0208\\|jisc6226\\)\\.1978"));
1432   Vcharset_chinese_gb2312 =
1433     make_charset (LEADING_BYTE_CHINESE_GB2312, Qchinese_gb2312, 3,
1434                   CHARSET_TYPE_94X94, 2, 0, 'A',
1435                   CHARSET_LEFT_TO_RIGHT,
1436                   build_string ("GB2312"),
1437                   build_string ("GB2312)"),
1438                   build_string ("GB2312 Chinese simplified"),
1439                   build_string ("gb2312"));
1440   Vcharset_japanese_jisx0208 =
1441     make_charset (LEADING_BYTE_JAPANESE_JISX0208, Qjapanese_jisx0208, 3,
1442                   CHARSET_TYPE_94X94, 2, 0, 'B',
1443                   CHARSET_LEFT_TO_RIGHT,
1444                   build_string ("JISX0208"),
1445                   build_string ("JISX0208.1983/1990 (Japanese)"),
1446                   build_string ("JISX0208.1983/1990 Japanese Kanji"),
1447                   build_string ("jisx0208.19\\(83\\|90\\)"));
1448   Vcharset_korean_ksc5601 =
1449     make_charset (LEADING_BYTE_KOREAN_KSC5601, Qkorean_ksc5601, 3,
1450                   CHARSET_TYPE_94X94, 2, 0, 'C',
1451                   CHARSET_LEFT_TO_RIGHT,
1452                   build_string ("KSC5601"),
1453                   build_string ("KSC5601 (Korean"),
1454                   build_string ("KSC5601 Korean Hangul and Hanja"),
1455                   build_string ("ksc5601"));
1456   Vcharset_japanese_jisx0212 =
1457     make_charset (LEADING_BYTE_JAPANESE_JISX0212, Qjapanese_jisx0212, 3,
1458                   CHARSET_TYPE_94X94, 2, 0, 'D',
1459                   CHARSET_LEFT_TO_RIGHT,
1460                   build_string ("JISX0212"),
1461                   build_string ("JISX0212 (Japanese)"),
1462                   build_string ("JISX0212 Japanese Supplement"),
1463                   build_string ("jisx0212"));
1464
1465 #define CHINESE_CNS_PLANE_RE(n) "cns11643[.-]\\(.*[.-]\\)?" n "$"
1466   Vcharset_chinese_cns11643_1 =
1467     make_charset (LEADING_BYTE_CHINESE_CNS11643_1, Qchinese_cns11643_1, 3,
1468                   CHARSET_TYPE_94X94, 2, 0, 'G',
1469                   CHARSET_LEFT_TO_RIGHT,
1470                   build_string ("CNS11643-1"),
1471                   build_string ("CNS11643-1 (Chinese traditional)"),
1472                   build_string
1473                   ("CNS 11643 Plane 1 Chinese traditional"),
1474                   build_string (CHINESE_CNS_PLANE_RE("1")));
1475   Vcharset_chinese_cns11643_2 =
1476     make_charset (LEADING_BYTE_CHINESE_CNS11643_2, Qchinese_cns11643_2, 3,
1477                   CHARSET_TYPE_94X94, 2, 0, 'H',
1478                   CHARSET_LEFT_TO_RIGHT,
1479                   build_string ("CNS11643-2"),
1480                   build_string ("CNS11643-2 (Chinese traditional)"),
1481                   build_string
1482                   ("CNS 11643 Plane 2 Chinese traditional"),
1483                   build_string (CHINESE_CNS_PLANE_RE("2")));
1484   Vcharset_chinese_big5_1 =
1485     make_charset (LEADING_BYTE_CHINESE_BIG5_1, Qchinese_big5_1, 3,
1486                   CHARSET_TYPE_94X94, 2, 0, '0',
1487                   CHARSET_LEFT_TO_RIGHT,
1488                   build_string ("Big5"),
1489                   build_string ("Big5 (Level-1)"),
1490                   build_string
1491                   ("Big5 Level-1 Chinese traditional"),
1492                   build_string ("big5"));
1493   Vcharset_chinese_big5_2 =
1494     make_charset (LEADING_BYTE_CHINESE_BIG5_2, Qchinese_big5_2, 3,
1495                   CHARSET_TYPE_94X94, 2, 0, '1',
1496                   CHARSET_LEFT_TO_RIGHT,
1497                   build_string ("Big5"),
1498                   build_string ("Big5 (Level-2)"),
1499                   build_string
1500                   ("Big5 Level-2 Chinese traditional"),
1501                   build_string ("big5"));
1502
1503
1504 #ifdef ENABLE_COMPOSITE_CHARS
1505   /* #### For simplicity, we put composite chars into a 96x96 charset.
1506      This is going to lead to problems because you can run out of
1507      room, esp. as we don't yet recycle numbers. */
1508   Vcharset_composite =
1509     make_charset (LEADING_BYTE_COMPOSITE, Qcomposite, 3,
1510                   CHARSET_TYPE_96X96, 2, 0, 0,
1511                   CHARSET_LEFT_TO_RIGHT,
1512                   build_string ("Composite"),
1513                   build_string ("Composite characters"),
1514                   build_string ("Composite characters"),
1515                   build_string (""));
1516
1517   composite_char_row_next = 32;
1518   composite_char_col_next = 32;
1519
1520   Vcomposite_char_string2char_hash_table =
1521     make_lisp_hash_table (500, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL);
1522   Vcomposite_char_char2string_hash_table =
1523     make_lisp_hash_table (500, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
1524   staticpro (&Vcomposite_char_string2char_hash_table);
1525   staticpro (&Vcomposite_char_char2string_hash_table);
1526 #endif /* ENABLE_COMPOSITE_CHARS */
1527
1528 }