1 /* Functions to handle multilingual characters.
2 Copyright (C) 1992, 1995 Free Software Foundation, Inc.
3 Copyright (C) 1995 Sun Microsystems, Inc.
5 This file is part of XEmacs.
7 XEmacs is free software; you can redistribute it and/or modify it
8 under the terms of the GNU General Public License as published by the
9 Free Software Foundation; either version 2, or (at your option) any
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
17 You should have received a copy of the GNU General Public License
18 along with XEmacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
22 /* Synched up with: FSF 20.3. Not in FSF. */
24 /* Rewritten by Ben Wing <ben@xemacs.org>. */
37 /* The various pre-defined charsets. */
39 Lisp_Object Vcharset_ascii;
40 Lisp_Object Vcharset_control_1;
41 Lisp_Object Vcharset_latin_iso8859_1;
42 Lisp_Object Vcharset_latin_iso8859_2;
43 Lisp_Object Vcharset_latin_iso8859_3;
44 Lisp_Object Vcharset_latin_iso8859_4;
45 Lisp_Object Vcharset_thai_tis620;
46 Lisp_Object Vcharset_greek_iso8859_7;
47 Lisp_Object Vcharset_arabic_iso8859_6;
48 Lisp_Object Vcharset_hebrew_iso8859_8;
49 Lisp_Object Vcharset_katakana_jisx0201;
50 Lisp_Object Vcharset_latin_jisx0201;
51 Lisp_Object Vcharset_cyrillic_iso8859_5;
52 Lisp_Object Vcharset_latin_iso8859_9;
53 Lisp_Object Vcharset_japanese_jisx0208_1978;
54 Lisp_Object Vcharset_chinese_gb2312;
55 Lisp_Object Vcharset_japanese_jisx0208;
56 Lisp_Object Vcharset_korean_ksc5601;
57 Lisp_Object Vcharset_japanese_jisx0212;
58 Lisp_Object Vcharset_chinese_cns11643_1;
59 Lisp_Object Vcharset_chinese_cns11643_2;
61 Lisp_Object Vcharset_ucs_bmp;
62 Lisp_Object Vcharset_latin_viscii;
63 Lisp_Object Vcharset_latin_viscii_lower;
64 Lisp_Object Vcharset_latin_viscii_upper;
65 Lisp_Object Vcharset_ethiopic_ucs;
66 Lisp_Object Vcharset_hiragana_jisx0208;
67 Lisp_Object Vcharset_katakana_jisx0208;
69 Lisp_Object Vcharset_chinese_big5_1;
70 Lisp_Object Vcharset_chinese_big5_2;
72 #ifdef ENABLE_COMPOSITE_CHARS
73 Lisp_Object Vcharset_composite;
75 /* Hash tables for composite chars. One maps string representing
76 composed chars to their equivalent chars; one goes the
78 Lisp_Object Vcomposite_char_char2string_hash_table;
79 Lisp_Object Vcomposite_char_string2char_hash_table;
81 static int composite_char_row_next;
82 static int composite_char_col_next;
84 #endif /* ENABLE_COMPOSITE_CHARS */
86 /* Table of charsets indexed by leading byte. */
87 Lisp_Object charset_by_leading_byte[NUM_LEADING_BYTES];
89 /* Table of charsets indexed by type/final-byte/direction. */
91 Lisp_Object charset_by_attributes[4][128];
93 Lisp_Object charset_by_attributes[4][128][2];
97 /* Table of number of bytes in the string representation of a character
98 indexed by the first byte of that representation.
100 rep_bytes_by_first_byte(c) is more efficient than the equivalent
101 canonical computation:
103 (BYTE_ASCII_P (c) ? 1 : XCHARSET_REP_BYTES (CHARSET_BY_LEADING_BYTE (c))) */
105 Bytecount rep_bytes_by_first_byte[0xA0] =
106 { /* 0x00 - 0x7f are for straight ASCII */
107 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
108 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
109 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
110 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
111 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
112 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
113 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
114 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
115 /* 0x80 - 0x8f are for Dimension-1 official charsets */
117 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3,
119 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
121 /* 0x90 - 0x9d are for Dimension-2 official charsets */
122 /* 0x9e is for Dimension-1 private charsets */
123 /* 0x9f is for Dimension-2 private charsets */
124 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4
131 mark_char_byte_table (Lisp_Object obj, void (*markobj) (Lisp_Object))
133 struct Lisp_Char_Byte_Table *cte = XCHAR_BYTE_TABLE (obj);
136 for (i = 0; i < 256; i++)
138 markobj (cte->property[i]);
144 char_byte_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
146 struct Lisp_Char_Byte_Table *cte1 = XCHAR_BYTE_TABLE (obj1);
147 struct Lisp_Char_Byte_Table *cte2 = XCHAR_BYTE_TABLE (obj2);
150 for (i = 0; i < 256; i++)
151 if (CHAR_BYTE_TABLE_P (cte1->property[i]))
153 if (CHAR_BYTE_TABLE_P (cte2->property[i]))
155 if (!char_byte_table_equal (cte1->property[i],
156 cte2->property[i], depth + 1))
163 if (!internal_equal (cte1->property[i], cte2->property[i], depth + 1))
169 char_byte_table_hash (Lisp_Object obj, int depth)
171 struct Lisp_Char_Byte_Table *cte = XCHAR_BYTE_TABLE (obj);
173 return internal_array_hash (cte->property, 256, depth);
176 static const struct lrecord_description char_byte_table_description[] = {
177 { XD_LISP_OBJECT, offsetof(struct Lisp_Char_Byte_Table, property), 256 },
181 DEFINE_LRECORD_IMPLEMENTATION ("char-byte-table", char_byte_table,
182 mark_char_byte_table,
183 internal_object_printer,
184 0, char_byte_table_equal,
185 char_byte_table_hash,
186 char_byte_table_description,
187 struct Lisp_Char_Byte_Table);
190 make_char_byte_table (Lisp_Object initval)
194 struct Lisp_Char_Byte_Table *cte =
195 alloc_lcrecord_type (struct Lisp_Char_Byte_Table,
196 &lrecord_char_byte_table);
198 for (i = 0; i < 256; i++)
199 cte->property[i] = initval;
201 XSETCHAR_BYTE_TABLE (obj, cte);
206 copy_char_byte_table (Lisp_Object entry)
208 struct Lisp_Char_Byte_Table *cte = XCHAR_BYTE_TABLE (entry);
211 struct Lisp_Char_Byte_Table *ctenew =
212 alloc_lcrecord_type (struct Lisp_Char_Byte_Table,
213 &lrecord_char_byte_table);
215 for (i = 0; i < 256; i++)
217 Lisp_Object new = cte->property[i];
218 if (CHAR_BYTE_TABLE_P (new))
219 ctenew->property[i] = copy_char_byte_table (new);
221 ctenew->property[i] = new;
224 XSETCHAR_BYTE_TABLE (obj, ctenew);
230 mark_char_code_table (Lisp_Object obj, void (*markobj) (Lisp_Object))
232 struct Lisp_Char_Code_Table *cte = XCHAR_CODE_TABLE (obj);
238 char_code_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
240 struct Lisp_Char_Code_Table *cte1 = XCHAR_CODE_TABLE (obj1);
241 struct Lisp_Char_Code_Table *cte2 = XCHAR_CODE_TABLE (obj2);
243 return char_byte_table_equal (cte1->table, cte2->table, depth + 1);
247 char_code_table_hash (Lisp_Object obj, int depth)
249 struct Lisp_Char_Code_Table *cte = XCHAR_CODE_TABLE (obj);
251 return char_code_table_hash (cte->table, depth + 1);
254 static const struct lrecord_description char_code_table_description[] = {
255 { XD_LISP_OBJECT, offsetof(struct Lisp_Char_Code_Table, table), 1 },
259 DEFINE_LRECORD_IMPLEMENTATION ("char-code-table", char_code_table,
260 mark_char_code_table,
261 internal_object_printer,
262 0, char_code_table_equal,
263 char_code_table_hash,
264 char_code_table_description,
265 struct Lisp_Char_Code_Table);
268 make_char_code_table (Lisp_Object initval)
271 struct Lisp_Char_Code_Table *cte =
272 alloc_lcrecord_type (struct Lisp_Char_Code_Table,
273 &lrecord_char_code_table);
275 cte->table = make_char_byte_table (initval);
277 XSETCHAR_CODE_TABLE (obj, cte);
282 copy_char_code_table (Lisp_Object entry)
284 struct Lisp_Char_Code_Table *cte = XCHAR_CODE_TABLE (entry);
286 struct Lisp_Char_Code_Table *ctenew =
287 alloc_lcrecord_type (struct Lisp_Char_Code_Table,
288 &lrecord_char_code_table);
290 ctenew->table = copy_char_byte_table (cte->table);
291 XSETCHAR_CODE_TABLE (obj, ctenew);
297 get_char_code_table (Emchar ch, Lisp_Object table)
299 unsigned int code = ch;
300 struct Lisp_Char_Byte_Table* cpt
301 = XCHAR_BYTE_TABLE (XCHAR_CODE_TABLE (table)->table);
302 Lisp_Object ret = cpt->property [(unsigned char)(code >> 24)];
304 if (CHAR_BYTE_TABLE_P (ret))
305 cpt = XCHAR_BYTE_TABLE (ret);
309 ret = cpt->property [(unsigned char) (code >> 16)];
310 if (CHAR_BYTE_TABLE_P (ret))
311 cpt = XCHAR_BYTE_TABLE (ret);
315 ret = cpt->property [(unsigned char) (code >> 8)];
316 if (CHAR_BYTE_TABLE_P (ret))
317 cpt = XCHAR_BYTE_TABLE (ret);
321 return cpt->property [(unsigned char) code];
325 put_char_code_table (Emchar ch, Lisp_Object value, Lisp_Object table)
327 unsigned int code = ch;
328 struct Lisp_Char_Byte_Table* cpt1
329 = XCHAR_BYTE_TABLE (XCHAR_CODE_TABLE (table)->table);
330 Lisp_Object ret = cpt1->property[(unsigned char)(code >> 24)];
332 if (CHAR_BYTE_TABLE_P (ret))
334 struct Lisp_Char_Byte_Table* cpt2 = XCHAR_BYTE_TABLE (ret);
336 ret = cpt2->property[(unsigned char)(code >> 16)];
337 if (CHAR_BYTE_TABLE_P (ret))
339 struct Lisp_Char_Byte_Table* cpt3 = XCHAR_BYTE_TABLE (ret);
341 ret = cpt3->property[(unsigned char)(code >> 8)];
342 if (CHAR_BYTE_TABLE_P (ret))
344 struct Lisp_Char_Byte_Table* cpt4
345 = XCHAR_BYTE_TABLE (ret);
347 cpt4->property[(unsigned char)code] = value;
349 else if (!EQ (ret, value))
351 Lisp_Object cpt4 = make_char_byte_table (ret);
353 XCHAR_BYTE_TABLE(cpt4)->property[(unsigned char)code] = value;
354 cpt3->property[(unsigned char)(code >> 8)] = cpt4;
357 else if (!EQ (ret, value))
359 Lisp_Object cpt3 = make_char_byte_table (ret);
360 Lisp_Object cpt4 = make_char_byte_table (ret);
362 XCHAR_BYTE_TABLE(cpt4)->property[(unsigned char)code] = value;
363 XCHAR_BYTE_TABLE(cpt3)->property[(unsigned char)(code >> 8)]
365 cpt2->property[(unsigned char)(code >> 16)] = cpt3;
368 else if (!EQ (ret, value))
370 Lisp_Object cpt2 = make_char_byte_table (ret);
371 Lisp_Object cpt3 = make_char_byte_table (ret);
372 Lisp_Object cpt4 = make_char_byte_table (ret);
374 XCHAR_BYTE_TABLE(cpt4)->property[(unsigned char)code] = value;
375 XCHAR_BYTE_TABLE(cpt3)->property[(unsigned char)(code >> 8)] = cpt4;
376 XCHAR_BYTE_TABLE(cpt2)->property[(unsigned char)(code >> 16)] = cpt3;
377 cpt1->property[(unsigned char)(code >> 24)] = cpt2;
382 Lisp_Object Vcharacter_attribute_table;
383 Lisp_Object Vcharacter_composition_table;
384 Lisp_Object Vcharacter_variant_table;
386 Lisp_Object Q_decomposition;
389 Lisp_Object QnoBreak;
390 Lisp_Object Qfraction;
400 to_char_code (Lisp_Object v, char* err_msg, Lisp_Object err_arg)
406 else if (EQ (v, Qcompat))
408 else if (EQ (v, QnoBreak))
410 else if (EQ (v, Qfraction))
412 else if (EQ (v, Qsuper))
414 else if (EQ (v, Qsub))
416 else if (EQ (v, Qcircle))
418 else if (EQ (v, Qsquare))
420 else if (EQ (v, Qwide))
422 else if (EQ (v, Qnarrow))
424 else if (EQ (v, Qfont))
427 signal_simple_error (err_msg, err_arg);
430 DEFUN ("get-composite-char", Fget_composite_char, 1, 1, 0, /*
431 Return character corresponding with list.
435 Lisp_Object table = Vcharacter_composition_table;
436 Lisp_Object rest = list;
440 Lisp_Object v = Fcar (rest);
442 Emchar c = to_char_code (v, "Invalid value for composition", list);
444 ret = get_char_code_table (c, table);
449 if (!CHAR_CODE_TABLE_P (ret))
454 else if (!CONSP (rest))
456 else if (CHAR_CODE_TABLE_P (ret))
459 signal_simple_error ("Invalid table is found with", list);
461 signal_simple_error ("Invalid value for composition", list);
464 DEFUN ("char-variants", Fchar_variants, 1, 1, 0, /*
465 Return variants of CHARACTER.
469 CHECK_CHAR (character);
470 return Fcopy_list (get_char_code_table (XCHAR (character),
471 Vcharacter_variant_table));
474 DEFUN ("char-attribute-alist", Fchar_attribute_alist, 1, 1, 0, /*
475 Return the alist of attributes of CHARACTER.
479 CHECK_CHAR (character);
480 return Fcopy_alist (get_char_code_table (XCHAR (character),
481 Vcharacter_attribute_table));
484 DEFUN ("get-char-attribute", Fget_char_attribute, 2, 2, 0, /*
485 Return the value of CHARACTER's ATTRIBUTE.
487 (character, attribute))
490 = get_char_code_table (XCHAR (character), Vcharacter_attribute_table);
496 if (!NILP (ccs = Ffind_charset (attribute)))
499 return Fcdr (Fassq (attribute, ret));
503 put_char_attribute (Lisp_Object character, Lisp_Object attribute,
506 Emchar char_code = XCHAR (character);
508 = get_char_code_table (char_code, Vcharacter_attribute_table);
511 cell = Fassq (attribute, ret);
515 ret = Fcons (Fcons (attribute, value), ret);
517 else if (!EQ (Fcdr (cell), value))
519 Fsetcdr (cell, value);
521 put_char_code_table (char_code, ret, Vcharacter_attribute_table);
525 DEFUN ("put-char-attribute", Fput_char_attribute, 3, 3, 0, /*
526 Store CHARACTER's ATTRIBUTE with VALUE.
528 (character, attribute, value))
532 ccs = Ffind_charset (attribute);
536 Lisp_Object v = XCHARSET_DECODING_TABLE (ccs);
541 /* ad-hoc method for `ascii' */
542 if ((XCHARSET_CHARS (ccs) == 94) &&
543 (XCHARSET_BYTE_OFFSET (ccs) != 33))
544 ccs_len = 128 - XCHARSET_BYTE_OFFSET (ccs);
546 ccs_len = XCHARSET_CHARS (ccs);
549 signal_simple_error ("Invalid value for coded-charset",
553 rest = Fget_char_attribute (character, attribute);
560 Lisp_Object ei = Fcar (rest);
562 i = XINT (ei) - XCHARSET_BYTE_OFFSET (ccs);
563 nv = XVECTOR_DATA(v)[i];
570 XVECTOR_DATA(v)[i] = Qnil;
571 v = XCHARSET_DECODING_TABLE (ccs);
576 XCHARSET_DECODING_TABLE (ccs) = v = make_vector (ccs_len, Qnil);
579 if (XCHARSET_GRAPHIC (ccs) == 1)
580 value = Fcopy_list (value);
585 Lisp_Object ei = Fcar (rest);
588 signal_simple_error ("Invalid value for coded-charset", value);
590 if ((i < 0) || (255 < i))
591 signal_simple_error ("Invalid value for coded-charset", value);
592 if (XCHARSET_GRAPHIC (ccs) == 1)
595 Fsetcar (rest, make_int (i));
597 i -= XCHARSET_BYTE_OFFSET (ccs);
598 nv = XVECTOR_DATA(v)[i];
604 nv = (XVECTOR_DATA(v)[i] = make_vector (ccs_len, Qnil));
611 XVECTOR_DATA(v)[i] = character;
613 else if (EQ (attribute, Q_decomposition))
615 Lisp_Object rest = value;
616 Lisp_Object table = Vcharacter_composition_table;
619 signal_simple_error ("Invalid value for ->decomposition",
624 Lisp_Object v = Fcar (rest);
627 = to_char_code (v, "Invalid value for ->decomposition", value);
632 put_char_code_table (c, character, table);
637 ntable = get_char_code_table (c, table);
638 if (!CHAR_CODE_TABLE_P (ntable))
640 ntable = make_char_code_table (Qnil);
641 put_char_code_table (c, ntable, table);
647 else if (EQ (attribute, Q_ucs))
653 signal_simple_error ("Invalid value for ->ucs", value);
657 ret = get_char_code_table (c, Vcharacter_variant_table);
658 if (NILP (Fmemq (character, ret)))
660 put_char_code_table (c, Fcons (character, ret),
661 Vcharacter_variant_table);
664 return put_char_attribute (character, attribute, value);
669 DEFUN ("define-char", Fdefine_char, 1, 1, 0, /*
670 Store character's ATTRIBUTES.
674 Lisp_Object rest = attributes;
675 Lisp_Object code = Fcdr (Fassq (Qucs, attributes));
676 Lisp_Object character;
682 Lisp_Object cell = Fcar (rest);
686 signal_simple_error ("Invalid argument", attributes);
687 if (!NILP (ccs = Ffind_charset (Fcar (cell)))
688 && XCHARSET_FINAL (ccs))
692 if (XCHARSET_DIMENSION (ccs) == 1)
694 Lisp_Object eb1 = Fcar (Fcdr (cell));
698 signal_simple_error ("Invalid argument", attributes);
700 switch (XCHARSET_CHARS (ccs))
704 + (XCHARSET_FINAL (ccs) - '0') * 94 + (b1 - 33);
708 + (XCHARSET_FINAL (ccs) - '0') * 96 + (b1 - 32);
714 else if (XCHARSET_DIMENSION (ccs) == 2)
716 Lisp_Object eb1 = Fcar (Fcdr (cell));
717 Lisp_Object eb2 = Fcar (Fcdr (Fcdr (cell)));
721 signal_simple_error ("Invalid argument", attributes);
724 signal_simple_error ("Invalid argument", attributes);
726 switch (XCHARSET_CHARS (ccs))
729 code = MIN_CHAR_94x94
730 + (XCHARSET_FINAL (ccs) - '0') * 94 * 94
731 + (b1 - 33) * 94 + (b2 - 33);
734 code = MIN_CHAR_96x96
735 + (XCHARSET_FINAL (ccs) - '0') * 96 * 96
736 + (b1 - 32) * 96 + (b2 - 32);
747 character = make_char (code);
748 goto setup_attributes;
754 else if (!INTP (code))
755 signal_simple_error ("Invalid argument", attributes);
757 character = make_char (XINT (code));
763 Lisp_Object cell = Fcar (rest);
766 signal_simple_error ("Invalid argument", attributes);
767 Fput_char_attribute (character, Fcar (cell), Fcdr (cell));
771 get_char_code_table (XCHAR (character), Vcharacter_attribute_table);
774 Lisp_Object Vutf_2000_version;
778 int leading_code_private_11;
781 Lisp_Object Qcharsetp;
783 /* Qdoc_string, Qdimension, Qchars defined in general.c */
784 Lisp_Object Qregistry, Qfinal, Qgraphic;
785 Lisp_Object Qdirection;
786 Lisp_Object Qreverse_direction_charset;
787 Lisp_Object Qleading_byte;
788 Lisp_Object Qshort_name, Qlong_name;
804 Qjapanese_jisx0208_1978,
816 Qvietnamese_viscii_lower,
817 Qvietnamese_viscii_upper,
826 Lisp_Object Ql2r, Qr2l;
828 Lisp_Object Vcharset_hash_table;
831 static Charset_ID next_allocated_leading_byte;
833 static Charset_ID next_allocated_1_byte_leading_byte;
834 static Charset_ID next_allocated_2_byte_leading_byte;
837 /* Composite characters are characters constructed by overstriking two
838 or more regular characters.
840 1) The old Mule implementation involves storing composite characters
841 in a buffer as a tag followed by all of the actual characters
842 used to make up the composite character. I think this is a bad
843 idea; it greatly complicates code that wants to handle strings
844 one character at a time because it has to deal with the possibility
845 of great big ungainly characters. It's much more reasonable to
846 simply store an index into a table of composite characters.
848 2) The current implementation only allows for 16,384 separate
849 composite characters over the lifetime of the XEmacs process.
850 This could become a potential problem if the user
851 edited lots of different files that use composite characters.
852 Due to FSF bogosity, increasing the number of allowable
853 composite characters under Mule would decrease the number
854 of possible faces that can exist. Mule already has shrunk
855 this to 2048, and further shrinkage would become uncomfortable.
856 No such problems exist in XEmacs.
858 Composite characters could be represented as 0x80 C1 C2 C3,
859 where each C[1-3] is in the range 0xA0 - 0xFF. This allows
860 for slightly under 2^20 (one million) composite characters
861 over the XEmacs process lifetime, and you only need to
862 increase the size of a Mule character from 19 to 21 bits.
863 Or you could use 0x80 C1 C2 C3 C4, allowing for about
864 85 million (slightly over 2^26) composite characters. */
867 /************************************************************************/
868 /* Basic Emchar functions */
869 /************************************************************************/
871 /* Convert a non-ASCII Mule character C into a one-character Mule-encoded
872 string in STR. Returns the number of bytes stored.
873 Do not call this directly. Use the macro set_charptr_emchar() instead.
877 non_ascii_set_charptr_emchar (Bufbyte *str, Emchar c)
892 else if ( c <= 0x7ff )
894 *p++ = (c >> 6) | 0xc0;
895 *p++ = (c & 0x3f) | 0x80;
897 else if ( c <= 0xffff )
899 *p++ = (c >> 12) | 0xe0;
900 *p++ = ((c >> 6) & 0x3f) | 0x80;
901 *p++ = (c & 0x3f) | 0x80;
903 else if ( c <= 0x1fffff )
905 *p++ = (c >> 18) | 0xf0;
906 *p++ = ((c >> 12) & 0x3f) | 0x80;
907 *p++ = ((c >> 6) & 0x3f) | 0x80;
908 *p++ = (c & 0x3f) | 0x80;
910 else if ( c <= 0x3ffffff )
912 *p++ = (c >> 24) | 0xf8;
913 *p++ = ((c >> 18) & 0x3f) | 0x80;
914 *p++ = ((c >> 12) & 0x3f) | 0x80;
915 *p++ = ((c >> 6) & 0x3f) | 0x80;
916 *p++ = (c & 0x3f) | 0x80;
920 *p++ = (c >> 30) | 0xfc;
921 *p++ = ((c >> 24) & 0x3f) | 0x80;
922 *p++ = ((c >> 18) & 0x3f) | 0x80;
923 *p++ = ((c >> 12) & 0x3f) | 0x80;
924 *p++ = ((c >> 6) & 0x3f) | 0x80;
925 *p++ = (c & 0x3f) | 0x80;
928 BREAKUP_CHAR (c, charset, c1, c2);
929 lb = CHAR_LEADING_BYTE (c);
930 if (LEADING_BYTE_PRIVATE_P (lb))
931 *p++ = PRIVATE_LEADING_BYTE_PREFIX (lb);
933 if (EQ (charset, Vcharset_control_1))
942 /* Return the first character from a Mule-encoded string in STR,
943 assuming it's non-ASCII. Do not call this directly.
944 Use the macro charptr_emchar() instead. */
947 non_ascii_charptr_emchar (CONST Bufbyte *str)
960 else if ( b >= 0xf8 )
965 else if ( b >= 0xf0 )
970 else if ( b >= 0xe0 )
975 else if ( b >= 0xc0 )
985 for( ; len > 0; len-- )
988 ch = ( ch << 6 ) | ( b & 0x3f );
992 Bufbyte i0 = *str, i1, i2 = 0;
995 if (i0 == LEADING_BYTE_CONTROL_1)
996 return (Emchar) (*++str - 0x20);
998 if (LEADING_BYTE_PREFIX_P (i0))
1003 charset = CHARSET_BY_LEADING_BYTE (i0);
1004 if (XCHARSET_DIMENSION (charset) == 2)
1007 return MAKE_CHAR (charset, i1, i2);
1011 /* Return whether CH is a valid Emchar, assuming it's non-ASCII.
1012 Do not call this directly. Use the macro valid_char_p() instead. */
1016 non_ascii_valid_char_p (Emchar ch)
1020 /* Must have only lowest 19 bits set */
1024 f1 = CHAR_FIELD1 (ch);
1025 f2 = CHAR_FIELD2 (ch);
1026 f3 = CHAR_FIELD3 (ch);
1030 Lisp_Object charset;
1032 if (f2 < MIN_CHAR_FIELD2_OFFICIAL ||
1033 (f2 > MAX_CHAR_FIELD2_OFFICIAL && f2 < MIN_CHAR_FIELD2_PRIVATE) ||
1034 f2 > MAX_CHAR_FIELD2_PRIVATE)
1039 if (f3 != 0x20 && f3 != 0x7F)
1043 NOTE: This takes advantage of the fact that
1044 FIELD2_TO_OFFICIAL_LEADING_BYTE and
1045 FIELD2_TO_PRIVATE_LEADING_BYTE are the same.
1047 charset = CHARSET_BY_LEADING_BYTE (f2 + FIELD2_TO_OFFICIAL_LEADING_BYTE);
1048 return (XCHARSET_CHARS (charset) == 96);
1052 Lisp_Object charset;
1054 if (f1 < MIN_CHAR_FIELD1_OFFICIAL ||
1055 (f1 > MAX_CHAR_FIELD1_OFFICIAL && f1 < MIN_CHAR_FIELD1_PRIVATE) ||
1056 f1 > MAX_CHAR_FIELD1_PRIVATE)
1058 if (f2 < 0x20 || f3 < 0x20)
1061 #ifdef ENABLE_COMPOSITE_CHARS
1062 if (f1 + FIELD1_TO_OFFICIAL_LEADING_BYTE == LEADING_BYTE_COMPOSITE)
1064 if (UNBOUNDP (Fgethash (make_int (ch),
1065 Vcomposite_char_char2string_hash_table,
1070 #endif /* ENABLE_COMPOSITE_CHARS */
1072 if (f2 != 0x20 && f2 != 0x7F && f3 != 0x20 && f3 != 0x7F)
1075 if (f1 <= MAX_CHAR_FIELD1_OFFICIAL)
1077 CHARSET_BY_LEADING_BYTE (f1 + FIELD1_TO_OFFICIAL_LEADING_BYTE);
1080 CHARSET_BY_LEADING_BYTE (f1 + FIELD1_TO_PRIVATE_LEADING_BYTE);
1082 return (XCHARSET_CHARS (charset) == 96);
1088 /************************************************************************/
1089 /* Basic string functions */
1090 /************************************************************************/
1092 /* Copy the character pointed to by PTR into STR, assuming it's
1093 non-ASCII. Do not call this directly. Use the macro
1094 charptr_copy_char() instead. */
1097 non_ascii_charptr_copy_char (CONST Bufbyte *ptr, Bufbyte *str)
1099 Bufbyte *strptr = str;
1101 switch (REP_BYTES_BY_FIRST_BYTE (*strptr))
1103 /* Notice fallthrough. */
1105 case 6: *++strptr = *ptr++;
1106 case 5: *++strptr = *ptr++;
1108 case 4: *++strptr = *ptr++;
1109 case 3: *++strptr = *ptr++;
1110 case 2: *++strptr = *ptr;
1115 return strptr + 1 - str;
1119 /************************************************************************/
1120 /* streams of Emchars */
1121 /************************************************************************/
1123 /* Treat a stream as a stream of Emchar's rather than a stream of bytes.
1124 The functions below are not meant to be called directly; use
1125 the macros in insdel.h. */
1128 Lstream_get_emchar_1 (Lstream *stream, int ch)
1130 Bufbyte str[MAX_EMCHAR_LEN];
1131 Bufbyte *strptr = str;
1133 str[0] = (Bufbyte) ch;
1134 switch (REP_BYTES_BY_FIRST_BYTE (ch))
1136 /* Notice fallthrough. */
1139 ch = Lstream_getc (stream);
1141 *++strptr = (Bufbyte) ch;
1143 ch = Lstream_getc (stream);
1145 *++strptr = (Bufbyte) ch;
1148 ch = Lstream_getc (stream);
1150 *++strptr = (Bufbyte) ch;
1152 ch = Lstream_getc (stream);
1154 *++strptr = (Bufbyte) ch;
1156 ch = Lstream_getc (stream);
1158 *++strptr = (Bufbyte) ch;
1163 return charptr_emchar (str);
1167 Lstream_fput_emchar (Lstream *stream, Emchar ch)
1169 Bufbyte str[MAX_EMCHAR_LEN];
1170 Bytecount len = set_charptr_emchar (str, ch);
1171 return Lstream_write (stream, str, len);
1175 Lstream_funget_emchar (Lstream *stream, Emchar ch)
1177 Bufbyte str[MAX_EMCHAR_LEN];
1178 Bytecount len = set_charptr_emchar (str, ch);
1179 Lstream_unread (stream, str, len);
1183 /************************************************************************/
1184 /* charset object */
1185 /************************************************************************/
1188 mark_charset (Lisp_Object obj, void (*markobj) (Lisp_Object))
1190 struct Lisp_Charset *cs = XCHARSET (obj);
1192 markobj (cs->short_name);
1193 markobj (cs->long_name);
1194 markobj (cs->doc_string);
1195 markobj (cs->registry);
1196 markobj (cs->ccl_program);
1198 markobj (cs->decoding_table);
1204 print_charset (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1206 struct Lisp_Charset *cs = XCHARSET (obj);
1210 error ("printing unreadable object #<charset %s 0x%x>",
1211 string_data (XSYMBOL (CHARSET_NAME (cs))->name),
1214 write_c_string ("#<charset ", printcharfun);
1215 print_internal (CHARSET_NAME (cs), printcharfun, 0);
1216 write_c_string (" ", printcharfun);
1217 print_internal (CHARSET_SHORT_NAME (cs), printcharfun, 1);
1218 write_c_string (" ", printcharfun);
1219 print_internal (CHARSET_LONG_NAME (cs), printcharfun, 1);
1220 write_c_string (" ", printcharfun);
1221 print_internal (CHARSET_DOC_STRING (cs), printcharfun, 1);
1222 sprintf (buf, " %s %s cols=%d g%d final='%c' reg=",
1223 CHARSET_TYPE (cs) == CHARSET_TYPE_94 ? "94" :
1224 CHARSET_TYPE (cs) == CHARSET_TYPE_96 ? "96" :
1225 CHARSET_TYPE (cs) == CHARSET_TYPE_94X94 ? "94x94" :
1227 CHARSET_DIRECTION (cs) == CHARSET_LEFT_TO_RIGHT ? "l2r" : "r2l",
1228 CHARSET_COLUMNS (cs),
1229 CHARSET_GRAPHIC (cs),
1230 CHARSET_FINAL (cs));
1231 write_c_string (buf, printcharfun);
1232 print_internal (CHARSET_REGISTRY (cs), printcharfun, 0);
1233 sprintf (buf, " 0x%x>", cs->header.uid);
1234 write_c_string (buf, printcharfun);
1237 static const struct lrecord_description charset_description[] = {
1238 { XD_LISP_OBJECT, offsetof(struct Lisp_Charset, name), 7 },
1240 { XD_LISP_OBJECT, offsetof(struct Lisp_Charset, decoding_table), 2 },
1245 DEFINE_LRECORD_IMPLEMENTATION ("charset", charset,
1246 mark_charset, print_charset, 0, 0, 0,
1247 charset_description,
1248 struct Lisp_Charset);
1250 /* Make a new charset. */
1253 make_charset (Charset_ID id, Lisp_Object name,
1254 unsigned char type, unsigned char columns, unsigned char graphic,
1255 Bufbyte final, unsigned char direction, Lisp_Object short_name,
1256 Lisp_Object long_name, Lisp_Object doc,
1258 Lisp_Object decoding_table,
1259 Emchar ucs_min, Emchar ucs_max,
1260 Emchar code_offset, unsigned char byte_offset)
1263 struct Lisp_Charset *cs =
1264 alloc_lcrecord_type (struct Lisp_Charset, &lrecord_charset);
1265 XSETCHARSET (obj, cs);
1267 CHARSET_ID (cs) = id;
1268 CHARSET_NAME (cs) = name;
1269 CHARSET_SHORT_NAME (cs) = short_name;
1270 CHARSET_LONG_NAME (cs) = long_name;
1271 CHARSET_DIRECTION (cs) = direction;
1272 CHARSET_TYPE (cs) = type;
1273 CHARSET_COLUMNS (cs) = columns;
1274 CHARSET_GRAPHIC (cs) = graphic;
1275 CHARSET_FINAL (cs) = final;
1276 CHARSET_DOC_STRING (cs) = doc;
1277 CHARSET_REGISTRY (cs) = reg;
1278 CHARSET_CCL_PROGRAM (cs) = Qnil;
1279 CHARSET_REVERSE_DIRECTION_CHARSET (cs) = Qnil;
1281 CHARSET_DECODING_TABLE(cs) = Qnil;
1282 CHARSET_UCS_MIN(cs) = ucs_min;
1283 CHARSET_UCS_MAX(cs) = ucs_max;
1284 CHARSET_CODE_OFFSET(cs) = code_offset;
1285 CHARSET_BYTE_OFFSET(cs) = byte_offset;
1288 switch (CHARSET_TYPE (cs))
1290 case CHARSET_TYPE_94:
1291 CHARSET_DIMENSION (cs) = 1;
1292 CHARSET_CHARS (cs) = 94;
1294 case CHARSET_TYPE_96:
1295 CHARSET_DIMENSION (cs) = 1;
1296 CHARSET_CHARS (cs) = 96;
1298 case CHARSET_TYPE_94X94:
1299 CHARSET_DIMENSION (cs) = 2;
1300 CHARSET_CHARS (cs) = 94;
1302 case CHARSET_TYPE_96X96:
1303 CHARSET_DIMENSION (cs) = 2;
1304 CHARSET_CHARS (cs) = 96;
1307 case CHARSET_TYPE_128:
1308 CHARSET_DIMENSION (cs) = 1;
1309 CHARSET_CHARS (cs) = 128;
1311 case CHARSET_TYPE_128X128:
1312 CHARSET_DIMENSION (cs) = 2;
1313 CHARSET_CHARS (cs) = 128;
1315 case CHARSET_TYPE_256:
1316 CHARSET_DIMENSION (cs) = 1;
1317 CHARSET_CHARS (cs) = 256;
1319 case CHARSET_TYPE_256X256:
1320 CHARSET_DIMENSION (cs) = 2;
1321 CHARSET_CHARS (cs) = 256;
1327 if (id == LEADING_BYTE_ASCII)
1328 CHARSET_REP_BYTES (cs) = 1;
1330 CHARSET_REP_BYTES (cs) = CHARSET_DIMENSION (cs) + 1;
1332 CHARSET_REP_BYTES (cs) = CHARSET_DIMENSION (cs) + 2;
1337 /* some charsets do not have final characters. This includes
1338 ASCII, Control-1, Composite, and the two faux private
1341 if (code_offset == 0)
1343 assert (NILP (charset_by_attributes[type][final]));
1344 charset_by_attributes[type][final] = obj;
1347 assert (NILP (charset_by_attributes[type][final][direction]));
1348 charset_by_attributes[type][final][direction] = obj;
1352 assert (NILP (charset_by_leading_byte[id - MIN_LEADING_BYTE]));
1353 charset_by_leading_byte[id - MIN_LEADING_BYTE] = obj;
1356 /* official leading byte */
1357 rep_bytes_by_first_byte[id] = CHARSET_REP_BYTES (cs);
1360 /* Some charsets are "faux" and don't have names or really exist at
1361 all except in the leading-byte table. */
1363 Fputhash (name, obj, Vcharset_hash_table);
1368 get_unallocated_leading_byte (int dimension)
1373 if (next_allocated_leading_byte > MAX_LEADING_BYTE_PRIVATE)
1376 lb = next_allocated_leading_byte++;
1380 if (next_allocated_1_byte_leading_byte > MAX_LEADING_BYTE_PRIVATE_1)
1383 lb = next_allocated_1_byte_leading_byte++;
1387 if (next_allocated_2_byte_leading_byte > MAX_LEADING_BYTE_PRIVATE_2)
1390 lb = next_allocated_2_byte_leading_byte++;
1396 ("No more character sets free for this dimension",
1397 make_int (dimension));
1404 range_charset_code_point (Lisp_Object charset, Emchar ch)
1408 if ((XCHARSET_UCS_MIN (charset) <= ch)
1409 && (ch <= XCHARSET_UCS_MAX (charset)))
1411 d = ch - XCHARSET_UCS_MIN (charset) + XCHARSET_CODE_OFFSET (charset);
1413 if (XCHARSET_DIMENSION (charset) == 1)
1414 return list1 (make_int (d + XCHARSET_BYTE_OFFSET (charset)));
1415 else if (XCHARSET_DIMENSION (charset) == 2)
1416 return list2 (make_int (d / XCHARSET_CHARS (charset)
1417 + XCHARSET_BYTE_OFFSET (charset)),
1418 make_int (d % XCHARSET_CHARS (charset)
1419 + XCHARSET_BYTE_OFFSET (charset)));
1420 else if (XCHARSET_DIMENSION (charset) == 3)
1421 return list3 (make_int (d / (XCHARSET_CHARS (charset)
1422 * XCHARSET_CHARS (charset))
1423 + XCHARSET_BYTE_OFFSET (charset)),
1424 make_int (d / XCHARSET_CHARS (charset)
1425 % XCHARSET_CHARS (charset)
1426 + XCHARSET_BYTE_OFFSET (charset)),
1427 make_int (d % XCHARSET_CHARS (charset)
1428 + XCHARSET_BYTE_OFFSET (charset)));
1429 else /* if (XCHARSET_DIMENSION (charset) == 4) */
1430 return list4 (make_int (d / (XCHARSET_CHARS (charset)
1431 * XCHARSET_CHARS (charset)
1432 * XCHARSET_CHARS (charset))
1433 + XCHARSET_BYTE_OFFSET (charset)),
1434 make_int (d / (XCHARSET_CHARS (charset)
1435 * XCHARSET_CHARS (charset))
1436 % XCHARSET_CHARS (charset)
1437 + XCHARSET_BYTE_OFFSET (charset)),
1438 make_int (d / XCHARSET_CHARS (charset)
1439 % XCHARSET_CHARS (charset)
1440 + XCHARSET_BYTE_OFFSET (charset)),
1441 make_int (d % XCHARSET_CHARS (charset)
1442 + XCHARSET_BYTE_OFFSET (charset)));
1444 else if (XCHARSET_CODE_OFFSET (charset) == 0)
1446 if (XCHARSET_DIMENSION (charset) == 1)
1448 if (XCHARSET_CHARS (charset) == 94)
1450 if (((d = ch - (MIN_CHAR_94
1451 + (XCHARSET_FINAL (charset) - '0') * 94)) >= 0)
1453 return list1 (make_int (d + 33));
1455 else if (XCHARSET_CHARS (charset) == 96)
1457 if (((d = ch - (MIN_CHAR_96
1458 + (XCHARSET_FINAL (charset) - '0') * 96)) >= 0)
1460 return list1 (make_int (d + 32));
1465 else if (XCHARSET_DIMENSION (charset) == 2)
1467 if (XCHARSET_CHARS (charset) == 94)
1469 if (((d = ch - (MIN_CHAR_94x94
1470 + (XCHARSET_FINAL (charset) - '0') * 94 * 94))
1473 return list2 (make_int ((d / 94) + 33),
1474 make_int (d % 94 + 33));
1476 else if (XCHARSET_CHARS (charset) == 96)
1478 if (((d = ch - (MIN_CHAR_96x96
1479 + (XCHARSET_FINAL (charset) - '0') * 96 * 96))
1482 return list2 (make_int ((d / 96) + 32),
1483 make_int (d % 96 + 32));
1491 split_builtin_char (Emchar c)
1493 if (c < MIN_CHAR_OBS_94x94)
1495 if (c <= MAX_CHAR_BASIC_LATIN)
1497 return list2 (Vcharset_ascii, make_int (c));
1501 return list2 (Vcharset_control_1, make_int (c & 0x7F));
1505 return list2 (Vcharset_latin_iso8859_1, make_int (c & 0x7F));
1507 else if ((MIN_CHAR_GREEK <= c) && (c <= MAX_CHAR_GREEK))
1509 return list2 (Vcharset_greek_iso8859_7,
1510 make_int (c - MIN_CHAR_GREEK + 0x20));
1512 else if ((MIN_CHAR_CYRILLIC <= c) && (c <= MAX_CHAR_CYRILLIC))
1514 return list2 (Vcharset_cyrillic_iso8859_5,
1515 make_int (c - MIN_CHAR_CYRILLIC + 0x20));
1517 else if ((MIN_CHAR_HEBREW <= c) && (c <= MAX_CHAR_HEBREW))
1519 return list2 (Vcharset_hebrew_iso8859_8,
1520 make_int (c - MIN_CHAR_HEBREW + 0x20));
1522 else if ((MIN_CHAR_THAI <= c) && (c <= MAX_CHAR_THAI))
1524 return list2 (Vcharset_thai_tis620,
1525 make_int (c - MIN_CHAR_THAI + 0x20));
1527 else if ((MIN_CHAR_HALFWIDTH_KATAKANA <= c)
1528 && (c <= MAX_CHAR_HALFWIDTH_KATAKANA))
1530 return list2 (Vcharset_katakana_jisx0201,
1531 make_int (c - MIN_CHAR_HALFWIDTH_KATAKANA + 33));
1535 return list3 (Vcharset_ucs_bmp,
1536 make_int (c >> 8), make_int (c & 0xff));
1539 else if (c <= MAX_CHAR_OBS_94x94)
1541 return list3 (CHARSET_BY_ATTRIBUTES
1542 (CHARSET_TYPE_94X94,
1543 ((c - MIN_CHAR_OBS_94x94) / (94 * 94)) + '@',
1544 CHARSET_LEFT_TO_RIGHT),
1545 make_int ((((c - MIN_CHAR_OBS_94x94) / 94) % 94) + 33),
1546 make_int (((c - MIN_CHAR_OBS_94x94) % 94) + 33));
1548 else if (c <= MAX_CHAR_94)
1550 return list2 (CHARSET_BY_ATTRIBUTES (CHARSET_TYPE_94,
1551 ((c - MIN_CHAR_94) / 94) + '0',
1552 CHARSET_LEFT_TO_RIGHT),
1553 make_int (((c - MIN_CHAR_94) % 94) + 33));
1555 else if (c <= MAX_CHAR_96)
1557 return list2 (CHARSET_BY_ATTRIBUTES (CHARSET_TYPE_96,
1558 ((c - MIN_CHAR_96) / 96) + '0',
1559 CHARSET_LEFT_TO_RIGHT),
1560 make_int (((c - MIN_CHAR_96) % 96) + 32));
1562 else if (c <= MAX_CHAR_94x94)
1564 return list3 (CHARSET_BY_ATTRIBUTES
1565 (CHARSET_TYPE_94X94,
1566 ((c - MIN_CHAR_94x94) / (94 * 94)) + '0',
1567 CHARSET_LEFT_TO_RIGHT),
1568 make_int ((((c - MIN_CHAR_94x94) / 94) % 94) + 33),
1569 make_int (((c - MIN_CHAR_94x94) % 94) + 33));
1571 else if (c <= MAX_CHAR_96x96)
1573 return list3 (CHARSET_BY_ATTRIBUTES
1574 (CHARSET_TYPE_96X96,
1575 ((c - MIN_CHAR_96x96) / (96 * 96)) + '0',
1576 CHARSET_LEFT_TO_RIGHT),
1577 make_int ((((c - MIN_CHAR_96x96) / 96) % 96) + 32),
1578 make_int (((c - MIN_CHAR_96x96) % 96) + 32));
1587 charset_code_point (Lisp_Object charset, Emchar ch)
1589 Lisp_Object cdef = get_char_code_table (ch, Vcharacter_attribute_table);
1591 if (!EQ (cdef, Qnil))
1593 Lisp_Object field = Fassq (charset, cdef);
1595 if (!EQ (field, Qnil))
1596 return Fcdr (field);
1598 return range_charset_code_point (charset, ch);
1601 Lisp_Object Vdefault_coded_charset_priority_list;
1605 /************************************************************************/
1606 /* Basic charset Lisp functions */
1607 /************************************************************************/
1609 DEFUN ("charsetp", Fcharsetp, 1, 1, 0, /*
1610 Return non-nil if OBJECT is a charset.
1614 return CHARSETP (object) ? Qt : Qnil;
1617 DEFUN ("find-charset", Ffind_charset, 1, 1, 0, /*
1618 Retrieve the charset of the given name.
1619 If CHARSET-OR-NAME is a charset object, it is simply returned.
1620 Otherwise, CHARSET-OR-NAME should be a symbol. If there is no such charset,
1621 nil is returned. Otherwise the associated charset object is returned.
1625 if (CHARSETP (charset_or_name))
1626 return charset_or_name;
1628 CHECK_SYMBOL (charset_or_name);
1629 return Fgethash (charset_or_name, Vcharset_hash_table, Qnil);
1632 DEFUN ("get-charset", Fget_charset, 1, 1, 0, /*
1633 Retrieve the charset of the given name.
1634 Same as `find-charset' except an error is signalled if there is no such
1635 charset instead of returning nil.
1639 Lisp_Object charset = Ffind_charset (name);
1642 signal_simple_error ("No such charset", name);
1646 /* We store the charsets in hash tables with the names as the key and the
1647 actual charset object as the value. Occasionally we need to use them
1648 in a list format. These routines provide us with that. */
1649 struct charset_list_closure
1651 Lisp_Object *charset_list;
1655 add_charset_to_list_mapper (Lisp_Object key, Lisp_Object value,
1656 void *charset_list_closure)
1658 /* This function can GC */
1659 struct charset_list_closure *chcl =
1660 (struct charset_list_closure*) charset_list_closure;
1661 Lisp_Object *charset_list = chcl->charset_list;
1663 *charset_list = Fcons (XCHARSET_NAME (value), *charset_list);
1667 DEFUN ("charset-list", Fcharset_list, 0, 0, 0, /*
1668 Return a list of the names of all defined charsets.
1672 Lisp_Object charset_list = Qnil;
1673 struct gcpro gcpro1;
1674 struct charset_list_closure charset_list_closure;
1676 GCPRO1 (charset_list);
1677 charset_list_closure.charset_list = &charset_list;
1678 elisp_maphash (add_charset_to_list_mapper, Vcharset_hash_table,
1679 &charset_list_closure);
1682 return charset_list;
1685 DEFUN ("charset-name", Fcharset_name, 1, 1, 0, /*
1686 Return the name of the given charset.
1690 return XCHARSET_NAME (Fget_charset (charset));
1693 DEFUN ("make-charset", Fmake_charset, 3, 3, 0, /*
1694 Define a new character set.
1695 This function is for use with Mule support.
1696 NAME is a symbol, the name by which the character set is normally referred.
1697 DOC-STRING is a string describing the character set.
1698 PROPS is a property list, describing the specific nature of the
1699 character set. Recognized properties are:
1701 'short-name Short version of the charset name (ex: Latin-1)
1702 'long-name Long version of the charset name (ex: ISO8859-1 (Latin-1))
1703 'registry A regular expression matching the font registry field for
1705 'dimension Number of octets used to index a character in this charset.
1706 Either 1 or 2. Defaults to 1.
1707 'columns Number of columns used to display a character in this charset.
1708 Only used in TTY mode. (Under X, the actual width of a
1709 character can be derived from the font used to display the
1710 characters.) If unspecified, defaults to the dimension
1711 (this is almost always the correct value).
1712 'chars Number of characters in each dimension (94 or 96).
1713 Defaults to 94. Note that if the dimension is 2, the
1714 character set thus described is 94x94 or 96x96.
1715 'final Final byte of ISO 2022 escape sequence. Must be
1716 supplied. Each combination of (DIMENSION, CHARS) defines a
1717 separate namespace for final bytes. Note that ISO
1718 2022 restricts the final byte to the range
1719 0x30 - 0x7E if dimension == 1, and 0x30 - 0x5F if
1720 dimension == 2. Note also that final bytes in the range
1721 0x30 - 0x3F are reserved for user-defined (not official)
1723 'graphic 0 (use left half of font on output) or 1 (use right half
1724 of font on output). Defaults to 0. For example, for
1725 a font whose registry is ISO8859-1, the left half
1726 (octets 0x20 - 0x7F) is the `ascii' character set, while
1727 the right half (octets 0xA0 - 0xFF) is the `latin-1'
1728 character set. With 'graphic set to 0, the octets
1729 will have their high bit cleared; with it set to 1,
1730 the octets will have their high bit set.
1731 'direction 'l2r (left-to-right) or 'r2l (right-to-left).
1733 'ccl-program A compiled CCL program used to convert a character in
1734 this charset into an index into the font. This is in
1735 addition to the 'graphic property. The CCL program
1736 is passed the octets of the character, with the high
1737 bit cleared and set depending upon whether the value
1738 of the 'graphic property is 0 or 1.
1740 (name, doc_string, props))
1742 int id, dimension = 1, chars = 94, graphic = 0, final = 0, columns = -1;
1743 int direction = CHARSET_LEFT_TO_RIGHT;
1745 Lisp_Object registry = Qnil;
1746 Lisp_Object charset;
1747 Lisp_Object rest, keyword, value;
1748 Lisp_Object ccl_program = Qnil;
1749 Lisp_Object short_name = Qnil, long_name = Qnil;
1750 int byte_offset = -1;
1752 CHECK_SYMBOL (name);
1753 if (!NILP (doc_string))
1754 CHECK_STRING (doc_string);
1756 charset = Ffind_charset (name);
1757 if (!NILP (charset))
1758 signal_simple_error ("Cannot redefine existing charset", name);
1760 EXTERNAL_PROPERTY_LIST_LOOP (rest, keyword, value, props)
1762 if (EQ (keyword, Qshort_name))
1764 CHECK_STRING (value);
1768 if (EQ (keyword, Qlong_name))
1770 CHECK_STRING (value);
1774 else if (EQ (keyword, Qdimension))
1777 dimension = XINT (value);
1778 if (dimension < 1 || dimension > 2)
1779 signal_simple_error ("Invalid value for 'dimension", value);
1782 else if (EQ (keyword, Qchars))
1785 chars = XINT (value);
1786 if (chars != 94 && chars != 96)
1787 signal_simple_error ("Invalid value for 'chars", value);
1790 else if (EQ (keyword, Qcolumns))
1793 columns = XINT (value);
1794 if (columns != 1 && columns != 2)
1795 signal_simple_error ("Invalid value for 'columns", value);
1798 else if (EQ (keyword, Qgraphic))
1801 graphic = XINT (value);
1803 if (graphic < 0 || graphic > 2)
1805 if (graphic < 0 || graphic > 1)
1807 signal_simple_error ("Invalid value for 'graphic", value);
1810 else if (EQ (keyword, Qregistry))
1812 CHECK_STRING (value);
1816 else if (EQ (keyword, Qdirection))
1818 if (EQ (value, Ql2r))
1819 direction = CHARSET_LEFT_TO_RIGHT;
1820 else if (EQ (value, Qr2l))
1821 direction = CHARSET_RIGHT_TO_LEFT;
1823 signal_simple_error ("Invalid value for 'direction", value);
1826 else if (EQ (keyword, Qfinal))
1828 CHECK_CHAR_COERCE_INT (value);
1829 final = XCHAR (value);
1830 if (final < '0' || final > '~')
1831 signal_simple_error ("Invalid value for 'final", value);
1834 else if (EQ (keyword, Qccl_program))
1836 CHECK_VECTOR (value);
1837 ccl_program = value;
1841 signal_simple_error ("Unrecognized property", keyword);
1845 error ("'final must be specified");
1846 if (dimension == 2 && final > 0x5F)
1848 ("Final must be in the range 0x30 - 0x5F for dimension == 2",
1852 type = (chars == 94) ? CHARSET_TYPE_94 : CHARSET_TYPE_96;
1854 type = (chars == 94) ? CHARSET_TYPE_94X94 : CHARSET_TYPE_96X96;
1856 if (!NILP (CHARSET_BY_ATTRIBUTES (type, final, CHARSET_LEFT_TO_RIGHT)) ||
1857 !NILP (CHARSET_BY_ATTRIBUTES (type, final, CHARSET_RIGHT_TO_LEFT)))
1859 ("Character set already defined for this DIMENSION/CHARS/FINAL combo");
1861 id = get_unallocated_leading_byte (dimension);
1863 if (NILP (doc_string))
1864 doc_string = build_string ("");
1866 if (NILP (registry))
1867 registry = build_string ("");
1869 if (NILP (short_name))
1870 XSETSTRING (short_name, XSYMBOL (name)->name);
1872 if (NILP (long_name))
1873 long_name = doc_string;
1876 columns = dimension;
1878 if (byte_offset < 0)
1882 else if (chars == 96)
1888 charset = make_charset (id, name, type, columns, graphic,
1889 final, direction, short_name, long_name,
1890 doc_string, registry,
1891 Qnil, 0, 0, 0, byte_offset);
1892 if (!NILP (ccl_program))
1893 XCHARSET_CCL_PROGRAM (charset) = ccl_program;
1897 DEFUN ("make-reverse-direction-charset", Fmake_reverse_direction_charset,
1899 Make a charset equivalent to CHARSET but which goes in the opposite direction.
1900 NEW-NAME is the name of the new charset. Return the new charset.
1902 (charset, new_name))
1904 Lisp_Object new_charset = Qnil;
1905 int id, dimension, columns, graphic, final;
1906 int direction, type;
1907 Lisp_Object registry, doc_string, short_name, long_name;
1908 struct Lisp_Charset *cs;
1910 charset = Fget_charset (charset);
1911 if (!NILP (XCHARSET_REVERSE_DIRECTION_CHARSET (charset)))
1912 signal_simple_error ("Charset already has reverse-direction charset",
1915 CHECK_SYMBOL (new_name);
1916 if (!NILP (Ffind_charset (new_name)))
1917 signal_simple_error ("Cannot redefine existing charset", new_name);
1919 cs = XCHARSET (charset);
1921 type = CHARSET_TYPE (cs);
1922 columns = CHARSET_COLUMNS (cs);
1923 dimension = CHARSET_DIMENSION (cs);
1924 id = get_unallocated_leading_byte (dimension);
1926 graphic = CHARSET_GRAPHIC (cs);
1927 final = CHARSET_FINAL (cs);
1928 direction = CHARSET_RIGHT_TO_LEFT;
1929 if (CHARSET_DIRECTION (cs) == CHARSET_RIGHT_TO_LEFT)
1930 direction = CHARSET_LEFT_TO_RIGHT;
1931 doc_string = CHARSET_DOC_STRING (cs);
1932 short_name = CHARSET_SHORT_NAME (cs);
1933 long_name = CHARSET_LONG_NAME (cs);
1934 registry = CHARSET_REGISTRY (cs);
1936 new_charset = make_charset (id, new_name, type, columns,
1937 graphic, final, direction, short_name, long_name,
1938 doc_string, registry,
1940 CHARSET_DECODING_TABLE(cs),
1941 CHARSET_UCS_MIN(cs),
1942 CHARSET_UCS_MAX(cs),
1943 CHARSET_CODE_OFFSET(cs),
1944 CHARSET_BYTE_OFFSET(cs)
1950 CHARSET_REVERSE_DIRECTION_CHARSET (cs) = new_charset;
1951 XCHARSET_REVERSE_DIRECTION_CHARSET (new_charset) = charset;
1956 DEFUN ("define-charset-alias", Fdefine_charset_alias, 2, 2, 0, /*
1957 Define symbol ALIAS as an alias for CHARSET.
1961 CHECK_SYMBOL (alias);
1962 charset = Fget_charset (charset);
1963 return Fputhash (alias, charset, Vcharset_hash_table);
1966 /* #### Reverse direction charsets not yet implemented. */
1968 DEFUN ("charset-reverse-direction-charset", Fcharset_reverse_direction_charset,
1970 Return the reverse-direction charset parallel to CHARSET, if any.
1971 This is the charset with the same properties (in particular, the same
1972 dimension, number of characters per dimension, and final byte) as
1973 CHARSET but whose characters are displayed in the opposite direction.
1977 charset = Fget_charset (charset);
1978 return XCHARSET_REVERSE_DIRECTION_CHARSET (charset);
1982 DEFUN ("charset-from-attributes", Fcharset_from_attributes, 3, 4, 0, /*
1983 Return a charset with the given DIMENSION, CHARS, FINAL, and DIRECTION.
1984 If DIRECTION is omitted, both directions will be checked (left-to-right
1985 will be returned if character sets exist for both directions).
1987 (dimension, chars, final, direction))
1989 int dm, ch, fi, di = -1;
1991 Lisp_Object obj = Qnil;
1993 CHECK_INT (dimension);
1994 dm = XINT (dimension);
1995 if (dm < 1 || dm > 2)
1996 signal_simple_error ("Invalid value for DIMENSION", dimension);
2000 if (ch != 94 && ch != 96)
2001 signal_simple_error ("Invalid value for CHARS", chars);
2003 CHECK_CHAR_COERCE_INT (final);
2005 if (fi < '0' || fi > '~')
2006 signal_simple_error ("Invalid value for FINAL", final);
2008 if (EQ (direction, Ql2r))
2009 di = CHARSET_LEFT_TO_RIGHT;
2010 else if (EQ (direction, Qr2l))
2011 di = CHARSET_RIGHT_TO_LEFT;
2012 else if (!NILP (direction))
2013 signal_simple_error ("Invalid value for DIRECTION", direction);
2015 if (dm == 2 && fi > 0x5F)
2017 ("Final must be in the range 0x30 - 0x5F for dimension == 2", final);
2020 type = (ch == 94) ? CHARSET_TYPE_94 : CHARSET_TYPE_96;
2022 type = (ch == 94) ? CHARSET_TYPE_94X94 : CHARSET_TYPE_96X96;
2026 obj = CHARSET_BY_ATTRIBUTES (type, fi, CHARSET_LEFT_TO_RIGHT);
2028 obj = CHARSET_BY_ATTRIBUTES (type, fi, CHARSET_RIGHT_TO_LEFT);
2031 obj = CHARSET_BY_ATTRIBUTES (type, fi, di);
2034 return XCHARSET_NAME (obj);
2038 DEFUN ("charset-short-name", Fcharset_short_name, 1, 1, 0, /*
2039 Return short name of CHARSET.
2043 return XCHARSET_SHORT_NAME (Fget_charset (charset));
2046 DEFUN ("charset-long-name", Fcharset_long_name, 1, 1, 0, /*
2047 Return long name of CHARSET.
2051 return XCHARSET_LONG_NAME (Fget_charset (charset));
2054 DEFUN ("charset-description", Fcharset_description, 1, 1, 0, /*
2055 Return description of CHARSET.
2059 return XCHARSET_DOC_STRING (Fget_charset (charset));
2062 DEFUN ("charset-dimension", Fcharset_dimension, 1, 1, 0, /*
2063 Return dimension of CHARSET.
2067 return make_int (XCHARSET_DIMENSION (Fget_charset (charset)));
2070 DEFUN ("charset-property", Fcharset_property, 2, 2, 0, /*
2071 Return property PROP of CHARSET.
2072 Recognized properties are those listed in `make-charset', as well as
2073 'name and 'doc-string.
2077 struct Lisp_Charset *cs;
2079 charset = Fget_charset (charset);
2080 cs = XCHARSET (charset);
2082 CHECK_SYMBOL (prop);
2083 if (EQ (prop, Qname)) return CHARSET_NAME (cs);
2084 if (EQ (prop, Qshort_name)) return CHARSET_SHORT_NAME (cs);
2085 if (EQ (prop, Qlong_name)) return CHARSET_LONG_NAME (cs);
2086 if (EQ (prop, Qdoc_string)) return CHARSET_DOC_STRING (cs);
2087 if (EQ (prop, Qdimension)) return make_int (CHARSET_DIMENSION (cs));
2088 if (EQ (prop, Qcolumns)) return make_int (CHARSET_COLUMNS (cs));
2089 if (EQ (prop, Qgraphic)) return make_int (CHARSET_GRAPHIC (cs));
2090 if (EQ (prop, Qfinal)) return make_char (CHARSET_FINAL (cs));
2091 if (EQ (prop, Qchars)) return make_int (CHARSET_CHARS (cs));
2092 if (EQ (prop, Qregistry)) return CHARSET_REGISTRY (cs);
2093 if (EQ (prop, Qccl_program)) return CHARSET_CCL_PROGRAM (cs);
2094 if (EQ (prop, Qdirection))
2095 return CHARSET_DIRECTION (cs) == CHARSET_LEFT_TO_RIGHT ? Ql2r : Qr2l;
2096 if (EQ (prop, Qreverse_direction_charset))
2098 Lisp_Object obj = CHARSET_REVERSE_DIRECTION_CHARSET (cs);
2102 return XCHARSET_NAME (obj);
2104 signal_simple_error ("Unrecognized charset property name", prop);
2105 return Qnil; /* not reached */
2108 DEFUN ("charset-id", Fcharset_id, 1, 1, 0, /*
2109 Return charset identification number of CHARSET.
2113 return make_int(XCHARSET_LEADING_BYTE (Fget_charset (charset)));
2116 /* #### We need to figure out which properties we really want to
2119 DEFUN ("set-charset-ccl-program", Fset_charset_ccl_program, 2, 2, 0, /*
2120 Set the 'ccl-program property of CHARSET to CCL-PROGRAM.
2122 (charset, ccl_program))
2124 charset = Fget_charset (charset);
2125 CHECK_VECTOR (ccl_program);
2126 XCHARSET_CCL_PROGRAM (charset) = ccl_program;
2131 invalidate_charset_font_caches (Lisp_Object charset)
2133 /* Invalidate font cache entries for charset on all devices. */
2134 Lisp_Object devcons, concons, hash_table;
2135 DEVICE_LOOP_NO_BREAK (devcons, concons)
2137 struct device *d = XDEVICE (XCAR (devcons));
2138 hash_table = Fgethash (charset, d->charset_font_cache, Qunbound);
2139 if (!UNBOUNDP (hash_table))
2140 Fclrhash (hash_table);
2144 DEFUN ("set-charset-registry", Fset_charset_registry, 2, 2, 0, /*
2145 Set the 'registry property of CHARSET to REGISTRY.
2147 (charset, registry))
2149 charset = Fget_charset (charset);
2150 CHECK_STRING (registry);
2151 XCHARSET_REGISTRY (charset) = registry;
2152 invalidate_charset_font_caches (charset);
2153 face_property_was_changed (Vdefault_face, Qfont, Qglobal);
2158 DEFUN ("charset-mapping-table", Fcharset_mapping_table, 1, 1, 0, /*
2159 Return mapping-table of CHARSET.
2163 return XCHARSET_DECODING_TABLE (Fget_charset (charset));
2166 DEFUN ("set-charset-mapping-table", Fset_charset_mapping_table, 2, 2, 0, /*
2167 Set mapping-table of CHARSET to TABLE.
2171 struct Lisp_Charset *cs;
2172 Lisp_Object old_table;
2175 charset = Fget_charset (charset);
2176 cs = XCHARSET (charset);
2178 if (EQ (table, Qnil))
2180 CHARSET_DECODING_TABLE(cs) = table;
2183 else if (VECTORP (table))
2187 /* ad-hoc method for `ascii' */
2188 if ((CHARSET_CHARS (cs) == 94) &&
2189 (CHARSET_BYTE_OFFSET (cs) != 33))
2190 ccs_len = 128 - CHARSET_BYTE_OFFSET (cs);
2192 ccs_len = CHARSET_CHARS (cs);
2194 if (XVECTOR_LENGTH (table) > ccs_len)
2195 args_out_of_range (table, make_int (CHARSET_CHARS (cs)));
2196 old_table = CHARSET_DECODING_TABLE(cs);
2197 CHARSET_DECODING_TABLE(cs) = table;
2200 signal_error (Qwrong_type_argument,
2201 list2 (build_translated_string ("vector-or-nil-p"),
2203 /* signal_simple_error ("Wrong type argument: vector-or-nil-p", table); */
2205 switch (CHARSET_DIMENSION (cs))
2208 for (i = 0; i < XVECTOR_LENGTH (table); i++)
2210 Lisp_Object c = XVECTOR_DATA(table)[i];
2215 list1 (make_int (i + CHARSET_BYTE_OFFSET (cs))));
2219 for (i = 0; i < XVECTOR_LENGTH (table); i++)
2221 Lisp_Object v = XVECTOR_DATA(table)[i];
2227 if (XVECTOR_LENGTH (v) > CHARSET_CHARS (cs))
2229 CHARSET_DECODING_TABLE(cs) = old_table;
2230 args_out_of_range (v, make_int (CHARSET_CHARS (cs)));
2232 for (j = 0; j < XVECTOR_LENGTH (v); j++)
2234 Lisp_Object c = XVECTOR_DATA(v)[j];
2237 put_char_attribute (c, charset,
2240 (i + CHARSET_BYTE_OFFSET (cs)),
2242 (j + CHARSET_BYTE_OFFSET (cs))));
2246 put_char_attribute (v, charset,
2248 (make_int (i + CHARSET_BYTE_OFFSET (cs))));
2257 /************************************************************************/
2258 /* Lisp primitives for working with characters */
2259 /************************************************************************/
2261 DEFUN ("make-char", Fmake_char, 2, 3, 0, /*
2262 Make a character from CHARSET and octets ARG1 and ARG2.
2263 ARG2 is required only for characters from two-dimensional charsets.
2264 For example, (make-char 'latin-iso8859-2 185) will return the Latin 2
2265 character s with caron.
2267 (charset, arg1, arg2))
2269 struct Lisp_Charset *cs;
2271 int lowlim, highlim;
2273 charset = Fget_charset (charset);
2274 cs = XCHARSET (charset);
2276 if (EQ (charset, Vcharset_ascii)) lowlim = 0, highlim = 127;
2277 else if (EQ (charset, Vcharset_control_1)) lowlim = 0, highlim = 31;
2279 else if (CHARSET_CHARS (cs) == 256) lowlim = 0, highlim = 255;
2281 else if (CHARSET_CHARS (cs) == 94) lowlim = 33, highlim = 126;
2282 else /* CHARSET_CHARS (cs) == 96) */ lowlim = 32, highlim = 127;
2285 /* It is useful (and safe, according to Olivier Galibert) to strip
2286 the 8th bit off ARG1 and ARG2 becaue it allows programmers to
2287 write (make-char 'latin-iso8859-2 CODE) where code is the actual
2288 Latin 2 code of the character. */
2296 if (a1 < lowlim || a1 > highlim)
2297 args_out_of_range_3 (arg1, make_int (lowlim), make_int (highlim));
2299 if (CHARSET_DIMENSION (cs) == 1)
2303 ("Charset is of dimension one; second octet must be nil", arg2);
2304 return make_char (MAKE_CHAR (charset, a1, 0));
2313 a2 = XINT (arg2) & 0x7f;
2315 if (a2 < lowlim || a2 > highlim)
2316 args_out_of_range_3 (arg2, make_int (lowlim), make_int (highlim));
2318 return make_char (MAKE_CHAR (charset, a1, a2));
2321 DEFUN ("char-charset", Fchar_charset, 1, 1, 0, /*
2322 Return the character set of char CH.
2326 CHECK_CHAR_COERCE_INT (ch);
2328 return XCHARSET_NAME (CHAR_CHARSET (XCHAR (ch)));
2331 DEFUN ("split-char", Fsplit_char, 1, 1, 0, /*
2332 Return list of charset and one or two position-codes of CHAR.
2336 /* This function can GC */
2337 struct gcpro gcpro1, gcpro2;
2338 Lisp_Object charset = Qnil;
2339 Lisp_Object rc = Qnil;
2342 GCPRO2 (charset, rc);
2343 CHECK_CHAR_COERCE_INT (character);
2345 BREAKUP_CHAR (XCHAR (character), charset, c1, c2);
2347 if (XCHARSET_DIMENSION (Fget_charset (charset)) == 2)
2349 rc = list3 (XCHARSET_NAME (charset), make_int (c1), make_int (c2));
2353 rc = list2 (XCHARSET_NAME (charset), make_int (c1));
2361 #ifdef ENABLE_COMPOSITE_CHARS
2362 /************************************************************************/
2363 /* composite character functions */
2364 /************************************************************************/
2367 lookup_composite_char (Bufbyte *str, int len)
2369 Lisp_Object lispstr = make_string (str, len);
2370 Lisp_Object ch = Fgethash (lispstr,
2371 Vcomposite_char_string2char_hash_table,
2377 if (composite_char_row_next >= 128)
2378 signal_simple_error ("No more composite chars available", lispstr);
2379 emch = MAKE_CHAR (Vcharset_composite, composite_char_row_next,
2380 composite_char_col_next);
2381 Fputhash (make_char (emch), lispstr,
2382 Vcomposite_char_char2string_hash_table);
2383 Fputhash (lispstr, make_char (emch),
2384 Vcomposite_char_string2char_hash_table);
2385 composite_char_col_next++;
2386 if (composite_char_col_next >= 128)
2388 composite_char_col_next = 32;
2389 composite_char_row_next++;
2398 composite_char_string (Emchar ch)
2400 Lisp_Object str = Fgethash (make_char (ch),
2401 Vcomposite_char_char2string_hash_table,
2403 assert (!UNBOUNDP (str));
2407 xxDEFUN ("make-composite-char", Fmake_composite_char, 1, 1, 0, /*
2408 Convert a string into a single composite character.
2409 The character is the result of overstriking all the characters in
2414 CHECK_STRING (string);
2415 return make_char (lookup_composite_char (XSTRING_DATA (string),
2416 XSTRING_LENGTH (string)));
2419 xxDEFUN ("composite-char-string", Fcomposite_char_string, 1, 1, 0, /*
2420 Return a string of the characters comprising a composite character.
2428 if (CHAR_LEADING_BYTE (emch) != LEADING_BYTE_COMPOSITE)
2429 signal_simple_error ("Must be composite char", ch);
2430 return composite_char_string (emch);
2432 #endif /* ENABLE_COMPOSITE_CHARS */
2435 /************************************************************************/
2436 /* initialization */
2437 /************************************************************************/
2440 syms_of_mule_charset (void)
2442 DEFSUBR (Fcharsetp);
2443 DEFSUBR (Ffind_charset);
2444 DEFSUBR (Fget_charset);
2445 DEFSUBR (Fcharset_list);
2446 DEFSUBR (Fcharset_name);
2447 DEFSUBR (Fmake_charset);
2448 DEFSUBR (Fmake_reverse_direction_charset);
2449 /* DEFSUBR (Freverse_direction_charset); */
2450 DEFSUBR (Fdefine_charset_alias);
2451 DEFSUBR (Fcharset_from_attributes);
2452 DEFSUBR (Fcharset_short_name);
2453 DEFSUBR (Fcharset_long_name);
2454 DEFSUBR (Fcharset_description);
2455 DEFSUBR (Fcharset_dimension);
2456 DEFSUBR (Fcharset_property);
2457 DEFSUBR (Fcharset_id);
2458 DEFSUBR (Fset_charset_ccl_program);
2459 DEFSUBR (Fset_charset_registry);
2461 DEFSUBR (Fchar_attribute_alist);
2462 DEFSUBR (Fget_char_attribute);
2463 DEFSUBR (Fput_char_attribute);
2464 DEFSUBR (Fdefine_char);
2465 DEFSUBR (Fchar_variants);
2466 DEFSUBR (Fget_composite_char);
2467 DEFSUBR (Fcharset_mapping_table);
2468 DEFSUBR (Fset_charset_mapping_table);
2471 DEFSUBR (Fmake_char);
2472 DEFSUBR (Fchar_charset);
2473 DEFSUBR (Fsplit_char);
2475 #ifdef ENABLE_COMPOSITE_CHARS
2476 DEFSUBR (Fmake_composite_char);
2477 DEFSUBR (Fcomposite_char_string);
2480 defsymbol (&Qcharsetp, "charsetp");
2481 defsymbol (&Qregistry, "registry");
2482 defsymbol (&Qfinal, "final");
2483 defsymbol (&Qgraphic, "graphic");
2484 defsymbol (&Qdirection, "direction");
2485 defsymbol (&Qreverse_direction_charset, "reverse-direction-charset");
2486 defsymbol (&Qshort_name, "short-name");
2487 defsymbol (&Qlong_name, "long-name");
2489 defsymbol (&Ql2r, "l2r");
2490 defsymbol (&Qr2l, "r2l");
2492 /* Charsets, compatible with FSF 20.3
2493 Naming convention is Script-Charset[-Edition] */
2494 defsymbol (&Qascii, "ascii");
2495 defsymbol (&Qcontrol_1, "control-1");
2496 defsymbol (&Qlatin_iso8859_1, "latin-iso8859-1");
2497 defsymbol (&Qlatin_iso8859_2, "latin-iso8859-2");
2498 defsymbol (&Qlatin_iso8859_3, "latin-iso8859-3");
2499 defsymbol (&Qlatin_iso8859_4, "latin-iso8859-4");
2500 defsymbol (&Qthai_tis620, "thai-tis620");
2501 defsymbol (&Qgreek_iso8859_7, "greek-iso8859-7");
2502 defsymbol (&Qarabic_iso8859_6, "arabic-iso8859-6");
2503 defsymbol (&Qhebrew_iso8859_8, "hebrew-iso8859-8");
2504 defsymbol (&Qkatakana_jisx0201, "katakana-jisx0201");
2505 defsymbol (&Qlatin_jisx0201, "latin-jisx0201");
2506 defsymbol (&Qcyrillic_iso8859_5, "cyrillic-iso8859-5");
2507 defsymbol (&Qlatin_iso8859_9, "latin-iso8859-9");
2508 defsymbol (&Qjapanese_jisx0208_1978, "japanese-jisx0208-1978");
2509 defsymbol (&Qchinese_gb2312, "chinese-gb2312");
2510 defsymbol (&Qjapanese_jisx0208, "japanese-jisx0208");
2511 defsymbol (&Qkorean_ksc5601, "korean-ksc5601");
2512 defsymbol (&Qjapanese_jisx0212, "japanese-jisx0212");
2513 defsymbol (&Qchinese_cns11643_1, "chinese-cns11643-1");
2514 defsymbol (&Qchinese_cns11643_2, "chinese-cns11643-2");
2516 defsymbol (&Q_ucs, "->ucs");
2517 defsymbol (&Q_decomposition, "->decomposition");
2518 defsymbol (&Qcompat, "compat");
2519 defsymbol (&QnoBreak, "noBreak");
2520 defsymbol (&Qfraction, "fraction");
2521 defsymbol (&Qsuper, "super");
2522 defsymbol (&Qsub, "sub");
2523 defsymbol (&Qcircle, "circle");
2524 defsymbol (&Qsquare, "square");
2525 defsymbol (&Qwide, "wide");
2526 defsymbol (&Qnarrow, "narrow");
2527 defsymbol (&Qfont, "font");
2528 defsymbol (&Qucs, "ucs");
2529 defsymbol (&Qucs_bmp, "ucs-bmp");
2530 defsymbol (&Qlatin_viscii, "latin-viscii");
2531 defsymbol (&Qlatin_viscii_lower, "latin-viscii-lower");
2532 defsymbol (&Qlatin_viscii_upper, "latin-viscii-upper");
2533 defsymbol (&Qvietnamese_viscii_lower, "vietnamese-viscii-lower");
2534 defsymbol (&Qvietnamese_viscii_upper, "vietnamese-viscii-upper");
2535 defsymbol (&Qethiopic_ucs, "ethiopic-ucs");
2536 defsymbol (&Qhiragana_jisx0208, "hiragana-jisx0208");
2537 defsymbol (&Qkatakana_jisx0208, "katakana-jisx0208");
2539 defsymbol (&Qchinese_big5_1, "chinese-big5-1");
2540 defsymbol (&Qchinese_big5_2, "chinese-big5-2");
2542 defsymbol (&Qcomposite, "composite");
2546 vars_of_mule_charset (void)
2553 /* Table of charsets indexed by leading byte. */
2554 for (i = 0; i < countof (charset_by_leading_byte); i++)
2555 charset_by_leading_byte[i] = Qnil;
2558 /* Table of charsets indexed by type/final-byte. */
2559 for (i = 0; i < countof (charset_by_attributes); i++)
2560 for (j = 0; j < countof (charset_by_attributes[0]); j++)
2561 charset_by_attributes[i][j] = Qnil;
2563 /* Table of charsets indexed by type/final-byte/direction. */
2564 for (i = 0; i < countof (charset_by_attributes); i++)
2565 for (j = 0; j < countof (charset_by_attributes[0]); j++)
2566 for (k = 0; k < countof (charset_by_attributes[0][0]); k++)
2567 charset_by_attributes[i][j][k] = Qnil;
2571 next_allocated_leading_byte = MIN_LEADING_BYTE_PRIVATE;
2573 next_allocated_1_byte_leading_byte = MIN_LEADING_BYTE_PRIVATE_1;
2574 next_allocated_2_byte_leading_byte = MIN_LEADING_BYTE_PRIVATE_2;
2578 leading_code_private_11 = PRE_LEADING_BYTE_PRIVATE_1;
2579 DEFVAR_INT ("leading-code-private-11", &leading_code_private_11 /*
2580 Leading-code of private TYPE9N charset of column-width 1.
2582 leading_code_private_11 = PRE_LEADING_BYTE_PRIVATE_1;
2586 Vutf_2000_version = build_string("0.12 (Kashiwara)");
2587 DEFVAR_LISP ("utf-2000-version", &Vutf_2000_version /*
2588 Version number of UTF-2000.
2591 staticpro (&Vcharacter_attribute_table);
2592 Vcharacter_attribute_table = make_char_code_table (Qnil);
2594 staticpro (&Vcharacter_composition_table);
2595 Vcharacter_composition_table = make_char_code_table (Qnil);
2597 staticpro (&Vcharacter_variant_table);
2598 Vcharacter_variant_table = make_char_code_table (Qnil);
2600 Vdefault_coded_charset_priority_list = Qnil;
2601 DEFVAR_LISP ("default-coded-charset-priority-list",
2602 &Vdefault_coded_charset_priority_list /*
2603 Default order of preferred coded-character-sets.
2609 complex_vars_of_mule_charset (void)
2611 staticpro (&Vcharset_hash_table);
2612 Vcharset_hash_table =
2613 make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
2615 /* Predefined character sets. We store them into variables for
2620 make_charset (LEADING_BYTE_UCS_BMP, Qucs_bmp,
2621 CHARSET_TYPE_256X256, 1, 2, 0,
2622 CHARSET_LEFT_TO_RIGHT,
2623 build_string ("BMP"),
2624 build_string ("BMP"),
2625 build_string ("ISO/IEC 10646 Group 0 Plane 0 (BMP)"),
2626 build_string ("\\(ISO10646.*-1\\|UNICODE[23]?-0\\)"),
2627 Qnil, 0, 0xFFFF, 0, 0);
2629 # define MIN_CHAR_THAI 0
2630 # define MAX_CHAR_THAI 0
2631 # define MIN_CHAR_GREEK 0
2632 # define MAX_CHAR_GREEK 0
2633 # define MIN_CHAR_HEBREW 0
2634 # define MAX_CHAR_HEBREW 0
2635 # define MIN_CHAR_HALFWIDTH_KATAKANA 0
2636 # define MAX_CHAR_HALFWIDTH_KATAKANA 0
2637 # define MIN_CHAR_CYRILLIC 0
2638 # define MAX_CHAR_CYRILLIC 0
2641 make_charset (LEADING_BYTE_ASCII, Qascii,
2642 CHARSET_TYPE_94, 1, 0, 'B',
2643 CHARSET_LEFT_TO_RIGHT,
2644 build_string ("ASCII"),
2645 build_string ("ASCII)"),
2646 build_string ("ASCII (ISO646 IRV)"),
2647 build_string ("\\(iso8859-[0-9]*\\|-ascii\\)"),
2648 Qnil, 0, 0x7F, 0, 0);
2649 Vcharset_control_1 =
2650 make_charset (LEADING_BYTE_CONTROL_1, Qcontrol_1,
2651 CHARSET_TYPE_94, 1, 1, 0,
2652 CHARSET_LEFT_TO_RIGHT,
2653 build_string ("C1"),
2654 build_string ("Control characters"),
2655 build_string ("Control characters 128-191"),
2657 Qnil, 0x80, 0x9F, 0, 0);
2658 Vcharset_latin_iso8859_1 =
2659 make_charset (LEADING_BYTE_LATIN_ISO8859_1, Qlatin_iso8859_1,
2660 CHARSET_TYPE_96, 1, 1, 'A',
2661 CHARSET_LEFT_TO_RIGHT,
2662 build_string ("Latin-1"),
2663 build_string ("ISO8859-1 (Latin-1)"),
2664 build_string ("ISO8859-1 (Latin-1)"),
2665 build_string ("iso8859-1"),
2666 Qnil, 0xA0, 0xFF, 0, 32);
2667 Vcharset_latin_iso8859_2 =
2668 make_charset (LEADING_BYTE_LATIN_ISO8859_2, Qlatin_iso8859_2,
2669 CHARSET_TYPE_96, 1, 1, 'B',
2670 CHARSET_LEFT_TO_RIGHT,
2671 build_string ("Latin-2"),
2672 build_string ("ISO8859-2 (Latin-2)"),
2673 build_string ("ISO8859-2 (Latin-2)"),
2674 build_string ("iso8859-2"),
2676 Vcharset_latin_iso8859_3 =
2677 make_charset (LEADING_BYTE_LATIN_ISO8859_3, Qlatin_iso8859_3,
2678 CHARSET_TYPE_96, 1, 1, 'C',
2679 CHARSET_LEFT_TO_RIGHT,
2680 build_string ("Latin-3"),
2681 build_string ("ISO8859-3 (Latin-3)"),
2682 build_string ("ISO8859-3 (Latin-3)"),
2683 build_string ("iso8859-3"),
2685 Vcharset_latin_iso8859_4 =
2686 make_charset (LEADING_BYTE_LATIN_ISO8859_4, Qlatin_iso8859_4,
2687 CHARSET_TYPE_96, 1, 1, 'D',
2688 CHARSET_LEFT_TO_RIGHT,
2689 build_string ("Latin-4"),
2690 build_string ("ISO8859-4 (Latin-4)"),
2691 build_string ("ISO8859-4 (Latin-4)"),
2692 build_string ("iso8859-4"),
2694 Vcharset_thai_tis620 =
2695 make_charset (LEADING_BYTE_THAI_TIS620, Qthai_tis620,
2696 CHARSET_TYPE_96, 1, 1, 'T',
2697 CHARSET_LEFT_TO_RIGHT,
2698 build_string ("TIS620"),
2699 build_string ("TIS620 (Thai)"),
2700 build_string ("TIS620.2529 (Thai)"),
2701 build_string ("tis620"),
2702 Qnil, MIN_CHAR_THAI, MAX_CHAR_THAI, 0, 32);
2703 Vcharset_greek_iso8859_7 =
2704 make_charset (LEADING_BYTE_GREEK_ISO8859_7, Qgreek_iso8859_7,
2705 CHARSET_TYPE_96, 1, 1, 'F',
2706 CHARSET_LEFT_TO_RIGHT,
2707 build_string ("ISO8859-7"),
2708 build_string ("ISO8859-7 (Greek)"),
2709 build_string ("ISO8859-7 (Greek)"),
2710 build_string ("iso8859-7"),
2711 Qnil, MIN_CHAR_GREEK, MAX_CHAR_GREEK, 0, 32);
2712 Vcharset_arabic_iso8859_6 =
2713 make_charset (LEADING_BYTE_ARABIC_ISO8859_6, Qarabic_iso8859_6,
2714 CHARSET_TYPE_96, 1, 1, 'G',
2715 CHARSET_RIGHT_TO_LEFT,
2716 build_string ("ISO8859-6"),
2717 build_string ("ISO8859-6 (Arabic)"),
2718 build_string ("ISO8859-6 (Arabic)"),
2719 build_string ("iso8859-6"),
2721 Vcharset_hebrew_iso8859_8 =
2722 make_charset (LEADING_BYTE_HEBREW_ISO8859_8, Qhebrew_iso8859_8,
2723 CHARSET_TYPE_96, 1, 1, 'H',
2724 CHARSET_RIGHT_TO_LEFT,
2725 build_string ("ISO8859-8"),
2726 build_string ("ISO8859-8 (Hebrew)"),
2727 build_string ("ISO8859-8 (Hebrew)"),
2728 build_string ("iso8859-8"),
2729 Qnil, MIN_CHAR_HEBREW, MAX_CHAR_HEBREW, 0, 32);
2730 Vcharset_katakana_jisx0201 =
2731 make_charset (LEADING_BYTE_KATAKANA_JISX0201, Qkatakana_jisx0201,
2732 CHARSET_TYPE_94, 1, 1, 'I',
2733 CHARSET_LEFT_TO_RIGHT,
2734 build_string ("JISX0201 Kana"),
2735 build_string ("JISX0201.1976 (Japanese Kana)"),
2736 build_string ("JISX0201.1976 Japanese Kana"),
2737 build_string ("jisx0201\\.1976"),
2739 MIN_CHAR_HALFWIDTH_KATAKANA,
2740 MAX_CHAR_HALFWIDTH_KATAKANA, 0, 33);
2741 Vcharset_latin_jisx0201 =
2742 make_charset (LEADING_BYTE_LATIN_JISX0201, Qlatin_jisx0201,
2743 CHARSET_TYPE_94, 1, 0, 'J',
2744 CHARSET_LEFT_TO_RIGHT,
2745 build_string ("JISX0201 Roman"),
2746 build_string ("JISX0201.1976 (Japanese Roman)"),
2747 build_string ("JISX0201.1976 Japanese Roman"),
2748 build_string ("jisx0201\\.1976"),
2750 Vcharset_cyrillic_iso8859_5 =
2751 make_charset (LEADING_BYTE_CYRILLIC_ISO8859_5, Qcyrillic_iso8859_5,
2752 CHARSET_TYPE_96, 1, 1, 'L',
2753 CHARSET_LEFT_TO_RIGHT,
2754 build_string ("ISO8859-5"),
2755 build_string ("ISO8859-5 (Cyrillic)"),
2756 build_string ("ISO8859-5 (Cyrillic)"),
2757 build_string ("iso8859-5"),
2758 Qnil, MIN_CHAR_CYRILLIC, MAX_CHAR_CYRILLIC, 0, 32);
2759 Vcharset_latin_iso8859_9 =
2760 make_charset (LEADING_BYTE_LATIN_ISO8859_9, Qlatin_iso8859_9,
2761 CHARSET_TYPE_96, 1, 1, 'M',
2762 CHARSET_LEFT_TO_RIGHT,
2763 build_string ("Latin-5"),
2764 build_string ("ISO8859-9 (Latin-5)"),
2765 build_string ("ISO8859-9 (Latin-5)"),
2766 build_string ("iso8859-9"),
2768 Vcharset_japanese_jisx0208_1978 =
2769 make_charset (LEADING_BYTE_JAPANESE_JISX0208_1978, Qjapanese_jisx0208_1978,
2770 CHARSET_TYPE_94X94, 2, 0, '@',
2771 CHARSET_LEFT_TO_RIGHT,
2772 build_string ("JIS X0208:1978"),
2773 build_string ("JIS X0208:1978 (Japanese)"),
2775 ("JIS X0208:1978 Japanese Kanji (so called \"old JIS\")"),
2776 build_string ("\\(jisx0208\\|jisc6226\\)\\.1978"),
2778 Vcharset_chinese_gb2312 =
2779 make_charset (LEADING_BYTE_CHINESE_GB2312, Qchinese_gb2312,
2780 CHARSET_TYPE_94X94, 2, 0, 'A',
2781 CHARSET_LEFT_TO_RIGHT,
2782 build_string ("GB2312"),
2783 build_string ("GB2312)"),
2784 build_string ("GB2312 Chinese simplified"),
2785 build_string ("gb2312"),
2787 Vcharset_japanese_jisx0208 =
2788 make_charset (LEADING_BYTE_JAPANESE_JISX0208, Qjapanese_jisx0208,
2789 CHARSET_TYPE_94X94, 2, 0, 'B',
2790 CHARSET_LEFT_TO_RIGHT,
2791 build_string ("JISX0208"),
2792 build_string ("JIS X0208:1983 (Japanese)"),
2793 build_string ("JIS X0208:1983 Japanese Kanji"),
2794 build_string ("jisx0208\\.1983"),
2796 Vcharset_korean_ksc5601 =
2797 make_charset (LEADING_BYTE_KOREAN_KSC5601, Qkorean_ksc5601,
2798 CHARSET_TYPE_94X94, 2, 0, 'C',
2799 CHARSET_LEFT_TO_RIGHT,
2800 build_string ("KSC5601"),
2801 build_string ("KSC5601 (Korean"),
2802 build_string ("KSC5601 Korean Hangul and Hanja"),
2803 build_string ("ksc5601"),
2805 Vcharset_japanese_jisx0212 =
2806 make_charset (LEADING_BYTE_JAPANESE_JISX0212, Qjapanese_jisx0212,
2807 CHARSET_TYPE_94X94, 2, 0, 'D',
2808 CHARSET_LEFT_TO_RIGHT,
2809 build_string ("JISX0212"),
2810 build_string ("JISX0212 (Japanese)"),
2811 build_string ("JISX0212 Japanese Supplement"),
2812 build_string ("jisx0212"),
2815 #define CHINESE_CNS_PLANE_RE(n) "cns11643[.-]\\(.*[.-]\\)?" n "$"
2816 Vcharset_chinese_cns11643_1 =
2817 make_charset (LEADING_BYTE_CHINESE_CNS11643_1, Qchinese_cns11643_1,
2818 CHARSET_TYPE_94X94, 2, 0, 'G',
2819 CHARSET_LEFT_TO_RIGHT,
2820 build_string ("CNS11643-1"),
2821 build_string ("CNS11643-1 (Chinese traditional)"),
2823 ("CNS 11643 Plane 1 Chinese traditional"),
2824 build_string (CHINESE_CNS_PLANE_RE("1")),
2826 Vcharset_chinese_cns11643_2 =
2827 make_charset (LEADING_BYTE_CHINESE_CNS11643_2, Qchinese_cns11643_2,
2828 CHARSET_TYPE_94X94, 2, 0, 'H',
2829 CHARSET_LEFT_TO_RIGHT,
2830 build_string ("CNS11643-2"),
2831 build_string ("CNS11643-2 (Chinese traditional)"),
2833 ("CNS 11643 Plane 2 Chinese traditional"),
2834 build_string (CHINESE_CNS_PLANE_RE("2")),
2837 Vcharset_latin_viscii_lower =
2838 make_charset (LEADING_BYTE_LATIN_VISCII_LOWER, Qlatin_viscii_lower,
2839 CHARSET_TYPE_96, 1, 1, '1',
2840 CHARSET_LEFT_TO_RIGHT,
2841 build_string ("VISCII lower"),
2842 build_string ("VISCII lower (Vietnamese)"),
2843 build_string ("VISCII lower (Vietnamese)"),
2844 build_string ("MULEVISCII-LOWER"),
2846 Vcharset_latin_viscii_upper =
2847 make_charset (LEADING_BYTE_LATIN_VISCII_UPPER, Qlatin_viscii_upper,
2848 CHARSET_TYPE_96, 1, 1, '2',
2849 CHARSET_LEFT_TO_RIGHT,
2850 build_string ("VISCII upper"),
2851 build_string ("VISCII upper (Vietnamese)"),
2852 build_string ("VISCII upper (Vietnamese)"),
2853 build_string ("MULEVISCII-UPPER"),
2855 Vcharset_latin_viscii =
2856 make_charset (LEADING_BYTE_LATIN_VISCII, Qlatin_viscii,
2857 CHARSET_TYPE_256, 1, 2, 0,
2858 CHARSET_LEFT_TO_RIGHT,
2859 build_string ("VISCII"),
2860 build_string ("VISCII 1.1 (Vietnamese)"),
2861 build_string ("VISCII 1.1 (Vietnamese)"),
2862 build_string ("VISCII1\\.1"),
2864 Vcharset_ethiopic_ucs =
2865 make_charset (LEADING_BYTE_ETHIOPIC_UCS, Qethiopic_ucs,
2866 CHARSET_TYPE_256X256, 2, 2, 0,
2867 CHARSET_LEFT_TO_RIGHT,
2868 build_string ("Ethiopic (UCS)"),
2869 build_string ("Ethiopic (UCS)"),
2870 build_string ("Ethiopic of UCS"),
2871 build_string ("Ethiopic-Unicode"),
2872 Qnil, 0x1200, 0x137F, 0x1200, 0);
2873 Vcharset_hiragana_jisx0208 =
2874 make_charset (LEADING_BYTE_HIRAGANA_JISX0208, Qhiragana_jisx0208,
2875 CHARSET_TYPE_94X94, 2, 0, 'B',
2876 CHARSET_LEFT_TO_RIGHT,
2877 build_string ("Hiragana"),
2878 build_string ("Hiragana of JIS X0208"),
2879 build_string ("Japanese Hiragana of JIS X0208"),
2880 build_string ("jisx0208\\.19\\(78\\|83\\|90\\)"),
2881 Qnil, MIN_CHAR_HIRAGANA, MAX_CHAR_HIRAGANA,
2882 (0x24 - 33) * 94 + (0x21 - 33), 33);
2883 Vcharset_katakana_jisx0208 =
2884 make_charset (LEADING_BYTE_KATAKANA_JISX0208, Qkatakana_jisx0208,
2885 CHARSET_TYPE_94X94, 2, 0, 'B',
2886 CHARSET_LEFT_TO_RIGHT,
2887 build_string ("Katakana"),
2888 build_string ("Katakana of JIS X0208"),
2889 build_string ("Japanese Katakana of JIS X0208"),
2890 build_string ("jisx0208\\.19\\(78\\|83\\|90\\)"),
2891 Qnil, MIN_CHAR_KATAKANA, MAX_CHAR_KATAKANA,
2892 (0x25 - 33) * 94 + (0x21 - 33), 33);
2894 Vcharset_chinese_big5_1 =
2895 make_charset (LEADING_BYTE_CHINESE_BIG5_1, Qchinese_big5_1,
2896 CHARSET_TYPE_94X94, 2, 0, '0',
2897 CHARSET_LEFT_TO_RIGHT,
2898 build_string ("Big5"),
2899 build_string ("Big5 (Level-1)"),
2901 ("Big5 Level-1 Chinese traditional"),
2902 build_string ("big5"),
2904 Vcharset_chinese_big5_2 =
2905 make_charset (LEADING_BYTE_CHINESE_BIG5_2, Qchinese_big5_2,
2906 CHARSET_TYPE_94X94, 2, 0, '1',
2907 CHARSET_LEFT_TO_RIGHT,
2908 build_string ("Big5"),
2909 build_string ("Big5 (Level-2)"),
2911 ("Big5 Level-2 Chinese traditional"),
2912 build_string ("big5"),
2915 #ifdef ENABLE_COMPOSITE_CHARS
2916 /* #### For simplicity, we put composite chars into a 96x96 charset.
2917 This is going to lead to problems because you can run out of
2918 room, esp. as we don't yet recycle numbers. */
2919 Vcharset_composite =
2920 make_charset (LEADING_BYTE_COMPOSITE, Qcomposite,
2921 CHARSET_TYPE_96X96, 2, 0, 0,
2922 CHARSET_LEFT_TO_RIGHT,
2923 build_string ("Composite"),
2924 build_string ("Composite characters"),
2925 build_string ("Composite characters"),
2928 composite_char_row_next = 32;
2929 composite_char_col_next = 32;
2931 Vcomposite_char_string2char_hash_table =
2932 make_lisp_hash_table (500, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL);
2933 Vcomposite_char_char2string_hash_table =
2934 make_lisp_hash_table (500, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
2935 staticpro (&Vcomposite_char_string2char_hash_table);
2936 staticpro (&Vcomposite_char_char2string_hash_table);
2937 #endif /* ENABLE_COMPOSITE_CHARS */