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