1 /* Basic character set support.
2 Copyright (C) 2001-2012 Free Software Foundation, Inc.
3 Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 2005, 2006, 2007, 2008, 2009, 2010, 2011
5 National Institute of Advanced Industrial Science and Technology (AIST)
6 Registration Number H14PRO021
8 Copyright (C) 2003, 2004
9 National Institute of Advanced Industrial Science and Technology (AIST)
10 Registration Number H13PRO009
12 This file is part of GNU Emacs.
14 GNU Emacs is free software: you can redistribute it and/or modify
15 it under the terms of the GNU General Public License as published by
16 the Free Software Foundation, either version 3 of the License, or
17 (at your option) any later version.
19 GNU Emacs is distributed in the hope that it will be useful,
20 but WITHOUT ANY WARRANTY; without even the implied warranty of
21 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 GNU General Public License for more details.
24 You should have received a copy of the GNU General Public License
25 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
33 #include <sys/types.h>
36 #include "character.h"
42 /*** GENERAL NOTES on CODED CHARACTER SETS (CHARSETS) ***
44 A coded character set ("charset" hereafter) is a meaningful
45 collection (i.e. language, culture, functionality, etc.) of
46 characters. Emacs handles multiple charsets at once. In Emacs Lisp
47 code, a charset is represented by a symbol. In C code, a charset is
48 represented by its ID number or by a pointer to a struct charset.
50 The actual information about each charset is stored in two places.
51 Lispy information is stored in the hash table Vcharset_hash_table as
52 a vector (charset attributes). The other information is stored in
53 charset_table as a struct charset.
57 /* Hash table that contains attributes of each charset. Keys are
58 charset symbols, and values are vectors of charset attributes. */
59 Lisp_Object Vcharset_hash_table
;
61 /* Table of struct charset. */
62 struct charset
*charset_table
;
64 static ptrdiff_t charset_table_size
;
65 static int charset_table_used
;
67 Lisp_Object Qcharsetp
;
69 /* Special charset symbols. */
71 static Lisp_Object Qeight_bit
;
72 static Lisp_Object Qiso_8859_1
;
73 static Lisp_Object Qunicode
;
74 static Lisp_Object Qemacs
;
76 /* The corresponding charsets. */
78 int charset_eight_bit
;
79 static int charset_iso_8859_1
;
81 static int charset_emacs
;
83 /* The other special charsets. */
84 int charset_jisx0201_roman
;
85 int charset_jisx0208_1978
;
89 /* Value of charset attribute `charset-iso-plane'. */
90 static Lisp_Object Qgl
, Qgr
;
92 /* Charset of unibyte characters. */
95 /* List of charsets ordered by the priority. */
96 Lisp_Object Vcharset_ordered_list
;
98 /* Sub-list of Vcharset_ordered_list that contains all non-preferred
100 Lisp_Object Vcharset_non_preferred_head
;
102 /* Incremented everytime we change Vcharset_ordered_list. This is
103 unsigned short so that it fits in Lisp_Int and never matches
105 unsigned short charset_ordered_list_tick
;
107 /* List of iso-2022 charsets. */
108 Lisp_Object Viso_2022_charset_list
;
110 /* List of emacs-mule charsets. */
111 Lisp_Object Vemacs_mule_charset_list
;
113 int emacs_mule_charset
[256];
115 /* Mapping table from ISO2022's charset (specified by DIMENSION,
116 CHARS, and FINAL-CHAR) to Emacs' charset. */
117 int iso_charset_table
[ISO_MAX_DIMENSION
][ISO_MAX_CHARS
][ISO_MAX_FINAL
];
119 #define CODE_POINT_TO_INDEX(charset, code) \
120 ((charset)->code_linear_p \
121 ? (int) ((code) - (charset)->min_code) \
122 : (((charset)->code_space_mask[(code) >> 24] & 0x8) \
123 && ((charset)->code_space_mask[((code) >> 16) & 0xFF] & 0x4) \
124 && ((charset)->code_space_mask[((code) >> 8) & 0xFF] & 0x2) \
125 && ((charset)->code_space_mask[(code) & 0xFF] & 0x1)) \
126 ? (int) (((((code) >> 24) - (charset)->code_space[12]) \
127 * (charset)->code_space[11]) \
128 + (((((code) >> 16) & 0xFF) - (charset)->code_space[8]) \
129 * (charset)->code_space[7]) \
130 + (((((code) >> 8) & 0xFF) - (charset)->code_space[4]) \
131 * (charset)->code_space[3]) \
132 + (((code) & 0xFF) - (charset)->code_space[0]) \
133 - ((charset)->char_index_offset)) \
137 /* Return the code-point for the character index IDX in CHARSET.
138 IDX should be an unsigned int variable in a valid range (which is
139 always in nonnegative int range too). IDX contains garbage afterwards. */
141 #define INDEX_TO_CODE_POINT(charset, idx) \
142 ((charset)->code_linear_p \
143 ? (idx) + (charset)->min_code \
144 : (idx += (charset)->char_index_offset, \
145 (((charset)->code_space[0] + (idx) % (charset)->code_space[2]) \
146 | (((charset)->code_space[4] \
147 + ((idx) / (charset)->code_space[3] % (charset)->code_space[6])) \
149 | (((charset)->code_space[8] \
150 + ((idx) / (charset)->code_space[7] % (charset)->code_space[10])) \
152 | (((charset)->code_space[12] + ((idx) / (charset)->code_space[11])) \
155 /* Structure to hold mapping tables for a charset. Used by temacs
156 invoked for dumping. */
160 /* The current charset for which the following tables are setup. */
161 struct charset
*current
;
163 /* 1 iff the following table is used for encoder. */
166 /* When the following table is used for encoding, minimum and
167 maximum character of the current charset. */
168 int min_char
, max_char
;
170 /* A Unicode character corresponding to the code index 0 (i.e. the
171 minimum code-point) of the current charset, or -1 if the code
172 index 0 is not a Unicode character. This is checked when
173 table.encoder[CHAR] is zero. */
177 /* Table mapping code-indices (not code-points) of the current
178 charset to Unicode characters. If decoder[CHAR] is -1, CHAR
179 doesn't belong to the current charset. */
180 int decoder
[0x10000];
181 /* Table mapping Unicode characters to code-indices of the current
182 charset. The first 0x10000 elements are for BMP (0..0xFFFF),
183 and the last 0x10000 are for SMP (0x10000..0x1FFFF) or SIP
184 (0x20000..0x2FFFF). Note that there is no charset map that
185 uses both SMP and SIP. */
186 unsigned short encoder
[0x20000];
188 } *temp_charset_work
;
190 #define SET_TEMP_CHARSET_WORK_ENCODER(C, CODE) \
193 temp_charset_work->zero_index_char = (C); \
194 else if ((C) < 0x20000) \
195 temp_charset_work->table.encoder[(C)] = (CODE); \
197 temp_charset_work->table.encoder[(C) - 0x10000] = (CODE); \
200 #define GET_TEMP_CHARSET_WORK_ENCODER(C) \
201 ((C) == temp_charset_work->zero_index_char ? 0 \
202 : (C) < 0x20000 ? (temp_charset_work->table.encoder[(C)] \
203 ? (int) temp_charset_work->table.encoder[(C)] : -1) \
204 : temp_charset_work->table.encoder[(C) - 0x10000] \
205 ? temp_charset_work->table.encoder[(C) - 0x10000] : -1)
207 #define SET_TEMP_CHARSET_WORK_DECODER(C, CODE) \
208 (temp_charset_work->table.decoder[(CODE)] = (C))
210 #define GET_TEMP_CHARSET_WORK_DECODER(CODE) \
211 (temp_charset_work->table.decoder[(CODE)])
214 /* Set to 1 to warn that a charset map is loaded and thus a buffer
215 text and a string data may be relocated. */
216 int charset_map_loaded
;
218 struct charset_map_entries
224 struct charset_map_entries
*next
;
227 /* Load the mapping information of CHARSET from ENTRIES for
228 initializing (CONTROL_FLAG == 0), decoding (CONTROL_FLAG == 1), and
229 encoding (CONTROL_FLAG == 2).
231 If CONTROL_FLAG is 0, setup CHARSET->min_char, CHARSET->max_char,
232 and CHARSET->fast_map.
234 If CONTROL_FLAG is 1, setup the following tables according to
235 CHARSET->method and inhibit_load_charset_map.
237 CHARSET->method | inhibit_lcm == 0 | inhibit_lcm == 1
238 ----------------------+--------------------+---------------------------
239 CHARSET_METHOD_MAP | CHARSET->decoder | temp_charset_work->decoder
240 ----------------------+--------------------+---------------------------
241 CHARSET_METHOD_OFFSET | Vchar_unify_table | temp_charset_work->decoder
243 If CONTROL_FLAG is 2, setup the following tables.
245 CHARSET->method | inhibit_lcm == 0 | inhibit_lcm == 1
246 ----------------------+--------------------+---------------------------
247 CHARSET_METHOD_MAP | CHARSET->encoder | temp_charset_work->encoder
248 ----------------------+--------------------+--------------------------
249 CHARSET_METHOD_OFFSET | CHARSET->deunifier | temp_charset_work->encoder
253 load_charset_map (struct charset
*charset
, struct charset_map_entries
*entries
, int n_entries
, int control_flag
)
255 Lisp_Object vec
IF_LINT (= Qnil
), table
IF_LINT (= Qnil
);
256 unsigned max_code
= CHARSET_MAX_CODE (charset
);
257 int ascii_compatible_p
= charset
->ascii_compatible_p
;
258 int min_char
, max_char
, nonascii_min_char
;
260 unsigned char *fast_map
= charset
->fast_map
;
267 if (! inhibit_load_charset_map
)
269 if (control_flag
== 1)
271 if (charset
->method
== CHARSET_METHOD_MAP
)
273 int n
= CODE_POINT_TO_INDEX (charset
, max_code
) + 1;
275 vec
= CHARSET_DECODER (charset
)
276 = Fmake_vector (make_number (n
), make_number (-1));
280 char_table_set_range (Vchar_unify_table
,
281 charset
->min_char
, charset
->max_char
,
287 table
= Fmake_char_table (Qnil
, Qnil
);
288 if (charset
->method
== CHARSET_METHOD_MAP
)
289 CHARSET_ENCODER (charset
) = table
;
291 CHARSET_DEUNIFIER (charset
) = table
;
296 if (! temp_charset_work
)
297 temp_charset_work
= xmalloc (sizeof *temp_charset_work
);
298 if (control_flag
== 1)
300 memset (temp_charset_work
->table
.decoder
, -1,
301 sizeof (int) * 0x10000);
305 memset (temp_charset_work
->table
.encoder
, 0,
306 sizeof (unsigned short) * 0x20000);
307 temp_charset_work
->zero_index_char
= -1;
309 temp_charset_work
->current
= charset
;
310 temp_charset_work
->for_encoder
= (control_flag
== 2);
313 charset_map_loaded
= 1;
316 min_char
= max_char
= entries
->entry
[0].c
;
317 nonascii_min_char
= MAX_CHAR
;
318 for (i
= 0; i
< n_entries
; i
++)
321 int from_index
, to_index
, lim_index
;
323 int idx
= i
% 0x10000;
325 if (i
> 0 && idx
== 0)
326 entries
= entries
->next
;
327 from
= entries
->entry
[idx
].from
;
328 to
= entries
->entry
[idx
].to
;
329 from_c
= entries
->entry
[idx
].c
;
330 from_index
= CODE_POINT_TO_INDEX (charset
, from
);
333 to_index
= from_index
;
338 to_index
= CODE_POINT_TO_INDEX (charset
, to
);
339 to_c
= from_c
+ (to_index
- from_index
);
341 if (from_index
< 0 || to_index
< 0)
343 lim_index
= to_index
+ 1;
347 else if (from_c
< min_char
)
350 if (control_flag
== 1)
352 if (charset
->method
== CHARSET_METHOD_MAP
)
353 for (; from_index
< lim_index
; from_index
++, from_c
++)
354 ASET (vec
, from_index
, make_number (from_c
));
356 for (; from_index
< lim_index
; from_index
++, from_c
++)
357 CHAR_TABLE_SET (Vchar_unify_table
,
358 CHARSET_CODE_OFFSET (charset
) + from_index
,
359 make_number (from_c
));
361 else if (control_flag
== 2)
363 if (charset
->method
== CHARSET_METHOD_MAP
364 && CHARSET_COMPACT_CODES_P (charset
))
365 for (; from_index
< lim_index
; from_index
++, from_c
++)
367 unsigned code
= from_index
;
368 code
= INDEX_TO_CODE_POINT (charset
, code
);
370 if (NILP (CHAR_TABLE_REF (table
, from_c
)))
371 CHAR_TABLE_SET (table
, from_c
, make_number (code
));
374 for (; from_index
< lim_index
; from_index
++, from_c
++)
376 if (NILP (CHAR_TABLE_REF (table
, from_c
)))
377 CHAR_TABLE_SET (table
, from_c
, make_number (from_index
));
380 else if (control_flag
== 3)
381 for (; from_index
< lim_index
; from_index
++, from_c
++)
382 SET_TEMP_CHARSET_WORK_DECODER (from_c
, from_index
);
383 else if (control_flag
== 4)
384 for (; from_index
< lim_index
; from_index
++, from_c
++)
385 SET_TEMP_CHARSET_WORK_ENCODER (from_c
, from_index
);
386 else /* control_flag == 0 */
388 if (ascii_compatible_p
)
390 if (! ASCII_BYTE_P (from_c
))
392 if (from_c
< nonascii_min_char
)
393 nonascii_min_char
= from_c
;
395 else if (! ASCII_BYTE_P (to_c
))
397 nonascii_min_char
= 0x80;
401 for (; from_c
<= to_c
; from_c
++)
402 CHARSET_FAST_MAP_SET (from_c
, fast_map
);
406 if (control_flag
== 0)
408 CHARSET_MIN_CHAR (charset
) = (ascii_compatible_p
409 ? nonascii_min_char
: min_char
);
410 CHARSET_MAX_CHAR (charset
) = max_char
;
412 else if (control_flag
== 4)
414 temp_charset_work
->min_char
= min_char
;
415 temp_charset_work
->max_char
= max_char
;
420 /* Read a hexadecimal number (preceded by "0x") from the file FP while
421 paying attention to comment character '#'. */
423 static inline unsigned
424 read_hex (FILE *fp
, int *eof
, int *overflow
)
429 while ((c
= getc (fp
)) != EOF
)
433 while ((c
= getc (fp
)) != EOF
&& c
!= '\n');
437 if ((c
= getc (fp
)) == EOF
|| c
== 'x')
447 while (isxdigit (c
= getc (fp
)))
449 if (UINT_MAX
>> 4 < n
)
452 | (c
- ('0' <= c
&& c
<= '9' ? '0'
453 : 'A' <= c
&& c
<= 'F' ? 'A' - 10
461 /* Return a mapping vector for CHARSET loaded from MAPFILE.
462 Each line of MAPFILE has this form
464 where 0xAAAA is a code-point and 0xCCCC is the corresponding
465 character code, or this form
467 where 0xAAAA and 0xBBBB are code-points specifying a range, and
468 0xCCCC is the first character code of the range.
470 The returned vector has this form:
471 [ CODE1 CHAR1 CODE2 CHAR2 .... ]
472 where CODE1 is a code-point or a cons of code-points specifying a
475 Note that this function uses `openp' to open MAPFILE but ignores
476 `file-name-handler-alist' to avoid running any Lisp code. */
479 load_charset_map_from_file (struct charset
*charset
, Lisp_Object mapfile
, int control_flag
)
481 unsigned min_code
= CHARSET_MIN_CODE (charset
);
482 unsigned max_code
= CHARSET_MAX_CODE (charset
);
485 Lisp_Object suffixes
;
486 struct charset_map_entries
*head
, *entries
;
491 suffixes
= Fcons (build_string (".map"),
492 Fcons (build_string (".TXT"), Qnil
));
494 count
= SPECPDL_INDEX ();
495 specbind (Qfile_name_handler_alist
, Qnil
);
496 fd
= openp (Vcharset_map_path
, mapfile
, suffixes
, NULL
, Qnil
);
497 unbind_to (count
, Qnil
);
499 || ! (fp
= fdopen (fd
, "r")))
500 error ("Failure in loading charset map: %s", SDATA (mapfile
));
502 /* Use SAFE_ALLOCA instead of alloca, as `charset_map_entries' is
503 large (larger than MAX_ALLOCA). */
504 SAFE_ALLOCA (head
, struct charset_map_entries
*,
505 sizeof (struct charset_map_entries
));
507 memset (entries
, 0, sizeof (struct charset_map_entries
));
512 unsigned from
, to
, c
;
514 int eof
= 0, overflow
= 0;
516 from
= read_hex (fp
, &eof
, &overflow
);
519 if (getc (fp
) == '-')
520 to
= read_hex (fp
, &eof
, &overflow
);
525 c
= read_hex (fp
, &eof
, &overflow
);
531 if (from
< min_code
|| to
> max_code
|| from
> to
|| c
> MAX_CHAR
)
534 if (n_entries
> 0 && (n_entries
% 0x10000) == 0)
536 SAFE_ALLOCA (entries
->next
, struct charset_map_entries
*,
537 sizeof (struct charset_map_entries
));
538 entries
= entries
->next
;
539 memset (entries
, 0, sizeof (struct charset_map_entries
));
543 entries
->entry
[idx
].from
= from
;
544 entries
->entry
[idx
].to
= to
;
545 entries
->entry
[idx
].c
= c
;
550 load_charset_map (charset
, head
, n_entries
, control_flag
);
555 load_charset_map_from_vector (struct charset
*charset
, Lisp_Object vec
, int control_flag
)
557 unsigned min_code
= CHARSET_MIN_CODE (charset
);
558 unsigned max_code
= CHARSET_MAX_CODE (charset
);
559 struct charset_map_entries
*head
, *entries
;
561 int len
= ASIZE (vec
);
567 add_to_log ("Failure in loading charset map: %V", vec
, Qnil
);
571 /* Use SAFE_ALLOCA instead of alloca, as `charset_map_entries' is
572 large (larger than MAX_ALLOCA). */
573 SAFE_ALLOCA (head
, struct charset_map_entries
*,
574 sizeof (struct charset_map_entries
));
576 memset (entries
, 0, sizeof (struct charset_map_entries
));
579 for (i
= 0; i
< len
; i
+= 2)
581 Lisp_Object val
, val2
;
591 from
= XFASTINT (val
);
592 to
= XFASTINT (val2
);
595 from
= to
= XFASTINT (val
);
596 val
= AREF (vec
, i
+ 1);
600 if (from
< min_code
|| to
> max_code
|| from
> to
|| c
> MAX_CHAR
)
603 if (n_entries
> 0 && (n_entries
% 0x10000) == 0)
605 SAFE_ALLOCA (entries
->next
, struct charset_map_entries
*,
606 sizeof (struct charset_map_entries
));
607 entries
= entries
->next
;
608 memset (entries
, 0, sizeof (struct charset_map_entries
));
610 idx
= n_entries
% 0x10000;
611 entries
->entry
[idx
].from
= from
;
612 entries
->entry
[idx
].to
= to
;
613 entries
->entry
[idx
].c
= c
;
617 load_charset_map (charset
, head
, n_entries
, control_flag
);
622 /* Load a mapping table for CHARSET. CONTROL-FLAG tells what kind of
623 map it is (see the comment of load_charset_map for the detail). */
626 load_charset (struct charset
*charset
, int control_flag
)
630 if (inhibit_load_charset_map
632 && charset
== temp_charset_work
->current
633 && ((control_flag
== 2) == temp_charset_work
->for_encoder
))
636 if (CHARSET_METHOD (charset
) == CHARSET_METHOD_MAP
)
637 map
= CHARSET_MAP (charset
);
640 if (! CHARSET_UNIFIED_P (charset
))
642 map
= CHARSET_UNIFY_MAP (charset
);
645 load_charset_map_from_file (charset
, map
, control_flag
);
647 load_charset_map_from_vector (charset
, map
, control_flag
);
651 DEFUN ("charsetp", Fcharsetp
, Scharsetp
, 1, 1, 0,
652 doc
: /* Return non-nil if and only if OBJECT is a charset.*/)
655 return (CHARSETP (object
) ? Qt
: Qnil
);
660 map_charset_for_dump (void (*c_function
) (Lisp_Object
, Lisp_Object
),
661 Lisp_Object function
, Lisp_Object arg
,
662 unsigned int from
, unsigned int to
)
664 int from_idx
= CODE_POINT_TO_INDEX (temp_charset_work
->current
, from
);
665 int to_idx
= CODE_POINT_TO_INDEX (temp_charset_work
->current
, to
);
670 range
= Fcons (Qnil
, Qnil
);
673 c
= temp_charset_work
->min_char
;
674 stop
= (temp_charset_work
->max_char
< 0x20000
675 ? temp_charset_work
->max_char
: 0xFFFF);
679 int idx
= GET_TEMP_CHARSET_WORK_ENCODER (c
);
681 if (idx
>= from_idx
&& idx
<= to_idx
)
683 if (NILP (XCAR (range
)))
684 XSETCAR (range
, make_number (c
));
686 else if (! NILP (XCAR (range
)))
688 XSETCDR (range
, make_number (c
- 1));
690 (*c_function
) (arg
, range
);
692 call2 (function
, range
, arg
);
693 XSETCAR (range
, Qnil
);
697 if (c
== temp_charset_work
->max_char
)
699 if (! NILP (XCAR (range
)))
701 XSETCDR (range
, make_number (c
));
703 (*c_function
) (arg
, range
);
705 call2 (function
, range
, arg
);
710 stop
= temp_charset_work
->max_char
;
718 map_charset_chars (void (*c_function
)(Lisp_Object
, Lisp_Object
), Lisp_Object function
,
719 Lisp_Object arg
, struct charset
*charset
, unsigned from
, unsigned to
)
724 partial
= (from
> CHARSET_MIN_CODE (charset
)
725 || to
< CHARSET_MAX_CODE (charset
));
727 if (CHARSET_METHOD (charset
) == CHARSET_METHOD_OFFSET
)
729 int from_idx
= CODE_POINT_TO_INDEX (charset
, from
);
730 int to_idx
= CODE_POINT_TO_INDEX (charset
, to
);
731 int from_c
= from_idx
+ CHARSET_CODE_OFFSET (charset
);
732 int to_c
= to_idx
+ CHARSET_CODE_OFFSET (charset
);
734 if (CHARSET_UNIFIED_P (charset
))
736 if (! CHAR_TABLE_P (CHARSET_DEUNIFIER (charset
)))
737 load_charset (charset
, 2);
738 if (CHAR_TABLE_P (CHARSET_DEUNIFIER (charset
)))
739 map_char_table_for_charset (c_function
, function
,
740 CHARSET_DEUNIFIER (charset
), arg
,
741 partial
? charset
: NULL
, from
, to
);
743 map_charset_for_dump (c_function
, function
, arg
, from
, to
);
746 range
= Fcons (make_number (from_c
), make_number (to_c
));
748 (*c_function
) (arg
, range
);
750 call2 (function
, range
, arg
);
752 else if (CHARSET_METHOD (charset
) == CHARSET_METHOD_MAP
)
754 if (! CHAR_TABLE_P (CHARSET_ENCODER (charset
)))
755 load_charset (charset
, 2);
756 if (CHAR_TABLE_P (CHARSET_ENCODER (charset
)))
757 map_char_table_for_charset (c_function
, function
,
758 CHARSET_ENCODER (charset
), arg
,
759 partial
? charset
: NULL
, from
, to
);
761 map_charset_for_dump (c_function
, function
, arg
, from
, to
);
763 else if (CHARSET_METHOD (charset
) == CHARSET_METHOD_SUBSET
)
765 Lisp_Object subset_info
;
768 subset_info
= CHARSET_SUBSET (charset
);
769 charset
= CHARSET_FROM_ID (XFASTINT (AREF (subset_info
, 0)));
770 offset
= XINT (AREF (subset_info
, 3));
772 if (from
< XFASTINT (AREF (subset_info
, 1)))
773 from
= XFASTINT (AREF (subset_info
, 1));
775 if (to
> XFASTINT (AREF (subset_info
, 2)))
776 to
= XFASTINT (AREF (subset_info
, 2));
777 map_charset_chars (c_function
, function
, arg
, charset
, from
, to
);
779 else /* i.e. CHARSET_METHOD_SUPERSET */
783 for (parents
= CHARSET_SUPERSET (charset
); CONSP (parents
);
784 parents
= XCDR (parents
))
787 unsigned this_from
, this_to
;
789 charset
= CHARSET_FROM_ID (XFASTINT (XCAR (XCAR (parents
))));
790 offset
= XINT (XCDR (XCAR (parents
)));
791 this_from
= from
> offset
? from
- offset
: 0;
792 this_to
= to
> offset
? to
- offset
: 0;
793 if (this_from
< CHARSET_MIN_CODE (charset
))
794 this_from
= CHARSET_MIN_CODE (charset
);
795 if (this_to
> CHARSET_MAX_CODE (charset
))
796 this_to
= CHARSET_MAX_CODE (charset
);
797 map_charset_chars (c_function
, function
, arg
, charset
,
803 DEFUN ("map-charset-chars", Fmap_charset_chars
, Smap_charset_chars
, 2, 5, 0,
804 doc
: /* Call FUNCTION for all characters in CHARSET.
805 FUNCTION is called with an argument RANGE and the optional 3rd
808 RANGE is a cons (FROM . TO), where FROM and TO indicate a range of
809 characters contained in CHARSET.
811 The optional 4th and 5th arguments FROM-CODE and TO-CODE specify the
812 range of code points (in CHARSET) of target characters. */)
813 (Lisp_Object function
, Lisp_Object charset
, Lisp_Object arg
, Lisp_Object from_code
, Lisp_Object to_code
)
818 CHECK_CHARSET_GET_CHARSET (charset
, cs
);
819 if (NILP (from_code
))
820 from
= CHARSET_MIN_CODE (cs
);
823 from
= XINT (from_code
);
824 if (from
< CHARSET_MIN_CODE (cs
))
825 from
= CHARSET_MIN_CODE (cs
);
828 to
= CHARSET_MAX_CODE (cs
);
832 if (to
> CHARSET_MAX_CODE (cs
))
833 to
= CHARSET_MAX_CODE (cs
);
835 map_charset_chars (NULL
, function
, arg
, cs
, from
, to
);
840 /* Define a charset according to the arguments. The Nth argument is
841 the Nth attribute of the charset (the last attribute `charset-id'
842 is not included). See the docstring of `define-charset' for the
845 DEFUN ("define-charset-internal", Fdefine_charset_internal
,
846 Sdefine_charset_internal
, charset_arg_max
, MANY
, 0,
847 doc
: /* For internal use only.
848 usage: (define-charset-internal ...) */)
849 (ptrdiff_t nargs
, Lisp_Object
*args
)
851 /* Charset attr vector. */
854 EMACS_UINT hash_code
;
855 struct Lisp_Hash_Table
*hash_table
= XHASH_TABLE (Vcharset_hash_table
);
857 struct charset charset
;
860 int new_definition_p
;
863 if (nargs
!= charset_arg_max
)
864 return Fsignal (Qwrong_number_of_arguments
,
865 Fcons (intern ("define-charset-internal"),
866 make_number (nargs
)));
868 attrs
= Fmake_vector (make_number (charset_attr_max
), Qnil
);
870 CHECK_SYMBOL (args
[charset_arg_name
]);
871 ASET (attrs
, charset_name
, args
[charset_arg_name
]);
873 val
= args
[charset_arg_code_space
];
874 for (i
= 0, dimension
= 0, nchars
= 1; ; i
++)
876 Lisp_Object min_byte_obj
, max_byte_obj
;
877 int min_byte
, max_byte
;
879 min_byte_obj
= Faref (val
, make_number (i
* 2));
880 max_byte_obj
= Faref (val
, make_number (i
* 2 + 1));
881 CHECK_RANGED_INTEGER (min_byte_obj
, 0, 255);
882 min_byte
= XINT (min_byte_obj
);
883 CHECK_RANGED_INTEGER (max_byte_obj
, min_byte
, 255);
884 max_byte
= XINT (max_byte_obj
);
885 charset
.code_space
[i
* 4] = min_byte
;
886 charset
.code_space
[i
* 4 + 1] = max_byte
;
887 charset
.code_space
[i
* 4 + 2] = max_byte
- min_byte
+ 1;
892 nchars
*= charset
.code_space
[i
* 4 + 2];
893 charset
.code_space
[i
* 4 + 3] = nchars
;
896 val
= args
[charset_arg_dimension
];
898 charset
.dimension
= dimension
;
901 CHECK_RANGED_INTEGER (val
, 1, 4);
902 charset
.dimension
= XINT (val
);
905 charset
.code_linear_p
906 = (charset
.dimension
== 1
907 || (charset
.code_space
[2] == 256
908 && (charset
.dimension
== 2
909 || (charset
.code_space
[6] == 256
910 && (charset
.dimension
== 3
911 || charset
.code_space
[10] == 256)))));
913 if (! charset
.code_linear_p
)
915 charset
.code_space_mask
= xzalloc (256);
916 for (i
= 0; i
< 4; i
++)
917 for (j
= charset
.code_space
[i
* 4]; j
<= charset
.code_space
[i
* 4 + 1];
919 charset
.code_space_mask
[j
] |= (1 << i
);
922 charset
.iso_chars_96
= charset
.code_space
[2] == 96;
924 charset
.min_code
= (charset
.code_space
[0]
925 | (charset
.code_space
[4] << 8)
926 | (charset
.code_space
[8] << 16)
927 | ((unsigned) charset
.code_space
[12] << 24));
928 charset
.max_code
= (charset
.code_space
[1]
929 | (charset
.code_space
[5] << 8)
930 | (charset
.code_space
[9] << 16)
931 | ((unsigned) charset
.code_space
[13] << 24));
932 charset
.char_index_offset
= 0;
934 val
= args
[charset_arg_min_code
];
937 unsigned code
= cons_to_unsigned (val
, UINT_MAX
);
939 if (code
< charset
.min_code
940 || code
> charset
.max_code
)
941 args_out_of_range_3 (make_fixnum_or_float (charset
.min_code
),
942 make_fixnum_or_float (charset
.max_code
), val
);
943 charset
.char_index_offset
= CODE_POINT_TO_INDEX (&charset
, code
);
944 charset
.min_code
= code
;
947 val
= args
[charset_arg_max_code
];
950 unsigned code
= cons_to_unsigned (val
, UINT_MAX
);
952 if (code
< charset
.min_code
953 || code
> charset
.max_code
)
954 args_out_of_range_3 (make_fixnum_or_float (charset
.min_code
),
955 make_fixnum_or_float (charset
.max_code
), val
);
956 charset
.max_code
= code
;
959 charset
.compact_codes_p
= charset
.max_code
< 0x10000;
961 val
= args
[charset_arg_invalid_code
];
964 if (charset
.min_code
> 0)
965 charset
.invalid_code
= 0;
968 if (charset
.max_code
< UINT_MAX
)
969 charset
.invalid_code
= charset
.max_code
+ 1;
971 error ("Attribute :invalid-code must be specified");
975 charset
.invalid_code
= cons_to_unsigned (val
, UINT_MAX
);
977 val
= args
[charset_arg_iso_final
];
979 charset
.iso_final
= -1;
983 if (XINT (val
) < '0' || XINT (val
) > 127)
984 error ("Invalid iso-final-char: %"pI
"d", XINT (val
));
985 charset
.iso_final
= XINT (val
);
988 val
= args
[charset_arg_iso_revision
];
990 charset
.iso_revision
= -1;
993 CHECK_RANGED_INTEGER (val
, -1, 63);
994 charset
.iso_revision
= XINT (val
);
997 val
= args
[charset_arg_emacs_mule_id
];
999 charset
.emacs_mule_id
= -1;
1003 if ((XINT (val
) > 0 && XINT (val
) <= 128) || XINT (val
) >= 256)
1004 error ("Invalid emacs-mule-id: %"pI
"d", XINT (val
));
1005 charset
.emacs_mule_id
= XINT (val
);
1008 charset
.ascii_compatible_p
= ! NILP (args
[charset_arg_ascii_compatible_p
]);
1010 charset
.supplementary_p
= ! NILP (args
[charset_arg_supplementary_p
]);
1012 charset
.unified_p
= 0;
1014 memset (charset
.fast_map
, 0, sizeof (charset
.fast_map
));
1016 if (! NILP (args
[charset_arg_code_offset
]))
1018 val
= args
[charset_arg_code_offset
];
1019 CHECK_CHARACTER (val
);
1021 charset
.method
= CHARSET_METHOD_OFFSET
;
1022 charset
.code_offset
= XINT (val
);
1024 i
= CODE_POINT_TO_INDEX (&charset
, charset
.max_code
);
1025 if (MAX_CHAR
- charset
.code_offset
< i
)
1026 error ("Unsupported max char: %d", charset
.max_char
);
1027 charset
.max_char
= i
+ charset
.code_offset
;
1028 i
= CODE_POINT_TO_INDEX (&charset
, charset
.min_code
);
1029 charset
.min_char
= i
+ charset
.code_offset
;
1031 i
= (charset
.min_char
>> 7) << 7;
1032 for (; i
< 0x10000 && i
<= charset
.max_char
; i
+= 128)
1033 CHARSET_FAST_MAP_SET (i
, charset
.fast_map
);
1034 i
= (i
>> 12) << 12;
1035 for (; i
<= charset
.max_char
; i
+= 0x1000)
1036 CHARSET_FAST_MAP_SET (i
, charset
.fast_map
);
1037 if (charset
.code_offset
== 0 && charset
.max_char
>= 0x80)
1038 charset
.ascii_compatible_p
= 1;
1040 else if (! NILP (args
[charset_arg_map
]))
1042 val
= args
[charset_arg_map
];
1043 ASET (attrs
, charset_map
, val
);
1044 charset
.method
= CHARSET_METHOD_MAP
;
1046 else if (! NILP (args
[charset_arg_subset
]))
1049 Lisp_Object parent_min_code
, parent_max_code
, parent_code_offset
;
1050 struct charset
*parent_charset
;
1052 val
= args
[charset_arg_subset
];
1053 parent
= Fcar (val
);
1054 CHECK_CHARSET_GET_CHARSET (parent
, parent_charset
);
1055 parent_min_code
= Fnth (make_number (1), val
);
1056 CHECK_NATNUM (parent_min_code
);
1057 parent_max_code
= Fnth (make_number (2), val
);
1058 CHECK_NATNUM (parent_max_code
);
1059 parent_code_offset
= Fnth (make_number (3), val
);
1060 CHECK_NUMBER (parent_code_offset
);
1061 val
= Fmake_vector (make_number (4), Qnil
);
1062 ASET (val
, 0, make_number (parent_charset
->id
));
1063 ASET (val
, 1, parent_min_code
);
1064 ASET (val
, 2, parent_max_code
);
1065 ASET (val
, 3, parent_code_offset
);
1066 ASET (attrs
, charset_subset
, val
);
1068 charset
.method
= CHARSET_METHOD_SUBSET
;
1069 /* Here, we just copy the parent's fast_map. It's not accurate,
1070 but at least it works for quickly detecting which character
1071 DOESN'T belong to this charset. */
1072 for (i
= 0; i
< 190; i
++)
1073 charset
.fast_map
[i
] = parent_charset
->fast_map
[i
];
1075 /* We also copy these for parents. */
1076 charset
.min_char
= parent_charset
->min_char
;
1077 charset
.max_char
= parent_charset
->max_char
;
1079 else if (! NILP (args
[charset_arg_superset
]))
1081 val
= args
[charset_arg_superset
];
1082 charset
.method
= CHARSET_METHOD_SUPERSET
;
1083 val
= Fcopy_sequence (val
);
1084 ASET (attrs
, charset_superset
, val
);
1086 charset
.min_char
= MAX_CHAR
;
1087 charset
.max_char
= 0;
1088 for (; ! NILP (val
); val
= Fcdr (val
))
1090 Lisp_Object elt
, car_part
, cdr_part
;
1091 int this_id
, offset
;
1092 struct charset
*this_charset
;
1097 car_part
= XCAR (elt
);
1098 cdr_part
= XCDR (elt
);
1099 CHECK_CHARSET_GET_ID (car_part
, this_id
);
1100 CHECK_TYPE_RANGED_INTEGER (int, cdr_part
);
1101 offset
= XINT (cdr_part
);
1105 CHECK_CHARSET_GET_ID (elt
, this_id
);
1108 XSETCAR (val
, Fcons (make_number (this_id
), make_number (offset
)));
1110 this_charset
= CHARSET_FROM_ID (this_id
);
1111 if (charset
.min_char
> this_charset
->min_char
)
1112 charset
.min_char
= this_charset
->min_char
;
1113 if (charset
.max_char
< this_charset
->max_char
)
1114 charset
.max_char
= this_charset
->max_char
;
1115 for (i
= 0; i
< 190; i
++)
1116 charset
.fast_map
[i
] |= this_charset
->fast_map
[i
];
1120 error ("None of :code-offset, :map, :parents are specified");
1122 val
= args
[charset_arg_unify_map
];
1123 if (! NILP (val
) && !STRINGP (val
))
1125 ASET (attrs
, charset_unify_map
, val
);
1127 CHECK_LIST (args
[charset_arg_plist
]);
1128 ASET (attrs
, charset_plist
, args
[charset_arg_plist
]);
1130 charset
.hash_index
= hash_lookup (hash_table
, args
[charset_arg_name
],
1132 if (charset
.hash_index
>= 0)
1134 new_definition_p
= 0;
1135 id
= XFASTINT (CHARSET_SYMBOL_ID (args
[charset_arg_name
]));
1136 HASH_VALUE (hash_table
, charset
.hash_index
) = attrs
;
1140 charset
.hash_index
= hash_put (hash_table
, args
[charset_arg_name
], attrs
,
1142 if (charset_table_used
== charset_table_size
)
1144 /* Ensure that charset IDs fit into 'int' as well as into the
1145 restriction imposed by fixnums. Although the 'int' restriction
1146 could be removed, too much other code would need altering; for
1147 example, the IDs are stuffed into struct
1148 coding_system.charbuf[i] entries, which are 'int'. */
1149 int old_size
= charset_table_size
;
1150 struct charset
*new_table
=
1151 xpalloc (0, &charset_table_size
, 1,
1152 min (INT_MAX
, MOST_POSITIVE_FIXNUM
),
1153 sizeof *charset_table
);
1154 memcpy (new_table
, charset_table
, old_size
* sizeof *new_table
);
1155 charset_table
= new_table
;
1156 /* FIXME: This leaks memory, as the old charset_table becomes
1157 unreachable. If the old charset table is charset_table_init
1158 then this leak is intentional; otherwise, it's unclear.
1159 If the latter memory leak is intentional, a
1160 comment should be added to explain this. If not, the old
1161 charset_table should be freed, by passing it as the 1st argument
1162 to xpalloc and removing the memcpy. */
1164 id
= charset_table_used
++;
1165 new_definition_p
= 1;
1168 ASET (attrs
, charset_id
, make_number (id
));
1170 charset_table
[id
] = charset
;
1172 if (charset
.method
== CHARSET_METHOD_MAP
)
1174 load_charset (&charset
, 0);
1175 charset_table
[id
] = charset
;
1178 if (charset
.iso_final
>= 0)
1180 ISO_CHARSET_TABLE (charset
.dimension
, charset
.iso_chars_96
,
1181 charset
.iso_final
) = id
;
1182 if (new_definition_p
)
1183 Viso_2022_charset_list
= nconc2 (Viso_2022_charset_list
,
1184 Fcons (make_number (id
), Qnil
));
1185 if (ISO_CHARSET_TABLE (1, 0, 'J') == id
)
1186 charset_jisx0201_roman
= id
;
1187 else if (ISO_CHARSET_TABLE (2, 0, '@') == id
)
1188 charset_jisx0208_1978
= id
;
1189 else if (ISO_CHARSET_TABLE (2, 0, 'B') == id
)
1190 charset_jisx0208
= id
;
1191 else if (ISO_CHARSET_TABLE (2, 0, 'C') == id
)
1192 charset_ksc5601
= id
;
1195 if (charset
.emacs_mule_id
>= 0)
1197 emacs_mule_charset
[charset
.emacs_mule_id
] = id
;
1198 if (charset
.emacs_mule_id
< 0xA0)
1199 emacs_mule_bytes
[charset
.emacs_mule_id
] = charset
.dimension
+ 1;
1201 emacs_mule_bytes
[charset
.emacs_mule_id
] = charset
.dimension
+ 2;
1202 if (new_definition_p
)
1203 Vemacs_mule_charset_list
= nconc2 (Vemacs_mule_charset_list
,
1204 Fcons (make_number (id
), Qnil
));
1207 if (new_definition_p
)
1209 Vcharset_list
= Fcons (args
[charset_arg_name
], Vcharset_list
);
1210 if (charset
.supplementary_p
)
1211 Vcharset_ordered_list
= nconc2 (Vcharset_ordered_list
,
1212 Fcons (make_number (id
), Qnil
));
1217 for (tail
= Vcharset_ordered_list
; CONSP (tail
); tail
= XCDR (tail
))
1219 struct charset
*cs
= CHARSET_FROM_ID (XINT (XCAR (tail
)));
1221 if (cs
->supplementary_p
)
1224 if (EQ (tail
, Vcharset_ordered_list
))
1225 Vcharset_ordered_list
= Fcons (make_number (id
),
1226 Vcharset_ordered_list
);
1227 else if (NILP (tail
))
1228 Vcharset_ordered_list
= nconc2 (Vcharset_ordered_list
,
1229 Fcons (make_number (id
), Qnil
));
1232 val
= Fcons (XCAR (tail
), XCDR (tail
));
1233 XSETCDR (tail
, val
);
1234 XSETCAR (tail
, make_number (id
));
1237 charset_ordered_list_tick
++;
1244 /* Same as Fdefine_charset_internal but arguments are more convenient
1245 to call from C (typically in syms_of_charset). This can define a
1246 charset of `offset' method only. Return the ID of the new
1250 define_charset_internal (Lisp_Object name
,
1252 const char *code_space_chars
,
1253 unsigned min_code
, unsigned max_code
,
1254 int iso_final
, int iso_revision
, int emacs_mule_id
,
1255 int ascii_compatible
, int supplementary
,
1258 const unsigned char *code_space
= (const unsigned char *) code_space_chars
;
1259 Lisp_Object args
[charset_arg_max
];
1260 Lisp_Object plist
[14];
1264 args
[charset_arg_name
] = name
;
1265 args
[charset_arg_dimension
] = make_number (dimension
);
1266 val
= Fmake_vector (make_number (8), make_number (0));
1267 for (i
= 0; i
< 8; i
++)
1268 ASET (val
, i
, make_number (code_space
[i
]));
1269 args
[charset_arg_code_space
] = val
;
1270 args
[charset_arg_min_code
] = make_number (min_code
);
1271 args
[charset_arg_max_code
] = make_number (max_code
);
1272 args
[charset_arg_iso_final
]
1273 = (iso_final
< 0 ? Qnil
: make_number (iso_final
));
1274 args
[charset_arg_iso_revision
] = make_number (iso_revision
);
1275 args
[charset_arg_emacs_mule_id
]
1276 = (emacs_mule_id
< 0 ? Qnil
: make_number (emacs_mule_id
));
1277 args
[charset_arg_ascii_compatible_p
] = ascii_compatible
? Qt
: Qnil
;
1278 args
[charset_arg_supplementary_p
] = supplementary
? Qt
: Qnil
;
1279 args
[charset_arg_invalid_code
] = Qnil
;
1280 args
[charset_arg_code_offset
] = make_number (code_offset
);
1281 args
[charset_arg_map
] = Qnil
;
1282 args
[charset_arg_subset
] = Qnil
;
1283 args
[charset_arg_superset
] = Qnil
;
1284 args
[charset_arg_unify_map
] = Qnil
;
1286 plist
[0] = intern_c_string (":name");
1287 plist
[1] = args
[charset_arg_name
];
1288 plist
[2] = intern_c_string (":dimension");
1289 plist
[3] = args
[charset_arg_dimension
];
1290 plist
[4] = intern_c_string (":code-space");
1291 plist
[5] = args
[charset_arg_code_space
];
1292 plist
[6] = intern_c_string (":iso-final-char");
1293 plist
[7] = args
[charset_arg_iso_final
];
1294 plist
[8] = intern_c_string (":emacs-mule-id");
1295 plist
[9] = args
[charset_arg_emacs_mule_id
];
1296 plist
[10] = intern_c_string (":ascii-compatible-p");
1297 plist
[11] = args
[charset_arg_ascii_compatible_p
];
1298 plist
[12] = intern_c_string (":code-offset");
1299 plist
[13] = args
[charset_arg_code_offset
];
1301 args
[charset_arg_plist
] = Flist (14, plist
);
1302 Fdefine_charset_internal (charset_arg_max
, args
);
1304 return XINT (CHARSET_SYMBOL_ID (name
));
1308 DEFUN ("define-charset-alias", Fdefine_charset_alias
,
1309 Sdefine_charset_alias
, 2, 2, 0,
1310 doc
: /* Define ALIAS as an alias for charset CHARSET. */)
1311 (Lisp_Object alias
, Lisp_Object charset
)
1315 CHECK_CHARSET_GET_ATTR (charset
, attr
);
1316 Fputhash (alias
, attr
, Vcharset_hash_table
);
1317 Vcharset_list
= Fcons (alias
, Vcharset_list
);
1322 DEFUN ("charset-plist", Fcharset_plist
, Scharset_plist
, 1, 1, 0,
1323 doc
: /* Return the property list of CHARSET. */)
1324 (Lisp_Object charset
)
1328 CHECK_CHARSET_GET_ATTR (charset
, attrs
);
1329 return CHARSET_ATTR_PLIST (attrs
);
1333 DEFUN ("set-charset-plist", Fset_charset_plist
, Sset_charset_plist
, 2, 2, 0,
1334 doc
: /* Set CHARSET's property list to PLIST. */)
1335 (Lisp_Object charset
, Lisp_Object plist
)
1339 CHECK_CHARSET_GET_ATTR (charset
, attrs
);
1340 CHARSET_ATTR_PLIST (attrs
) = plist
;
1345 DEFUN ("unify-charset", Funify_charset
, Sunify_charset
, 1, 3, 0,
1346 doc
: /* Unify characters of CHARSET with Unicode.
1347 This means reading the relevant file and installing the table defined
1348 by CHARSET's `:unify-map' property.
1350 Optional second arg UNIFY-MAP is a file name string or a vector. It has
1351 the same meaning as the `:unify-map' attribute in the function
1352 `define-charset' (which see).
1354 Optional third argument DEUNIFY, if non-nil, means to de-unify CHARSET. */)
1355 (Lisp_Object charset
, Lisp_Object unify_map
, Lisp_Object deunify
)
1360 CHECK_CHARSET_GET_ID (charset
, id
);
1361 cs
= CHARSET_FROM_ID (id
);
1363 ? CHARSET_UNIFIED_P (cs
) && ! NILP (CHARSET_DEUNIFIER (cs
))
1364 : ! CHARSET_UNIFIED_P (cs
))
1367 CHARSET_UNIFIED_P (cs
) = 0;
1370 if (CHARSET_METHOD (cs
) != CHARSET_METHOD_OFFSET
1371 || CHARSET_CODE_OFFSET (cs
) < 0x110000)
1372 error ("Can't unify charset: %s", SDATA (SYMBOL_NAME (charset
)));
1373 if (NILP (unify_map
))
1374 unify_map
= CHARSET_UNIFY_MAP (cs
);
1377 if (! STRINGP (unify_map
) && ! VECTORP (unify_map
))
1378 signal_error ("Bad unify-map", unify_map
);
1379 CHARSET_UNIFY_MAP (cs
) = unify_map
;
1381 if (NILP (Vchar_unify_table
))
1382 Vchar_unify_table
= Fmake_char_table (Qnil
, Qnil
);
1383 char_table_set_range (Vchar_unify_table
,
1384 cs
->min_char
, cs
->max_char
, charset
);
1385 CHARSET_UNIFIED_P (cs
) = 1;
1387 else if (CHAR_TABLE_P (Vchar_unify_table
))
1389 unsigned min_code
= CHARSET_MIN_CODE (cs
);
1390 unsigned max_code
= CHARSET_MAX_CODE (cs
);
1391 int min_char
= DECODE_CHAR (cs
, min_code
);
1392 int max_char
= DECODE_CHAR (cs
, max_code
);
1394 char_table_set_range (Vchar_unify_table
, min_char
, max_char
, Qnil
);
1400 DEFUN ("get-unused-iso-final-char", Fget_unused_iso_final_char
,
1401 Sget_unused_iso_final_char
, 2, 2, 0,
1403 Return an unused ISO final char for a charset of DIMENSION and CHARS.
1404 DIMENSION is the number of bytes to represent a character: 1 or 2.
1405 CHARS is the number of characters in a dimension: 94 or 96.
1407 This final char is for private use, thus the range is `0' (48) .. `?' (63).
1408 If there's no unused final char for the specified kind of charset,
1410 (Lisp_Object dimension
, Lisp_Object chars
)
1414 CHECK_NUMBER (dimension
);
1415 CHECK_NUMBER (chars
);
1416 if (XINT (dimension
) != 1 && XINT (dimension
) != 2 && XINT (dimension
) != 3)
1417 args_out_of_range_3 (dimension
, make_number (1), make_number (3));
1418 if (XINT (chars
) != 94 && XINT (chars
) != 96)
1419 args_out_of_range_3 (chars
, make_number (94), make_number (96));
1420 for (final_char
= '0'; final_char
<= '?'; final_char
++)
1421 if (ISO_CHARSET_TABLE (XINT (dimension
), XINT (chars
), final_char
) < 0)
1423 return (final_char
<= '?' ? make_number (final_char
) : Qnil
);
1427 check_iso_charset_parameter (Lisp_Object dimension
, Lisp_Object chars
, Lisp_Object final_char
)
1429 CHECK_NATNUM (dimension
);
1430 CHECK_NATNUM (chars
);
1431 CHECK_CHARACTER (final_char
);
1433 if (XINT (dimension
) > 3)
1434 error ("Invalid DIMENSION %"pI
"d, it should be 1, 2, or 3",
1436 if (XINT (chars
) != 94 && XINT (chars
) != 96)
1437 error ("Invalid CHARS %"pI
"d, it should be 94 or 96", XINT (chars
));
1438 if (XINT (final_char
) < '0' || XINT (final_char
) > '~')
1439 error ("Invalid FINAL-CHAR %c, it should be `0'..`~'",
1440 (int)XINT (final_char
));
1444 DEFUN ("declare-equiv-charset", Fdeclare_equiv_charset
, Sdeclare_equiv_charset
,
1446 doc
: /* Declare an equivalent charset for ISO-2022 decoding.
1448 On decoding by an ISO-2022 base coding system, when a charset
1449 specified by DIMENSION, CHARS, and FINAL-CHAR is designated, behave as
1450 if CHARSET is designated instead. */)
1451 (Lisp_Object dimension
, Lisp_Object chars
, Lisp_Object final_char
, Lisp_Object charset
)
1456 CHECK_CHARSET_GET_ID (charset
, id
);
1457 check_iso_charset_parameter (dimension
, chars
, final_char
);
1458 chars_flag
= XINT (chars
) == 96;
1459 ISO_CHARSET_TABLE (XINT (dimension
), chars_flag
, XINT (final_char
)) = id
;
1464 /* Return information about charsets in the text at PTR of NBYTES
1465 bytes, which are NCHARS characters. The value is:
1467 0: Each character is represented by one byte. This is always
1468 true for a unibyte string. For a multibyte string, true if
1469 it contains only ASCII characters.
1471 1: No charsets other than ascii, control-1, and latin-1 are
1478 string_xstring_p (Lisp_Object string
)
1480 const unsigned char *p
= SDATA (string
);
1481 const unsigned char *endp
= p
+ SBYTES (string
);
1483 if (SCHARS (string
) == SBYTES (string
))
1488 int c
= STRING_CHAR_ADVANCE (p
);
1497 /* Find charsets in the string at PTR of NCHARS and NBYTES.
1499 CHARSETS is a vector. If Nth element is non-nil, it means the
1500 charset whose id is N is already found.
1502 It may lookup a translation table TABLE if supplied. */
1505 find_charsets_in_text (const unsigned char *ptr
, ptrdiff_t nchars
, ptrdiff_t nbytes
, Lisp_Object charsets
, Lisp_Object table
, int multibyte
)
1507 const unsigned char *pend
= ptr
+ nbytes
;
1509 if (nchars
== nbytes
)
1512 ASET (charsets
, charset_ascii
, Qt
);
1519 c
= translate_char (table
, c
);
1520 if (ASCII_BYTE_P (c
))
1521 ASET (charsets
, charset_ascii
, Qt
);
1523 ASET (charsets
, charset_eight_bit
, Qt
);
1530 int c
= STRING_CHAR_ADVANCE (ptr
);
1531 struct charset
*charset
;
1534 c
= translate_char (table
, c
);
1535 charset
= CHAR_CHARSET (c
);
1536 ASET (charsets
, CHARSET_ID (charset
), Qt
);
1541 DEFUN ("find-charset-region", Ffind_charset_region
, Sfind_charset_region
,
1543 doc
: /* Return a list of charsets in the region between BEG and END.
1544 BEG and END are buffer positions.
1545 Optional arg TABLE if non-nil is a translation table to look up.
1547 If the current buffer is unibyte, the returned list may contain
1548 only `ascii', `eight-bit-control', and `eight-bit-graphic'. */)
1549 (Lisp_Object beg
, Lisp_Object end
, Lisp_Object table
)
1551 Lisp_Object charsets
;
1552 ptrdiff_t from
, from_byte
, to
, stop
, stop_byte
;
1555 int multibyte
= ! NILP (BVAR (current_buffer
, enable_multibyte_characters
));
1557 validate_region (&beg
, &end
);
1558 from
= XFASTINT (beg
);
1559 stop
= to
= XFASTINT (end
);
1561 if (from
< GPT
&& GPT
< to
)
1564 stop_byte
= GPT_BYTE
;
1567 stop_byte
= CHAR_TO_BYTE (stop
);
1569 from_byte
= CHAR_TO_BYTE (from
);
1571 charsets
= Fmake_vector (make_number (charset_table_used
), Qnil
);
1574 find_charsets_in_text (BYTE_POS_ADDR (from_byte
), stop
- from
,
1575 stop_byte
- from_byte
, charsets
, table
,
1579 from
= stop
, from_byte
= stop_byte
;
1580 stop
= to
, stop_byte
= CHAR_TO_BYTE (stop
);
1587 for (i
= charset_table_used
- 1; i
>= 0; i
--)
1588 if (!NILP (AREF (charsets
, i
)))
1589 val
= Fcons (CHARSET_NAME (charset_table
+ i
), val
);
1593 DEFUN ("find-charset-string", Ffind_charset_string
, Sfind_charset_string
,
1595 doc
: /* Return a list of charsets in STR.
1596 Optional arg TABLE if non-nil is a translation table to look up.
1598 If STR is unibyte, the returned list may contain
1599 only `ascii', `eight-bit-control', and `eight-bit-graphic'. */)
1600 (Lisp_Object str
, Lisp_Object table
)
1602 Lisp_Object charsets
;
1608 charsets
= Fmake_vector (make_number (charset_table_used
), Qnil
);
1609 find_charsets_in_text (SDATA (str
), SCHARS (str
), SBYTES (str
),
1611 STRING_MULTIBYTE (str
));
1613 for (i
= charset_table_used
- 1; i
>= 0; i
--)
1614 if (!NILP (AREF (charsets
, i
)))
1615 val
= Fcons (CHARSET_NAME (charset_table
+ i
), val
);
1621 /* Return a unified character code for C (>= 0x110000). VAL is a
1622 value of Vchar_unify_table for C; i.e. it is nil, an integer, or a
1625 maybe_unify_char (int c
, Lisp_Object val
)
1627 struct charset
*charset
;
1630 return XFASTINT (val
);
1634 CHECK_CHARSET_GET_CHARSET (val
, charset
);
1636 /* The call to load_charset below can allocate memory, which screws
1637 callers of this function through STRING_CHAR_* macros that hold C
1638 pointers to buffer text, if REL_ALLOC is used. */
1639 r_alloc_inhibit_buffer_relocation (1);
1641 load_charset (charset
, 1);
1642 if (! inhibit_load_charset_map
)
1644 val
= CHAR_TABLE_REF (Vchar_unify_table
, c
);
1650 int code_index
= c
- CHARSET_CODE_OFFSET (charset
);
1651 int unified
= GET_TEMP_CHARSET_WORK_DECODER (code_index
);
1657 r_alloc_inhibit_buffer_relocation (0);
1663 /* Return a character corresponding to the code-point CODE of
1667 decode_char (struct charset
*charset
, unsigned int code
)
1670 enum charset_method method
= CHARSET_METHOD (charset
);
1672 if (code
< CHARSET_MIN_CODE (charset
) || code
> CHARSET_MAX_CODE (charset
))
1675 if (method
== CHARSET_METHOD_SUBSET
)
1677 Lisp_Object subset_info
;
1679 subset_info
= CHARSET_SUBSET (charset
);
1680 charset
= CHARSET_FROM_ID (XFASTINT (AREF (subset_info
, 0)));
1681 code
-= XINT (AREF (subset_info
, 3));
1682 if (code
< XFASTINT (AREF (subset_info
, 1))
1683 || code
> XFASTINT (AREF (subset_info
, 2)))
1686 c
= DECODE_CHAR (charset
, code
);
1688 else if (method
== CHARSET_METHOD_SUPERSET
)
1690 Lisp_Object parents
;
1692 parents
= CHARSET_SUPERSET (charset
);
1694 for (; CONSP (parents
); parents
= XCDR (parents
))
1696 int id
= XINT (XCAR (XCAR (parents
)));
1697 int code_offset
= XINT (XCDR (XCAR (parents
)));
1698 unsigned this_code
= code
- code_offset
;
1700 charset
= CHARSET_FROM_ID (id
);
1701 if ((c
= DECODE_CHAR (charset
, this_code
)) >= 0)
1707 char_index
= CODE_POINT_TO_INDEX (charset
, code
);
1711 if (method
== CHARSET_METHOD_MAP
)
1713 Lisp_Object decoder
;
1715 decoder
= CHARSET_DECODER (charset
);
1716 if (! VECTORP (decoder
))
1718 load_charset (charset
, 1);
1719 decoder
= CHARSET_DECODER (charset
);
1721 if (VECTORP (decoder
))
1722 c
= XINT (AREF (decoder
, char_index
));
1724 c
= GET_TEMP_CHARSET_WORK_DECODER (char_index
);
1726 else /* method == CHARSET_METHOD_OFFSET */
1728 c
= char_index
+ CHARSET_CODE_OFFSET (charset
);
1729 if (CHARSET_UNIFIED_P (charset
)
1730 && c
> MAX_UNICODE_CHAR
)
1731 MAYBE_UNIFY_CHAR (c
);
1738 /* Variable used temporarily by the macro ENCODE_CHAR. */
1739 Lisp_Object charset_work
;
1741 /* Return a code-point of CHAR in CHARSET. If CHAR doesn't belong to
1742 CHARSET, return CHARSET_INVALID_CODE (CHARSET). If STRICT is true,
1743 use CHARSET's strict_max_char instead of max_char. */
1746 encode_char (struct charset
*charset
, int c
)
1749 enum charset_method method
= CHARSET_METHOD (charset
);
1751 if (CHARSET_UNIFIED_P (charset
))
1753 Lisp_Object deunifier
;
1754 int code_index
= -1;
1756 deunifier
= CHARSET_DEUNIFIER (charset
);
1757 if (! CHAR_TABLE_P (deunifier
))
1759 load_charset (charset
, 2);
1760 deunifier
= CHARSET_DEUNIFIER (charset
);
1762 if (CHAR_TABLE_P (deunifier
))
1764 Lisp_Object deunified
= CHAR_TABLE_REF (deunifier
, c
);
1766 if (INTEGERP (deunified
))
1767 code_index
= XINT (deunified
);
1771 code_index
= GET_TEMP_CHARSET_WORK_ENCODER (c
);
1773 if (code_index
>= 0)
1774 c
= CHARSET_CODE_OFFSET (charset
) + code_index
;
1777 if (method
== CHARSET_METHOD_SUBSET
)
1779 Lisp_Object subset_info
;
1780 struct charset
*this_charset
;
1782 subset_info
= CHARSET_SUBSET (charset
);
1783 this_charset
= CHARSET_FROM_ID (XFASTINT (AREF (subset_info
, 0)));
1784 code
= ENCODE_CHAR (this_charset
, c
);
1785 if (code
== CHARSET_INVALID_CODE (this_charset
)
1786 || code
< XFASTINT (AREF (subset_info
, 1))
1787 || code
> XFASTINT (AREF (subset_info
, 2)))
1788 return CHARSET_INVALID_CODE (charset
);
1789 code
+= XINT (AREF (subset_info
, 3));
1793 if (method
== CHARSET_METHOD_SUPERSET
)
1795 Lisp_Object parents
;
1797 parents
= CHARSET_SUPERSET (charset
);
1798 for (; CONSP (parents
); parents
= XCDR (parents
))
1800 int id
= XINT (XCAR (XCAR (parents
)));
1801 int code_offset
= XINT (XCDR (XCAR (parents
)));
1802 struct charset
*this_charset
= CHARSET_FROM_ID (id
);
1804 code
= ENCODE_CHAR (this_charset
, c
);
1805 if (code
!= CHARSET_INVALID_CODE (this_charset
))
1806 return code
+ code_offset
;
1808 return CHARSET_INVALID_CODE (charset
);
1811 if (! CHARSET_FAST_MAP_REF ((c
), charset
->fast_map
)
1812 || c
< CHARSET_MIN_CHAR (charset
) || c
> CHARSET_MAX_CHAR (charset
))
1813 return CHARSET_INVALID_CODE (charset
);
1815 if (method
== CHARSET_METHOD_MAP
)
1817 Lisp_Object encoder
;
1820 encoder
= CHARSET_ENCODER (charset
);
1821 if (! CHAR_TABLE_P (CHARSET_ENCODER (charset
)))
1823 load_charset (charset
, 2);
1824 encoder
= CHARSET_ENCODER (charset
);
1826 if (CHAR_TABLE_P (encoder
))
1828 val
= CHAR_TABLE_REF (encoder
, c
);
1830 return CHARSET_INVALID_CODE (charset
);
1832 if (! CHARSET_COMPACT_CODES_P (charset
))
1833 code
= INDEX_TO_CODE_POINT (charset
, code
);
1837 code
= GET_TEMP_CHARSET_WORK_ENCODER (c
);
1838 code
= INDEX_TO_CODE_POINT (charset
, code
);
1841 else /* method == CHARSET_METHOD_OFFSET */
1843 unsigned code_index
= c
- CHARSET_CODE_OFFSET (charset
);
1845 code
= INDEX_TO_CODE_POINT (charset
, code_index
);
1852 DEFUN ("decode-char", Fdecode_char
, Sdecode_char
, 2, 3, 0,
1853 doc
: /* Decode the pair of CHARSET and CODE-POINT into a character.
1854 Return nil if CODE-POINT is not valid in CHARSET.
1856 CODE-POINT may be a cons (HIGHER-16-BIT-VALUE . LOWER-16-BIT-VALUE).
1858 Optional argument RESTRICTION specifies a way to map the pair of CCS
1859 and CODE-POINT to a character. Currently not supported and just ignored. */)
1860 (Lisp_Object charset
, Lisp_Object code_point
, Lisp_Object restriction
)
1864 struct charset
*charsetp
;
1866 CHECK_CHARSET_GET_ID (charset
, id
);
1867 code
= cons_to_unsigned (code_point
, UINT_MAX
);
1868 charsetp
= CHARSET_FROM_ID (id
);
1869 c
= DECODE_CHAR (charsetp
, code
);
1870 return (c
>= 0 ? make_number (c
) : Qnil
);
1874 DEFUN ("encode-char", Fencode_char
, Sencode_char
, 2, 3, 0,
1875 doc
: /* Encode the character CH into a code-point of CHARSET.
1876 Return nil if CHARSET doesn't include CH.
1878 Optional argument RESTRICTION specifies a way to map CH to a
1879 code-point in CCS. Currently not supported and just ignored. */)
1880 (Lisp_Object ch
, Lisp_Object charset
, Lisp_Object restriction
)
1884 struct charset
*charsetp
;
1886 CHECK_CHARSET_GET_ID (charset
, id
);
1887 CHECK_CHARACTER (ch
);
1889 charsetp
= CHARSET_FROM_ID (id
);
1890 code
= ENCODE_CHAR (charsetp
, c
);
1891 if (code
== CHARSET_INVALID_CODE (charsetp
))
1893 return INTEGER_TO_CONS (code
);
1897 DEFUN ("make-char", Fmake_char
, Smake_char
, 1, 5, 0,
1899 /* Return a character of CHARSET whose position codes are CODEn.
1901 CODE1 through CODE4 are optional, but if you don't supply sufficient
1902 position codes, it is assumed that the minimum code in each dimension
1904 (Lisp_Object charset
, Lisp_Object code1
, Lisp_Object code2
, Lisp_Object code3
, Lisp_Object code4
)
1907 struct charset
*charsetp
;
1911 CHECK_CHARSET_GET_ID (charset
, id
);
1912 charsetp
= CHARSET_FROM_ID (id
);
1914 dimension
= CHARSET_DIMENSION (charsetp
);
1916 code
= (CHARSET_ASCII_COMPATIBLE_P (charsetp
)
1917 ? 0 : CHARSET_MIN_CODE (charsetp
));
1920 CHECK_NATNUM (code1
);
1921 if (XFASTINT (code1
) >= 0x100)
1922 args_out_of_range (make_number (0xFF), code1
);
1923 code
= XFASTINT (code1
);
1929 code
|= charsetp
->code_space
[(dimension
- 2) * 4];
1932 CHECK_NATNUM (code2
);
1933 if (XFASTINT (code2
) >= 0x100)
1934 args_out_of_range (make_number (0xFF), code2
);
1935 code
|= XFASTINT (code2
);
1942 code
|= charsetp
->code_space
[(dimension
- 3) * 4];
1945 CHECK_NATNUM (code3
);
1946 if (XFASTINT (code3
) >= 0x100)
1947 args_out_of_range (make_number (0xFF), code3
);
1948 code
|= XFASTINT (code3
);
1955 code
|= charsetp
->code_space
[0];
1958 CHECK_NATNUM (code4
);
1959 if (XFASTINT (code4
) >= 0x100)
1960 args_out_of_range (make_number (0xFF), code4
);
1961 code
|= XFASTINT (code4
);
1968 if (CHARSET_ISO_FINAL (charsetp
) >= 0)
1970 c
= DECODE_CHAR (charsetp
, code
);
1972 error ("Invalid code(s)");
1973 return make_number (c
);
1977 /* Return the first charset in CHARSET_LIST that contains C.
1978 CHARSET_LIST is a list of charset IDs. If it is nil, use
1979 Vcharset_ordered_list. */
1982 char_charset (int c
, Lisp_Object charset_list
, unsigned int *code_return
)
1986 if (NILP (charset_list
))
1987 charset_list
= Vcharset_ordered_list
;
1991 while (CONSP (charset_list
))
1993 struct charset
*charset
= CHARSET_FROM_ID (XINT (XCAR (charset_list
)));
1994 unsigned code
= ENCODE_CHAR (charset
, c
);
1996 if (code
!= CHARSET_INVALID_CODE (charset
))
1999 *code_return
= code
;
2002 charset_list
= XCDR (charset_list
);
2004 && c
<= MAX_UNICODE_CHAR
2005 && EQ (charset_list
, Vcharset_non_preferred_head
))
2006 return CHARSET_FROM_ID (charset_unicode
);
2008 return (maybe_null
? NULL
2009 : c
<= MAX_5_BYTE_CHAR
? CHARSET_FROM_ID (charset_emacs
)
2010 : CHARSET_FROM_ID (charset_eight_bit
));
2014 DEFUN ("split-char", Fsplit_char
, Ssplit_char
, 1, 1, 0,
2016 /*Return list of charset and one to four position-codes of CH.
2017 The charset is decided by the current priority order of charsets.
2018 A position-code is a byte value of each dimension of the code-point of
2019 CH in the charset. */)
2022 struct charset
*charset
;
2027 CHECK_CHARACTER (ch
);
2029 charset
= CHAR_CHARSET (c
);
2032 code
= ENCODE_CHAR (charset
, c
);
2033 if (code
== CHARSET_INVALID_CODE (charset
))
2035 dimension
= CHARSET_DIMENSION (charset
);
2036 for (val
= Qnil
; dimension
> 0; dimension
--)
2038 val
= Fcons (make_number (code
& 0xFF), val
);
2041 return Fcons (CHARSET_NAME (charset
), val
);
2045 DEFUN ("char-charset", Fchar_charset
, Schar_charset
, 1, 2, 0,
2046 doc
: /* Return the charset of highest priority that contains CH.
2047 If optional 2nd arg RESTRICTION is non-nil, it is a list of charsets
2048 from which to find the charset. It may also be a coding system. In
2049 that case, find the charset from what supported by that coding system. */)
2050 (Lisp_Object ch
, Lisp_Object restriction
)
2052 struct charset
*charset
;
2054 CHECK_CHARACTER (ch
);
2055 if (NILP (restriction
))
2056 charset
= CHAR_CHARSET (XINT (ch
));
2059 if (CONSP (restriction
))
2061 int c
= XFASTINT (ch
);
2063 for (; CONSP (restriction
); restriction
= XCDR (restriction
))
2065 struct charset
*rcharset
;
2067 CHECK_CHARSET_GET_CHARSET (XCAR (restriction
), rcharset
);
2068 if (ENCODE_CHAR (rcharset
, c
) != CHARSET_INVALID_CODE (rcharset
))
2069 return XCAR (restriction
);
2073 restriction
= coding_system_charset_list (restriction
);
2074 charset
= char_charset (XINT (ch
), restriction
, NULL
);
2078 return (CHARSET_NAME (charset
));
2082 DEFUN ("charset-after", Fcharset_after
, Scharset_after
, 0, 1, 0,
2084 Return charset of a character in the current buffer at position POS.
2085 If POS is nil, it defaults to the current point.
2086 If POS is out of range, the value is nil. */)
2090 struct charset
*charset
;
2092 ch
= Fchar_after (pos
);
2093 if (! INTEGERP (ch
))
2095 charset
= CHAR_CHARSET (XINT (ch
));
2096 return (CHARSET_NAME (charset
));
2100 DEFUN ("iso-charset", Fiso_charset
, Siso_charset
, 3, 3, 0,
2102 Return charset of ISO's specification DIMENSION, CHARS, and FINAL-CHAR.
2104 ISO 2022's designation sequence (escape sequence) distinguishes charsets
2105 by their DIMENSION, CHARS, and FINAL-CHAR,
2106 whereas Emacs distinguishes them by charset symbol.
2107 See the documentation of the function `charset-info' for the meanings of
2108 DIMENSION, CHARS, and FINAL-CHAR. */)
2109 (Lisp_Object dimension
, Lisp_Object chars
, Lisp_Object final_char
)
2114 check_iso_charset_parameter (dimension
, chars
, final_char
);
2115 chars_flag
= XFASTINT (chars
) == 96;
2116 id
= ISO_CHARSET_TABLE (XFASTINT (dimension
), chars_flag
,
2117 XFASTINT (final_char
));
2118 return (id
>= 0 ? CHARSET_NAME (CHARSET_FROM_ID (id
)) : Qnil
);
2122 DEFUN ("clear-charset-maps", Fclear_charset_maps
, Sclear_charset_maps
,
2126 Clear temporary charset mapping tables.
2127 It should be called only from temacs invoked for dumping. */)
2130 if (temp_charset_work
)
2132 xfree (temp_charset_work
);
2133 temp_charset_work
= NULL
;
2136 if (CHAR_TABLE_P (Vchar_unify_table
))
2137 Foptimize_char_table (Vchar_unify_table
, Qnil
);
2142 DEFUN ("charset-priority-list", Fcharset_priority_list
,
2143 Scharset_priority_list
, 0, 1, 0,
2144 doc
: /* Return the list of charsets ordered by priority.
2145 HIGHESTP non-nil means just return the highest priority one. */)
2146 (Lisp_Object highestp
)
2148 Lisp_Object val
= Qnil
, list
= Vcharset_ordered_list
;
2150 if (!NILP (highestp
))
2151 return CHARSET_NAME (CHARSET_FROM_ID (XINT (Fcar (list
))));
2153 while (!NILP (list
))
2155 val
= Fcons (CHARSET_NAME (CHARSET_FROM_ID (XINT (XCAR (list
)))), val
);
2158 return Fnreverse (val
);
2161 DEFUN ("set-charset-priority", Fset_charset_priority
, Sset_charset_priority
,
2163 doc
: /* Assign higher priority to the charsets given as arguments.
2164 usage: (set-charset-priority &rest charsets) */)
2165 (ptrdiff_t nargs
, Lisp_Object
*args
)
2167 Lisp_Object new_head
, old_list
, arglist
[2];
2168 Lisp_Object list_2022
, list_emacs_mule
;
2172 old_list
= Fcopy_sequence (Vcharset_ordered_list
);
2174 for (i
= 0; i
< nargs
; i
++)
2176 CHECK_CHARSET_GET_ID (args
[i
], id
);
2177 if (! NILP (Fmemq (make_number (id
), old_list
)))
2179 old_list
= Fdelq (make_number (id
), old_list
);
2180 new_head
= Fcons (make_number (id
), new_head
);
2183 arglist
[0] = Fnreverse (new_head
);
2184 arglist
[1] = Vcharset_non_preferred_head
= old_list
;
2185 Vcharset_ordered_list
= Fnconc (2, arglist
);
2186 charset_ordered_list_tick
++;
2188 charset_unibyte
= -1;
2189 for (old_list
= Vcharset_ordered_list
, list_2022
= list_emacs_mule
= Qnil
;
2190 CONSP (old_list
); old_list
= XCDR (old_list
))
2192 if (! NILP (Fmemq (XCAR (old_list
), Viso_2022_charset_list
)))
2193 list_2022
= Fcons (XCAR (old_list
), list_2022
);
2194 if (! NILP (Fmemq (XCAR (old_list
), Vemacs_mule_charset_list
)))
2195 list_emacs_mule
= Fcons (XCAR (old_list
), list_emacs_mule
);
2196 if (charset_unibyte
< 0)
2198 struct charset
*charset
= CHARSET_FROM_ID (XINT (XCAR (old_list
)));
2200 if (CHARSET_DIMENSION (charset
) == 1
2201 && CHARSET_ASCII_COMPATIBLE_P (charset
)
2202 && CHARSET_MAX_CHAR (charset
) >= 0x80)
2203 charset_unibyte
= CHARSET_ID (charset
);
2206 Viso_2022_charset_list
= Fnreverse (list_2022
);
2207 Vemacs_mule_charset_list
= Fnreverse (list_emacs_mule
);
2208 if (charset_unibyte
< 0)
2209 charset_unibyte
= charset_iso_8859_1
;
2214 DEFUN ("charset-id-internal", Fcharset_id_internal
, Scharset_id_internal
,
2216 doc
: /* Internal use only.
2217 Return charset identification number of CHARSET. */)
2218 (Lisp_Object charset
)
2222 CHECK_CHARSET_GET_ID (charset
, id
);
2223 return make_number (id
);
2226 struct charset_sort_data
2228 Lisp_Object charset
;
2234 charset_compare (const void *d1
, const void *d2
)
2236 const struct charset_sort_data
*data1
= d1
, *data2
= d2
;
2237 if (data1
->priority
!= data2
->priority
)
2238 return data1
->priority
< data2
->priority
? -1 : 1;
2242 DEFUN ("sort-charsets", Fsort_charsets
, Ssort_charsets
, 1, 1, 0,
2243 doc
: /* Sort charset list CHARSETS by a priority of each charset.
2244 Return the sorted list. CHARSETS is modified by side effects.
2245 See also `charset-priority-list' and `set-charset-priority'. */)
2246 (Lisp_Object charsets
)
2248 Lisp_Object len
= Flength (charsets
);
2249 ptrdiff_t n
= XFASTINT (len
), i
, j
;
2251 Lisp_Object tail
, elt
, attrs
;
2252 struct charset_sort_data
*sort_data
;
2253 int id
, min_id
= INT_MAX
, max_id
= INT_MIN
;
2258 SAFE_NALLOCA (sort_data
, 1, n
);
2259 for (tail
= charsets
, i
= 0; CONSP (tail
); tail
= XCDR (tail
), i
++)
2262 CHECK_CHARSET_GET_ATTR (elt
, attrs
);
2263 sort_data
[i
].charset
= elt
;
2264 sort_data
[i
].id
= id
= XINT (CHARSET_ATTR_ID (attrs
));
2270 for (done
= 0, tail
= Vcharset_ordered_list
, i
= 0;
2271 done
< n
&& CONSP (tail
); tail
= XCDR (tail
), i
++)
2274 id
= XFASTINT (elt
);
2275 if (id
>= min_id
&& id
<= max_id
)
2276 for (j
= 0; j
< n
; j
++)
2277 if (sort_data
[j
].id
== id
)
2279 sort_data
[j
].priority
= i
;
2283 qsort (sort_data
, n
, sizeof *sort_data
, charset_compare
);
2284 for (i
= 0, tail
= charsets
; CONSP (tail
); tail
= XCDR (tail
), i
++)
2285 XSETCAR (tail
, sort_data
[i
].charset
);
2294 Lisp_Object tempdir
;
2295 tempdir
= Fexpand_file_name (build_string ("charsets"), Vdata_directory
);
2296 if (access (SSDATA (tempdir
), 0) < 0)
2298 /* This used to be non-fatal (dir_warning), but it should not
2299 happen, and if it does sooner or later it will cause some
2300 obscure problem (eg bug#6401), so better abort. */
2301 fprintf (stderr
, "Error: charsets directory not found:\n\
2303 Emacs will not function correctly without the character map files.\n\
2304 Please check your installation!\n",
2309 Vcharset_map_path
= Fcons (tempdir
, Qnil
);
2314 init_charset_once (void)
2318 for (i
= 0; i
< ISO_MAX_DIMENSION
; i
++)
2319 for (j
= 0; j
< ISO_MAX_CHARS
; j
++)
2320 for (k
= 0; k
< ISO_MAX_FINAL
; k
++)
2321 iso_charset_table
[i
][j
][k
] = -1;
2323 for (i
= 0; i
< 256; i
++)
2324 emacs_mule_charset
[i
] = -1;
2326 charset_jisx0201_roman
= -1;
2327 charset_jisx0208_1978
= -1;
2328 charset_jisx0208
= -1;
2329 charset_ksc5601
= -1;
2334 /* Allocate an initial charset table that is large enough to handle
2335 Emacs while it is bootstrapping. As of September 2011, the size
2336 needs to be at least 166; make it a bit bigger to allow for future
2339 Don't make the value so small that the table is reallocated during
2340 bootstrapping, as glibc malloc calls larger than just under 64 KiB
2341 during an initial bootstrap wreak havoc after dumping; see the
2342 M_MMAP_THRESHOLD value in alloc.c, plus there is a extra overhead
2343 internal to glibc malloc and perhaps to Emacs malloc debugging. */
2344 static struct charset charset_table_init
[180];
2347 syms_of_charset (void)
2349 DEFSYM (Qcharsetp
, "charsetp");
2351 DEFSYM (Qascii
, "ascii");
2352 DEFSYM (Qunicode
, "unicode");
2353 DEFSYM (Qemacs
, "emacs");
2354 DEFSYM (Qeight_bit
, "eight-bit");
2355 DEFSYM (Qiso_8859_1
, "iso-8859-1");
2360 staticpro (&Vcharset_ordered_list
);
2361 Vcharset_ordered_list
= Qnil
;
2363 staticpro (&Viso_2022_charset_list
);
2364 Viso_2022_charset_list
= Qnil
;
2366 staticpro (&Vemacs_mule_charset_list
);
2367 Vemacs_mule_charset_list
= Qnil
;
2369 /* Don't staticpro them here. It's done in syms_of_fns. */
2370 QCtest
= intern_c_string (":test");
2371 Qeq
= intern_c_string ("eq");
2373 staticpro (&Vcharset_hash_table
);
2375 Lisp_Object args
[2];
2378 Vcharset_hash_table
= Fmake_hash_table (2, args
);
2381 charset_table
= charset_table_init
;
2382 charset_table_size
= sizeof charset_table_init
/ sizeof *charset_table_init
;
2383 charset_table_used
= 0;
2385 defsubr (&Scharsetp
);
2386 defsubr (&Smap_charset_chars
);
2387 defsubr (&Sdefine_charset_internal
);
2388 defsubr (&Sdefine_charset_alias
);
2389 defsubr (&Scharset_plist
);
2390 defsubr (&Sset_charset_plist
);
2391 defsubr (&Sunify_charset
);
2392 defsubr (&Sget_unused_iso_final_char
);
2393 defsubr (&Sdeclare_equiv_charset
);
2394 defsubr (&Sfind_charset_region
);
2395 defsubr (&Sfind_charset_string
);
2396 defsubr (&Sdecode_char
);
2397 defsubr (&Sencode_char
);
2398 defsubr (&Ssplit_char
);
2399 defsubr (&Smake_char
);
2400 defsubr (&Schar_charset
);
2401 defsubr (&Scharset_after
);
2402 defsubr (&Siso_charset
);
2403 defsubr (&Sclear_charset_maps
);
2404 defsubr (&Scharset_priority_list
);
2405 defsubr (&Sset_charset_priority
);
2406 defsubr (&Scharset_id_internal
);
2407 defsubr (&Ssort_charsets
);
2409 DEFVAR_LISP ("charset-map-path", Vcharset_map_path
,
2410 doc
: /* List of directories to search for charset map files. */);
2411 Vcharset_map_path
= Qnil
;
2413 DEFVAR_BOOL ("inhibit-load-charset-map", inhibit_load_charset_map
,
2414 doc
: /* Inhibit loading of charset maps. Used when dumping Emacs. */);
2415 inhibit_load_charset_map
= 0;
2417 DEFVAR_LISP ("charset-list", Vcharset_list
,
2418 doc
: /* List of all charsets ever defined. */);
2419 Vcharset_list
= Qnil
;
2421 DEFVAR_LISP ("current-iso639-language", Vcurrent_iso639_language
,
2422 doc
: /* ISO639 language mnemonic symbol for the current language environment.
2423 If the current language environment is for multiple languages (e.g. "Latin-1"),
2424 the value may be a list of mnemonics. */);
2425 Vcurrent_iso639_language
= Qnil
;
2428 = define_charset_internal (Qascii
, 1, "\x00\x7F\x00\x00\x00\x00",
2429 0, 127, 'B', -1, 0, 1, 0, 0);
2431 = define_charset_internal (Qiso_8859_1
, 1, "\x00\xFF\x00\x00\x00\x00",
2432 0, 255, -1, -1, -1, 1, 0, 0);
2434 = define_charset_internal (Qunicode
, 3, "\x00\xFF\x00\xFF\x00\x10",
2435 0, MAX_UNICODE_CHAR
, -1, 0, -1, 1, 0, 0);
2437 = define_charset_internal (Qemacs
, 3, "\x00\xFF\x00\xFF\x00\x3F",
2438 0, MAX_5_BYTE_CHAR
, -1, 0, -1, 1, 1, 0);
2440 = define_charset_internal (Qeight_bit
, 1, "\x80\xFF\x00\x00\x00\x00",
2441 128, 255, -1, 0, -1, 0, 1,
2442 MAX_5_BYTE_CHAR
+ 1);
2443 charset_unibyte
= charset_iso_8859_1
;