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