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