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