ad06e2056f32ae25cfb955d3d87039f9d57e74c4
[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 { /* [tomo] Current implementation does not have complete error
2507      handling mechanism.  It seems better to recover encoding/decoding
2508      tables when TABLE is broken. */
2509   struct Lisp_Charset *cs;
2510   /* Lisp_Object old_table; */
2511   size_t i;
2512   int byte_offset;
2513
2514   charset = Fget_charset (charset);
2515   cs = XCHARSET (charset);
2516
2517   if (NILP (table))
2518     {
2519       CHARSET_DECODING_TABLE(cs) = Qnil;
2520       return table;
2521     }
2522   else if (VECTORP (table))
2523     {
2524       int ccs_len = CHARSET_BYTE_SIZE (cs);
2525
2526       if (XVECTOR_LENGTH (table) > ccs_len)
2527         args_out_of_range (table, make_int (CHARSET_CHARS (cs)));
2528       /* old_table = CHARSET_DECODING_TABLE(cs); */
2529       /* CHARSET_DECODING_TABLE(cs) = table; */
2530       CHARSET_DECODING_TABLE(cs) = Qnil;
2531     }
2532   else
2533     signal_error (Qwrong_type_argument,
2534                   list2 (build_translated_string ("vector-or-nil-p"),
2535                          table));
2536   /* signal_simple_error ("Wrong type argument: vector-or-nil-p", table); */
2537
2538   byte_offset = CHARSET_BYTE_OFFSET (cs);
2539   switch (CHARSET_DIMENSION (cs))
2540     {
2541     case 1:
2542       for (i = 0; i < XVECTOR_LENGTH (table); i++)
2543         {
2544           Lisp_Object c = XVECTOR_DATA(table)[i];
2545
2546           if (CHARP (c))
2547             put_char_ccs_code_point (c, charset,
2548                                      make_int (i + byte_offset));
2549         }
2550       break;
2551     case 2:
2552       for (i = 0; i < XVECTOR_LENGTH (table); i++)
2553         {
2554           Lisp_Object v = XVECTOR_DATA(table)[i];
2555
2556           if (VECTORP (v))
2557             {
2558               size_t j;
2559
2560               if (XVECTOR_LENGTH (v) > CHARSET_CHARS (cs))
2561                 {
2562                   /* CHARSET_DECODING_TABLE(cs) = old_table; */
2563                   args_out_of_range (v, make_int (CHARSET_CHARS (cs)));
2564                 }
2565               for (j = 0; j < XVECTOR_LENGTH (v); j++)
2566                 {
2567                   Lisp_Object c = XVECTOR_DATA(v)[j];
2568
2569                   if (CHARP (c))
2570                     put_char_ccs_code_point
2571                       (c, charset,
2572                        make_int ( ( (i + byte_offset) << 8 )
2573                                   | (j + byte_offset)
2574                                   ) );
2575                 }
2576             }
2577           else if (CHARP (v))
2578             put_char_ccs_code_point (v, charset,
2579                                      make_int (i + byte_offset));
2580         }
2581       break;
2582     }
2583   return table;
2584 }
2585 #endif
2586
2587 \f
2588 /************************************************************************/
2589 /*              Lisp primitives for working with characters             */
2590 /************************************************************************/
2591
2592 #ifdef UTF2000
2593 DEFUN ("decode-char", Fdecode_char, 2, 2, 0, /*
2594 Make a character from CHARSET and code-point CODE.
2595 */
2596        (charset, code))
2597 {
2598   int c;
2599
2600   charset = Fget_charset (charset);
2601   CHECK_INT (code);
2602   c = XINT (code);
2603   if (XCHARSET_GRAPHIC (charset) == 1)
2604     c &= 0x7F7F7F7F;
2605   return make_char (DECODE_CHAR (charset, c));
2606 }
2607 #endif
2608
2609 DEFUN ("make-char", Fmake_char, 2, 3, 0, /*
2610 Make a character from CHARSET and octets ARG1 and ARG2.
2611 ARG2 is required only for characters from two-dimensional charsets.
2612 For example, (make-char 'latin-iso8859-2 185) will return the Latin 2
2613 character s with caron.
2614 */
2615        (charset, arg1, arg2))
2616 {
2617   Lisp_Charset *cs;
2618   int a1, a2;
2619   int lowlim, highlim;
2620
2621   charset = Fget_charset (charset);
2622   cs = XCHARSET (charset);
2623
2624   if      (EQ (charset, Vcharset_ascii))     lowlim =  0, highlim = 127;
2625   else if (EQ (charset, Vcharset_control_1)) lowlim =  0, highlim =  31;
2626 #ifdef UTF2000
2627   else if (CHARSET_CHARS (cs) == 256)        lowlim =  0, highlim = 255;
2628 #endif
2629   else if (CHARSET_CHARS (cs) == 94)         lowlim = 33, highlim = 126;
2630   else  /* CHARSET_CHARS (cs) == 96) */      lowlim = 32, highlim = 127;
2631
2632   CHECK_INT (arg1);
2633   /* It is useful (and safe, according to Olivier Galibert) to strip
2634      the 8th bit off ARG1 and ARG2 becaue it allows programmers to
2635      write (make-char 'latin-iso8859-2 CODE) where code is the actual
2636      Latin 2 code of the character.  */
2637 #ifdef UTF2000
2638   a1 = XINT (arg1);
2639   if (highlim < 128)
2640     a1 &= 0x7f;
2641 #else
2642   a1 = XINT (arg1);
2643 #endif
2644   if (a1 < lowlim || a1 > highlim)
2645     args_out_of_range_3 (arg1, make_int (lowlim), make_int (highlim));
2646
2647   if (CHARSET_DIMENSION (cs) == 1)
2648     {
2649       if (!NILP (arg2))
2650         signal_simple_error
2651           ("Charset is of dimension one; second octet must be nil", arg2);
2652       return make_char (MAKE_CHAR (charset, a1, 0));
2653     }
2654
2655   CHECK_INT (arg2);
2656 #ifdef UTF2000
2657   a2 = XINT (arg2);
2658   if (highlim < 128)
2659     a2 &= 0x7f;
2660 #else
2661   a2 = XINT (arg2) & 0x7f;
2662 #endif
2663   if (a2 < lowlim || a2 > highlim)
2664     args_out_of_range_3 (arg2, make_int (lowlim), make_int (highlim));
2665
2666   return make_char (MAKE_CHAR (charset, a1, a2));
2667 }
2668
2669 DEFUN ("char-charset", Fchar_charset, 1, 1, 0, /*
2670 Return the character set of char CH.
2671 */
2672        (ch))
2673 {
2674   CHECK_CHAR_COERCE_INT (ch);
2675
2676   return XCHARSET_NAME (CHAR_CHARSET (XCHAR (ch)));
2677 }
2678
2679 DEFUN ("char-octet", Fchar_octet, 1, 2, 0, /*
2680 Return the octet numbered N (should be 0 or 1) of char CH.
2681 N defaults to 0 if omitted.
2682 */
2683        (ch, n))
2684 {
2685   Lisp_Object charset;
2686   int octet0, octet1;
2687
2688   CHECK_CHAR_COERCE_INT (ch);
2689
2690   BREAKUP_CHAR (XCHAR (ch), charset, octet0, octet1);
2691
2692   if (NILP (n) || EQ (n, Qzero))
2693     return make_int (octet0);
2694   else if (EQ (n, make_int (1)))
2695     return make_int (octet1);
2696   else
2697     signal_simple_error ("Octet number must be 0 or 1", n);
2698 }
2699
2700 DEFUN ("split-char", Fsplit_char, 1, 1, 0, /*
2701 Return list of charset and one or two position-codes of CHAR.
2702 */
2703        (character))
2704 {
2705   /* This function can GC */
2706   struct gcpro gcpro1, gcpro2;
2707   Lisp_Object charset = Qnil;
2708   Lisp_Object rc = Qnil;
2709 #ifdef UTF2000
2710   int code_point;
2711   int dimension;
2712 #else
2713   int c1, c2;
2714 #endif
2715
2716   GCPRO2 (charset, rc);
2717   CHECK_CHAR_COERCE_INT (character);
2718
2719 #ifdef UTF2000
2720   code_point = ENCODE_CHAR (XCHAR (character), charset);
2721   dimension = XCHARSET_DIMENSION (charset);
2722   while (dimension > 0)
2723     {
2724       rc = Fcons (make_int (code_point & 255), rc);
2725       code_point >>= 8;
2726       dimension--;
2727     }
2728   rc = Fcons (XCHARSET_NAME (charset), rc);
2729 #else
2730   BREAKUP_CHAR (XCHAR (character), charset, c1, c2);
2731
2732   if (XCHARSET_DIMENSION (Fget_charset (charset)) == 2)
2733     {
2734       rc = list3 (XCHARSET_NAME (charset), make_int (c1), make_int (c2));
2735     }
2736   else
2737     {
2738       rc = list2 (XCHARSET_NAME (charset), make_int (c1));
2739     }
2740 #endif
2741   UNGCPRO;
2742
2743   return rc;
2744 }
2745
2746 \f
2747 #ifdef ENABLE_COMPOSITE_CHARS
2748 /************************************************************************/
2749 /*                     composite character functions                    */
2750 /************************************************************************/
2751
2752 Emchar
2753 lookup_composite_char (Bufbyte *str, int len)
2754 {
2755   Lisp_Object lispstr = make_string (str, len);
2756   Lisp_Object ch = Fgethash (lispstr,
2757                              Vcomposite_char_string2char_hash_table,
2758                              Qunbound);
2759   Emchar emch;
2760
2761   if (UNBOUNDP (ch))
2762     {
2763       if (composite_char_row_next >= 128)
2764         signal_simple_error ("No more composite chars available", lispstr);
2765       emch = MAKE_CHAR (Vcharset_composite, composite_char_row_next,
2766                         composite_char_col_next);
2767       Fputhash (make_char (emch), lispstr,
2768                 Vcomposite_char_char2string_hash_table);
2769       Fputhash (lispstr, make_char (emch),
2770                 Vcomposite_char_string2char_hash_table);
2771       composite_char_col_next++;
2772       if (composite_char_col_next >= 128)
2773         {
2774           composite_char_col_next = 32;
2775           composite_char_row_next++;
2776         }
2777     }
2778   else
2779     emch = XCHAR (ch);
2780   return emch;
2781 }
2782
2783 Lisp_Object
2784 composite_char_string (Emchar ch)
2785 {
2786   Lisp_Object str = Fgethash (make_char (ch),
2787                               Vcomposite_char_char2string_hash_table,
2788                               Qunbound);
2789   assert (!UNBOUNDP (str));
2790   return str;
2791 }
2792
2793 xxDEFUN ("make-composite-char", Fmake_composite_char, 1, 1, 0, /*
2794 Convert a string into a single composite character.
2795 The character is the result of overstriking all the characters in
2796 the string.
2797 */
2798        (string))
2799 {
2800   CHECK_STRING (string);
2801   return make_char (lookup_composite_char (XSTRING_DATA (string),
2802                                            XSTRING_LENGTH (string)));
2803 }
2804
2805 xxDEFUN ("composite-char-string", Fcomposite_char_string, 1, 1, 0, /*
2806 Return a string of the characters comprising a composite character.
2807 */
2808        (ch))
2809 {
2810   Emchar emch;
2811
2812   CHECK_CHAR (ch);
2813   emch = XCHAR (ch);
2814   if (CHAR_LEADING_BYTE (emch) != LEADING_BYTE_COMPOSITE)
2815     signal_simple_error ("Must be composite char", ch);
2816   return composite_char_string (emch);
2817 }
2818 #endif /* ENABLE_COMPOSITE_CHARS */
2819
2820 \f
2821 /************************************************************************/
2822 /*                            initialization                            */
2823 /************************************************************************/
2824
2825 void
2826 syms_of_mule_charset (void)
2827 {
2828 #ifdef UTF2000
2829   INIT_LRECORD_IMPLEMENTATION (byte_table);
2830   INIT_LRECORD_IMPLEMENTATION (char_id_table);
2831 #endif
2832   INIT_LRECORD_IMPLEMENTATION (charset);
2833
2834   DEFSUBR (Fcharsetp);
2835   DEFSUBR (Ffind_charset);
2836   DEFSUBR (Fget_charset);
2837   DEFSUBR (Fcharset_list);
2838   DEFSUBR (Fcharset_name);
2839   DEFSUBR (Fmake_charset);
2840   DEFSUBR (Fmake_reverse_direction_charset);
2841   /*  DEFSUBR (Freverse_direction_charset); */
2842   DEFSUBR (Fdefine_charset_alias);
2843   DEFSUBR (Fcharset_from_attributes);
2844   DEFSUBR (Fcharset_short_name);
2845   DEFSUBR (Fcharset_long_name);
2846   DEFSUBR (Fcharset_description);
2847   DEFSUBR (Fcharset_dimension);
2848   DEFSUBR (Fcharset_property);
2849   DEFSUBR (Fcharset_id);
2850   DEFSUBR (Fset_charset_ccl_program);
2851   DEFSUBR (Fset_charset_registry);
2852 #ifdef UTF2000
2853   DEFSUBR (Fchar_attribute_alist);
2854   DEFSUBR (Fget_char_attribute);
2855   DEFSUBR (Fput_char_attribute);
2856   DEFSUBR (Fremove_char_attribute);
2857   DEFSUBR (Fdefine_char);
2858   DEFSUBR (Fchar_variants);
2859   DEFSUBR (Fget_composite_char);
2860   DEFSUBR (Fcharset_mapping_table);
2861   DEFSUBR (Fset_charset_mapping_table);
2862 #endif
2863
2864 #ifdef UTF2000
2865   DEFSUBR (Fdecode_char);
2866 #endif
2867   DEFSUBR (Fmake_char);
2868   DEFSUBR (Fchar_charset);
2869   DEFSUBR (Fchar_octet);
2870   DEFSUBR (Fsplit_char);
2871
2872 #ifdef ENABLE_COMPOSITE_CHARS
2873   DEFSUBR (Fmake_composite_char);
2874   DEFSUBR (Fcomposite_char_string);
2875 #endif
2876
2877   defsymbol (&Qcharsetp, "charsetp");
2878   defsymbol (&Qregistry, "registry");
2879   defsymbol (&Qfinal, "final");
2880   defsymbol (&Qgraphic, "graphic");
2881   defsymbol (&Qdirection, "direction");
2882   defsymbol (&Qreverse_direction_charset, "reverse-direction-charset");
2883   defsymbol (&Qshort_name, "short-name");
2884   defsymbol (&Qlong_name, "long-name");
2885
2886   defsymbol (&Ql2r, "l2r");
2887   defsymbol (&Qr2l, "r2l");
2888
2889   /* Charsets, compatible with FSF 20.3
2890      Naming convention is Script-Charset[-Edition] */
2891   defsymbol (&Qascii,                   "ascii");
2892   defsymbol (&Qcontrol_1,               "control-1");
2893   defsymbol (&Qlatin_iso8859_1,         "latin-iso8859-1");
2894   defsymbol (&Qlatin_iso8859_2,         "latin-iso8859-2");
2895   defsymbol (&Qlatin_iso8859_3,         "latin-iso8859-3");
2896   defsymbol (&Qlatin_iso8859_4,         "latin-iso8859-4");
2897   defsymbol (&Qthai_tis620,             "thai-tis620");
2898   defsymbol (&Qgreek_iso8859_7,         "greek-iso8859-7");
2899   defsymbol (&Qarabic_iso8859_6,        "arabic-iso8859-6");
2900   defsymbol (&Qhebrew_iso8859_8,        "hebrew-iso8859-8");
2901   defsymbol (&Qkatakana_jisx0201,       "katakana-jisx0201");
2902   defsymbol (&Qlatin_jisx0201,          "latin-jisx0201");
2903   defsymbol (&Qcyrillic_iso8859_5,      "cyrillic-iso8859-5");
2904   defsymbol (&Qlatin_iso8859_9,         "latin-iso8859-9");
2905   defsymbol (&Qjapanese_jisx0208_1978,  "japanese-jisx0208-1978");
2906   defsymbol (&Qchinese_gb2312,          "chinese-gb2312");
2907   defsymbol (&Qjapanese_jisx0208,       "japanese-jisx0208");
2908   defsymbol (&Qjapanese_jisx0208_1990,  "japanese-jisx0208-1990");
2909   defsymbol (&Qkorean_ksc5601,          "korean-ksc5601");
2910   defsymbol (&Qjapanese_jisx0212,       "japanese-jisx0212");
2911   defsymbol (&Qchinese_cns11643_1,      "chinese-cns11643-1");
2912   defsymbol (&Qchinese_cns11643_2,      "chinese-cns11643-2");
2913 #ifdef UTF2000
2914   defsymbol (&Qname,                    "name");
2915   defsymbol (&Q_ucs,                    "->ucs");
2916   defsymbol (&Q_decomposition,          "->decomposition");
2917   defsymbol (&Qcompat,                  "compat");
2918   defsymbol (&Qisolated,                "isolated");
2919   defsymbol (&Qinitial,                 "initial");
2920   defsymbol (&Qmedial,                  "medial");
2921   defsymbol (&Qfinal,                   "final");
2922   defsymbol (&Qvertical,                "vertical");
2923   defsymbol (&QnoBreak,                 "noBreak");
2924   defsymbol (&Qfraction,                "fraction");
2925   defsymbol (&Qsuper,                   "super");
2926   defsymbol (&Qsub,                     "sub");
2927   defsymbol (&Qcircle,                  "circle");
2928   defsymbol (&Qsquare,                  "square");
2929   defsymbol (&Qwide,                    "wide");
2930   defsymbol (&Qnarrow,                  "narrow");
2931   defsymbol (&Qsmall,                   "small");
2932   defsymbol (&Qfont,                    "font");
2933   defsymbol (&Qucs,                     "ucs");
2934   defsymbol (&Qucs_bmp,                 "ucs-bmp");
2935   defsymbol (&Qlatin_viscii,            "latin-viscii");
2936   defsymbol (&Qlatin_tcvn5712,          "latin-tcvn5712");
2937   defsymbol (&Qlatin_viscii_lower,      "latin-viscii-lower");
2938   defsymbol (&Qlatin_viscii_upper,      "latin-viscii-upper");
2939   defsymbol (&Qvietnamese_viscii_lower, "vietnamese-viscii-lower");
2940   defsymbol (&Qvietnamese_viscii_upper, "vietnamese-viscii-upper");
2941   defsymbol (&Qideograph_daikanwa,      "ideograph-daikanwa");
2942   defsymbol (&Qmojikyo,                 "mojikyo");
2943   defsymbol (&Qmojikyo_pj_1,            "mojikyo-pj-1");
2944   defsymbol (&Qmojikyo_pj_2,            "mojikyo-pj-2");
2945   defsymbol (&Qmojikyo_pj_3,            "mojikyo-pj-3");
2946   defsymbol (&Qmojikyo_pj_4,            "mojikyo-pj-4");
2947   defsymbol (&Qmojikyo_pj_5,            "mojikyo-pj-5");
2948   defsymbol (&Qmojikyo_pj_6,            "mojikyo-pj-6");
2949   defsymbol (&Qmojikyo_pj_7,            "mojikyo-pj-7");
2950   defsymbol (&Qmojikyo_pj_8,            "mojikyo-pj-8");
2951   defsymbol (&Qmojikyo_pj_9,            "mojikyo-pj-9");
2952   defsymbol (&Qmojikyo_pj_10,           "mojikyo-pj-10");
2953   defsymbol (&Qmojikyo_pj_11,           "mojikyo-pj-11");
2954   defsymbol (&Qmojikyo_pj_12,           "mojikyo-pj-12");
2955   defsymbol (&Qmojikyo_pj_13,           "mojikyo-pj-13");
2956   defsymbol (&Qmojikyo_pj_14,           "mojikyo-pj-14");
2957   defsymbol (&Qmojikyo_pj_15,           "mojikyo-pj-15");
2958   defsymbol (&Qmojikyo_pj_16,           "mojikyo-pj-16");
2959   defsymbol (&Qmojikyo_pj_17,           "mojikyo-pj-17");
2960   defsymbol (&Qmojikyo_pj_18,           "mojikyo-pj-18");
2961   defsymbol (&Qmojikyo_pj_19,           "mojikyo-pj-19");
2962   defsymbol (&Qmojikyo_pj_20,           "mojikyo-pj-20");
2963   defsymbol (&Qmojikyo_pj_21,           "mojikyo-pj-21");
2964   defsymbol (&Qethiopic_ucs,            "ethiopic-ucs");
2965 #endif
2966   defsymbol (&Qchinese_big5_1,          "chinese-big5-1");
2967   defsymbol (&Qchinese_big5_2,          "chinese-big5-2");
2968
2969   defsymbol (&Qcomposite,               "composite");
2970 }
2971
2972 void
2973 vars_of_mule_charset (void)
2974 {
2975   int i, j;
2976 #ifndef UTF2000
2977   int k;
2978 #endif
2979
2980   chlook = xnew (struct charset_lookup);
2981   dumpstruct (&chlook, &charset_lookup_description);
2982
2983   /* Table of charsets indexed by leading byte. */
2984   for (i = 0; i < countof (chlook->charset_by_leading_byte); i++)
2985     chlook->charset_by_leading_byte[i] = Qnil;
2986
2987 #ifdef UTF2000
2988   /* Table of charsets indexed by type/final-byte. */
2989   for (i = 0; i < countof (chlook->charset_by_attributes); i++)
2990     for (j = 0; j < countof (chlook->charset_by_attributes[0]); j++)
2991       chlook->charset_by_attributes[i][j] = Qnil;
2992 #else
2993   /* Table of charsets indexed by type/final-byte/direction. */
2994   for (i = 0; i < countof (chlook->charset_by_attributes); i++)
2995     for (j = 0; j < countof (chlook->charset_by_attributes[0]); j++)
2996       for (k = 0; k < countof (chlook->charset_by_attributes[0][0]); k++)
2997         chlook->charset_by_attributes[i][j][k] = Qnil;
2998 #endif
2999
3000 #ifdef UTF2000
3001   chlook->next_allocated_leading_byte = MIN_LEADING_BYTE_PRIVATE;
3002 #else
3003   chlook->next_allocated_1_byte_leading_byte = MIN_LEADING_BYTE_PRIVATE_1;
3004   chlook->next_allocated_2_byte_leading_byte = MIN_LEADING_BYTE_PRIVATE_2;
3005 #endif
3006
3007 #ifndef UTF2000
3008   leading_code_private_11 = PRE_LEADING_BYTE_PRIVATE_1;
3009   DEFVAR_INT ("leading-code-private-11", &leading_code_private_11 /*
3010 Leading-code of private TYPE9N charset of column-width 1.
3011 */ );
3012   leading_code_private_11 = PRE_LEADING_BYTE_PRIVATE_1;
3013 #endif
3014
3015 #ifdef UTF2000
3016   Vutf_2000_version = build_string("0.15 (Sangō)");
3017   DEFVAR_LISP ("utf-2000-version", &Vutf_2000_version /*
3018 Version number of UTF-2000.
3019 */ );
3020
3021   staticpro (&Vcharacter_attribute_table);
3022   Vcharacter_attribute_table = make_char_id_table (Qnil, 0);
3023
3024   staticpro (&Vcharacter_name_table);
3025   Vcharacter_name_table = make_char_id_table (Qnil, 0);
3026
3027   /* staticpro (&Vcharacter_composition_table); */
3028   Vcharacter_composition_table = make_char_id_table (Qnil, -1);
3029
3030   staticpro (&Vcharacter_variant_table);
3031   Vcharacter_variant_table = make_char_id_table (Qnil, 0);
3032
3033   Vdefault_coded_charset_priority_list = Qnil;
3034   DEFVAR_LISP ("default-coded-charset-priority-list",
3035                &Vdefault_coded_charset_priority_list /*
3036 Default order of preferred coded-character-sets.
3037 */ );
3038 #endif
3039 }
3040
3041 void
3042 complex_vars_of_mule_charset (void)
3043 {
3044   staticpro (&Vcharset_hash_table);
3045   Vcharset_hash_table =
3046     make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
3047
3048   /* Predefined character sets.  We store them into variables for
3049      ease of access. */
3050
3051 #ifdef UTF2000
3052   staticpro (&Vcharset_ucs);
3053   Vcharset_ucs =
3054     make_charset (LEADING_BYTE_UCS, Qucs, 256, 4,
3055                   1, 2, 0, CHARSET_LEFT_TO_RIGHT,
3056                   build_string ("UCS"),
3057                   build_string ("UCS"),
3058                   build_string ("ISO/IEC 10646"),
3059                   build_string (""),
3060                   Qnil, 0, 0xFFFFFFF, 0, 0);
3061   staticpro (&Vcharset_ucs_bmp);
3062   Vcharset_ucs_bmp =
3063     make_charset (LEADING_BYTE_UCS_BMP, Qucs_bmp, 256, 2,
3064                   1, 2, 0, CHARSET_LEFT_TO_RIGHT,
3065                   build_string ("BMP"),
3066                   build_string ("BMP"),
3067                   build_string ("ISO/IEC 10646 Group 0 Plane 0 (BMP)"),
3068                   build_string ("\\(ISO10646.*-1\\|UNICODE[23]?-0\\)"),
3069                   Qnil, 0, 0xFFFF, 0, 0);
3070 #else
3071 # define MIN_CHAR_THAI 0
3072 # define MAX_CHAR_THAI 0
3073 # define MIN_CHAR_HEBREW 0
3074 # define MAX_CHAR_HEBREW 0
3075 # define MIN_CHAR_HALFWIDTH_KATAKANA 0
3076 # define MAX_CHAR_HALFWIDTH_KATAKANA 0
3077 #endif
3078   staticpro (&Vcharset_ascii);
3079   Vcharset_ascii =
3080     make_charset (LEADING_BYTE_ASCII, Qascii, 94, 1,
3081                   1, 0, 'B', CHARSET_LEFT_TO_RIGHT,
3082                   build_string ("ASCII"),
3083                   build_string ("ASCII)"),
3084                   build_string ("ASCII (ISO646 IRV)"),
3085                   build_string ("\\(iso8859-[0-9]*\\|-ascii\\)"),
3086                   Qnil, 0, 0x7F, 0, 0);
3087   staticpro (&Vcharset_control_1);
3088   Vcharset_control_1 =
3089     make_charset (LEADING_BYTE_CONTROL_1, Qcontrol_1, 94, 1,
3090                   1, 1, 0, CHARSET_LEFT_TO_RIGHT,
3091                   build_string ("C1"),
3092                   build_string ("Control characters"),
3093                   build_string ("Control characters 128-191"),
3094                   build_string (""),
3095                   Qnil, 0x80, 0x9F, 0, 0);
3096   staticpro (&Vcharset_latin_iso8859_1);
3097   Vcharset_latin_iso8859_1 =
3098     make_charset (LEADING_BYTE_LATIN_ISO8859_1, Qlatin_iso8859_1, 96, 1,
3099                   1, 1, 'A', CHARSET_LEFT_TO_RIGHT,
3100                   build_string ("Latin-1"),
3101                   build_string ("ISO8859-1 (Latin-1)"),
3102                   build_string ("ISO8859-1 (Latin-1)"),
3103                   build_string ("iso8859-1"),
3104                   Qnil, 0xA0, 0xFF, 0, 32);
3105   staticpro (&Vcharset_latin_iso8859_2);
3106   Vcharset_latin_iso8859_2 =
3107     make_charset (LEADING_BYTE_LATIN_ISO8859_2, Qlatin_iso8859_2, 96, 1,
3108                   1, 1, 'B', CHARSET_LEFT_TO_RIGHT,
3109                   build_string ("Latin-2"),
3110                   build_string ("ISO8859-2 (Latin-2)"),
3111                   build_string ("ISO8859-2 (Latin-2)"),
3112                   build_string ("iso8859-2"),
3113                   Qnil, 0, 0, 0, 32);
3114   staticpro (&Vcharset_latin_iso8859_3);
3115   Vcharset_latin_iso8859_3 =
3116     make_charset (LEADING_BYTE_LATIN_ISO8859_3, Qlatin_iso8859_3, 96, 1,
3117                   1, 1, 'C', CHARSET_LEFT_TO_RIGHT,
3118                   build_string ("Latin-3"),
3119                   build_string ("ISO8859-3 (Latin-3)"),
3120                   build_string ("ISO8859-3 (Latin-3)"),
3121                   build_string ("iso8859-3"),
3122                   Qnil, 0, 0, 0, 32);
3123   staticpro (&Vcharset_latin_iso8859_4);
3124   Vcharset_latin_iso8859_4 =
3125     make_charset (LEADING_BYTE_LATIN_ISO8859_4, Qlatin_iso8859_4, 96, 1,
3126                   1, 1, 'D', CHARSET_LEFT_TO_RIGHT,
3127                   build_string ("Latin-4"),
3128                   build_string ("ISO8859-4 (Latin-4)"),
3129                   build_string ("ISO8859-4 (Latin-4)"),
3130                   build_string ("iso8859-4"),
3131                   Qnil, 0, 0, 0, 32);
3132   staticpro (&Vcharset_thai_tis620);
3133   Vcharset_thai_tis620 =
3134     make_charset (LEADING_BYTE_THAI_TIS620, Qthai_tis620, 96, 1,
3135                   1, 1, 'T', CHARSET_LEFT_TO_RIGHT,
3136                   build_string ("TIS620"),
3137                   build_string ("TIS620 (Thai)"),
3138                   build_string ("TIS620.2529 (Thai)"),
3139                   build_string ("tis620"),
3140                   Qnil, MIN_CHAR_THAI, MAX_CHAR_THAI, 0, 32);
3141   staticpro (&Vcharset_greek_iso8859_7);
3142   Vcharset_greek_iso8859_7 =
3143     make_charset (LEADING_BYTE_GREEK_ISO8859_7, Qgreek_iso8859_7, 96, 1,
3144                   1, 1, 'F', CHARSET_LEFT_TO_RIGHT,
3145                   build_string ("ISO8859-7"),
3146                   build_string ("ISO8859-7 (Greek)"),
3147                   build_string ("ISO8859-7 (Greek)"),
3148                   build_string ("iso8859-7"),
3149                   Qnil,
3150                   0 /* MIN_CHAR_GREEK */,
3151                   0 /* MAX_CHAR_GREEK */, 0, 32);
3152   staticpro (&Vcharset_arabic_iso8859_6);
3153   Vcharset_arabic_iso8859_6 =
3154     make_charset (LEADING_BYTE_ARABIC_ISO8859_6, Qarabic_iso8859_6, 96, 1,
3155                   1, 1, 'G', CHARSET_RIGHT_TO_LEFT,
3156                   build_string ("ISO8859-6"),
3157                   build_string ("ISO8859-6 (Arabic)"),
3158                   build_string ("ISO8859-6 (Arabic)"),
3159                   build_string ("iso8859-6"),
3160                   Qnil, 0, 0, 0, 32);
3161   staticpro (&Vcharset_hebrew_iso8859_8);
3162   Vcharset_hebrew_iso8859_8 =
3163     make_charset (LEADING_BYTE_HEBREW_ISO8859_8, Qhebrew_iso8859_8, 96, 1,
3164                   1, 1, 'H', CHARSET_RIGHT_TO_LEFT,
3165                   build_string ("ISO8859-8"),
3166                   build_string ("ISO8859-8 (Hebrew)"),
3167                   build_string ("ISO8859-8 (Hebrew)"),
3168                   build_string ("iso8859-8"),
3169                   Qnil, MIN_CHAR_HEBREW, MAX_CHAR_HEBREW, 0, 32);
3170   staticpro (&Vcharset_katakana_jisx0201);
3171   Vcharset_katakana_jisx0201 =
3172     make_charset (LEADING_BYTE_KATAKANA_JISX0201, Qkatakana_jisx0201, 94, 1,
3173                   1, 1, 'I', CHARSET_LEFT_TO_RIGHT,
3174                   build_string ("JISX0201 Kana"),
3175                   build_string ("JISX0201.1976 (Japanese Kana)"),
3176                   build_string ("JISX0201.1976 Japanese Kana"),
3177                   build_string ("jisx0201\\.1976"),
3178                   Qnil, 0, 0, 0, 33);
3179   staticpro (&Vcharset_latin_jisx0201);
3180   Vcharset_latin_jisx0201 =
3181     make_charset (LEADING_BYTE_LATIN_JISX0201, Qlatin_jisx0201, 94, 1,
3182                   1, 0, 'J', CHARSET_LEFT_TO_RIGHT,
3183                   build_string ("JISX0201 Roman"),
3184                   build_string ("JISX0201.1976 (Japanese Roman)"),
3185                   build_string ("JISX0201.1976 Japanese Roman"),
3186                   build_string ("jisx0201\\.1976"),
3187                   Qnil, 0, 0, 0, 33);
3188   staticpro (&Vcharset_cyrillic_iso8859_5);
3189   Vcharset_cyrillic_iso8859_5 =
3190     make_charset (LEADING_BYTE_CYRILLIC_ISO8859_5, Qcyrillic_iso8859_5, 96, 1,
3191                   1, 1, 'L', CHARSET_LEFT_TO_RIGHT,
3192                   build_string ("ISO8859-5"),
3193                   build_string ("ISO8859-5 (Cyrillic)"),
3194                   build_string ("ISO8859-5 (Cyrillic)"),
3195                   build_string ("iso8859-5"),
3196                   Qnil,
3197                   0 /* MIN_CHAR_CYRILLIC */,
3198                   0 /* MAX_CHAR_CYRILLIC */, 0, 32);
3199   staticpro (&Vcharset_latin_iso8859_9);
3200   Vcharset_latin_iso8859_9 =
3201     make_charset (LEADING_BYTE_LATIN_ISO8859_9, Qlatin_iso8859_9, 96, 1,
3202                   1, 1, 'M', CHARSET_LEFT_TO_RIGHT,
3203                   build_string ("Latin-5"),
3204                   build_string ("ISO8859-9 (Latin-5)"),
3205                   build_string ("ISO8859-9 (Latin-5)"),
3206                   build_string ("iso8859-9"),
3207                   Qnil, 0, 0, 0, 32);
3208   staticpro (&Vcharset_japanese_jisx0208_1978);
3209   Vcharset_japanese_jisx0208_1978 =
3210     make_charset (LEADING_BYTE_JAPANESE_JISX0208_1978,
3211                   Qjapanese_jisx0208_1978, 94, 2,
3212                   2, 0, '@', CHARSET_LEFT_TO_RIGHT,
3213                   build_string ("JIS X0208:1978"),
3214                   build_string ("JIS X0208:1978 (Japanese)"),
3215                   build_string
3216                   ("JIS X0208:1978 Japanese Kanji (so called \"old JIS\")"),
3217                   build_string ("\\(jisx0208\\|jisc6226\\)\\.1978"),
3218                   Qnil, 0, 0, 0, 33);
3219   staticpro (&Vcharset_chinese_gb2312);
3220   Vcharset_chinese_gb2312 =
3221     make_charset (LEADING_BYTE_CHINESE_GB2312, Qchinese_gb2312, 94, 2,
3222                   2, 0, 'A', CHARSET_LEFT_TO_RIGHT,
3223                   build_string ("GB2312"),
3224                   build_string ("GB2312)"),
3225                   build_string ("GB2312 Chinese simplified"),
3226                   build_string ("gb2312"),
3227                   Qnil, 0, 0, 0, 33);
3228   staticpro (&Vcharset_japanese_jisx0208);
3229   Vcharset_japanese_jisx0208 =
3230     make_charset (LEADING_BYTE_JAPANESE_JISX0208, Qjapanese_jisx0208, 94, 2,
3231                   2, 0, 'B', CHARSET_LEFT_TO_RIGHT,
3232                   build_string ("JISX0208"),
3233                   build_string ("JIS X0208:1983 (Japanese)"),
3234                   build_string ("JIS X0208:1983 Japanese Kanji"),
3235                   build_string ("jisx0208\\.1983"),
3236                   Qnil, 0, 0, 0, 33);
3237 #ifdef UTF2000
3238   staticpro (&Vcharset_japanese_jisx0208_1990);
3239   Vcharset_japanese_jisx0208_1990 =
3240     make_charset (LEADING_BYTE_JAPANESE_JISX0208_1990,
3241                   Qjapanese_jisx0208_1990, 94, 2,
3242                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3243                   build_string ("JISX0208-1990"),
3244                   build_string ("JIS X0208:1990 (Japanese)"),
3245                   build_string ("JIS X0208:1990 Japanese Kanji"),
3246                   build_string ("jisx0208\\.1990"),
3247                   Qnil,
3248                   MIN_CHAR_JIS_X0208_1990,
3249                   MAX_CHAR_JIS_X0208_1990, 0, 33);
3250 #endif
3251   staticpro (&Vcharset_korean_ksc5601);
3252   Vcharset_korean_ksc5601 =
3253     make_charset (LEADING_BYTE_KOREAN_KSC5601, Qkorean_ksc5601, 94, 2,
3254                   2, 0, 'C', CHARSET_LEFT_TO_RIGHT,
3255                   build_string ("KSC5601"),
3256                   build_string ("KSC5601 (Korean"),
3257                   build_string ("KSC5601 Korean Hangul and Hanja"),
3258                   build_string ("ksc5601"),
3259                   Qnil, 0, 0, 0, 33);
3260   staticpro (&Vcharset_japanese_jisx0212);
3261   Vcharset_japanese_jisx0212 =
3262     make_charset (LEADING_BYTE_JAPANESE_JISX0212, Qjapanese_jisx0212, 94, 2,
3263                   2, 0, 'D', CHARSET_LEFT_TO_RIGHT,
3264                   build_string ("JISX0212"),
3265                   build_string ("JISX0212 (Japanese)"),
3266                   build_string ("JISX0212 Japanese Supplement"),
3267                   build_string ("jisx0212"),
3268                   Qnil, 0, 0, 0, 33);
3269
3270 #define CHINESE_CNS_PLANE_RE(n) "cns11643[.-]\\(.*[.-]\\)?" n "$"
3271   staticpro (&Vcharset_chinese_cns11643_1);
3272   Vcharset_chinese_cns11643_1 =
3273     make_charset (LEADING_BYTE_CHINESE_CNS11643_1, Qchinese_cns11643_1, 94, 2,
3274                   2, 0, 'G', CHARSET_LEFT_TO_RIGHT,
3275                   build_string ("CNS11643-1"),
3276                   build_string ("CNS11643-1 (Chinese traditional)"),
3277                   build_string
3278                   ("CNS 11643 Plane 1 Chinese traditional"),
3279                   build_string (CHINESE_CNS_PLANE_RE("1")),
3280                   Qnil, 0, 0, 0, 33);
3281   staticpro (&Vcharset_chinese_cns11643_2);
3282   Vcharset_chinese_cns11643_2 =
3283     make_charset (LEADING_BYTE_CHINESE_CNS11643_2, Qchinese_cns11643_2, 94, 2,
3284                   2, 0, 'H', CHARSET_LEFT_TO_RIGHT,
3285                   build_string ("CNS11643-2"),
3286                   build_string ("CNS11643-2 (Chinese traditional)"),
3287                   build_string
3288                   ("CNS 11643 Plane 2 Chinese traditional"),
3289                   build_string (CHINESE_CNS_PLANE_RE("2")),
3290                   Qnil, 0, 0, 0, 33);
3291 #ifdef UTF2000
3292   staticpro (&Vcharset_latin_tcvn5712);
3293   Vcharset_latin_tcvn5712 =
3294     make_charset (LEADING_BYTE_LATIN_TCVN5712, Qlatin_tcvn5712, 96, 1,
3295                   1, 1, 'Z', CHARSET_LEFT_TO_RIGHT,
3296                   build_string ("TCVN 5712"),
3297                   build_string ("TCVN 5712 (VSCII-2)"),
3298                   build_string ("Vietnamese TCVN 5712:1983 (VSCII-2)"),
3299                   build_string ("tcvn5712-1"),
3300                   Qnil, 0, 0, 0, 32);
3301   staticpro (&Vcharset_latin_viscii_lower);
3302   Vcharset_latin_viscii_lower =
3303     make_charset (LEADING_BYTE_LATIN_VISCII_LOWER, Qlatin_viscii_lower, 96, 1,
3304                   1, 1, '1', CHARSET_LEFT_TO_RIGHT,
3305                   build_string ("VISCII lower"),
3306                   build_string ("VISCII lower (Vietnamese)"),
3307                   build_string ("VISCII lower (Vietnamese)"),
3308                   build_string ("MULEVISCII-LOWER"),
3309                   Qnil, 0, 0, 0, 32);
3310   staticpro (&Vcharset_latin_viscii_upper);
3311   Vcharset_latin_viscii_upper =
3312     make_charset (LEADING_BYTE_LATIN_VISCII_UPPER, Qlatin_viscii_upper, 96, 1,
3313                   1, 1, '2', CHARSET_LEFT_TO_RIGHT,
3314                   build_string ("VISCII upper"),
3315                   build_string ("VISCII upper (Vietnamese)"),
3316                   build_string ("VISCII upper (Vietnamese)"),
3317                   build_string ("MULEVISCII-UPPER"),
3318                   Qnil, 0, 0, 0, 32);
3319   staticpro (&Vcharset_latin_viscii);
3320   Vcharset_latin_viscii =
3321     make_charset (LEADING_BYTE_LATIN_VISCII, Qlatin_viscii, 256, 1,
3322                   1, 2, 0, CHARSET_LEFT_TO_RIGHT,
3323                   build_string ("VISCII"),
3324                   build_string ("VISCII 1.1 (Vietnamese)"),
3325                   build_string ("VISCII 1.1 (Vietnamese)"),
3326                   build_string ("VISCII1\\.1"),
3327                   Qnil, 0, 0, 0, 0);
3328   staticpro (&Vcharset_ideograph_daikanwa);
3329   Vcharset_ideograph_daikanwa =
3330     make_charset (LEADING_BYTE_DAIKANWA, Qideograph_daikanwa, 256, 2,
3331                   2, 2, 0, CHARSET_LEFT_TO_RIGHT,
3332                   build_string ("Daikanwa"),
3333                   build_string ("Morohashi's Daikanwa"),
3334                   build_string ("Daikanwa dictionary by MOROHASHI Tetsuji"),
3335                   build_string ("Daikanwa"),
3336                   Qnil, MIN_CHAR_DAIKANWA, MAX_CHAR_DAIKANWA, 0, 0);
3337   staticpro (&Vcharset_mojikyo);
3338   Vcharset_mojikyo =
3339     make_charset (LEADING_BYTE_MOJIKYO, Qmojikyo, 256, 3,
3340                   2, 2, 0, CHARSET_LEFT_TO_RIGHT,
3341                   build_string ("Mojikyo"),
3342                   build_string ("Mojikyo"),
3343                   build_string ("Konjaku-Mojikyo"),
3344                   build_string (""),
3345                   Qnil, MIN_CHAR_MOJIKYO, MAX_CHAR_MOJIKYO, 0, 0);
3346   staticpro (&Vcharset_mojikyo_pj_1);
3347   Vcharset_mojikyo_pj_1 =
3348     make_charset (LEADING_BYTE_MOJIKYO_PJ_1, Qmojikyo_pj_1, 94, 2,
3349                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3350                   build_string ("Mojikyo-PJ-1"),
3351                   build_string ("Mojikyo (pseudo JIS encoding) part 1"),
3352                   build_string
3353                   ("Konjaku-Mojikyo (pseudo JIS encoding) part 1"),
3354                   build_string ("jisx0208\\.Mojikyo-1$"),
3355                   Qnil, 0, 0, 0, 33);
3356   staticpro (&Vcharset_mojikyo_pj_2);
3357   Vcharset_mojikyo_pj_2 =
3358     make_charset (LEADING_BYTE_MOJIKYO_PJ_2, Qmojikyo_pj_2, 94, 2,
3359                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3360                   build_string ("Mojikyo-PJ-2"),
3361                   build_string ("Mojikyo (pseudo JIS encoding) part 2"),
3362                   build_string
3363                   ("Konjaku-Mojikyo (pseudo JIS encoding) part 2"),
3364                   build_string ("jisx0208\\.Mojikyo-2$"),
3365                   Qnil, 0, 0, 0, 33);
3366   staticpro (&Vcharset_mojikyo_pj_3);
3367   Vcharset_mojikyo_pj_3 =
3368     make_charset (LEADING_BYTE_MOJIKYO_PJ_3, Qmojikyo_pj_3, 94, 2,
3369                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3370                   build_string ("Mojikyo-PJ-3"),
3371                   build_string ("Mojikyo (pseudo JIS encoding) part 3"),
3372                   build_string
3373                   ("Konjaku-Mojikyo (pseudo JIS encoding) part 3"),
3374                   build_string ("jisx0208\\.Mojikyo-3$"),
3375                   Qnil, 0, 0, 0, 33);
3376   staticpro (&Vcharset_mojikyo_pj_4);
3377   Vcharset_mojikyo_pj_4 =
3378     make_charset (LEADING_BYTE_MOJIKYO_PJ_4, Qmojikyo_pj_4, 94, 2,
3379                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3380                   build_string ("Mojikyo-PJ-4"),
3381                   build_string ("Mojikyo (pseudo JIS encoding) part 4"),
3382                   build_string
3383                   ("Konjaku-Mojikyo (pseudo JIS encoding) part 4"),
3384                   build_string ("jisx0208\\.Mojikyo-4$"),
3385                   Qnil, 0, 0, 0, 33);
3386   staticpro (&Vcharset_mojikyo_pj_5);
3387   Vcharset_mojikyo_pj_5 =
3388     make_charset (LEADING_BYTE_MOJIKYO_PJ_5, Qmojikyo_pj_5, 94, 2,
3389                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3390                   build_string ("Mojikyo-PJ-5"),
3391                   build_string ("Mojikyo (pseudo JIS encoding) part 5"),
3392                   build_string
3393                   ("Konjaku-Mojikyo (pseudo JIS encoding) part 5"),
3394                   build_string ("jisx0208\\.Mojikyo-5$"),
3395                   Qnil, 0, 0, 0, 33);
3396   staticpro (&Vcharset_mojikyo_pj_6);
3397   Vcharset_mojikyo_pj_6 =
3398     make_charset (LEADING_BYTE_MOJIKYO_PJ_6, Qmojikyo_pj_6, 94, 2,
3399                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3400                   build_string ("Mojikyo-PJ-6"),
3401                   build_string ("Mojikyo (pseudo JIS encoding) part 6"),
3402                   build_string
3403                   ("Konjaku-Mojikyo (pseudo JIS encoding) part 6"),
3404                   build_string ("jisx0208\\.Mojikyo-6$"),
3405                   Qnil, 0, 0, 0, 33);
3406   staticpro (&Vcharset_mojikyo_pj_7);
3407   Vcharset_mojikyo_pj_7 =
3408     make_charset (LEADING_BYTE_MOJIKYO_PJ_7, Qmojikyo_pj_7, 94, 2,
3409                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3410                   build_string ("Mojikyo-PJ-7"),
3411                   build_string ("Mojikyo (pseudo JIS encoding) part 7"),
3412                   build_string
3413                   ("Konjaku-Mojikyo (pseudo JIS encoding) part 7"),
3414                   build_string ("jisx0208\\.Mojikyo-7$"),
3415                   Qnil, 0, 0, 0, 33);
3416   staticpro (&Vcharset_mojikyo_pj_8);
3417   Vcharset_mojikyo_pj_8 =
3418     make_charset (LEADING_BYTE_MOJIKYO_PJ_8, Qmojikyo_pj_8, 94, 2,
3419                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3420                   build_string ("Mojikyo-PJ-8"),
3421                   build_string ("Mojikyo (pseudo JIS encoding) part 8"),
3422                   build_string
3423                   ("Konjaku-Mojikyo (pseudo JIS encoding) part 8"),
3424                   build_string ("jisx0208\\.Mojikyo-8$"),
3425                   Qnil, 0, 0, 0, 33);
3426   staticpro (&Vcharset_mojikyo_pj_9);
3427   Vcharset_mojikyo_pj_9 =
3428     make_charset (LEADING_BYTE_MOJIKYO_PJ_9, Qmojikyo_pj_9, 94, 2,
3429                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3430                   build_string ("Mojikyo-PJ-9"),
3431                   build_string ("Mojikyo (pseudo JIS encoding) part 9"),
3432                   build_string
3433                   ("Konjaku-Mojikyo (pseudo JIS encoding) part 9"),
3434                   build_string ("jisx0208\\.Mojikyo-9$"),
3435                   Qnil, 0, 0, 0, 33);
3436   staticpro (&Vcharset_mojikyo_pj_10);
3437   Vcharset_mojikyo_pj_10 =
3438     make_charset (LEADING_BYTE_MOJIKYO_PJ_10, Qmojikyo_pj_10, 94, 2,
3439                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3440                   build_string ("Mojikyo-PJ-10"),
3441                   build_string ("Mojikyo (pseudo JIS encoding) part 10"),
3442                   build_string
3443                   ("Konjaku-Mojikyo (pseudo JIS encoding) part 10"),
3444                   build_string ("jisx0208\\.Mojikyo-10$"),
3445                   Qnil, 0, 0, 0, 33);
3446   staticpro (&Vcharset_mojikyo_pj_11);
3447   Vcharset_mojikyo_pj_11 =
3448     make_charset (LEADING_BYTE_MOJIKYO_PJ_11, Qmojikyo_pj_11, 94, 2,
3449                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3450                   build_string ("Mojikyo-PJ-11"),
3451                   build_string ("Mojikyo (pseudo JIS encoding) part 11"),
3452                   build_string
3453                   ("Konjaku-Mojikyo (pseudo JIS encoding) part 11"),
3454                   build_string ("jisx0208\\.Mojikyo-11$"),
3455                   Qnil, 0, 0, 0, 33);
3456   staticpro (&Vcharset_mojikyo_pj_12);
3457   Vcharset_mojikyo_pj_12 =
3458     make_charset (LEADING_BYTE_MOJIKYO_PJ_12, Qmojikyo_pj_12, 94, 2,
3459                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3460                   build_string ("Mojikyo-PJ-12"),
3461                   build_string ("Mojikyo (pseudo JIS encoding) part 12"),
3462                   build_string
3463                   ("Konjaku-Mojikyo (pseudo JIS encoding) part 12"),
3464                   build_string ("jisx0208\\.Mojikyo-12$"),
3465                   Qnil, 0, 0, 0, 33);
3466   staticpro (&Vcharset_mojikyo_pj_13);
3467   Vcharset_mojikyo_pj_13 =
3468     make_charset (LEADING_BYTE_MOJIKYO_PJ_13, Qmojikyo_pj_13, 94, 2,
3469                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3470                   build_string ("Mojikyo-PJ-13"),
3471                   build_string ("Mojikyo (pseudo JIS encoding) part 13"),
3472                   build_string
3473                   ("Konjaku-Mojikyo (pseudo JIS encoding) part 13"),
3474                   build_string ("jisx0208\\.Mojikyo-13$"),
3475                   Qnil, 0, 0, 0, 33);
3476   staticpro (&Vcharset_mojikyo_pj_14);
3477   Vcharset_mojikyo_pj_14 =
3478     make_charset (LEADING_BYTE_MOJIKYO_PJ_14, Qmojikyo_pj_14, 94, 2,
3479                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3480                   build_string ("Mojikyo-PJ-14"),
3481                   build_string ("Mojikyo (pseudo JIS encoding) part 14"),
3482                   build_string
3483                   ("Konjaku-Mojikyo (pseudo JIS encoding) part 14"),
3484                   build_string ("jisx0208\\.Mojikyo-14$"),
3485                   Qnil, 0, 0, 0, 33);
3486   staticpro (&Vcharset_mojikyo_pj_15);
3487   Vcharset_mojikyo_pj_15 =
3488     make_charset (LEADING_BYTE_MOJIKYO_PJ_15, Qmojikyo_pj_15, 94, 2,
3489                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3490                   build_string ("Mojikyo-PJ-15"),
3491                   build_string ("Mojikyo (pseudo JIS encoding) part 15"),
3492                   build_string
3493                   ("Konjaku-Mojikyo (pseudo JIS encoding) part 15"),
3494                   build_string ("jisx0208\\.Mojikyo-15$"),
3495                   Qnil, 0, 0, 0, 33);
3496   staticpro (&Vcharset_mojikyo_pj_16);
3497   Vcharset_mojikyo_pj_16 =
3498     make_charset (LEADING_BYTE_MOJIKYO_PJ_16, Qmojikyo_pj_16, 94, 2,
3499                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3500                   build_string ("Mojikyo-PJ-16"),
3501                   build_string ("Mojikyo (pseudo JIS encoding) part 16"),
3502                   build_string
3503                   ("Konjaku-Mojikyo (pseudo JIS encoding) part 16"),
3504                   build_string ("jisx0208\\.Mojikyo-16$"),
3505                   Qnil, 0, 0, 0, 33);
3506   staticpro (&Vcharset_mojikyo_pj_17);
3507   Vcharset_mojikyo_pj_17 =
3508     make_charset (LEADING_BYTE_MOJIKYO_PJ_17, Qmojikyo_pj_17, 94, 2,
3509                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3510                   build_string ("Mojikyo-PJ-17"),
3511                   build_string ("Mojikyo (pseudo JIS encoding) part 17"),
3512                   build_string
3513                   ("Konjaku-Mojikyo (pseudo JIS encoding) part 17"),
3514                   build_string ("jisx0208\\.Mojikyo-17$"),
3515                   Qnil, 0, 0, 0, 33);
3516   staticpro (&Vcharset_mojikyo_pj_18);
3517   Vcharset_mojikyo_pj_18 =
3518     make_charset (LEADING_BYTE_MOJIKYO_PJ_18, Qmojikyo_pj_18, 94, 2,
3519                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3520                   build_string ("Mojikyo-PJ-18"),
3521                   build_string ("Mojikyo (pseudo JIS encoding) part 18"),
3522                   build_string
3523                   ("Konjaku-Mojikyo (pseudo JIS encoding) part 18"),
3524                   build_string ("jisx0208\\.Mojikyo-18$"),
3525                   Qnil, 0, 0, 0, 33);
3526   staticpro (&Vcharset_mojikyo_pj_19);
3527   Vcharset_mojikyo_pj_19 =
3528     make_charset (LEADING_BYTE_MOJIKYO_PJ_19, Qmojikyo_pj_19, 94, 2,
3529                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3530                   build_string ("Mojikyo-PJ-19"),
3531                   build_string ("Mojikyo (pseudo JIS encoding) part 19"),
3532                   build_string
3533                   ("Konjaku-Mojikyo (pseudo JIS encoding) part 19"),
3534                   build_string ("jisx0208\\.Mojikyo-19$"),
3535                   Qnil, 0, 0, 0, 33);
3536   staticpro (&Vcharset_mojikyo_pj_20);
3537   Vcharset_mojikyo_pj_20 =
3538     make_charset (LEADING_BYTE_MOJIKYO_PJ_20, Qmojikyo_pj_20, 94, 2,
3539                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3540                   build_string ("Mojikyo-PJ-20"),
3541                   build_string ("Mojikyo (pseudo JIS encoding) part 20"),
3542                   build_string
3543                   ("Konjaku-Mojikyo (pseudo JIS encoding) part 20"),
3544                   build_string ("jisx0208\\.Mojikyo-20$"),
3545                   Qnil, 0, 0, 0, 33);
3546   staticpro (&Vcharset_mojikyo_pj_21);
3547   Vcharset_mojikyo_pj_21 =
3548     make_charset (LEADING_BYTE_MOJIKYO_PJ_21, Qmojikyo_pj_21, 94, 2,
3549                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3550                   build_string ("Mojikyo-PJ-21"),
3551                   build_string ("Mojikyo (pseudo JIS encoding) part 21"),
3552                   build_string
3553                   ("Konjaku-Mojikyo (pseudo JIS encoding) part 21"),
3554                   build_string ("jisx0208\\.Mojikyo-21$"),
3555                   Qnil, 0, 0, 0, 33);
3556   staticpro (&Vcharset_ethiopic_ucs);
3557   Vcharset_ethiopic_ucs =
3558     make_charset (LEADING_BYTE_ETHIOPIC_UCS, Qethiopic_ucs, 256, 2,
3559                   2, 2, 0, CHARSET_LEFT_TO_RIGHT,
3560                   build_string ("Ethiopic (UCS)"),
3561                   build_string ("Ethiopic (UCS)"),
3562                   build_string ("Ethiopic of UCS"),
3563                   build_string ("Ethiopic-Unicode"),
3564                   Qnil, 0x1200, 0x137F, 0x1200, 0);
3565 #endif
3566   staticpro (&Vcharset_chinese_big5_1);
3567   Vcharset_chinese_big5_1 =
3568     make_charset (LEADING_BYTE_CHINESE_BIG5_1, Qchinese_big5_1, 94, 2,
3569                   2, 0, '0', CHARSET_LEFT_TO_RIGHT,
3570                   build_string ("Big5"),
3571                   build_string ("Big5 (Level-1)"),
3572                   build_string
3573                   ("Big5 Level-1 Chinese traditional"),
3574                   build_string ("big5"),
3575                   Qnil, 0, 0, 0, 33);
3576   staticpro (&Vcharset_chinese_big5_2);
3577   Vcharset_chinese_big5_2 =
3578     make_charset (LEADING_BYTE_CHINESE_BIG5_2, Qchinese_big5_2, 94, 2,
3579                   2, 0, '1', CHARSET_LEFT_TO_RIGHT,
3580                   build_string ("Big5"),
3581                   build_string ("Big5 (Level-2)"),
3582                   build_string
3583                   ("Big5 Level-2 Chinese traditional"),
3584                   build_string ("big5"),
3585                   Qnil, 0, 0, 0, 33);
3586
3587 #ifdef ENABLE_COMPOSITE_CHARS
3588   /* #### For simplicity, we put composite chars into a 96x96 charset.
3589      This is going to lead to problems because you can run out of
3590      room, esp. as we don't yet recycle numbers. */
3591   staticpro (&Vcharset_composite);
3592   Vcharset_composite =
3593     make_charset (LEADING_BYTE_COMPOSITE, Qcomposite, 96, 2,
3594                   2, 0, 0, CHARSET_LEFT_TO_RIGHT,
3595                   build_string ("Composite"),
3596                   build_string ("Composite characters"),
3597                   build_string ("Composite characters"),
3598                   build_string (""));
3599
3600   /* #### not dumped properly */
3601   composite_char_row_next = 32;
3602   composite_char_col_next = 32;
3603
3604   Vcomposite_char_string2char_hash_table =
3605     make_lisp_hash_table (500, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL);
3606   Vcomposite_char_char2string_hash_table =
3607     make_lisp_hash_table (500, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
3608   staticpro (&Vcomposite_char_string2char_hash_table);
3609   staticpro (&Vcomposite_char_char2string_hash_table);
3610 #endif /* ENABLE_COMPOSITE_CHARS */
3611
3612 }