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