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