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