Sync up with r21-4-10-utf-2000-0_20-ucs-cns-l.
[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    Copyright (C) 1999,2000,2001,2002,2003 MORIOKA Tomohiko
5
6 This file is part of XEmacs.
7
8 XEmacs is free software; you can redistribute it and/or modify it
9 under the terms of the GNU General Public License as published by the
10 Free Software Foundation; either version 2, or (at your option) any
11 later version.
12
13 XEmacs is distributed in the hope that it will be useful, but WITHOUT
14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
15 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
16 for more details.
17
18 You should have received a copy of the GNU General Public License
19 along with XEmacs; see the file COPYING.  If not, write to
20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
21 Boston, MA 02111-1307, USA.  */
22
23 /* Rewritten by Ben Wing <ben@xemacs.org>. */
24
25 /* Rewritten by MORIOKA Tomohiko <tomo@m17n.org> for XEmacs UTF-2000. */
26
27 #include <config.h>
28 #ifdef UTF2000
29 #include <limits.h>
30 #endif
31 #include "lisp.h"
32
33 #include "buffer.h"
34 #include "chartab.h"
35 #include "elhash.h"
36 #include "lstream.h"
37 #include "device.h"
38 #include "faces.h"
39 #include "mule-ccl.h"
40
41 /* The various pre-defined charsets. */
42
43 Lisp_Object Vcharset_ascii;
44 Lisp_Object Vcharset_control_1;
45 Lisp_Object Vcharset_latin_iso8859_1;
46 Lisp_Object Vcharset_latin_iso8859_2;
47 Lisp_Object Vcharset_latin_iso8859_3;
48 Lisp_Object Vcharset_latin_iso8859_4;
49 Lisp_Object Vcharset_thai_tis620;
50 Lisp_Object Vcharset_greek_iso8859_7;
51 Lisp_Object Vcharset_arabic_iso8859_6;
52 Lisp_Object Vcharset_hebrew_iso8859_8;
53 Lisp_Object Vcharset_katakana_jisx0201;
54 Lisp_Object Vcharset_latin_jisx0201;
55 Lisp_Object Vcharset_cyrillic_iso8859_5;
56 Lisp_Object Vcharset_latin_iso8859_9;
57 Lisp_Object Vcharset_japanese_jisx0208_1978;
58 Lisp_Object Vcharset_chinese_gb2312;
59 Lisp_Object Vcharset_chinese_gb12345;
60 Lisp_Object Vcharset_japanese_jisx0208;
61 Lisp_Object Vcharset_japanese_jisx0208_1990;
62 Lisp_Object Vcharset_korean_ksc5601;
63 Lisp_Object Vcharset_japanese_jisx0212;
64 Lisp_Object Vcharset_chinese_cns11643_1;
65 Lisp_Object Vcharset_chinese_cns11643_2;
66 #ifdef UTF2000
67 Lisp_Object Vcharset_ucs;
68 Lisp_Object Vcharset_ucs_bmp;
69 Lisp_Object Vcharset_ucs_smp;
70 Lisp_Object Vcharset_ucs_sip;
71 Lisp_Object Vcharset_ucs_gb;
72 Lisp_Object Vcharset_latin_viscii;
73 Lisp_Object Vcharset_latin_tcvn5712;
74 Lisp_Object Vcharset_latin_viscii_lower;
75 Lisp_Object Vcharset_latin_viscii_upper;
76 Lisp_Object Vcharset_jis_x0208;
77 Lisp_Object Vcharset_chinese_big5;
78 Lisp_Object Vcharset_ethiopic_ucs;
79 #endif
80 Lisp_Object Vcharset_chinese_big5_1;
81 Lisp_Object Vcharset_chinese_big5_2;
82
83 #ifdef ENABLE_COMPOSITE_CHARS
84 Lisp_Object Vcharset_composite;
85
86 /* Hash tables for composite chars.  One maps string representing
87    composed chars to their equivalent chars; one goes the
88    other way. */
89 Lisp_Object Vcomposite_char_char2string_hash_table;
90 Lisp_Object Vcomposite_char_string2char_hash_table;
91
92 static int composite_char_row_next;
93 static int composite_char_col_next;
94
95 #endif /* ENABLE_COMPOSITE_CHARS */
96
97 struct charset_lookup *chlook;
98
99 static const struct lrecord_description charset_lookup_description_1[] = {
100   { XD_LISP_OBJECT_ARRAY, offsetof (struct charset_lookup, charset_by_leading_byte),
101 #ifdef UTF2000
102     NUM_LEADING_BYTES+4*128
103 #else
104     128+4*128*2 
105 #endif
106   }, { XD_END }
107 };
108
109 static const struct struct_description charset_lookup_description = {
110   sizeof (struct charset_lookup),
111   charset_lookup_description_1
112 };
113
114 #ifndef UTF2000
115 /* Table of number of bytes in the string representation of a character
116    indexed by the first byte of that representation.
117
118    rep_bytes_by_first_byte(c) is more efficient than the equivalent
119    canonical computation:
120
121    XCHARSET_REP_BYTES (CHARSET_BY_LEADING_BYTE (c)) */
122
123 const Bytecount rep_bytes_by_first_byte[0xA0] =
124 { /* 0x00 - 0x7f are for straight ASCII */
125   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
126   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
127   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
128   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
129   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
130   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
131   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
132   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
133   /* 0x80 - 0x8f are for Dimension-1 official charsets */
134 #ifdef CHAR_IS_UCS4
135   2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3,
136 #else
137   2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
138 #endif
139   /* 0x90 - 0x9d are for Dimension-2 official charsets */
140   /* 0x9e is for Dimension-1 private charsets */
141   /* 0x9f is for Dimension-2 private charsets */
142   3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4
143 };
144 #endif
145
146 #ifdef UTF2000
147
148 int decoding_table_check_elements (Lisp_Object v, int dim, int ccs_len);
149 int
150 decoding_table_check_elements (Lisp_Object v, int dim, int ccs_len)
151 {
152   int i;
153
154   if (XVECTOR_LENGTH (v) > ccs_len)
155     return -1;
156
157   for (i = 0; i < XVECTOR_LENGTH (v); i++)
158     {
159       Lisp_Object c = XVECTOR_DATA(v)[i];
160
161       if (!NILP (c) && !CHARP (c))
162         {
163           if (VECTORP (c))
164             {
165               int ret = decoding_table_check_elements (c, dim - 1, ccs_len);
166               if (ret)
167                 return ret;
168             }
169           else
170             return -2;
171         }
172     }
173   return 0;
174 }
175
176 Lisp_Object
177 put_char_ccs_code_point (Lisp_Object character,
178                          Lisp_Object ccs, Lisp_Object value)
179 {
180   if (!EQ (XCHARSET_NAME (ccs), Qucs)
181       || !INTP (value)
182       || (XCHAR (character) != XINT (value)))
183     {
184       Lisp_Object v = XCHARSET_DECODING_TABLE (ccs);
185       int code_point;
186
187       if (CONSP (value))
188         { /* obsolete representation: value must be a list of bytes */
189           Lisp_Object ret = Fcar (value);
190           Lisp_Object rest;
191
192           if (!INTP (ret))
193             signal_simple_error ("Invalid value for coded-charset", value);
194           code_point = XINT (ret);
195           if (XCHARSET_GRAPHIC (ccs) == 1)
196             code_point &= 0x7F;
197           rest = Fcdr (value);
198           while (!NILP (rest))
199             {
200               int j;
201
202               if (!CONSP (rest))
203                 signal_simple_error ("Invalid value for coded-charset",
204                                      value);
205               ret = Fcar (rest);
206               if (!INTP (ret))
207                 signal_simple_error ("Invalid value for coded-charset",
208                                      value);
209               j = XINT (ret);
210               if (XCHARSET_GRAPHIC (ccs) == 1)
211                 j &= 0x7F;
212               code_point = (code_point << 8) | j;
213               rest = Fcdr (rest);
214             }
215           value = make_int (code_point);
216         }
217       else if (INTP (value))
218         {
219           code_point = XINT (value);
220           if (XCHARSET_GRAPHIC (ccs) == 1)
221             {
222               code_point &= 0x7F7F7F7F;
223               value = make_int (code_point);
224             }
225         }
226       else
227         signal_simple_error ("Invalid value for coded-charset", value);
228
229       if (VECTORP (v))
230         {
231           Lisp_Object cpos = Fget_char_attribute (character, ccs, Qnil);
232           if (INTP (cpos))
233             {
234               decoding_table_remove_char (ccs, XINT (cpos));
235             }
236         }
237       decoding_table_put_char (ccs, code_point, character);
238     }
239   return value;
240 }
241
242 Lisp_Object
243 remove_char_ccs (Lisp_Object character, Lisp_Object ccs)
244 {
245   Lisp_Object decoding_table = XCHARSET_DECODING_TABLE (ccs);
246   Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (ccs);
247
248   if (VECTORP (decoding_table))
249     {
250       Lisp_Object cpos = Fget_char_attribute (character, ccs, Qnil);
251
252       if (!NILP (cpos))
253         {
254           decoding_table_remove_char (ccs, XINT (cpos));
255         }
256     }
257   if (CHAR_TABLEP (encoding_table))
258     {
259       put_char_id_table (XCHAR_TABLE(encoding_table), character, Qunbound);
260     }
261   return Qt;
262 }
263
264 #endif
265
266 #ifndef UTF2000
267 int leading_code_private_11;
268 #endif
269
270 Lisp_Object Qcharsetp;
271
272 /* Qdoc_string, Qdimension, Qchars defined in general.c */
273 Lisp_Object Qregistry, Qfinal, Qgraphic;
274 Lisp_Object Qdirection;
275 Lisp_Object Qreverse_direction_charset;
276 Lisp_Object Qleading_byte;
277 Lisp_Object Qshort_name, Qlong_name;
278 #ifdef UTF2000
279 Lisp_Object Qmin_code, Qmax_code, Qcode_offset;
280 Lisp_Object Qmother, Qconversion, Q94x60, Q94x94x60;
281 #endif
282
283 Lisp_Object Qascii,
284   Qcontrol_1,
285   Qlatin_iso8859_1,
286   Qlatin_iso8859_2,
287   Qlatin_iso8859_3,
288   Qlatin_iso8859_4,
289   Qthai_tis620,
290   Qgreek_iso8859_7,
291   Qarabic_iso8859_6,
292   Qhebrew_iso8859_8,
293   Qkatakana_jisx0201,
294   Qlatin_jisx0201,
295   Qcyrillic_iso8859_5,
296   Qlatin_iso8859_9,
297   Qjapanese_jisx0208_1978,
298   Qchinese_gb2312,
299   Qchinese_gb12345,
300   Qjapanese_jisx0208,
301   Qjapanese_jisx0208_1990,
302   Qkorean_ksc5601,
303   Qjapanese_jisx0212,
304   Qchinese_cns11643_1,
305   Qchinese_cns11643_2,
306 #ifdef UTF2000
307   Qucs,
308   Qucs_bmp,
309   Qucs_smp,
310   Qucs_sip,
311   Qucs_gb,
312   Qlatin_viscii,
313   Qlatin_tcvn5712,
314   Qlatin_viscii_lower,
315   Qlatin_viscii_upper,
316   Qvietnamese_viscii_lower,
317   Qvietnamese_viscii_upper,
318   Qjis_x0208,
319   Qchinese_big5,
320   Qethiopic_ucs,
321 #endif
322   Qchinese_big5_1,
323   Qchinese_big5_2,
324   Qcomposite;
325
326 Lisp_Object Ql2r, Qr2l;
327
328 Lisp_Object Vcharset_hash_table;
329
330 /* Composite characters are characters constructed by overstriking two
331    or more regular characters.
332
333    1) The old Mule implementation involves storing composite characters
334       in a buffer as a tag followed by all of the actual characters
335       used to make up the composite character.  I think this is a bad
336       idea; it greatly complicates code that wants to handle strings
337       one character at a time because it has to deal with the possibility
338       of great big ungainly characters.  It's much more reasonable to
339       simply store an index into a table of composite characters.
340
341    2) The current implementation only allows for 16,384 separate
342       composite characters over the lifetime of the XEmacs process.
343       This could become a potential problem if the user
344       edited lots of different files that use composite characters.
345       Due to FSF bogosity, increasing the number of allowable
346       composite characters under Mule would decrease the number
347       of possible faces that can exist.  Mule already has shrunk
348       this to 2048, and further shrinkage would become uncomfortable.
349       No such problems exist in XEmacs.
350
351       Composite characters could be represented as 0x80 C1 C2 C3,
352       where each C[1-3] is in the range 0xA0 - 0xFF.  This allows
353       for slightly under 2^20 (one million) composite characters
354       over the XEmacs process lifetime, and you only need to
355       increase the size of a Mule character from 19 to 21 bits.
356       Or you could use 0x80 C1 C2 C3 C4, allowing for about
357       85 million (slightly over 2^26) composite characters. */
358
359 \f
360 /************************************************************************/
361 /*                       Basic Emchar functions                         */
362 /************************************************************************/
363
364 /* Convert a non-ASCII Mule character C into a one-character Mule-encoded
365    string in STR.  Returns the number of bytes stored.
366    Do not call this directly.  Use the macro set_charptr_emchar() instead.
367  */
368
369 Bytecount
370 non_ascii_set_charptr_emchar (Bufbyte *str, Emchar c)
371 {
372   Bufbyte *p;
373 #ifndef UTF2000
374   Charset_ID lb;
375   int c1, c2;
376   Lisp_Object charset;
377 #endif
378
379   p = str;
380 #ifdef UTF2000
381   if ( c <= 0x7f )
382     {
383       *p++ = c;
384     }
385   else if ( c <= 0x7ff )
386     {
387       *p++ = (c >> 6) | 0xc0;
388       *p++ = (c & 0x3f) | 0x80;
389     }
390   else if ( c <= 0xffff )
391     {
392       *p++ =  (c >> 12) | 0xe0;
393       *p++ = ((c >>  6) & 0x3f) | 0x80;
394       *p++ =  (c        & 0x3f) | 0x80;
395     }
396   else if ( c <= 0x1fffff )
397     {
398       *p++ =  (c >> 18) | 0xf0;
399       *p++ = ((c >> 12) & 0x3f) | 0x80;
400       *p++ = ((c >>  6) & 0x3f) | 0x80;
401       *p++ =  (c        & 0x3f) | 0x80;
402     }
403   else if ( c <= 0x3ffffff )
404     {
405       *p++ =  (c >> 24) | 0xf8;
406       *p++ = ((c >> 18) & 0x3f) | 0x80;
407       *p++ = ((c >> 12) & 0x3f) | 0x80;
408       *p++ = ((c >>  6) & 0x3f) | 0x80;
409       *p++ =  (c        & 0x3f) | 0x80;
410     }
411   else
412     {
413       *p++ =  (c >> 30) | 0xfc;
414       *p++ = ((c >> 24) & 0x3f) | 0x80;
415       *p++ = ((c >> 18) & 0x3f) | 0x80;
416       *p++ = ((c >> 12) & 0x3f) | 0x80;
417       *p++ = ((c >>  6) & 0x3f) | 0x80;
418       *p++ =  (c        & 0x3f) | 0x80;
419     }
420 #else
421   BREAKUP_CHAR (c, charset, c1, c2);
422   lb = CHAR_LEADING_BYTE (c);
423   if (LEADING_BYTE_PRIVATE_P (lb))
424     *p++ = PRIVATE_LEADING_BYTE_PREFIX (lb);
425   *p++ = lb;
426   if (EQ (charset, Vcharset_control_1))
427     c1 += 0x20;
428   *p++ = c1 | 0x80;
429   if (c2)
430     *p++ = c2 | 0x80;
431 #endif
432   return (p - str);
433 }
434
435 /* Return the first character from a Mule-encoded string in STR,
436    assuming it's non-ASCII.  Do not call this directly.
437    Use the macro charptr_emchar() instead. */
438
439 Emchar
440 non_ascii_charptr_emchar (const Bufbyte *str)
441 {
442 #ifdef UTF2000
443   Bufbyte b;
444   Emchar ch;
445   int len;
446
447   b = *str++;
448   if ( b >= 0xfc )
449     {
450       ch = (b & 0x01);
451       len = 5;
452     }
453   else if ( b >= 0xf8 )
454     {
455       ch = b & 0x03;
456       len = 4;
457     }
458   else if ( b >= 0xf0 )
459     {
460       ch = b & 0x07;
461       len = 3;
462     }
463   else if ( b >= 0xe0 )
464     {
465       ch = b & 0x0f;
466       len = 2;
467     }
468   else if ( b >= 0xc0 )
469     {
470       ch = b & 0x1f;
471       len = 1;
472     }
473   else
474     {
475       ch = b;
476       len = 0;
477     }
478   for( ; len > 0; len-- )
479     {
480       b = *str++;
481       ch = ( ch << 6 ) | ( b & 0x3f );
482     }
483   return ch;
484 #else
485   Bufbyte i0 = *str, i1, i2 = 0;
486   Lisp_Object charset;
487
488   if (i0 == LEADING_BYTE_CONTROL_1)
489     return (Emchar) (*++str - 0x20);
490
491   if (LEADING_BYTE_PREFIX_P (i0))
492     i0 = *++str;
493
494   i1 = *++str & 0x7F;
495
496   charset = CHARSET_BY_LEADING_BYTE (i0);
497   if (XCHARSET_DIMENSION (charset) == 2)
498     i2 = *++str & 0x7F;
499
500   return MAKE_CHAR (charset, i1, i2);
501 #endif
502 }
503
504 /* Return whether CH is a valid Emchar, assuming it's non-ASCII.
505    Do not call this directly.  Use the macro valid_char_p() instead. */
506
507 #ifndef UTF2000
508 int
509 non_ascii_valid_char_p (Emchar ch)
510 {
511   int f1, f2, f3;
512
513   /* Must have only lowest 19 bits set */
514   if (ch & ~0x7FFFF)
515     return 0;
516
517   f1 = CHAR_FIELD1 (ch);
518   f2 = CHAR_FIELD2 (ch);
519   f3 = CHAR_FIELD3 (ch);
520
521   if (f1 == 0)
522     {
523       Lisp_Object charset;
524
525       if (f2 < MIN_CHAR_FIELD2_OFFICIAL ||
526           (f2 > MAX_CHAR_FIELD2_OFFICIAL && f2 < MIN_CHAR_FIELD2_PRIVATE) ||
527            f2 > MAX_CHAR_FIELD2_PRIVATE)
528         return 0;
529       if (f3 < 0x20)
530         return 0;
531
532       if (f3 != 0x20 && f3 != 0x7F && !(f2 >= MIN_CHAR_FIELD2_PRIVATE &&
533                                         f2 <= MAX_CHAR_FIELD2_PRIVATE))
534         return 1;
535
536       /*
537          NOTE: This takes advantage of the fact that
538          FIELD2_TO_OFFICIAL_LEADING_BYTE and
539          FIELD2_TO_PRIVATE_LEADING_BYTE are the same.
540          */
541       charset = CHARSET_BY_LEADING_BYTE (f2 + FIELD2_TO_OFFICIAL_LEADING_BYTE);
542       if (EQ (charset, Qnil))
543         return 0;
544       return (XCHARSET_CHARS (charset) == 96);
545     }
546   else
547     {
548       Lisp_Object charset;
549
550       if (f1 < MIN_CHAR_FIELD1_OFFICIAL ||
551           (f1 > MAX_CHAR_FIELD1_OFFICIAL && f1 < MIN_CHAR_FIELD1_PRIVATE) ||
552           f1 > MAX_CHAR_FIELD1_PRIVATE)
553         return 0;
554       if (f2 < 0x20 || f3 < 0x20)
555         return 0;
556
557 #ifdef ENABLE_COMPOSITE_CHARS
558       if (f1 + FIELD1_TO_OFFICIAL_LEADING_BYTE == LEADING_BYTE_COMPOSITE)
559         {
560           if (UNBOUNDP (Fgethash (make_int (ch),
561                                   Vcomposite_char_char2string_hash_table,
562                                   Qunbound)))
563             return 0;
564           return 1;
565         }
566 #endif /* ENABLE_COMPOSITE_CHARS */
567
568       if (f2 != 0x20 && f2 != 0x7F && f3 != 0x20 && f3 != 0x7F
569           && !(f1 >= MIN_CHAR_FIELD1_PRIVATE && f1 <= MAX_CHAR_FIELD1_PRIVATE))
570         return 1;
571
572       if (f1 <= MAX_CHAR_FIELD1_OFFICIAL)
573         charset =
574           CHARSET_BY_LEADING_BYTE (f1 + FIELD1_TO_OFFICIAL_LEADING_BYTE);
575       else
576         charset =
577           CHARSET_BY_LEADING_BYTE (f1 + FIELD1_TO_PRIVATE_LEADING_BYTE);
578
579       if (EQ (charset, Qnil))
580         return 0;
581       return (XCHARSET_CHARS (charset) == 96);
582     }
583 }
584 #endif
585
586 \f
587 /************************************************************************/
588 /*                       Basic string functions                         */
589 /************************************************************************/
590
591 /* Copy the character pointed to by SRC into DST.  Do not call this
592    directly.  Use the macro charptr_copy_char() instead.
593    Return the number of bytes copied.  */
594
595 Bytecount
596 non_ascii_charptr_copy_char (const Bufbyte *src, Bufbyte *dst)
597 {
598   unsigned int bytes = REP_BYTES_BY_FIRST_BYTE (*src);
599   unsigned int i;
600   for (i = bytes; i; i--, dst++, src++)
601     *dst = *src;
602   return bytes;
603 }
604
605 \f
606 /************************************************************************/
607 /*                        streams of Emchars                            */
608 /************************************************************************/
609
610 /* Treat a stream as a stream of Emchar's rather than a stream of bytes.
611    The functions below are not meant to be called directly; use
612    the macros in insdel.h. */
613
614 Emchar
615 Lstream_get_emchar_1 (Lstream *stream, int ch)
616 {
617   Bufbyte str[MAX_EMCHAR_LEN];
618   Bufbyte *strptr = str;
619   unsigned int bytes;
620
621   str[0] = (Bufbyte) ch;
622
623   for (bytes = REP_BYTES_BY_FIRST_BYTE (ch) - 1; bytes; bytes--)
624     {
625       int c = Lstream_getc (stream);
626       bufpos_checking_assert (c >= 0);
627       *++strptr = (Bufbyte) c;
628     }
629   return charptr_emchar (str);
630 }
631
632 int
633 Lstream_fput_emchar (Lstream *stream, Emchar ch)
634 {
635   Bufbyte str[MAX_EMCHAR_LEN];
636   Bytecount len = set_charptr_emchar (str, ch);
637   return Lstream_write (stream, str, len);
638 }
639
640 void
641 Lstream_funget_emchar (Lstream *stream, Emchar ch)
642 {
643   Bufbyte str[MAX_EMCHAR_LEN];
644   Bytecount len = set_charptr_emchar (str, ch);
645   Lstream_unread (stream, str, len);
646 }
647
648 \f
649 /************************************************************************/
650 /*                            charset object                            */
651 /************************************************************************/
652
653 static Lisp_Object
654 mark_charset (Lisp_Object obj)
655 {
656   Lisp_Charset *cs = XCHARSET (obj);
657
658   mark_object (cs->short_name);
659   mark_object (cs->long_name);
660   mark_object (cs->doc_string);
661   mark_object (cs->registry);
662   mark_object (cs->ccl_program);
663 #ifdef UTF2000
664   mark_object (cs->decoding_table);
665   mark_object (cs->mother);
666 #endif
667   return cs->name;
668 }
669
670 static void
671 print_charset (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
672 {
673   Lisp_Charset *cs = XCHARSET (obj);
674   char buf[200];
675
676   if (print_readably)
677     error ("printing unreadable object #<charset %s 0x%x>",
678            string_data (XSYMBOL (CHARSET_NAME (cs))->name),
679            cs->header.uid);
680
681   write_c_string ("#<charset ", printcharfun);
682   print_internal (CHARSET_NAME (cs), printcharfun, 0);
683   write_c_string (" ", printcharfun);
684   print_internal (CHARSET_SHORT_NAME (cs), printcharfun, 1);
685   write_c_string (" ", printcharfun);
686   print_internal (CHARSET_LONG_NAME (cs), printcharfun, 1);
687   write_c_string (" ", printcharfun);
688   print_internal (CHARSET_DOC_STRING (cs), printcharfun, 1);
689   sprintf (buf, " %d^%d %s cols=%d g%d final='%c' reg=",
690            CHARSET_CHARS (cs),
691            CHARSET_DIMENSION (cs),
692            CHARSET_DIRECTION (cs) == CHARSET_LEFT_TO_RIGHT ? "l2r" : "r2l",
693            CHARSET_COLUMNS (cs),
694            CHARSET_GRAPHIC (cs),
695            CHARSET_FINAL (cs));
696   write_c_string (buf, printcharfun);
697   print_internal (CHARSET_REGISTRY (cs), printcharfun, 0);
698   sprintf (buf, " 0x%x>", cs->header.uid);
699   write_c_string (buf, printcharfun);
700 }
701
702 static const struct lrecord_description charset_description[] = {
703   { XD_LISP_OBJECT, offsetof (Lisp_Charset, name) },
704   { XD_LISP_OBJECT, offsetof (Lisp_Charset, doc_string) },
705   { XD_LISP_OBJECT, offsetof (Lisp_Charset, registry) },
706   { XD_LISP_OBJECT, offsetof (Lisp_Charset, short_name) },
707   { XD_LISP_OBJECT, offsetof (Lisp_Charset, long_name) },
708   { XD_LISP_OBJECT, offsetof (Lisp_Charset, reverse_direction_charset) },
709   { XD_LISP_OBJECT, offsetof (Lisp_Charset, ccl_program) },
710 #ifdef UTF2000
711   { XD_LISP_OBJECT, offsetof (Lisp_Charset, decoding_table) },
712   { XD_LISP_OBJECT, offsetof (Lisp_Charset, mother) },
713 #endif
714   { XD_END }
715 };
716
717 DEFINE_LRECORD_IMPLEMENTATION ("charset", charset,
718                                mark_charset, print_charset, 0, 0, 0,
719                                charset_description,
720                                Lisp_Charset);
721
722 /* Make a new charset. */
723 /* #### SJT Should generic properties be allowed? */
724 static Lisp_Object
725 make_charset (Charset_ID id, Lisp_Object name,
726               unsigned short chars, unsigned char dimension,
727               unsigned char columns, unsigned char graphic,
728               Bufbyte final, unsigned char direction, Lisp_Object short_name,
729               Lisp_Object long_name, Lisp_Object doc,
730               Lisp_Object reg,
731               Lisp_Object decoding_table,
732               Emchar min_code, Emchar max_code,
733               Emchar code_offset, unsigned char byte_offset,
734               Lisp_Object mother, unsigned char conversion)
735 {
736   Lisp_Object obj;
737   Lisp_Charset *cs = alloc_lcrecord_type (Lisp_Charset, &lrecord_charset);
738
739   zero_lcrecord (cs);
740
741   XSETCHARSET (obj, cs);
742
743   CHARSET_ID            (cs) = id;
744   CHARSET_NAME          (cs) = name;
745   CHARSET_SHORT_NAME    (cs) = short_name;
746   CHARSET_LONG_NAME     (cs) = long_name;
747   CHARSET_CHARS         (cs) = chars;
748   CHARSET_DIMENSION     (cs) = dimension;
749   CHARSET_DIRECTION     (cs) = direction;
750   CHARSET_COLUMNS       (cs) = columns;
751   CHARSET_GRAPHIC       (cs) = graphic;
752   CHARSET_FINAL         (cs) = final;
753   CHARSET_DOC_STRING    (cs) = doc;
754   CHARSET_REGISTRY      (cs) = reg;
755   CHARSET_CCL_PROGRAM   (cs) = Qnil;
756   CHARSET_REVERSE_DIRECTION_CHARSET (cs) = Qnil;
757 #ifdef UTF2000
758   CHARSET_DECODING_TABLE(cs) = Qunbound;
759   CHARSET_MIN_CODE      (cs) = min_code;
760   CHARSET_MAX_CODE      (cs) = max_code;
761   CHARSET_CODE_OFFSET   (cs) = code_offset;
762   CHARSET_BYTE_OFFSET   (cs) = byte_offset;
763   CHARSET_MOTHER        (cs) = mother;
764   CHARSET_CONVERSION    (cs) = conversion;
765 #endif
766
767 #ifndef UTF2000
768   if (id == LEADING_BYTE_ASCII)
769     CHARSET_REP_BYTES (cs) = 1;
770   else if (id < 0xA0)
771     CHARSET_REP_BYTES (cs) = CHARSET_DIMENSION (cs) + 1;
772   else
773     CHARSET_REP_BYTES (cs) = CHARSET_DIMENSION (cs) + 2;
774 #endif
775
776   if (final)
777     {
778       /* some charsets do not have final characters.  This includes
779          ASCII, Control-1, Composite, and the two faux private
780          charsets. */
781       unsigned char iso2022_type
782         = (dimension == 1 ? 0 : 2) + (chars == 94 ? 0 : 1);
783 #if UTF2000
784       if (code_offset == 0)
785         {
786           assert (NILP (chlook->charset_by_attributes[iso2022_type][final]));
787           chlook->charset_by_attributes[iso2022_type][final] = obj;
788         }
789 #else
790       assert (NILP
791               (chlook->charset_by_attributes[iso2022_type][final][direction]));
792       chlook->charset_by_attributes[iso2022_type][final][direction] = obj;
793 #endif
794     }
795
796   assert (NILP (chlook->charset_by_leading_byte[id - MIN_LEADING_BYTE]));
797   chlook->charset_by_leading_byte[id - MIN_LEADING_BYTE] = obj;
798
799   /* Some charsets are "faux" and don't have names or really exist at
800      all except in the leading-byte table. */
801   if (!NILP (name))
802     Fputhash (name, obj, Vcharset_hash_table);
803   return obj;
804 }
805
806 static int
807 get_unallocated_leading_byte (int dimension)
808 {
809   Charset_ID lb;
810
811 #ifdef UTF2000
812   if (chlook->next_allocated_leading_byte > MAX_LEADING_BYTE_PRIVATE)
813     lb = 0;
814   else
815     lb = chlook->next_allocated_leading_byte++;
816 #else
817   if (dimension == 1)
818     {
819       if (chlook->next_allocated_1_byte_leading_byte > MAX_LEADING_BYTE_PRIVATE_1)
820         lb = 0;
821       else
822         lb = chlook->next_allocated_1_byte_leading_byte++;
823     }
824   else
825     {
826       if (chlook->next_allocated_2_byte_leading_byte > MAX_LEADING_BYTE_PRIVATE_2)
827         lb = 0;
828       else
829         lb = chlook->next_allocated_2_byte_leading_byte++;
830     }
831 #endif
832
833   if (!lb)
834     signal_simple_error
835       ("No more character sets free for this dimension",
836        make_int (dimension));
837
838   return lb;
839 }
840
841 #ifdef UTF2000
842 /* Number of Big5 characters which have the same code in 1st byte.  */
843
844 #define BIG5_SAME_ROW (0xFF - 0xA1 + 0x7F - 0x40)
845
846 Emchar
847 decode_defined_char (Lisp_Object ccs, int code_point)
848 {
849   int dim = XCHARSET_DIMENSION (ccs);
850   Lisp_Object decoding_table = XCHARSET_DECODING_TABLE (ccs);
851   Emchar char_id = -1;
852   Lisp_Object mother;
853
854   while (dim > 0)
855     {
856       dim--;
857       decoding_table
858         = get_ccs_octet_table (decoding_table, ccs,
859                                (code_point >> (dim * 8)) & 255);
860     }
861   if (CHARP (decoding_table))
862     return XCHAR (decoding_table);
863   if (char_id >= 0)
864     return char_id;
865   else if ( CHARSETP (mother = XCHARSET_MOTHER (ccs)) )
866     {
867       if ( XCHARSET_CONVERSION (ccs) == CONVERSION_IDENTICAL )
868         {
869           if ( EQ (mother, Vcharset_ucs) )
870             return DECODE_CHAR (mother, code_point);
871           else
872             return decode_defined_char (mother, code_point);
873         }
874     }
875   return -1;
876 }
877
878 Emchar
879 decode_builtin_char (Lisp_Object charset, int code_point)
880 {
881   Lisp_Object mother = XCHARSET_MOTHER (charset);
882   int final;
883
884   if ( XCHARSET_MAX_CODE (charset) > 0 )
885     {
886       if ( CHARSETP (mother) )
887         {
888           int code = code_point;
889
890           if ( XCHARSET_CONVERSION (charset) == CONVERSION_94x60 )
891             {
892               int row = code_point >> 8;
893               int cell = code_point & 255;        
894
895               if (row < 16 + 32)
896                 return -1;
897               else if (row < 16 + 32 + 30)
898                 code = (row - (16 + 32)) * 94 + cell - 33;
899               else if (row < 18 + 32 + 30)
900                 return -1;
901               else if (row < 18 + 32 + 60)
902                 code = (row - (18 + 32)) * 94 + cell - 33;
903             }
904           else if ( XCHARSET_CONVERSION (charset) == CONVERSION_94x94x60 )
905             {
906               int plane = code_point >> 16;
907               int row = (code_point >> 8) & 255;
908               int cell = code_point & 255;        
909
910               if (row < 16 + 32)
911                 return -1;
912               else if (row < 16 + 32 + 30)
913                 code
914                   = (plane - 33) * 94 * 60
915                   + (row - (16 + 32)) * 94
916                   + cell - 33;
917               else if (row < 18 + 32 + 30)
918                 return -1;
919               else if (row < 18 + 32 + 60)
920                 code
921                   = (plane - 33) * 94 * 60
922                   + (row - (18 + 32)) * 94
923                   + cell - 33;
924             }
925           return
926             decode_builtin_char (mother, code + XCHARSET_CODE_OFFSET(charset));
927         }
928       else
929         {
930           Emchar cid
931             = (XCHARSET_DIMENSION (charset) == 1
932                ?
933                code_point - XCHARSET_BYTE_OFFSET (charset)
934                :
935                ((code_point >> 8) - XCHARSET_BYTE_OFFSET (charset))
936                * XCHARSET_CHARS (charset)
937                + (code_point & 0xFF) - XCHARSET_BYTE_OFFSET (charset))
938             + XCHARSET_CODE_OFFSET (charset);
939           if ((cid < XCHARSET_MIN_CODE (charset))
940               || (XCHARSET_MAX_CODE (charset) < cid))
941             return -1;
942           return cid;
943         }
944     }
945   else if ((final = XCHARSET_FINAL (charset)) >= '0')
946     {
947       if (XCHARSET_DIMENSION (charset) == 1)
948         {
949           switch (XCHARSET_CHARS (charset))
950             {
951             case 94:
952               return MIN_CHAR_94
953                 + (final - '0') * 94 + ((code_point & 0x7F) - 33);
954             case 96:
955               return MIN_CHAR_96
956                 + (final - '0') * 96 + ((code_point & 0x7F) - 32);
957             default:
958               abort ();
959               return -1;
960             }
961         }
962       else
963         {
964           switch (XCHARSET_CHARS (charset))
965             {
966             case 94:
967               return MIN_CHAR_94x94
968                 + (final - '0') * 94 * 94
969                 + (((code_point >> 8) & 0x7F) - 33) * 94
970                 + ((code_point & 0x7F) - 33);
971             case 96:
972               return MIN_CHAR_96x96
973                 + (final - '0') * 96 * 96
974                 + (((code_point >> 8) & 0x7F) - 32) * 96
975                 + ((code_point & 0x7F) - 32);
976             default:
977               abort ();
978               return -1;
979             }
980         }
981     }
982   else
983     return -1;
984 }
985
986 int
987 charset_code_point (Lisp_Object charset, Emchar ch, int defined_only)
988 {
989   Lisp_Object encoding_table = XCHARSET_ENCODING_TABLE (charset);
990   Lisp_Object ret;
991
992   if ( CHAR_TABLEP (encoding_table)
993        && INTP (ret = get_char_id_table (XCHAR_TABLE(encoding_table),
994                                          ch)) )
995     return XINT (ret);
996   else
997     {
998       Lisp_Object mother = XCHARSET_MOTHER (charset);
999       int min = XCHARSET_MIN_CODE (charset);
1000       int max = XCHARSET_MAX_CODE (charset);
1001       int code = -1;
1002
1003       if ( CHARSETP (mother) )
1004         {
1005           if (XCHARSET_FINAL (charset) >= '0')
1006             code = charset_code_point (mother, ch, 1);
1007           else
1008             code = charset_code_point (mother, ch, defined_only);
1009         }
1010       else if (defined_only)
1011         return -1;
1012       else if ( ((max == 0) && CHARSETP (mother)
1013                  && (XCHARSET_FINAL (charset) == 0))
1014                 || ((min <= ch) && (ch <= max)) )
1015         code = ch;
1016       if ( ((max == 0) && CHARSETP (mother) && (code >= 0))
1017            || ((min <= code) && (code <= max)) )
1018         {
1019           int d = code - XCHARSET_CODE_OFFSET (charset);
1020
1021           if ( XCHARSET_CONVERSION (charset) == CONVERSION_IDENTICAL )
1022             return d;
1023           else if ( XCHARSET_CONVERSION (charset) == CONVERSION_94 )
1024             return d + 33;
1025           else if ( XCHARSET_CONVERSION (charset) == CONVERSION_96 )
1026             return d + 32;
1027           else if ( XCHARSET_CONVERSION (charset) == CONVERSION_94x60 )
1028             {
1029               int row  = d / 94;
1030               int cell = d % 94 + 33;
1031
1032               if (row < 30)
1033                 row += 16 + 32;
1034               else
1035                 row += 18 + 32;
1036               return (row << 8) | cell;
1037             }
1038           else if ( XCHARSET_CONVERSION (charset) == CONVERSION_94x94 )
1039             return ((d / 94 + 33) << 8) | (d % 94 + 33);
1040           else if ( XCHARSET_CONVERSION (charset) == CONVERSION_96x96 )
1041             return ((d / 96 + 32) << 8) | (d % 96 + 32);
1042           else if ( XCHARSET_CONVERSION (charset) == CONVERSION_94x94x60 )
1043             {
1044               int plane =  d / (94 * 60) + 33;
1045               int row   = (d % (94 * 60)) / 94;
1046               int cell  =  d %  94 + 33;
1047
1048               if (row < 30)
1049                 row += 16 + 32;
1050               else
1051                 row += 18 + 32;
1052               return (plane << 16) | (row << 8) | cell;
1053             }
1054           else if ( XCHARSET_CONVERSION (charset) == CONVERSION_94x94x94 )
1055             return
1056               (   (d / (94 * 94) + 33) << 16)
1057               |  ((d / 94 % 94   + 33) <<  8)
1058               |   (d % 94        + 33);
1059           else if ( XCHARSET_CONVERSION (charset) == CONVERSION_96x96x96 )
1060             return
1061               (   (d / (96 * 96) + 32) << 16)
1062               |  ((d / 96 % 96   + 32) <<  8)
1063               |   (d % 96        + 32);
1064           else if ( XCHARSET_CONVERSION (charset) == CONVERSION_94x94x94x94 )
1065             return
1066               (  (d / (94 * 94 * 94) + 33) << 24)
1067               | ((d / (94 * 94) % 94 + 33) << 16)
1068               | ((d / 94 % 94        + 33) <<  8)
1069               |  (d % 94             + 33);
1070           else if ( XCHARSET_CONVERSION (charset) == CONVERSION_96x96x96x96 )
1071             return
1072               (  (d / (96 * 96 * 96) + 32) << 24)
1073               | ((d / (96 * 96) % 96 + 32) << 16)
1074               | ((d / 96 % 96        + 32) <<  8)
1075               |  (d % 96             + 32);
1076           else
1077             {
1078               printf ("Unknown CCS-conversion %d is specified!",
1079                       XCHARSET_CONVERSION (charset));
1080               exit (-1);
1081             }
1082         }
1083       else if ( ( XCHARSET_FINAL (charset) >= '0' ) &&
1084                 ( XCHARSET_MIN_CODE (charset) == 0 )
1085                /*
1086                 (XCHARSET_CODE_OFFSET (charset) == 0) ||
1087                 (XCHARSET_CODE_OFFSET (charset)
1088                  == XCHARSET_MIN_CODE (charset))
1089                */ )
1090         {
1091           int d;
1092
1093           if (XCHARSET_DIMENSION (charset) == 1)
1094             {
1095               if (XCHARSET_CHARS (charset) == 94)
1096                 {
1097                   if (((d = ch - (MIN_CHAR_94
1098                                   + (XCHARSET_FINAL (charset) - '0') * 94))
1099                        >= 0)
1100                       && (d < 94))
1101                     return d + 33;
1102                 }
1103               else if (XCHARSET_CHARS (charset) == 96)
1104                 {
1105                   if (((d = ch - (MIN_CHAR_96
1106                                   + (XCHARSET_FINAL (charset) - '0') * 96))
1107                        >= 0)
1108                       && (d < 96))
1109                     return d + 32;
1110                 }
1111               else
1112                 return -1;
1113             }
1114           else if (XCHARSET_DIMENSION (charset) == 2)
1115             {
1116               if (XCHARSET_CHARS (charset) == 94)
1117                 {
1118                   if (((d = ch - (MIN_CHAR_94x94
1119                                   +
1120                                   (XCHARSET_FINAL (charset) - '0') * 94 * 94))
1121                        >= 0)
1122                       && (d < 94 * 94))
1123                     return (((d / 94) + 33) << 8) | (d % 94 + 33);
1124                 }
1125               else if (XCHARSET_CHARS (charset) == 96)
1126                 {
1127                   if (((d = ch - (MIN_CHAR_96x96
1128                                   +
1129                                   (XCHARSET_FINAL (charset) - '0') * 96 * 96))
1130                        >= 0)
1131                       && (d < 96 * 96))
1132                     return (((d / 96) + 32) << 8) | (d % 96 + 32);
1133                 }
1134               else
1135                 return -1;
1136             }
1137         }
1138     }
1139   return -1;
1140 }
1141
1142 int
1143 encode_builtin_char_1 (Emchar c, Lisp_Object* charset)
1144 {
1145   if (c <= MAX_CHAR_BASIC_LATIN)
1146     {
1147       *charset = Vcharset_ascii;
1148       return c;
1149     }
1150   else if (c < 0xA0)
1151     {
1152       *charset = Vcharset_control_1;
1153       return c & 0x7F;
1154     }
1155   else if (c <= 0xff)
1156     {
1157       *charset = Vcharset_latin_iso8859_1;
1158       return c & 0x7F;
1159     }
1160   /*
1161   else if ((MIN_CHAR_HEBREW <= c) && (c <= MAX_CHAR_HEBREW))
1162     {
1163       *charset = Vcharset_hebrew_iso8859_8;
1164       return c - MIN_CHAR_HEBREW + 0x20;
1165     }
1166   */
1167   else if ((MIN_CHAR_THAI <= c) && (c <= MAX_CHAR_THAI))
1168     {
1169       *charset = Vcharset_thai_tis620;
1170       return c - MIN_CHAR_THAI + 0x20;
1171     }
1172   /*
1173   else if ((MIN_CHAR_HALFWIDTH_KATAKANA <= c)
1174            && (c <= MAX_CHAR_HALFWIDTH_KATAKANA))
1175     {
1176       return list2 (Vcharset_katakana_jisx0201,
1177                     make_int (c - MIN_CHAR_HALFWIDTH_KATAKANA + 33));
1178     }
1179   */
1180   else if (c <= MAX_CHAR_BMP)
1181     {
1182       *charset = Vcharset_ucs_bmp;
1183       return c;
1184     }
1185   else if (c <= MAX_CHAR_SMP)
1186     {
1187       *charset = Vcharset_ucs_smp;
1188       return c - MIN_CHAR_SMP;
1189     }
1190   else if (c <= MAX_CHAR_SIP)
1191     {
1192       *charset = Vcharset_ucs_sip;
1193       return c - MIN_CHAR_SIP;
1194     }
1195   else if (c < MIN_CHAR_94)
1196     {
1197       *charset = Vcharset_ucs;
1198       return c;
1199     }
1200   else if (c <= MAX_CHAR_94)
1201     {
1202       *charset = CHARSET_BY_ATTRIBUTES (94, 1,
1203                                         ((c - MIN_CHAR_94) / 94) + '0',
1204                                         CHARSET_LEFT_TO_RIGHT);
1205       if (!NILP (*charset))
1206         return ((c - MIN_CHAR_94) % 94) + 33;
1207       else
1208         {
1209           *charset = Vcharset_ucs;
1210           return c;
1211         }
1212     }
1213   else if (c <= MAX_CHAR_96)
1214     {
1215       *charset = CHARSET_BY_ATTRIBUTES (96, 1,
1216                                         ((c - MIN_CHAR_96) / 96) + '0',
1217                                         CHARSET_LEFT_TO_RIGHT);
1218       if (!NILP (*charset))
1219         return ((c - MIN_CHAR_96) % 96) + 32;
1220       else
1221         {
1222           *charset = Vcharset_ucs;
1223           return c;
1224         }
1225     }
1226   else if (c <= MAX_CHAR_94x94)
1227     {
1228       *charset
1229         = CHARSET_BY_ATTRIBUTES (94, 2,
1230                                  ((c - MIN_CHAR_94x94) / (94 * 94)) + '0',
1231                                  CHARSET_LEFT_TO_RIGHT);
1232       if (!NILP (*charset))
1233         return (((((c - MIN_CHAR_94x94) / 94) % 94) + 33) << 8)
1234           | (((c - MIN_CHAR_94x94) % 94) + 33);
1235       else
1236         {
1237           *charset = Vcharset_ucs;
1238           return c;
1239         }
1240     }
1241   else if (c <= MAX_CHAR_96x96)
1242     {
1243       *charset
1244         = CHARSET_BY_ATTRIBUTES (96, 2,
1245                                  ((c - MIN_CHAR_96x96) / (96 * 96)) + '0',
1246                                  CHARSET_LEFT_TO_RIGHT);
1247       if (!NILP (*charset))
1248         return ((((c - MIN_CHAR_96x96) / 96) % 96) + 32) << 8
1249           | (((c - MIN_CHAR_96x96) % 96) + 32);
1250       else
1251         {
1252           *charset = Vcharset_ucs;
1253           return c;
1254         }
1255     }
1256   else
1257     {
1258       *charset = Vcharset_ucs;
1259       return c;
1260     }
1261 }
1262
1263 Lisp_Object Vdefault_coded_charset_priority_list;
1264 #endif
1265
1266 \f
1267 /************************************************************************/
1268 /*                      Basic charset Lisp functions                    */
1269 /************************************************************************/
1270
1271 DEFUN ("charsetp", Fcharsetp, 1, 1, 0, /*
1272 Return non-nil if OBJECT is a charset.
1273 */
1274        (object))
1275 {
1276   return CHARSETP (object) ? Qt : Qnil;
1277 }
1278
1279 DEFUN ("find-charset", Ffind_charset, 1, 1, 0, /*
1280 Retrieve the charset of the given name.
1281 If CHARSET-OR-NAME is a charset object, it is simply returned.
1282 Otherwise, CHARSET-OR-NAME should be a symbol.  If there is no such charset,
1283 nil is returned.  Otherwise the associated charset object is returned.
1284 */
1285        (charset_or_name))
1286 {
1287   if (CHARSETP (charset_or_name))
1288     return charset_or_name;
1289
1290   CHECK_SYMBOL (charset_or_name);
1291   return Fgethash (charset_or_name, Vcharset_hash_table, Qnil);
1292 }
1293
1294 DEFUN ("get-charset", Fget_charset, 1, 1, 0, /*
1295 Retrieve the charset of the given name.
1296 Same as `find-charset' except an error is signalled if there is no such
1297 charset instead of returning nil.
1298 */
1299        (name))
1300 {
1301   Lisp_Object charset = Ffind_charset (name);
1302
1303   if (NILP (charset))
1304     signal_simple_error ("No such charset", name);
1305   return charset;
1306 }
1307
1308 /* We store the charsets in hash tables with the names as the key and the
1309    actual charset object as the value.  Occasionally we need to use them
1310    in a list format.  These routines provide us with that. */
1311 struct charset_list_closure
1312 {
1313   Lisp_Object *charset_list;
1314 };
1315
1316 static int
1317 add_charset_to_list_mapper (Lisp_Object key, Lisp_Object value,
1318                             void *charset_list_closure)
1319 {
1320   /* This function can GC */
1321   struct charset_list_closure *chcl =
1322     (struct charset_list_closure*) charset_list_closure;
1323   Lisp_Object *charset_list = chcl->charset_list;
1324
1325   *charset_list = Fcons (key /* XCHARSET_NAME (value) */, *charset_list);
1326   return 0;
1327 }
1328
1329 DEFUN ("charset-list", Fcharset_list, 0, 0, 0, /*
1330 Return a list of the names of all defined charsets.
1331 */
1332        ())
1333 {
1334   Lisp_Object charset_list = Qnil;
1335   struct gcpro gcpro1;
1336   struct charset_list_closure charset_list_closure;
1337
1338   GCPRO1 (charset_list);
1339   charset_list_closure.charset_list = &charset_list;
1340   elisp_maphash (add_charset_to_list_mapper, Vcharset_hash_table,
1341                  &charset_list_closure);
1342   UNGCPRO;
1343
1344   return charset_list;
1345 }
1346
1347 DEFUN ("charset-name", Fcharset_name, 1, 1, 0, /*
1348 Return the name of charset CHARSET.
1349 */
1350        (charset))
1351 {
1352   return XCHARSET_NAME (Fget_charset (charset));
1353 }
1354
1355 /* #### SJT Should generic properties be allowed? */
1356 DEFUN ("make-charset", Fmake_charset, 3, 3, 0, /*
1357 Define a new character set.
1358 This function is for use with Mule support.
1359 NAME is a symbol, the name by which the character set is normally referred.
1360 DOC-STRING is a string describing the character set.
1361 PROPS is a property list, describing the specific nature of the
1362 character set.  Recognized properties are:
1363
1364 'short-name     Short version of the charset name (ex: Latin-1)
1365 'long-name      Long version of the charset name (ex: ISO8859-1 (Latin-1))
1366 'registry       A regular expression matching the font registry field for
1367                 this character set.
1368 'dimension      Number of octets used to index a character in this charset.
1369                 Either 1 or 2.  Defaults to 1.
1370                 If UTF-2000 feature is enabled, 3 or 4 are also available.
1371 'columns        Number of columns used to display a character in this charset.
1372                 Only used in TTY mode. (Under X, the actual width of a
1373                 character can be derived from the font used to display the
1374                 characters.) If unspecified, defaults to the dimension
1375                 (this is almost always the correct value).
1376 'chars          Number of characters in each dimension (94 or 96).
1377                 Defaults to 94.  Note that if the dimension is 2, the
1378                 character set thus described is 94x94 or 96x96.
1379                 If UTF-2000 feature is enabled, 128 or 256 are also available.
1380 'final          Final byte of ISO 2022 escape sequence.  Must be
1381                 supplied.  Each combination of (DIMENSION, CHARS) defines a
1382                 separate namespace for final bytes.  Note that ISO
1383                 2022 restricts the final byte to the range
1384                 0x30 - 0x7E if dimension == 1, and 0x30 - 0x5F if
1385                 dimension == 2.  Note also that final bytes in the range
1386                 0x30 - 0x3F are reserved for user-defined (not official)
1387                 character sets.
1388 'graphic        0 (use left half of font on output) or 1 (use right half
1389                 of font on output).  Defaults to 0.  For example, for
1390                 a font whose registry is ISO8859-1, the left half
1391                 (octets 0x20 - 0x7F) is the `ascii' character set, while
1392                 the right half (octets 0xA0 - 0xFF) is the `latin-1'
1393                 character set.  With 'graphic set to 0, the octets
1394                 will have their high bit cleared; with it set to 1,
1395                 the octets will have their high bit set.
1396 'direction      'l2r (left-to-right) or 'r2l (right-to-left).
1397                 Defaults to 'l2r.
1398 'ccl-program    A compiled CCL program used to convert a character in
1399                 this charset into an index into the font.  This is in
1400                 addition to the 'graphic property.  The CCL program
1401                 is passed the octets of the character, with the high
1402                 bit cleared and set depending upon whether the value
1403                 of the 'graphic property is 0 or 1.
1404 'mother         [UTF-2000 only] Base coded-charset.
1405 'code-min       [UTF-2000 only] Minimum code-point of a base coded-charset.
1406 'code-max       [UTF-2000 only] Maximum code-point of a base coded-charset.
1407 'code-offset    [UTF-2000 only] Offset for a code-point of a base
1408                 coded-charset.
1409 'conversion     [UTF-2000 only] Conversion for a code-point of a base
1410                 coded-charset (94x60 or 94x94x60).
1411 */
1412        (name, doc_string, props))
1413 {
1414   int id, dimension = 1, chars = 94, graphic = 0, final = 0, columns = -1;
1415   int direction = CHARSET_LEFT_TO_RIGHT;
1416   Lisp_Object registry = Qnil;
1417   Lisp_Object charset;
1418   Lisp_Object ccl_program = Qnil;
1419   Lisp_Object short_name = Qnil, long_name = Qnil;
1420   Lisp_Object mother = Qnil;
1421   int min_code = 0, max_code = 0, code_offset = 0;
1422   int byte_offset = -1;
1423   int conversion = 0;
1424
1425   CHECK_SYMBOL (name);
1426   if (!NILP (doc_string))
1427     CHECK_STRING (doc_string);
1428
1429   charset = Ffind_charset (name);
1430   if (!NILP (charset))
1431     signal_simple_error ("Cannot redefine existing charset", name);
1432
1433   {
1434     EXTERNAL_PROPERTY_LIST_LOOP_3 (keyword, value, props)
1435       {
1436         if (EQ (keyword, Qshort_name))
1437           {
1438             CHECK_STRING (value);
1439             short_name = value;
1440           }
1441
1442         if (EQ (keyword, Qlong_name))
1443           {
1444             CHECK_STRING (value);
1445             long_name = value;
1446           }
1447
1448         else if (EQ (keyword, Qdimension))
1449           {
1450             CHECK_INT (value);
1451             dimension = XINT (value);
1452             if (dimension < 1 ||
1453 #ifdef UTF2000
1454                 dimension > 4
1455 #else
1456                 dimension > 2
1457 #endif
1458                 )
1459               signal_simple_error ("Invalid value for 'dimension", value);
1460           }
1461
1462         else if (EQ (keyword, Qchars))
1463           {
1464             CHECK_INT (value);
1465             chars = XINT (value);
1466             if (chars != 94 && chars != 96
1467 #ifdef UTF2000
1468                 && chars != 128 && chars != 256
1469 #endif
1470                 )
1471               signal_simple_error ("Invalid value for 'chars", value);
1472           }
1473
1474         else if (EQ (keyword, Qcolumns))
1475           {
1476             CHECK_INT (value);
1477             columns = XINT (value);
1478             if (columns != 1 && columns != 2)
1479               signal_simple_error ("Invalid value for 'columns", value);
1480           }
1481
1482         else if (EQ (keyword, Qgraphic))
1483           {
1484             CHECK_INT (value);
1485             graphic = XINT (value);
1486             if (graphic < 0 ||
1487 #ifdef UTF2000
1488                 graphic > 2
1489 #else
1490                 graphic > 1
1491 #endif
1492                 )
1493               signal_simple_error ("Invalid value for 'graphic", value);
1494           }
1495
1496         else if (EQ (keyword, Qregistry))
1497           {
1498             CHECK_STRING (value);
1499             registry = value;
1500           }
1501
1502         else if (EQ (keyword, Qdirection))
1503           {
1504             if (EQ (value, Ql2r))
1505               direction = CHARSET_LEFT_TO_RIGHT;
1506             else if (EQ (value, Qr2l))
1507               direction = CHARSET_RIGHT_TO_LEFT;
1508             else
1509               signal_simple_error ("Invalid value for 'direction", value);
1510           }
1511
1512         else if (EQ (keyword, Qfinal))
1513           {
1514             CHECK_CHAR_COERCE_INT (value);
1515             final = XCHAR (value);
1516             if (final < '0' || final > '~')
1517               signal_simple_error ("Invalid value for 'final", value);
1518           }
1519
1520 #ifdef UTF2000
1521         else if (EQ (keyword, Qmother))
1522           {
1523             mother = Fget_charset (value);
1524           }
1525
1526         else if (EQ (keyword, Qmin_code))
1527           {
1528             CHECK_INT (value);
1529             min_code = XUINT (value);
1530           }
1531
1532         else if (EQ (keyword, Qmax_code))
1533           {
1534             CHECK_INT (value);
1535             max_code = XUINT (value);
1536           }
1537
1538         else if (EQ (keyword, Qcode_offset))
1539           {
1540             CHECK_INT (value);
1541             code_offset = XUINT (value);
1542           }
1543
1544         else if (EQ (keyword, Qconversion))
1545           {
1546             if (EQ (value, Q94x60))
1547               conversion = CONVERSION_94x60;
1548             else if (EQ (value, Q94x94x60))
1549               conversion = CONVERSION_94x94x60;
1550             else
1551               signal_simple_error ("Unrecognized conversion", value);
1552           }
1553
1554 #endif
1555         else if (EQ (keyword, Qccl_program))
1556           {
1557             struct ccl_program test_ccl;
1558
1559             if (setup_ccl_program (&test_ccl, value) < 0)
1560               signal_simple_error ("Invalid value for 'ccl-program", value);
1561             ccl_program = value;
1562           }
1563
1564         else
1565           signal_simple_error ("Unrecognized property", keyword);
1566       }
1567   }
1568
1569 #ifndef UTF2000
1570   if (!final)
1571     error ("'final must be specified");
1572 #endif
1573   if (dimension == 2 && final > 0x5F)
1574     signal_simple_error
1575       ("Final must be in the range 0x30 - 0x5F for dimension == 2",
1576        make_char (final));
1577
1578   if (!NILP (CHARSET_BY_ATTRIBUTES (chars, dimension, final,
1579                                     CHARSET_LEFT_TO_RIGHT)) ||
1580       !NILP (CHARSET_BY_ATTRIBUTES (chars, dimension, final,
1581                                     CHARSET_RIGHT_TO_LEFT)))
1582     error
1583       ("Character set already defined for this DIMENSION/CHARS/FINAL combo");
1584
1585   id = get_unallocated_leading_byte (dimension);
1586
1587   if (NILP (doc_string))
1588     doc_string = build_string ("");
1589
1590   if (NILP (registry))
1591     registry = build_string ("");
1592
1593   if (NILP (short_name))
1594     XSETSTRING (short_name, XSYMBOL (name)->name);
1595
1596   if (NILP (long_name))
1597     long_name = doc_string;
1598
1599   if (columns == -1)
1600     columns = dimension;
1601
1602   if (byte_offset < 0)
1603     {
1604       if (chars == 94)
1605         byte_offset = 33;
1606       else if (chars == 96)
1607         byte_offset = 32;
1608       else
1609         byte_offset = 0;
1610     }
1611
1612   charset = make_charset (id, name, chars, dimension, columns, graphic,
1613                           final, direction, short_name, long_name,
1614                           doc_string, registry,
1615                           Qnil, min_code, max_code, code_offset, byte_offset,
1616                           mother, conversion);
1617   if (!NILP (ccl_program))
1618     XCHARSET_CCL_PROGRAM (charset) = ccl_program;
1619   return charset;
1620 }
1621
1622 DEFUN ("make-reverse-direction-charset", Fmake_reverse_direction_charset,
1623        2, 2, 0, /*
1624 Make a charset equivalent to CHARSET but which goes in the opposite direction.
1625 NEW-NAME is the name of the new charset.  Return the new charset.
1626 */
1627        (charset, new_name))
1628 {
1629   Lisp_Object new_charset = Qnil;
1630   int id, chars, dimension, columns, graphic, final;
1631   int direction;
1632   Lisp_Object registry, doc_string, short_name, long_name;
1633   Lisp_Charset *cs;
1634
1635   charset = Fget_charset (charset);
1636   if (!NILP (XCHARSET_REVERSE_DIRECTION_CHARSET (charset)))
1637     signal_simple_error ("Charset already has reverse-direction charset",
1638                          charset);
1639
1640   CHECK_SYMBOL (new_name);
1641   if (!NILP (Ffind_charset (new_name)))
1642     signal_simple_error ("Cannot redefine existing charset", new_name);
1643
1644   cs = XCHARSET (charset);
1645
1646   chars     = CHARSET_CHARS     (cs);
1647   dimension = CHARSET_DIMENSION (cs);
1648   columns   = CHARSET_COLUMNS   (cs);
1649   id = get_unallocated_leading_byte (dimension);
1650
1651   graphic = CHARSET_GRAPHIC (cs);
1652   final = CHARSET_FINAL (cs);
1653   direction = CHARSET_RIGHT_TO_LEFT;
1654   if (CHARSET_DIRECTION (cs) == CHARSET_RIGHT_TO_LEFT)
1655     direction = CHARSET_LEFT_TO_RIGHT;
1656   doc_string = CHARSET_DOC_STRING (cs);
1657   short_name = CHARSET_SHORT_NAME (cs);
1658   long_name = CHARSET_LONG_NAME (cs);
1659   registry = CHARSET_REGISTRY (cs);
1660
1661   new_charset = make_charset (id, new_name, chars, dimension, columns,
1662                               graphic, final, direction, short_name, long_name,
1663                               doc_string, registry,
1664 #ifdef UTF2000
1665                               CHARSET_DECODING_TABLE(cs),
1666                               CHARSET_MIN_CODE(cs),
1667                               CHARSET_MAX_CODE(cs),
1668                               CHARSET_CODE_OFFSET(cs),
1669                               CHARSET_BYTE_OFFSET(cs),
1670                               CHARSET_MOTHER(cs),
1671                               CHARSET_CONVERSION (cs)
1672 #else
1673                               Qnil, 0, 0, 0, 0, Qnil, 0
1674 #endif
1675 );
1676
1677   CHARSET_REVERSE_DIRECTION_CHARSET (cs) = new_charset;
1678   XCHARSET_REVERSE_DIRECTION_CHARSET (new_charset) = charset;
1679
1680   return new_charset;
1681 }
1682
1683 DEFUN ("define-charset-alias", Fdefine_charset_alias, 2, 2, 0, /*
1684 Define symbol ALIAS as an alias for CHARSET.
1685 */
1686        (alias, charset))
1687 {
1688   CHECK_SYMBOL (alias);
1689   charset = Fget_charset (charset);
1690   return Fputhash (alias, charset, Vcharset_hash_table);
1691 }
1692
1693 /* #### Reverse direction charsets not yet implemented.  */
1694 #if 0
1695 DEFUN ("charset-reverse-direction-charset", Fcharset_reverse_direction_charset,
1696        1, 1, 0, /*
1697 Return the reverse-direction charset parallel to CHARSET, if any.
1698 This is the charset with the same properties (in particular, the same
1699 dimension, number of characters per dimension, and final byte) as
1700 CHARSET but whose characters are displayed in the opposite direction.
1701 */
1702        (charset))
1703 {
1704   charset = Fget_charset (charset);
1705   return XCHARSET_REVERSE_DIRECTION_CHARSET (charset);
1706 }
1707 #endif
1708
1709 DEFUN ("charset-from-attributes", Fcharset_from_attributes, 3, 4, 0, /*
1710 Return a charset with the given DIMENSION, CHARS, FINAL, and DIRECTION.
1711 If DIRECTION is omitted, both directions will be checked (left-to-right
1712 will be returned if character sets exist for both directions).
1713 */
1714        (dimension, chars, final, direction))
1715 {
1716   int dm, ch, fi, di = -1;
1717   Lisp_Object obj = Qnil;
1718
1719   CHECK_INT (dimension);
1720   dm = XINT (dimension);
1721   if (dm < 1 || dm > 2)
1722     signal_simple_error ("Invalid value for DIMENSION", dimension);
1723
1724   CHECK_INT (chars);
1725   ch = XINT (chars);
1726   if (ch != 94 && ch != 96)
1727     signal_simple_error ("Invalid value for CHARS", chars);
1728
1729   CHECK_CHAR_COERCE_INT (final);
1730   fi = XCHAR (final);
1731   if (fi < '0' || fi > '~')
1732     signal_simple_error ("Invalid value for FINAL", final);
1733
1734   if (EQ (direction, Ql2r))
1735     di = CHARSET_LEFT_TO_RIGHT;
1736   else if (EQ (direction, Qr2l))
1737     di = CHARSET_RIGHT_TO_LEFT;
1738   else if (!NILP (direction))
1739     signal_simple_error ("Invalid value for DIRECTION", direction);
1740
1741   if (dm == 2 && fi > 0x5F)
1742     signal_simple_error
1743       ("Final must be in the range 0x30 - 0x5F for dimension == 2", final);
1744
1745     if (di == -1)
1746     {
1747       obj = CHARSET_BY_ATTRIBUTES (ch, dm, fi, CHARSET_LEFT_TO_RIGHT);
1748       if (NILP (obj))
1749         obj = CHARSET_BY_ATTRIBUTES (ch, dm, fi, CHARSET_RIGHT_TO_LEFT);
1750     }
1751   else
1752     obj = CHARSET_BY_ATTRIBUTES (ch, dm, fi, di);
1753
1754   if (CHARSETP (obj))
1755     return XCHARSET_NAME (obj);
1756   return obj;
1757 }
1758
1759 DEFUN ("charset-short-name", Fcharset_short_name, 1, 1, 0, /*
1760 Return short name of CHARSET.
1761 */
1762        (charset))
1763 {
1764   return XCHARSET_SHORT_NAME (Fget_charset (charset));
1765 }
1766
1767 DEFUN ("charset-long-name", Fcharset_long_name, 1, 1, 0, /*
1768 Return long name of CHARSET.
1769 */
1770        (charset))
1771 {
1772   return XCHARSET_LONG_NAME (Fget_charset (charset));
1773 }
1774
1775 DEFUN ("charset-description", Fcharset_description, 1, 1, 0, /*
1776 Return description of CHARSET.
1777 */
1778        (charset))
1779 {
1780   return XCHARSET_DOC_STRING (Fget_charset (charset));
1781 }
1782
1783 DEFUN ("charset-dimension", Fcharset_dimension, 1, 1, 0, /*
1784 Return dimension of CHARSET.
1785 */
1786        (charset))
1787 {
1788   return make_int (XCHARSET_DIMENSION (Fget_charset (charset)));
1789 }
1790
1791 DEFUN ("charset-property", Fcharset_property, 2, 2, 0, /*
1792 Return property PROP of CHARSET, a charset object or symbol naming a charset.
1793 Recognized properties are those listed in `make-charset', as well as
1794 'name and 'doc-string.
1795 */
1796        (charset, prop))
1797 {
1798   Lisp_Charset *cs;
1799
1800   charset = Fget_charset (charset);
1801   cs = XCHARSET (charset);
1802
1803   CHECK_SYMBOL (prop);
1804   if (EQ (prop, Qname))        return CHARSET_NAME (cs);
1805   if (EQ (prop, Qshort_name))  return CHARSET_SHORT_NAME (cs);
1806   if (EQ (prop, Qlong_name))   return CHARSET_LONG_NAME (cs);
1807   if (EQ (prop, Qdoc_string))  return CHARSET_DOC_STRING (cs);
1808   if (EQ (prop, Qdimension))   return make_int (CHARSET_DIMENSION (cs));
1809   if (EQ (prop, Qcolumns))     return make_int (CHARSET_COLUMNS (cs));
1810   if (EQ (prop, Qgraphic))     return make_int (CHARSET_GRAPHIC (cs));
1811   if (EQ (prop, Qfinal))       return CHARSET_FINAL (cs) == 0 ?
1812                                  Qnil : make_char (CHARSET_FINAL (cs));
1813   if (EQ (prop, Qchars))       return make_int (CHARSET_CHARS (cs));
1814   if (EQ (prop, Qregistry))    return CHARSET_REGISTRY (cs);
1815   if (EQ (prop, Qccl_program)) return CHARSET_CCL_PROGRAM (cs);
1816   if (EQ (prop, Qdirection))
1817     return CHARSET_DIRECTION (cs) == CHARSET_LEFT_TO_RIGHT ? Ql2r : Qr2l;
1818   if (EQ (prop, Qreverse_direction_charset))
1819     {
1820       Lisp_Object obj = CHARSET_REVERSE_DIRECTION_CHARSET (cs);
1821       /* #### Is this translation OK?  If so, error checking sufficient? */
1822       return CHARSETP (obj) ? XCHARSET_NAME (obj) : obj;
1823     }
1824 #ifdef UTF2000
1825   if (EQ (prop, Qmother))
1826     return CHARSET_MOTHER (cs);
1827   if (EQ (prop, Qmin_code))
1828     return make_int (CHARSET_MIN_CODE (cs));
1829   if (EQ (prop, Qmax_code))
1830     return make_int (CHARSET_MAX_CODE (cs));
1831 #endif
1832   signal_simple_error ("Unrecognized charset property name", prop);
1833   return Qnil; /* not reached */
1834 }
1835
1836 DEFUN ("charset-id", Fcharset_id, 1, 1, 0, /*
1837 Return charset identification number of CHARSET.
1838 */
1839         (charset))
1840 {
1841   return make_int(XCHARSET_LEADING_BYTE (Fget_charset (charset)));
1842 }
1843
1844 /* #### We need to figure out which properties we really want to
1845    allow to be set. */
1846
1847 DEFUN ("set-charset-ccl-program", Fset_charset_ccl_program, 2, 2, 0, /*
1848 Set the 'ccl-program property of CHARSET to CCL-PROGRAM.
1849 */
1850        (charset, ccl_program))
1851 {
1852   struct ccl_program test_ccl;
1853
1854   charset = Fget_charset (charset);
1855   if (setup_ccl_program (&test_ccl, ccl_program) < 0)
1856     signal_simple_error ("Invalid ccl-program", ccl_program);
1857   XCHARSET_CCL_PROGRAM (charset) = ccl_program;
1858   return Qnil;
1859 }
1860
1861 static void
1862 invalidate_charset_font_caches (Lisp_Object charset)
1863 {
1864   /* Invalidate font cache entries for charset on all devices. */
1865   Lisp_Object devcons, concons, hash_table;
1866   DEVICE_LOOP_NO_BREAK (devcons, concons)
1867     {
1868       struct device *d = XDEVICE (XCAR (devcons));
1869       hash_table = Fgethash (charset, d->charset_font_cache, Qunbound);
1870       if (!UNBOUNDP (hash_table))
1871         Fclrhash (hash_table);
1872     }
1873 }
1874
1875 DEFUN ("set-charset-registry", Fset_charset_registry, 2, 2, 0, /*
1876 Set the 'registry property of CHARSET to REGISTRY.
1877 */
1878        (charset, registry))
1879 {
1880   charset = Fget_charset (charset);
1881   CHECK_STRING (registry);
1882   XCHARSET_REGISTRY (charset) = registry;
1883   invalidate_charset_font_caches (charset);
1884   face_property_was_changed (Vdefault_face, Qfont, Qglobal);
1885   return Qnil;
1886 }
1887
1888 #ifdef UTF2000
1889 DEFUN ("charset-mapping-table", Fcharset_mapping_table, 1, 1, 0, /*
1890 Return mapping-table of CHARSET.
1891 */
1892        (charset))
1893 {
1894   return XCHARSET_DECODING_TABLE (Fget_charset (charset));
1895 }
1896
1897 DEFUN ("set-charset-mapping-table", Fset_charset_mapping_table, 2, 2, 0, /*
1898 Set mapping-table of CHARSET to TABLE.
1899 */
1900        (charset, table))
1901 {
1902   struct Lisp_Charset *cs;
1903   size_t i;
1904   int byte_offset;
1905
1906   charset = Fget_charset (charset);
1907   cs = XCHARSET (charset);
1908
1909   if (NILP (table))
1910     {
1911       CHARSET_DECODING_TABLE(cs) = Qnil;
1912       return table;
1913     }
1914   else if (VECTORP (table))
1915     {
1916       int ccs_len = CHARSET_BYTE_SIZE (cs);
1917       int ret = decoding_table_check_elements (table,
1918                                                CHARSET_DIMENSION (cs),
1919                                                ccs_len);
1920       if (ret)
1921         {
1922           if (ret == -1)
1923             signal_simple_error ("Too big table", table);
1924           else if (ret == -2)
1925             signal_simple_error ("Invalid element is found", table);
1926           else
1927             signal_simple_error ("Something wrong", table);
1928         }
1929       CHARSET_DECODING_TABLE(cs) = Qnil;
1930     }
1931   else
1932     signal_error (Qwrong_type_argument,
1933                   list2 (build_translated_string ("vector-or-nil-p"),
1934                          table));
1935
1936   byte_offset = CHARSET_BYTE_OFFSET (cs);
1937   switch (CHARSET_DIMENSION (cs))
1938     {
1939     case 1:
1940       for (i = 0; i < XVECTOR_LENGTH (table); i++)
1941         {
1942           Lisp_Object c = XVECTOR_DATA(table)[i];
1943
1944           if (CHARP (c))
1945             Fput_char_attribute (c, XCHARSET_NAME (charset),
1946                                  make_int (i + byte_offset));
1947         }
1948       break;
1949     case 2:
1950       for (i = 0; i < XVECTOR_LENGTH (table); i++)
1951         {
1952           Lisp_Object v = XVECTOR_DATA(table)[i];
1953
1954           if (VECTORP (v))
1955             {
1956               size_t j;
1957
1958               for (j = 0; j < XVECTOR_LENGTH (v); j++)
1959                 {
1960                   Lisp_Object c = XVECTOR_DATA(v)[j];
1961
1962                   if (CHARP (c))
1963                     Fput_char_attribute
1964                       (c, XCHARSET_NAME (charset),
1965                        make_int ( ( (i + byte_offset) << 8 )
1966                                   | (j + byte_offset)
1967                                   ) );
1968                 }
1969             }
1970           else if (CHARP (v))
1971             Fput_char_attribute (v, XCHARSET_NAME (charset),
1972                                  make_int (i + byte_offset));
1973         }
1974       break;
1975     }
1976   return table;
1977 }
1978 #endif
1979
1980 \f
1981 /************************************************************************/
1982 /*              Lisp primitives for working with characters             */
1983 /************************************************************************/
1984
1985 #ifdef UTF2000
1986 DEFUN ("decode-char", Fdecode_char, 2, 3, 0, /*
1987 Make a character from CHARSET and code-point CODE.
1988 If DEFINED_ONLY is non-nil, builtin character is not returned.
1989 If corresponding character is not found, nil is returned.
1990 */
1991        (charset, code, defined_only))
1992 {
1993   int c;
1994
1995   charset = Fget_charset (charset);
1996   CHECK_INT (code);
1997   c = XINT (code);
1998   if (XCHARSET_GRAPHIC (charset) == 1)
1999     c &= 0x7F7F7F7F;
2000   if (NILP (defined_only))
2001     c = DECODE_CHAR (charset, c);
2002   else
2003     c = decode_defined_char (charset, c);
2004   return c >= 0 ? make_char (c) : Qnil;
2005 }
2006
2007 DEFUN ("decode-builtin-char", Fdecode_builtin_char, 2, 2, 0, /*
2008 Make a builtin character from CHARSET and code-point CODE.
2009 */
2010        (charset, code))
2011 {
2012   int c;
2013
2014   charset = Fget_charset (charset);
2015   CHECK_INT (code);
2016   if (EQ (charset, Vcharset_latin_viscii))
2017     {
2018       Lisp_Object chr = Fdecode_char (charset, code, Qnil);
2019       Lisp_Object ret;
2020
2021       if (!NILP (chr))
2022         {
2023           if (!NILP
2024               (ret = Fget_char_attribute (chr,
2025                                           Vcharset_latin_viscii_lower,
2026                                           Qnil)))
2027             {
2028               charset = Vcharset_latin_viscii_lower;
2029               code = ret;
2030             }
2031           else if (!NILP
2032                    (ret = Fget_char_attribute (chr,
2033                                                Vcharset_latin_viscii_upper,
2034                                                Qnil)))
2035             {
2036               charset = Vcharset_latin_viscii_upper;
2037               code = ret;
2038             }
2039         }
2040     }
2041   c = XINT (code);
2042 #if 0
2043   if (XCHARSET_GRAPHIC (charset) == 1)
2044     c &= 0x7F7F7F7F;
2045 #endif
2046   c = decode_builtin_char (charset, c);
2047   return c >= 0 ? make_char (c) : Fdecode_char (charset, code, Qnil);
2048 }
2049 #endif
2050
2051 DEFUN ("make-char", Fmake_char, 2, 3, 0, /*
2052 Make a character from CHARSET and octets ARG1 and ARG2.
2053 ARG2 is required only for characters from two-dimensional charsets.
2054 For example, (make-char 'latin-iso8859-2 185) will return the Latin 2
2055 character s with caron.
2056 */
2057        (charset, arg1, arg2))
2058 {
2059   Lisp_Charset *cs;
2060   int a1, a2;
2061   int lowlim, highlim;
2062
2063   charset = Fget_charset (charset);
2064   cs = XCHARSET (charset);
2065
2066   if      (EQ (charset, Vcharset_ascii))     lowlim =  0, highlim = 127;
2067   else if (EQ (charset, Vcharset_control_1)) lowlim =  0, highlim =  31;
2068 #ifdef UTF2000
2069   else if (CHARSET_CHARS (cs) == 256)        lowlim =  0, highlim = 255;
2070 #endif
2071   else if (CHARSET_CHARS (cs) == 94)         lowlim = 33, highlim = 126;
2072   else  /* CHARSET_CHARS (cs) == 96) */      lowlim = 32, highlim = 127;
2073
2074   CHECK_INT (arg1);
2075   /* It is useful (and safe, according to Olivier Galibert) to strip
2076      the 8th bit off ARG1 and ARG2 because it allows programmers to
2077      write (make-char 'latin-iso8859-2 CODE) where code is the actual
2078      Latin 2 code of the character.  */
2079 #ifdef UTF2000
2080   a1 = XINT (arg1);
2081   if (highlim < 128)
2082     a1 &= 0x7f;
2083 #else
2084   a1 = XINT (arg1);
2085 #endif
2086   if (a1 < lowlim || a1 > highlim)
2087     args_out_of_range_3 (arg1, make_int (lowlim), make_int (highlim));
2088
2089   if (CHARSET_DIMENSION (cs) == 1)
2090     {
2091       if (!NILP (arg2))
2092         signal_simple_error
2093           ("Charset is of dimension one; second octet must be nil", arg2);
2094       return make_char (MAKE_CHAR (charset, a1, 0));
2095     }
2096
2097   CHECK_INT (arg2);
2098 #ifdef UTF2000
2099   a2 = XINT (arg2);
2100   if (highlim < 128)
2101     a2 &= 0x7f;
2102 #else
2103   a2 = XINT (arg2) & 0x7f;
2104 #endif
2105   if (a2 < lowlim || a2 > highlim)
2106     args_out_of_range_3 (arg2, make_int (lowlim), make_int (highlim));
2107
2108   return make_char (MAKE_CHAR (charset, a1, a2));
2109 }
2110
2111 DEFUN ("char-charset", Fchar_charset, 1, 1, 0, /*
2112 Return the character set of CHARACTER.
2113 */
2114        (character))
2115 {
2116   CHECK_CHAR_COERCE_INT (character);
2117
2118   return XCHARSET_NAME (CHAR_CHARSET (XCHAR (character)));
2119 }
2120
2121 DEFUN ("char-octet", Fchar_octet, 1, 2, 0, /*
2122 Return the octet numbered N (should be 0 or 1) of CHARACTER.
2123 N defaults to 0 if omitted.
2124 */
2125        (character, n))
2126 {
2127   Lisp_Object charset;
2128   int octet0, octet1;
2129
2130   CHECK_CHAR_COERCE_INT (character);
2131
2132   BREAKUP_CHAR (XCHAR (character), charset, octet0, octet1);
2133
2134   if (NILP (n) || EQ (n, Qzero))
2135     return make_int (octet0);
2136   else if (EQ (n, make_int (1)))
2137     return make_int (octet1);
2138   else
2139     signal_simple_error ("Octet number must be 0 or 1", n);
2140 }
2141
2142 #ifdef UTF2000
2143 DEFUN ("encode-char", Fencode_char, 2, 3, 0, /*
2144 Return code-point of CHARACTER in specified CHARSET.
2145 */
2146        (character, charset, defined_only))
2147 {
2148   int code_point;
2149
2150   CHECK_CHAR_COERCE_INT (character);
2151   charset = Fget_charset (charset);
2152   code_point = charset_code_point (charset, XCHAR (character),
2153                                    !NILP (defined_only));
2154   if (code_point >= 0)
2155     return make_int (code_point);
2156   else
2157     return Qnil;
2158 }
2159 #endif
2160
2161 DEFUN ("split-char", Fsplit_char, 1, 1, 0, /*
2162 Return list of charset and one or two position-codes of CHARACTER.
2163 */
2164        (character))
2165 {
2166   /* This function can GC */
2167   struct gcpro gcpro1, gcpro2;
2168   Lisp_Object charset = Qnil;
2169   Lisp_Object rc = Qnil;
2170 #ifdef UTF2000
2171   int code_point;
2172   int dimension;
2173 #else
2174   int c1, c2;
2175 #endif
2176
2177   GCPRO2 (charset, rc);
2178   CHECK_CHAR_COERCE_INT (character);
2179
2180 #ifdef UTF2000
2181   code_point = ENCODE_CHAR (XCHAR (character), charset);
2182   dimension = XCHARSET_DIMENSION (charset);
2183   while (dimension > 0)
2184     {
2185       rc = Fcons (make_int (code_point & 255), rc);
2186       code_point >>= 8;
2187       dimension--;
2188     }
2189   rc = Fcons (XCHARSET_NAME (charset), rc);
2190 #else
2191   BREAKUP_CHAR (XCHAR (character), charset, c1, c2);
2192
2193   if (XCHARSET_DIMENSION (Fget_charset (charset)) == 2)
2194     {
2195       rc = list3 (XCHARSET_NAME (charset), make_int (c1), make_int (c2));
2196     }
2197   else
2198     {
2199       rc = list2 (XCHARSET_NAME (charset), make_int (c1));
2200     }
2201 #endif
2202   UNGCPRO;
2203
2204   return rc;
2205 }
2206
2207 \f
2208 #ifdef ENABLE_COMPOSITE_CHARS
2209 /************************************************************************/
2210 /*                     composite character functions                    */
2211 /************************************************************************/
2212
2213 Emchar
2214 lookup_composite_char (Bufbyte *str, int len)
2215 {
2216   Lisp_Object lispstr = make_string (str, len);
2217   Lisp_Object ch = Fgethash (lispstr,
2218                              Vcomposite_char_string2char_hash_table,
2219                              Qunbound);
2220   Emchar emch;
2221
2222   if (UNBOUNDP (ch))
2223     {
2224       if (composite_char_row_next >= 128)
2225         signal_simple_error ("No more composite chars available", lispstr);
2226       emch = MAKE_CHAR (Vcharset_composite, composite_char_row_next,
2227                         composite_char_col_next);
2228       Fputhash (make_char (emch), lispstr,
2229                 Vcomposite_char_char2string_hash_table);
2230       Fputhash (lispstr, make_char (emch),
2231                 Vcomposite_char_string2char_hash_table);
2232       composite_char_col_next++;
2233       if (composite_char_col_next >= 128)
2234         {
2235           composite_char_col_next = 32;
2236           composite_char_row_next++;
2237         }
2238     }
2239   else
2240     emch = XCHAR (ch);
2241   return emch;
2242 }
2243
2244 Lisp_Object
2245 composite_char_string (Emchar ch)
2246 {
2247   Lisp_Object str = Fgethash (make_char (ch),
2248                               Vcomposite_char_char2string_hash_table,
2249                               Qunbound);
2250   assert (!UNBOUNDP (str));
2251   return str;
2252 }
2253
2254 xxDEFUN ("make-composite-char", Fmake_composite_char, 1, 1, 0, /*
2255 Convert a string into a single composite character.
2256 The character is the result of overstriking all the characters in
2257 the string.
2258 */
2259        (string))
2260 {
2261   CHECK_STRING (string);
2262   return make_char (lookup_composite_char (XSTRING_DATA (string),
2263                                            XSTRING_LENGTH (string)));
2264 }
2265
2266 xxDEFUN ("composite-char-string", Fcomposite_char_string, 1, 1, 0, /*
2267 Return a string of the characters comprising a composite character.
2268 */
2269        (ch))
2270 {
2271   Emchar emch;
2272
2273   CHECK_CHAR (ch);
2274   emch = XCHAR (ch);
2275   if (CHAR_LEADING_BYTE (emch) != LEADING_BYTE_COMPOSITE)
2276     signal_simple_error ("Must be composite char", ch);
2277   return composite_char_string (emch);
2278 }
2279 #endif /* ENABLE_COMPOSITE_CHARS */
2280
2281 \f
2282 /************************************************************************/
2283 /*                            initialization                            */
2284 /************************************************************************/
2285
2286 void
2287 syms_of_mule_charset (void)
2288 {
2289   INIT_LRECORD_IMPLEMENTATION (charset);
2290
2291   DEFSUBR (Fcharsetp);
2292   DEFSUBR (Ffind_charset);
2293   DEFSUBR (Fget_charset);
2294   DEFSUBR (Fcharset_list);
2295   DEFSUBR (Fcharset_name);
2296   DEFSUBR (Fmake_charset);
2297   DEFSUBR (Fmake_reverse_direction_charset);
2298   /*  DEFSUBR (Freverse_direction_charset); */
2299   DEFSUBR (Fdefine_charset_alias);
2300   DEFSUBR (Fcharset_from_attributes);
2301   DEFSUBR (Fcharset_short_name);
2302   DEFSUBR (Fcharset_long_name);
2303   DEFSUBR (Fcharset_description);
2304   DEFSUBR (Fcharset_dimension);
2305   DEFSUBR (Fcharset_property);
2306   DEFSUBR (Fcharset_id);
2307   DEFSUBR (Fset_charset_ccl_program);
2308   DEFSUBR (Fset_charset_registry);
2309 #ifdef UTF2000
2310   DEFSUBR (Fcharset_mapping_table);
2311   DEFSUBR (Fset_charset_mapping_table);
2312 #endif
2313
2314 #ifdef UTF2000
2315   DEFSUBR (Fdecode_char);
2316   DEFSUBR (Fdecode_builtin_char);
2317   DEFSUBR (Fencode_char);
2318 #endif
2319   DEFSUBR (Fmake_char);
2320   DEFSUBR (Fchar_charset);
2321   DEFSUBR (Fchar_octet);
2322   DEFSUBR (Fsplit_char);
2323
2324 #ifdef ENABLE_COMPOSITE_CHARS
2325   DEFSUBR (Fmake_composite_char);
2326   DEFSUBR (Fcomposite_char_string);
2327 #endif
2328
2329   defsymbol (&Qcharsetp, "charsetp");
2330   defsymbol (&Qregistry, "registry");
2331   defsymbol (&Qfinal, "final");
2332   defsymbol (&Qgraphic, "graphic");
2333   defsymbol (&Qdirection, "direction");
2334   defsymbol (&Qreverse_direction_charset, "reverse-direction-charset");
2335   defsymbol (&Qshort_name, "short-name");
2336   defsymbol (&Qlong_name, "long-name");
2337 #ifdef UTF2000
2338   defsymbol (&Qmother, "mother");
2339   defsymbol (&Qmin_code, "min-code");
2340   defsymbol (&Qmax_code, "max-code");
2341   defsymbol (&Qcode_offset, "code-offset");
2342   defsymbol (&Qconversion, "conversion");
2343   defsymbol (&Q94x60, "94x60");
2344   defsymbol (&Q94x94x60, "94x94x60");
2345 #endif
2346
2347   defsymbol (&Ql2r, "l2r");
2348   defsymbol (&Qr2l, "r2l");
2349
2350   /* Charsets, compatible with FSF 20.3
2351      Naming convention is Script-Charset[-Edition] */
2352   defsymbol (&Qascii,                   "ascii");
2353   defsymbol (&Qcontrol_1,               "control-1");
2354   defsymbol (&Qlatin_iso8859_1,         "latin-iso8859-1");
2355   defsymbol (&Qlatin_iso8859_2,         "latin-iso8859-2");
2356   defsymbol (&Qlatin_iso8859_3,         "latin-iso8859-3");
2357   defsymbol (&Qlatin_iso8859_4,         "latin-iso8859-4");
2358   defsymbol (&Qthai_tis620,             "thai-tis620");
2359   defsymbol (&Qgreek_iso8859_7,         "greek-iso8859-7");
2360   defsymbol (&Qarabic_iso8859_6,        "arabic-iso8859-6");
2361   defsymbol (&Qhebrew_iso8859_8,        "hebrew-iso8859-8");
2362   defsymbol (&Qkatakana_jisx0201,       "katakana-jisx0201");
2363   defsymbol (&Qlatin_jisx0201,          "latin-jisx0201");
2364   defsymbol (&Qcyrillic_iso8859_5,      "cyrillic-iso8859-5");
2365   defsymbol (&Qlatin_iso8859_9,         "latin-iso8859-9");
2366   defsymbol (&Qjapanese_jisx0208_1978,  "japanese-jisx0208-1978");
2367   defsymbol (&Qchinese_gb2312,          "chinese-gb2312");
2368   defsymbol (&Qchinese_gb12345,         "chinese-gb12345");
2369   defsymbol (&Qjapanese_jisx0208,       "japanese-jisx0208");
2370   defsymbol (&Qjapanese_jisx0208_1990,  "japanese-jisx0208-1990");
2371   defsymbol (&Qkorean_ksc5601,          "korean-ksc5601");
2372   defsymbol (&Qjapanese_jisx0212,       "japanese-jisx0212");
2373   defsymbol (&Qchinese_cns11643_1,      "chinese-cns11643-1");
2374   defsymbol (&Qchinese_cns11643_2,      "chinese-cns11643-2");
2375 #ifdef UTF2000
2376   defsymbol (&Qucs,                     "ucs");
2377   defsymbol (&Qucs_bmp,                 "ucs-bmp");
2378   defsymbol (&Qucs_smp,                 "ucs-smp");
2379   defsymbol (&Qucs_sip,                 "ucs-sip");
2380   defsymbol (&Qucs_gb,                  "ucs-gb");
2381   defsymbol (&Qlatin_viscii,            "latin-viscii");
2382   defsymbol (&Qlatin_tcvn5712,          "latin-tcvn5712");
2383   defsymbol (&Qlatin_viscii_lower,      "latin-viscii-lower");
2384   defsymbol (&Qlatin_viscii_upper,      "latin-viscii-upper");
2385   defsymbol (&Qvietnamese_viscii_lower, "vietnamese-viscii-lower");
2386   defsymbol (&Qvietnamese_viscii_upper, "vietnamese-viscii-upper");
2387   defsymbol (&Qjis_x0208,               "=jis-x0208");
2388   defsymbol (&Qchinese_big5,            "chinese-big5");
2389   defsymbol (&Qethiopic_ucs,            "ethiopic-ucs");
2390 #endif
2391   defsymbol (&Qchinese_big5_1,          "chinese-big5-1");
2392   defsymbol (&Qchinese_big5_2,          "chinese-big5-2");
2393
2394   defsymbol (&Qcomposite,               "composite");
2395 }
2396
2397 void
2398 vars_of_mule_charset (void)
2399 {
2400   int i, j;
2401 #ifndef UTF2000
2402   int k;
2403 #endif
2404
2405   chlook = xnew_and_zero (struct charset_lookup); /* zero for Purify. */
2406   dump_add_root_struct_ptr (&chlook, &charset_lookup_description);
2407
2408   /* Table of charsets indexed by leading byte. */
2409   for (i = 0; i < countof (chlook->charset_by_leading_byte); i++)
2410     chlook->charset_by_leading_byte[i] = Qnil;
2411
2412 #ifdef UTF2000
2413   /* Table of charsets indexed by type/final-byte. */
2414   for (i = 0; i < countof (chlook->charset_by_attributes); i++)
2415     for (j = 0; j < countof (chlook->charset_by_attributes[0]); j++)
2416       chlook->charset_by_attributes[i][j] = Qnil;
2417 #else
2418   /* Table of charsets indexed by type/final-byte/direction. */
2419   for (i = 0; i < countof (chlook->charset_by_attributes); i++)
2420     for (j = 0; j < countof (chlook->charset_by_attributes[0]); j++)
2421       for (k = 0; k < countof (chlook->charset_by_attributes[0][0]); k++)
2422         chlook->charset_by_attributes[i][j][k] = Qnil;
2423 #endif
2424
2425 #ifdef UTF2000
2426   chlook->next_allocated_leading_byte = MIN_LEADING_BYTE_PRIVATE;
2427 #else
2428   chlook->next_allocated_1_byte_leading_byte = MIN_LEADING_BYTE_PRIVATE_1;
2429   chlook->next_allocated_2_byte_leading_byte = MIN_LEADING_BYTE_PRIVATE_2;
2430 #endif
2431
2432 #ifndef UTF2000
2433   leading_code_private_11 = PRE_LEADING_BYTE_PRIVATE_1;
2434   DEFVAR_INT ("leading-code-private-11", &leading_code_private_11 /*
2435 Leading-code of private TYPE9N charset of column-width 1.
2436 */ );
2437   leading_code_private_11 = PRE_LEADING_BYTE_PRIVATE_1;
2438 #endif
2439
2440 #ifdef UTF2000
2441   Vdefault_coded_charset_priority_list = Qnil;
2442   DEFVAR_LISP ("default-coded-charset-priority-list",
2443                &Vdefault_coded_charset_priority_list /*
2444 Default order of preferred coded-character-sets.
2445 */ );
2446 #endif
2447 }
2448
2449 void
2450 complex_vars_of_mule_charset (void)
2451 {
2452   staticpro (&Vcharset_hash_table);
2453   Vcharset_hash_table =
2454     make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
2455
2456   /* Predefined character sets.  We store them into variables for
2457      ease of access. */
2458
2459 #ifdef UTF2000
2460   staticpro (&Vcharset_ucs);
2461   Vcharset_ucs =
2462     make_charset (LEADING_BYTE_UCS, Qucs, 256, 4,
2463                   1, 2, 0, CHARSET_LEFT_TO_RIGHT,
2464                   build_string ("UCS"),
2465                   build_string ("UCS"),
2466                   build_string ("ISO/IEC 10646"),
2467                   build_string (""),
2468                   Qnil, 0, 0x7FFFFFFF, 0, 0, Qnil, CONVERSION_IDENTICAL);
2469   staticpro (&Vcharset_ucs_bmp);
2470   Vcharset_ucs_bmp =
2471     make_charset (LEADING_BYTE_UCS_BMP, Qucs_bmp, 256, 2,
2472                   1, 2, 0, CHARSET_LEFT_TO_RIGHT,
2473                   build_string ("BMP"),
2474                   build_string ("UCS-BMP"),
2475                   build_string ("ISO/IEC 10646 Group 0 Plane 0 (BMP)"),
2476                   build_string
2477                   ("\\(ISO10646.*-[01]\\|UCS00-0\\|UNICODE[23]?-0\\)"),
2478                   Qnil, 0, 0xFFFF, 0, 0, Qnil, CONVERSION_IDENTICAL);
2479   staticpro (&Vcharset_ucs_smp);
2480   Vcharset_ucs_smp =
2481     make_charset (LEADING_BYTE_UCS_SMP, Qucs_smp, 256, 2,
2482                   1, 2, 0, CHARSET_LEFT_TO_RIGHT,
2483                   build_string ("SMP"),
2484                   build_string ("UCS-SMP"),
2485                   build_string ("ISO/IEC 10646 Group 0 Plane 1 (SMP)"),
2486                   build_string ("UCS00-1"),
2487                   Qnil, MIN_CHAR_SMP, MAX_CHAR_SMP,
2488                   MIN_CHAR_SMP, 0, Qnil, CONVERSION_IDENTICAL);
2489   staticpro (&Vcharset_ucs_sip);
2490   Vcharset_ucs_sip =
2491     make_charset (LEADING_BYTE_UCS_SIP, Qucs_sip, 256, 2,
2492                   2, 2, 0, CHARSET_LEFT_TO_RIGHT,
2493                   build_string ("SIP"),
2494                   build_string ("UCS-SIP"),
2495                   build_string ("ISO/IEC 10646 Group 0 Plane 2 (SIP)"),
2496                   build_string ("\\(ISO10646.*-2\\|UCS00-2\\)"),
2497                   Qnil, MIN_CHAR_SIP, MAX_CHAR_SIP,
2498                   MIN_CHAR_SIP, 0, Qnil, CONVERSION_IDENTICAL);
2499   staticpro (&Vcharset_ucs_gb);
2500   Vcharset_ucs_gb =
2501     make_charset (LEADING_BYTE_UCS_GB, Qucs_gb, 256, 3,
2502                   2, 2, 0, CHARSET_LEFT_TO_RIGHT,
2503                   build_string ("UCS for GB"),
2504                   build_string ("UCS for GB"),
2505                   build_string ("ISO/IEC 10646 for GB"),
2506                   build_string (""),
2507                   Qnil, 0, 0, 0, 0, Vcharset_ucs, CONVERSION_IDENTICAL);
2508 #else
2509 # define MIN_CHAR_THAI 0
2510 # define MAX_CHAR_THAI 0
2511   /* # define MIN_CHAR_HEBREW 0 */
2512   /* # define MAX_CHAR_HEBREW 0 */
2513 # define MIN_CHAR_HALFWIDTH_KATAKANA 0
2514 # define MAX_CHAR_HALFWIDTH_KATAKANA 0
2515 #endif
2516   staticpro (&Vcharset_ascii);
2517   Vcharset_ascii =
2518     make_charset (LEADING_BYTE_ASCII, Qascii, 94, 1,
2519                   1, 0, 'B', CHARSET_LEFT_TO_RIGHT,
2520                   build_string ("ASCII"),
2521                   build_string ("ASCII)"),
2522                   build_string ("ASCII (ISO646 IRV)"),
2523                   build_string ("\\(iso8859-[0-9]*\\|-ascii\\)"),
2524                   Qnil, 0, 0x7F, 0, 0, Qnil, CONVERSION_IDENTICAL);
2525   staticpro (&Vcharset_control_1);
2526   Vcharset_control_1 =
2527     make_charset (LEADING_BYTE_CONTROL_1, Qcontrol_1, 94, 1,
2528                   1, 1, 0, CHARSET_LEFT_TO_RIGHT,
2529                   build_string ("C1"),
2530                   build_string ("Control characters"),
2531                   build_string ("Control characters 128-191"),
2532                   build_string (""),
2533                   Qnil, 0x80, 0x9F, 0x80, 0, Qnil, CONVERSION_IDENTICAL);
2534   staticpro (&Vcharset_latin_iso8859_1);
2535   Vcharset_latin_iso8859_1 =
2536     make_charset (LEADING_BYTE_LATIN_ISO8859_1, Qlatin_iso8859_1, 96, 1,
2537                   1, 1, 'A', CHARSET_LEFT_TO_RIGHT,
2538                   build_string ("Latin-1"),
2539                   build_string ("ISO8859-1 (Latin-1)"),
2540                   build_string ("ISO8859-1 (Latin-1)"),
2541                   build_string ("iso8859-1"),
2542                   Qnil, 0, 0, 0, 32, Qnil, CONVERSION_IDENTICAL);
2543   staticpro (&Vcharset_latin_iso8859_2);
2544   Vcharset_latin_iso8859_2 =
2545     make_charset (LEADING_BYTE_LATIN_ISO8859_2, Qlatin_iso8859_2, 96, 1,
2546                   1, 1, 'B', CHARSET_LEFT_TO_RIGHT,
2547                   build_string ("Latin-2"),
2548                   build_string ("ISO8859-2 (Latin-2)"),
2549                   build_string ("ISO8859-2 (Latin-2)"),
2550                   build_string ("iso8859-2"),
2551                   Qnil, 0, 0, 0, 32, Qnil, CONVERSION_IDENTICAL);
2552   staticpro (&Vcharset_latin_iso8859_3);
2553   Vcharset_latin_iso8859_3 =
2554     make_charset (LEADING_BYTE_LATIN_ISO8859_3, Qlatin_iso8859_3, 96, 1,
2555                   1, 1, 'C', CHARSET_LEFT_TO_RIGHT,
2556                   build_string ("Latin-3"),
2557                   build_string ("ISO8859-3 (Latin-3)"),
2558                   build_string ("ISO8859-3 (Latin-3)"),
2559                   build_string ("iso8859-3"),
2560                   Qnil, 0, 0, 0, 32, Qnil, CONVERSION_IDENTICAL);
2561   staticpro (&Vcharset_latin_iso8859_4);
2562   Vcharset_latin_iso8859_4 =
2563     make_charset (LEADING_BYTE_LATIN_ISO8859_4, Qlatin_iso8859_4, 96, 1,
2564                   1, 1, 'D', CHARSET_LEFT_TO_RIGHT,
2565                   build_string ("Latin-4"),
2566                   build_string ("ISO8859-4 (Latin-4)"),
2567                   build_string ("ISO8859-4 (Latin-4)"),
2568                   build_string ("iso8859-4"),
2569                   Qnil, 0, 0, 0, 32, Qnil, CONVERSION_IDENTICAL);
2570   staticpro (&Vcharset_thai_tis620);
2571   Vcharset_thai_tis620 =
2572     make_charset (LEADING_BYTE_THAI_TIS620, Qthai_tis620, 96, 1,
2573                   1, 1, 'T', CHARSET_LEFT_TO_RIGHT,
2574                   build_string ("TIS620"),
2575                   build_string ("TIS620 (Thai)"),
2576                   build_string ("TIS620.2529 (Thai)"),
2577                   build_string ("tis620"),
2578                   Qnil, 0, 0, 0, 32, Qnil, CONVERSION_IDENTICAL);
2579   staticpro (&Vcharset_greek_iso8859_7);
2580   Vcharset_greek_iso8859_7 =
2581     make_charset (LEADING_BYTE_GREEK_ISO8859_7, Qgreek_iso8859_7, 96, 1,
2582                   1, 1, 'F', CHARSET_LEFT_TO_RIGHT,
2583                   build_string ("ISO8859-7"),
2584                   build_string ("ISO8859-7 (Greek)"),
2585                   build_string ("ISO8859-7 (Greek)"),
2586                   build_string ("iso8859-7"),
2587                   Qnil, 0, 0, 0, 32, Qnil, CONVERSION_IDENTICAL);
2588   staticpro (&Vcharset_arabic_iso8859_6);
2589   Vcharset_arabic_iso8859_6 =
2590     make_charset (LEADING_BYTE_ARABIC_ISO8859_6, Qarabic_iso8859_6, 96, 1,
2591                   1, 1, 'G', CHARSET_RIGHT_TO_LEFT,
2592                   build_string ("ISO8859-6"),
2593                   build_string ("ISO8859-6 (Arabic)"),
2594                   build_string ("ISO8859-6 (Arabic)"),
2595                   build_string ("iso8859-6"),
2596                   Qnil, 0, 0, 0, 32, Qnil, CONVERSION_IDENTICAL);
2597   staticpro (&Vcharset_hebrew_iso8859_8);
2598   Vcharset_hebrew_iso8859_8 =
2599     make_charset (LEADING_BYTE_HEBREW_ISO8859_8, Qhebrew_iso8859_8, 96, 1,
2600                   1, 1, 'H', CHARSET_RIGHT_TO_LEFT,
2601                   build_string ("ISO8859-8"),
2602                   build_string ("ISO8859-8 (Hebrew)"),
2603                   build_string ("ISO8859-8 (Hebrew)"),
2604                   build_string ("iso8859-8"),
2605                   Qnil,
2606                   0 /* MIN_CHAR_HEBREW */,
2607                   0 /* MAX_CHAR_HEBREW */, 0, 32,
2608                   Qnil, CONVERSION_IDENTICAL);
2609   staticpro (&Vcharset_katakana_jisx0201);
2610   Vcharset_katakana_jisx0201 =
2611     make_charset (LEADING_BYTE_KATAKANA_JISX0201, Qkatakana_jisx0201, 94, 1,
2612                   1, 1, 'I', CHARSET_LEFT_TO_RIGHT,
2613                   build_string ("JISX0201 Kana"),
2614                   build_string ("JISX0201.1976 (Japanese Kana)"),
2615                   build_string ("JISX0201.1976 Japanese Kana"),
2616                   build_string ("jisx0201\\.1976"),
2617                   Qnil, 0, 0, 0, 33, Qnil, CONVERSION_IDENTICAL);
2618   staticpro (&Vcharset_latin_jisx0201);
2619   Vcharset_latin_jisx0201 =
2620     make_charset (LEADING_BYTE_LATIN_JISX0201, Qlatin_jisx0201, 94, 1,
2621                   1, 0, 'J', CHARSET_LEFT_TO_RIGHT,
2622                   build_string ("JISX0201 Roman"),
2623                   build_string ("JISX0201.1976 (Japanese Roman)"),
2624                   build_string ("JISX0201.1976 Japanese Roman"),
2625                   build_string ("jisx0201\\.1976"),
2626                   Qnil, 0, 0, 0, 33, Qnil, CONVERSION_IDENTICAL);
2627   staticpro (&Vcharset_cyrillic_iso8859_5);
2628   Vcharset_cyrillic_iso8859_5 =
2629     make_charset (LEADING_BYTE_CYRILLIC_ISO8859_5, Qcyrillic_iso8859_5, 96, 1,
2630                   1, 1, 'L', CHARSET_LEFT_TO_RIGHT,
2631                   build_string ("ISO8859-5"),
2632                   build_string ("ISO8859-5 (Cyrillic)"),
2633                   build_string ("ISO8859-5 (Cyrillic)"),
2634                   build_string ("iso8859-5"),
2635                   Qnil, 0, 0, 0, 32, Qnil, CONVERSION_IDENTICAL);
2636   staticpro (&Vcharset_latin_iso8859_9);
2637   Vcharset_latin_iso8859_9 =
2638     make_charset (LEADING_BYTE_LATIN_ISO8859_9, Qlatin_iso8859_9, 96, 1,
2639                   1, 1, 'M', CHARSET_LEFT_TO_RIGHT,
2640                   build_string ("Latin-5"),
2641                   build_string ("ISO8859-9 (Latin-5)"),
2642                   build_string ("ISO8859-9 (Latin-5)"),
2643                   build_string ("iso8859-9"),
2644                   Qnil, 0, 0, 0, 32, Qnil, CONVERSION_IDENTICAL);
2645 #ifdef UTF2000
2646   staticpro (&Vcharset_jis_x0208);
2647   Vcharset_jis_x0208 =
2648     make_charset (LEADING_BYTE_JIS_X0208,
2649                   Qjis_x0208, 94, 2,
2650                   2, 0, 'B', CHARSET_LEFT_TO_RIGHT,
2651                   build_string ("JIS X0208"),
2652                   build_string ("JIS X0208 Common"),
2653                   build_string ("JIS X0208 Common part"),
2654                   build_string ("jisx0208\\.1990"),
2655                   Qnil,
2656                   MIN_CHAR_JIS_X0208_1990,
2657                   MAX_CHAR_JIS_X0208_1990, MIN_CHAR_JIS_X0208_1990, 33,
2658                   Qnil, CONVERSION_94x94);
2659 #endif
2660   staticpro (&Vcharset_japanese_jisx0208_1978);
2661   Vcharset_japanese_jisx0208_1978 =
2662     make_charset (LEADING_BYTE_JAPANESE_JISX0208_1978,
2663                   Qjapanese_jisx0208_1978, 94, 2,
2664                   2, 0, '@', CHARSET_LEFT_TO_RIGHT,
2665                   build_string ("JIS X0208:1978"),
2666                   build_string ("JIS X0208:1978 (Japanese)"),
2667                   build_string
2668                   ("JIS X0208:1978 Japanese Kanji (so called \"old JIS\")"),
2669                   build_string ("\\(jisx0208\\|jisc6226\\)\\.1978"),
2670                   Qnil, 0, 0, 0, 33,
2671 #ifdef UTF2000
2672                   Vcharset_jis_x0208,
2673 #else
2674                   Qnil,
2675 #endif
2676                   CONVERSION_IDENTICAL);
2677   staticpro (&Vcharset_chinese_gb2312);
2678   Vcharset_chinese_gb2312 =
2679     make_charset (LEADING_BYTE_CHINESE_GB2312, Qchinese_gb2312, 94, 2,
2680                   2, 0, 'A', CHARSET_LEFT_TO_RIGHT,
2681                   build_string ("GB2312"),
2682                   build_string ("GB2312)"),
2683                   build_string ("GB2312 Chinese simplified"),
2684                   build_string ("gb2312"),
2685                   Qnil, 0, 0, 0, 33, Qnil, CONVERSION_IDENTICAL);
2686   staticpro (&Vcharset_chinese_gb12345);
2687   Vcharset_chinese_gb12345 =
2688     make_charset (LEADING_BYTE_CHINESE_GB12345, Qchinese_gb12345, 94, 2,
2689                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
2690                   build_string ("G1"),
2691                   build_string ("GB 12345)"),
2692                   build_string ("GB 12345-1990"),
2693                   build_string ("GB12345\\(\\.1990\\)?-0"),
2694                   Qnil, 0, 0, 0, 33, Qnil, CONVERSION_IDENTICAL);
2695   staticpro (&Vcharset_japanese_jisx0208);
2696   Vcharset_japanese_jisx0208 =
2697     make_charset (LEADING_BYTE_JAPANESE_JISX0208, Qjapanese_jisx0208, 94, 2,
2698                   2, 0, 'B', CHARSET_LEFT_TO_RIGHT,
2699                   build_string ("JISX0208"),
2700                   build_string ("JIS X0208:1983 (Japanese)"),
2701                   build_string ("JIS X0208:1983 Japanese Kanji"),
2702                   build_string ("jisx0208\\.1983"),
2703                   Qnil, 0, 0, 0, 33,
2704 #ifdef UTF2000
2705                   Vcharset_jis_x0208,
2706 #else
2707                   Qnil,
2708 #endif
2709                   CONVERSION_IDENTICAL);
2710 #ifdef UTF2000
2711   staticpro (&Vcharset_japanese_jisx0208_1990);
2712   Vcharset_japanese_jisx0208_1990 =
2713     make_charset (LEADING_BYTE_JAPANESE_JISX0208_1990,
2714                   Qjapanese_jisx0208_1990, 94, 2,
2715                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
2716                   build_string ("JISX0208-1990"),
2717                   build_string ("JIS X0208:1990 (Japanese)"),
2718                   build_string ("JIS X0208:1990 Japanese Kanji"),
2719                   build_string ("jisx0208\\.1990"),
2720                   Qnil,
2721                   0x2121 /* MIN_CHAR_JIS_X0208_1990 */,
2722                   0x7426 /* MAX_CHAR_JIS_X0208_1990 */,
2723                   0 /* MIN_CHAR_JIS_X0208_1990 */, 33,
2724                   Vcharset_jis_x0208 /* Qnil */,
2725                   CONVERSION_IDENTICAL /* CONVERSION_94x94 */);
2726 #endif
2727   staticpro (&Vcharset_korean_ksc5601);
2728   Vcharset_korean_ksc5601 =
2729     make_charset (LEADING_BYTE_KOREAN_KSC5601, Qkorean_ksc5601, 94, 2,
2730                   2, 0, 'C', CHARSET_LEFT_TO_RIGHT,
2731                   build_string ("KSC5601"),
2732                   build_string ("KSC5601 (Korean"),
2733                   build_string ("KSC5601 Korean Hangul and Hanja"),
2734                   build_string ("ksc5601"),
2735                   Qnil, 0, 0, 0, 33, Qnil, CONVERSION_IDENTICAL);
2736   staticpro (&Vcharset_japanese_jisx0212);
2737   Vcharset_japanese_jisx0212 =
2738     make_charset (LEADING_BYTE_JAPANESE_JISX0212, Qjapanese_jisx0212, 94, 2,
2739                   2, 0, 'D', CHARSET_LEFT_TO_RIGHT,
2740                   build_string ("JISX0212"),
2741                   build_string ("JISX0212 (Japanese)"),
2742                   build_string ("JISX0212 Japanese Supplement"),
2743                   build_string ("jisx0212"),
2744                   Qnil, 0, 0, 0, 33, Qnil, CONVERSION_IDENTICAL);
2745
2746 #define CHINESE_CNS_PLANE_RE(n) "cns11643[.-]\\(.*[.-]\\)?" n "$"
2747   staticpro (&Vcharset_chinese_cns11643_1);
2748   Vcharset_chinese_cns11643_1 =
2749     make_charset (LEADING_BYTE_CHINESE_CNS11643_1, Qchinese_cns11643_1, 94, 2,
2750                   2, 0, 'G', CHARSET_LEFT_TO_RIGHT,
2751                   build_string ("CNS11643-1"),
2752                   build_string ("CNS11643-1 (Chinese traditional)"),
2753                   build_string
2754                   ("CNS 11643 Plane 1 Chinese traditional"),
2755                   build_string (CHINESE_CNS_PLANE_RE("1")),
2756                   Qnil, 0, 0, 0, 33, Qnil, CONVERSION_IDENTICAL);
2757   staticpro (&Vcharset_chinese_cns11643_2);
2758   Vcharset_chinese_cns11643_2 =
2759     make_charset (LEADING_BYTE_CHINESE_CNS11643_2, Qchinese_cns11643_2, 94, 2,
2760                   2, 0, 'H', CHARSET_LEFT_TO_RIGHT,
2761                   build_string ("CNS11643-2"),
2762                   build_string ("CNS11643-2 (Chinese traditional)"),
2763                   build_string
2764                   ("CNS 11643 Plane 2 Chinese traditional"),
2765                   build_string (CHINESE_CNS_PLANE_RE("2")),
2766                   Qnil, 0, 0, 0, 33, Qnil, CONVERSION_IDENTICAL);
2767 #ifdef UTF2000
2768   staticpro (&Vcharset_latin_tcvn5712);
2769   Vcharset_latin_tcvn5712 =
2770     make_charset (LEADING_BYTE_LATIN_TCVN5712, Qlatin_tcvn5712, 96, 1,
2771                   1, 1, 'Z', CHARSET_LEFT_TO_RIGHT,
2772                   build_string ("TCVN 5712"),
2773                   build_string ("TCVN 5712 (VSCII-2)"),
2774                   build_string ("Vietnamese TCVN 5712:1983 (VSCII-2)"),
2775                   build_string ("tcvn5712\\(\\.1993\\)?-1"),
2776                   Qnil, 0, 0, 0, 32, Qnil, CONVERSION_IDENTICAL);
2777   staticpro (&Vcharset_latin_viscii_lower);
2778   Vcharset_latin_viscii_lower =
2779     make_charset (LEADING_BYTE_LATIN_VISCII_LOWER, Qlatin_viscii_lower, 96, 1,
2780                   1, 1, '1', CHARSET_LEFT_TO_RIGHT,
2781                   build_string ("VISCII lower"),
2782                   build_string ("VISCII lower (Vietnamese)"),
2783                   build_string ("VISCII lower (Vietnamese)"),
2784                   build_string ("MULEVISCII-LOWER"),
2785                   Qnil, 0, 0, 0, 32, Qnil, CONVERSION_IDENTICAL);
2786   staticpro (&Vcharset_latin_viscii_upper);
2787   Vcharset_latin_viscii_upper =
2788     make_charset (LEADING_BYTE_LATIN_VISCII_UPPER, Qlatin_viscii_upper, 96, 1,
2789                   1, 1, '2', CHARSET_LEFT_TO_RIGHT,
2790                   build_string ("VISCII upper"),
2791                   build_string ("VISCII upper (Vietnamese)"),
2792                   build_string ("VISCII upper (Vietnamese)"),
2793                   build_string ("MULEVISCII-UPPER"),
2794                   Qnil, 0, 0, 0, 32, Qnil, CONVERSION_IDENTICAL);
2795   staticpro (&Vcharset_latin_viscii);
2796   Vcharset_latin_viscii =
2797     make_charset (LEADING_BYTE_LATIN_VISCII, Qlatin_viscii, 256, 1,
2798                   1, 2, 0, CHARSET_LEFT_TO_RIGHT,
2799                   build_string ("VISCII"),
2800                   build_string ("VISCII 1.1 (Vietnamese)"),
2801                   build_string ("VISCII 1.1 (Vietnamese)"),
2802                   build_string ("VISCII1\\.1"),
2803                   Qnil, 0, 0, 0, 0, Qnil, CONVERSION_IDENTICAL);
2804   staticpro (&Vcharset_chinese_big5);
2805   Vcharset_chinese_big5 =
2806     make_charset (LEADING_BYTE_CHINESE_BIG5, Qchinese_big5, 256, 2,
2807                   2, 2, 0, CHARSET_LEFT_TO_RIGHT,
2808                   build_string ("Big5"),
2809                   build_string ("Big5"),
2810                   build_string ("Big5 Chinese traditional"),
2811                   build_string ("big5-0"),
2812                   Qnil,
2813                   MIN_CHAR_BIG5_CDP, MAX_CHAR_BIG5_CDP,
2814                   MIN_CHAR_BIG5_CDP, 0, Qnil, CONVERSION_IDENTICAL);
2815
2816   staticpro (&Vcharset_ethiopic_ucs);
2817   Vcharset_ethiopic_ucs =
2818     make_charset (LEADING_BYTE_ETHIOPIC_UCS, Qethiopic_ucs, 256, 2,
2819                   2, 2, 0, CHARSET_LEFT_TO_RIGHT,
2820                   build_string ("Ethiopic (UCS)"),
2821                   build_string ("Ethiopic (UCS)"),
2822                   build_string ("Ethiopic of UCS"),
2823                   build_string ("Ethiopic-Unicode"),
2824                   Qnil, 0x1200, 0x137F, 0, 0,
2825                   Qnil, CONVERSION_IDENTICAL);
2826 #endif
2827   staticpro (&Vcharset_chinese_big5_1);
2828   Vcharset_chinese_big5_1 =
2829     make_charset (LEADING_BYTE_CHINESE_BIG5_1, Qchinese_big5_1, 94, 2,
2830                   2, 0, '0', CHARSET_LEFT_TO_RIGHT,
2831                   build_string ("Big5"),
2832                   build_string ("Big5 (Level-1)"),
2833                   build_string
2834                   ("Big5 Level-1 Chinese traditional"),
2835                   build_string ("big5"),
2836                   Qnil, 0, 0, 0, 33, Qnil, CONVERSION_IDENTICAL);
2837   staticpro (&Vcharset_chinese_big5_2);
2838   Vcharset_chinese_big5_2 =
2839     make_charset (LEADING_BYTE_CHINESE_BIG5_2, Qchinese_big5_2, 94, 2,
2840                   2, 0, '1', CHARSET_LEFT_TO_RIGHT,
2841                   build_string ("Big5"),
2842                   build_string ("Big5 (Level-2)"),
2843                   build_string
2844                   ("Big5 Level-2 Chinese traditional"),
2845                   build_string ("big5"),
2846                   Qnil, 0, 0, 0, 33, Qnil, CONVERSION_IDENTICAL);
2847
2848 #ifdef ENABLE_COMPOSITE_CHARS
2849   /* #### For simplicity, we put composite chars into a 96x96 charset.
2850      This is going to lead to problems because you can run out of
2851      room, esp. as we don't yet recycle numbers. */
2852   staticpro (&Vcharset_composite);
2853   Vcharset_composite =
2854     make_charset (LEADING_BYTE_COMPOSITE, Qcomposite, 96, 2,
2855                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
2856                   build_string ("Composite"),
2857                   build_string ("Composite characters"),
2858                   build_string ("Composite characters"),
2859                   build_string (""));
2860
2861   /* #### not dumped properly */
2862   composite_char_row_next = 32;
2863   composite_char_col_next = 32;
2864
2865   Vcomposite_char_string2char_hash_table =
2866     make_lisp_hash_table (500, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL);
2867   Vcomposite_char_char2string_hash_table =
2868     make_lisp_hash_table (500, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
2869   staticpro (&Vcomposite_char_string2char_hash_table);
2870   staticpro (&Vcomposite_char_char2string_hash_table);
2871 #endif /* ENABLE_COMPOSITE_CHARS */
2872
2873 }