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