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