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