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