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