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