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