1 /* Basic character set support.
2 Copyright (C) 2001-2013 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 bool 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 bool 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
= Fmake_vector (make_number (n
), make_number (-1));
276 set_charset_attr (charset
, charset_decoder
, vec
);
280 char_table_set_range (Vchar_unify_table
,
281 charset
->min_char
, charset
->max_char
,
287 table
= Fmake_char_table (Qnil
, Qnil
);
288 set_charset_attr (charset
,
289 (charset
->method
== CHARSET_METHOD_MAP
290 ? charset_encoder
: charset_deunifier
),
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 '#'. */
424 read_hex (FILE *fp
, bool *eof
, bool *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 (c_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
,
482 unsigned min_code
= CHARSET_MIN_CODE (charset
);
483 unsigned max_code
= CHARSET_MAX_CODE (charset
);
486 Lisp_Object suffixes
;
487 struct charset_map_entries
*head
, *entries
;
491 suffixes
= list2 (build_string (".map"), build_string (".TXT"));
493 count
= SPECPDL_INDEX ();
494 record_unwind_protect_nothing ();
495 specbind (Qfile_name_handler_alist
, Qnil
);
496 fd
= openp (Vcharset_map_path
, mapfile
, suffixes
, NULL
, Qnil
);
497 fp
= fd
< 0 ? 0 : fdopen (fd
, "r");
500 int open_errno
= errno
;
502 report_file_errno ("Loading charset map", mapfile
, open_errno
);
504 set_unwind_protect_ptr (count
, fclose_unwind
, fp
);
505 unbind_to (count
+ 1, Qnil
);
507 /* Use record_xmalloc, as `charset_map_entries' is
508 large (larger than MAX_ALLOCA). */
509 head
= record_xmalloc (sizeof *head
);
511 memset (entries
, 0, sizeof (struct charset_map_entries
));
516 unsigned from
, to
, c
;
518 bool eof
= 0, overflow
= 0;
520 from
= read_hex (fp
, &eof
, &overflow
);
523 if (getc (fp
) == '-')
524 to
= read_hex (fp
, &eof
, &overflow
);
529 c
= read_hex (fp
, &eof
, &overflow
);
535 if (from
< min_code
|| to
> max_code
|| from
> to
|| c
> MAX_CHAR
)
538 if (n_entries
== 0x10000)
540 entries
->next
= record_xmalloc (sizeof *entries
->next
);
541 entries
= entries
->next
;
542 memset (entries
, 0, sizeof (struct charset_map_entries
));
546 entries
->entry
[idx
].from
= from
;
547 entries
->entry
[idx
].to
= to
;
548 entries
->entry
[idx
].c
= c
;
552 clear_unwind_protect (count
);
554 load_charset_map (charset
, head
, n_entries
, control_flag
);
555 unbind_to (count
, Qnil
);
559 load_charset_map_from_vector (struct charset
*charset
, Lisp_Object vec
, int control_flag
)
561 unsigned min_code
= CHARSET_MIN_CODE (charset
);
562 unsigned max_code
= CHARSET_MAX_CODE (charset
);
563 struct charset_map_entries
*head
, *entries
;
565 int len
= ASIZE (vec
);
571 add_to_log ("Failure in loading charset map: %V", vec
, Qnil
);
575 /* Use SAFE_ALLOCA instead of alloca, as `charset_map_entries' is
576 large (larger than MAX_ALLOCA). */
577 head
= SAFE_ALLOCA (sizeof *head
);
579 memset (entries
, 0, sizeof (struct charset_map_entries
));
582 for (i
= 0; i
< len
; i
+= 2)
584 Lisp_Object val
, val2
;
594 from
= XFASTINT (val
);
595 to
= XFASTINT (val2
);
598 from
= to
= XFASTINT (val
);
599 val
= AREF (vec
, i
+ 1);
603 if (from
< min_code
|| to
> max_code
|| from
> to
|| c
> MAX_CHAR
)
606 if (n_entries
> 0 && (n_entries
% 0x10000) == 0)
608 entries
->next
= SAFE_ALLOCA (sizeof *entries
->next
);
609 entries
= entries
->next
;
610 memset (entries
, 0, sizeof (struct charset_map_entries
));
612 idx
= n_entries
% 0x10000;
613 entries
->entry
[idx
].from
= from
;
614 entries
->entry
[idx
].to
= to
;
615 entries
->entry
[idx
].c
= c
;
619 load_charset_map (charset
, head
, n_entries
, control_flag
);
624 /* Load a mapping table for CHARSET. CONTROL-FLAG tells what kind of
625 map it is (see the comment of load_charset_map for the detail). */
628 load_charset (struct charset
*charset
, int control_flag
)
632 if (inhibit_load_charset_map
634 && charset
== temp_charset_work
->current
635 && ((control_flag
== 2) == temp_charset_work
->for_encoder
))
638 if (CHARSET_METHOD (charset
) == CHARSET_METHOD_MAP
)
639 map
= CHARSET_MAP (charset
);
642 if (! CHARSET_UNIFIED_P (charset
))
644 map
= CHARSET_UNIFY_MAP (charset
);
647 load_charset_map_from_file (charset
, map
, control_flag
);
649 load_charset_map_from_vector (charset
, map
, control_flag
);
653 DEFUN ("charsetp", Fcharsetp
, Scharsetp
, 1, 1, 0,
654 doc
: /* Return non-nil if and only if OBJECT is a charset.*/)
657 return (CHARSETP (object
) ? Qt
: Qnil
);
662 map_charset_for_dump (void (*c_function
) (Lisp_Object
, Lisp_Object
),
663 Lisp_Object function
, Lisp_Object arg
,
664 unsigned int from
, unsigned int to
)
666 int from_idx
= CODE_POINT_TO_INDEX (temp_charset_work
->current
, from
);
667 int to_idx
= CODE_POINT_TO_INDEX (temp_charset_work
->current
, to
);
672 range
= Fcons (Qnil
, Qnil
);
675 c
= temp_charset_work
->min_char
;
676 stop
= (temp_charset_work
->max_char
< 0x20000
677 ? temp_charset_work
->max_char
: 0xFFFF);
681 int idx
= GET_TEMP_CHARSET_WORK_ENCODER (c
);
683 if (idx
>= from_idx
&& idx
<= to_idx
)
685 if (NILP (XCAR (range
)))
686 XSETCAR (range
, make_number (c
));
688 else if (! NILP (XCAR (range
)))
690 XSETCDR (range
, make_number (c
- 1));
692 (*c_function
) (arg
, range
);
694 call2 (function
, range
, arg
);
695 XSETCAR (range
, Qnil
);
699 if (c
== temp_charset_work
->max_char
)
701 if (! NILP (XCAR (range
)))
703 XSETCDR (range
, make_number (c
));
705 (*c_function
) (arg
, range
);
707 call2 (function
, range
, arg
);
712 stop
= temp_charset_work
->max_char
;
720 map_charset_chars (void (*c_function
)(Lisp_Object
, Lisp_Object
), Lisp_Object function
,
721 Lisp_Object arg
, struct charset
*charset
, unsigned from
, unsigned to
)
724 bool 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 bool 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
= make_uninit_vector (4);
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 set_hash_value_slot (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 ptrdiff_t new_size
= old_size
;
1151 struct charset
*new_table
=
1152 xpalloc (0, &new_size
, 1,
1153 min (INT_MAX
, MOST_POSITIVE_FIXNUM
),
1154 sizeof *charset_table
);
1155 memcpy (new_table
, charset_table
, old_size
* sizeof *new_table
);
1156 charset_table
= new_table
;
1157 charset_table_size
= new_size
;
1158 /* FIXME: This leaks memory, as the old charset_table becomes
1159 unreachable. If the old charset table is charset_table_init
1160 then this leak is intentional; otherwise, it's unclear.
1161 If the latter memory leak is intentional, a
1162 comment should be added to explain this. If not, the old
1163 charset_table should be freed, by passing it as the 1st argument
1164 to xpalloc and removing the memcpy. */
1166 id
= charset_table_used
++;
1167 new_definition_p
= 1;
1170 ASET (attrs
, charset_id
, make_number (id
));
1172 charset_table
[id
] = charset
;
1174 if (charset
.method
== CHARSET_METHOD_MAP
)
1176 load_charset (&charset
, 0);
1177 charset_table
[id
] = charset
;
1180 if (charset
.iso_final
>= 0)
1182 ISO_CHARSET_TABLE (charset
.dimension
, charset
.iso_chars_96
,
1183 charset
.iso_final
) = id
;
1184 if (new_definition_p
)
1185 Viso_2022_charset_list
= nconc2 (Viso_2022_charset_list
,
1186 list1 (make_number (id
)));
1187 if (ISO_CHARSET_TABLE (1, 0, 'J') == id
)
1188 charset_jisx0201_roman
= id
;
1189 else if (ISO_CHARSET_TABLE (2, 0, '@') == id
)
1190 charset_jisx0208_1978
= id
;
1191 else if (ISO_CHARSET_TABLE (2, 0, 'B') == id
)
1192 charset_jisx0208
= id
;
1193 else if (ISO_CHARSET_TABLE (2, 0, 'C') == id
)
1194 charset_ksc5601
= id
;
1197 if (charset
.emacs_mule_id
>= 0)
1199 emacs_mule_charset
[charset
.emacs_mule_id
] = id
;
1200 if (charset
.emacs_mule_id
< 0xA0)
1201 emacs_mule_bytes
[charset
.emacs_mule_id
] = charset
.dimension
+ 1;
1203 emacs_mule_bytes
[charset
.emacs_mule_id
] = charset
.dimension
+ 2;
1204 if (new_definition_p
)
1205 Vemacs_mule_charset_list
= nconc2 (Vemacs_mule_charset_list
,
1206 list1 (make_number (id
)));
1209 if (new_definition_p
)
1211 Vcharset_list
= Fcons (args
[charset_arg_name
], Vcharset_list
);
1212 if (charset
.supplementary_p
)
1213 Vcharset_ordered_list
= nconc2 (Vcharset_ordered_list
,
1214 list1 (make_number (id
)));
1219 for (tail
= Vcharset_ordered_list
; CONSP (tail
); tail
= XCDR (tail
))
1221 struct charset
*cs
= CHARSET_FROM_ID (XINT (XCAR (tail
)));
1223 if (cs
->supplementary_p
)
1226 if (EQ (tail
, Vcharset_ordered_list
))
1227 Vcharset_ordered_list
= Fcons (make_number (id
),
1228 Vcharset_ordered_list
);
1229 else if (NILP (tail
))
1230 Vcharset_ordered_list
= nconc2 (Vcharset_ordered_list
,
1231 list1 (make_number (id
)));
1234 val
= Fcons (XCAR (tail
), XCDR (tail
));
1235 XSETCDR (tail
, val
);
1236 XSETCAR (tail
, make_number (id
));
1239 charset_ordered_list_tick
++;
1246 /* Same as Fdefine_charset_internal but arguments are more convenient
1247 to call from C (typically in syms_of_charset). This can define a
1248 charset of `offset' method only. Return the ID of the new
1252 define_charset_internal (Lisp_Object name
,
1254 const char *code_space_chars
,
1255 unsigned min_code
, unsigned max_code
,
1256 int iso_final
, int iso_revision
, int emacs_mule_id
,
1257 bool ascii_compatible
, bool supplementary
,
1260 const unsigned char *code_space
= (const unsigned char *) code_space_chars
;
1261 Lisp_Object args
[charset_arg_max
];
1265 args
[charset_arg_name
] = name
;
1266 args
[charset_arg_dimension
] = make_number (dimension
);
1267 val
= make_uninit_vector (8);
1268 for (i
= 0; i
< 8; i
++)
1269 ASET (val
, i
, make_number (code_space
[i
]));
1270 args
[charset_arg_code_space
] = val
;
1271 args
[charset_arg_min_code
] = make_number (min_code
);
1272 args
[charset_arg_max_code
] = make_number (max_code
);
1273 args
[charset_arg_iso_final
]
1274 = (iso_final
< 0 ? Qnil
: make_number (iso_final
));
1275 args
[charset_arg_iso_revision
] = make_number (iso_revision
);
1276 args
[charset_arg_emacs_mule_id
]
1277 = (emacs_mule_id
< 0 ? Qnil
: make_number (emacs_mule_id
));
1278 args
[charset_arg_ascii_compatible_p
] = ascii_compatible
? Qt
: Qnil
;
1279 args
[charset_arg_supplementary_p
] = supplementary
? Qt
: Qnil
;
1280 args
[charset_arg_invalid_code
] = Qnil
;
1281 args
[charset_arg_code_offset
] = make_number (code_offset
);
1282 args
[charset_arg_map
] = Qnil
;
1283 args
[charset_arg_subset
] = Qnil
;
1284 args
[charset_arg_superset
] = Qnil
;
1285 args
[charset_arg_unify_map
] = Qnil
;
1287 args
[charset_arg_plist
] =
1288 listn (CONSTYPE_HEAP
, 14,
1289 intern_c_string (":name"),
1290 args
[charset_arg_name
],
1291 intern_c_string (":dimension"),
1292 args
[charset_arg_dimension
],
1293 intern_c_string (":code-space"),
1294 args
[charset_arg_code_space
],
1295 intern_c_string (":iso-final-char"),
1296 args
[charset_arg_iso_final
],
1297 intern_c_string (":emacs-mule-id"),
1298 args
[charset_arg_emacs_mule_id
],
1299 intern_c_string (":ascii-compatible-p"),
1300 args
[charset_arg_ascii_compatible_p
],
1301 intern_c_string (":code-offset"),
1302 args
[charset_arg_code_offset
]);
1303 Fdefine_charset_internal (charset_arg_max
, args
);
1305 return XINT (CHARSET_SYMBOL_ID (name
));
1309 DEFUN ("define-charset-alias", Fdefine_charset_alias
,
1310 Sdefine_charset_alias
, 2, 2, 0,
1311 doc
: /* Define ALIAS as an alias for charset CHARSET. */)
1312 (Lisp_Object alias
, Lisp_Object charset
)
1316 CHECK_CHARSET_GET_ATTR (charset
, attr
);
1317 Fputhash (alias
, attr
, Vcharset_hash_table
);
1318 Vcharset_list
= Fcons (alias
, Vcharset_list
);
1323 DEFUN ("charset-plist", Fcharset_plist
, Scharset_plist
, 1, 1, 0,
1324 doc
: /* Return the property list of CHARSET. */)
1325 (Lisp_Object charset
)
1329 CHECK_CHARSET_GET_ATTR (charset
, attrs
);
1330 return CHARSET_ATTR_PLIST (attrs
);
1334 DEFUN ("set-charset-plist", Fset_charset_plist
, Sset_charset_plist
, 2, 2, 0,
1335 doc
: /* Set CHARSET's property list to PLIST. */)
1336 (Lisp_Object charset
, Lisp_Object plist
)
1340 CHECK_CHARSET_GET_ATTR (charset
, attrs
);
1341 ASET (attrs
, charset_plist
, plist
);
1346 DEFUN ("unify-charset", Funify_charset
, Sunify_charset
, 1, 3, 0,
1347 doc
: /* Unify characters of CHARSET with Unicode.
1348 This means reading the relevant file and installing the table defined
1349 by CHARSET's `:unify-map' property.
1351 Optional second arg UNIFY-MAP is a file name string or a vector. It has
1352 the same meaning as the `:unify-map' attribute in the function
1353 `define-charset' (which see).
1355 Optional third argument DEUNIFY, if non-nil, means to de-unify CHARSET. */)
1356 (Lisp_Object charset
, Lisp_Object unify_map
, Lisp_Object deunify
)
1361 CHECK_CHARSET_GET_ID (charset
, id
);
1362 cs
= CHARSET_FROM_ID (id
);
1364 ? CHARSET_UNIFIED_P (cs
) && ! NILP (CHARSET_DEUNIFIER (cs
))
1365 : ! CHARSET_UNIFIED_P (cs
))
1368 CHARSET_UNIFIED_P (cs
) = 0;
1371 if (CHARSET_METHOD (cs
) != CHARSET_METHOD_OFFSET
1372 || CHARSET_CODE_OFFSET (cs
) < 0x110000)
1373 error ("Can't unify charset: %s", SDATA (SYMBOL_NAME (charset
)));
1374 if (NILP (unify_map
))
1375 unify_map
= CHARSET_UNIFY_MAP (cs
);
1378 if (! STRINGP (unify_map
) && ! VECTORP (unify_map
))
1379 signal_error ("Bad unify-map", unify_map
);
1380 set_charset_attr (cs
, charset_unify_map
, unify_map
);
1382 if (NILP (Vchar_unify_table
))
1383 Vchar_unify_table
= Fmake_char_table (Qnil
, Qnil
);
1384 char_table_set_range (Vchar_unify_table
,
1385 cs
->min_char
, cs
->max_char
, charset
);
1386 CHARSET_UNIFIED_P (cs
) = 1;
1388 else if (CHAR_TABLE_P (Vchar_unify_table
))
1390 unsigned min_code
= CHARSET_MIN_CODE (cs
);
1391 unsigned max_code
= CHARSET_MAX_CODE (cs
);
1392 int min_char
= DECODE_CHAR (cs
, min_code
);
1393 int max_char
= DECODE_CHAR (cs
, max_code
);
1395 char_table_set_range (Vchar_unify_table
, min_char
, max_char
, Qnil
);
1401 DEFUN ("get-unused-iso-final-char", Fget_unused_iso_final_char
,
1402 Sget_unused_iso_final_char
, 2, 2, 0,
1404 Return an unused ISO final char for a charset of DIMENSION and CHARS.
1405 DIMENSION is the number of bytes to represent a character: 1 or 2.
1406 CHARS is the number of characters in a dimension: 94 or 96.
1408 This final char is for private use, thus the range is `0' (48) .. `?' (63).
1409 If there's no unused final char for the specified kind of charset,
1411 (Lisp_Object dimension
, Lisp_Object chars
)
1415 CHECK_NUMBER (dimension
);
1416 CHECK_NUMBER (chars
);
1417 if (XINT (dimension
) != 1 && XINT (dimension
) != 2 && XINT (dimension
) != 3)
1418 args_out_of_range_3 (dimension
, make_number (1), make_number (3));
1419 if (XINT (chars
) != 94 && XINT (chars
) != 96)
1420 args_out_of_range_3 (chars
, make_number (94), make_number (96));
1421 for (final_char
= '0'; final_char
<= '?'; final_char
++)
1422 if (ISO_CHARSET_TABLE (XINT (dimension
), XINT (chars
), final_char
) < 0)
1424 return (final_char
<= '?' ? make_number (final_char
) : Qnil
);
1428 check_iso_charset_parameter (Lisp_Object dimension
, Lisp_Object chars
, Lisp_Object final_char
)
1430 CHECK_NATNUM (dimension
);
1431 CHECK_NATNUM (chars
);
1432 CHECK_CHARACTER (final_char
);
1434 if (XINT (dimension
) > 3)
1435 error ("Invalid DIMENSION %"pI
"d, it should be 1, 2, or 3",
1437 if (XINT (chars
) != 94 && XINT (chars
) != 96)
1438 error ("Invalid CHARS %"pI
"d, it should be 94 or 96", XINT (chars
));
1439 if (XINT (final_char
) < '0' || XINT (final_char
) > '~')
1440 error ("Invalid FINAL-CHAR %c, it should be `0'..`~'",
1441 (int)XINT (final_char
));
1445 DEFUN ("declare-equiv-charset", Fdeclare_equiv_charset
, Sdeclare_equiv_charset
,
1447 doc
: /* Declare an equivalent charset for ISO-2022 decoding.
1449 On decoding by an ISO-2022 base coding system, when a charset
1450 specified by DIMENSION, CHARS, and FINAL-CHAR is designated, behave as
1451 if CHARSET is designated instead. */)
1452 (Lisp_Object dimension
, Lisp_Object chars
, Lisp_Object final_char
, Lisp_Object charset
)
1457 CHECK_CHARSET_GET_ID (charset
, id
);
1458 check_iso_charset_parameter (dimension
, chars
, final_char
);
1459 chars_flag
= XINT (chars
) == 96;
1460 ISO_CHARSET_TABLE (XINT (dimension
), chars_flag
, XINT (final_char
)) = id
;
1465 /* Return information about charsets in the text at PTR of NBYTES
1466 bytes, which are NCHARS characters. The value is:
1468 0: Each character is represented by one byte. This is always
1469 true for a unibyte string. For a multibyte string, true if
1470 it contains only ASCII characters.
1472 1: No charsets other than ascii, control-1, and latin-1 are
1479 string_xstring_p (Lisp_Object string
)
1481 const unsigned char *p
= SDATA (string
);
1482 const unsigned char *endp
= p
+ SBYTES (string
);
1484 if (SCHARS (string
) == SBYTES (string
))
1489 int c
= STRING_CHAR_ADVANCE (p
);
1498 /* Find charsets in the string at PTR of NCHARS and NBYTES.
1500 CHARSETS is a vector. If Nth element is non-nil, it means the
1501 charset whose id is N is already found.
1503 It may lookup a translation table TABLE if supplied. */
1506 find_charsets_in_text (const unsigned char *ptr
, ptrdiff_t nchars
,
1507 ptrdiff_t nbytes
, Lisp_Object charsets
,
1508 Lisp_Object table
, bool multibyte
)
1510 const unsigned char *pend
= ptr
+ nbytes
;
1512 if (nchars
== nbytes
)
1515 ASET (charsets
, charset_ascii
, Qt
);
1522 c
= translate_char (table
, c
);
1523 if (ASCII_BYTE_P (c
))
1524 ASET (charsets
, charset_ascii
, Qt
);
1526 ASET (charsets
, charset_eight_bit
, Qt
);
1533 int c
= STRING_CHAR_ADVANCE (ptr
);
1534 struct charset
*charset
;
1537 c
= translate_char (table
, c
);
1538 charset
= CHAR_CHARSET (c
);
1539 ASET (charsets
, CHARSET_ID (charset
), Qt
);
1544 DEFUN ("find-charset-region", Ffind_charset_region
, Sfind_charset_region
,
1546 doc
: /* Return a list of charsets in the region between BEG and END.
1547 BEG and END are buffer positions.
1548 Optional arg TABLE if non-nil is a translation table to look up.
1550 If the current buffer is unibyte, the returned list may contain
1551 only `ascii', `eight-bit-control', and `eight-bit-graphic'. */)
1552 (Lisp_Object beg
, Lisp_Object end
, Lisp_Object table
)
1554 Lisp_Object charsets
;
1555 ptrdiff_t from
, from_byte
, to
, stop
, stop_byte
;
1558 bool multibyte
= ! NILP (BVAR (current_buffer
, enable_multibyte_characters
));
1560 validate_region (&beg
, &end
);
1561 from
= XFASTINT (beg
);
1562 stop
= to
= XFASTINT (end
);
1564 if (from
< GPT
&& GPT
< to
)
1567 stop_byte
= GPT_BYTE
;
1570 stop_byte
= CHAR_TO_BYTE (stop
);
1572 from_byte
= CHAR_TO_BYTE (from
);
1574 charsets
= Fmake_vector (make_number (charset_table_used
), Qnil
);
1577 find_charsets_in_text (BYTE_POS_ADDR (from_byte
), stop
- from
,
1578 stop_byte
- from_byte
, charsets
, table
,
1582 from
= stop
, from_byte
= stop_byte
;
1583 stop
= to
, stop_byte
= CHAR_TO_BYTE (stop
);
1590 for (i
= charset_table_used
- 1; i
>= 0; i
--)
1591 if (!NILP (AREF (charsets
, i
)))
1592 val
= Fcons (CHARSET_NAME (charset_table
+ i
), val
);
1596 DEFUN ("find-charset-string", Ffind_charset_string
, Sfind_charset_string
,
1598 doc
: /* Return a list of charsets in STR.
1599 Optional arg TABLE if non-nil is a translation table to look up.
1601 If STR is unibyte, the returned list may contain
1602 only `ascii', `eight-bit-control', and `eight-bit-graphic'. */)
1603 (Lisp_Object str
, Lisp_Object table
)
1605 Lisp_Object charsets
;
1611 charsets
= Fmake_vector (make_number (charset_table_used
), Qnil
);
1612 find_charsets_in_text (SDATA (str
), SCHARS (str
), SBYTES (str
),
1614 STRING_MULTIBYTE (str
));
1616 for (i
= charset_table_used
- 1; i
>= 0; i
--)
1617 if (!NILP (AREF (charsets
, i
)))
1618 val
= Fcons (CHARSET_NAME (charset_table
+ i
), val
);
1624 /* Return a unified character code for C (>= 0x110000). VAL is a
1625 value of Vchar_unify_table for C; i.e. it is nil, an integer, or a
1628 maybe_unify_char (int c
, Lisp_Object val
)
1630 struct charset
*charset
;
1633 return XFASTINT (val
);
1637 CHECK_CHARSET_GET_CHARSET (val
, charset
);
1639 /* The call to load_charset below can allocate memory, which screws
1640 callers of this function through STRING_CHAR_* macros that hold C
1641 pointers to buffer text, if REL_ALLOC is used. */
1642 r_alloc_inhibit_buffer_relocation (1);
1644 load_charset (charset
, 1);
1645 if (! inhibit_load_charset_map
)
1647 val
= CHAR_TABLE_REF (Vchar_unify_table
, c
);
1653 int code_index
= c
- CHARSET_CODE_OFFSET (charset
);
1654 int unified
= GET_TEMP_CHARSET_WORK_DECODER (code_index
);
1660 r_alloc_inhibit_buffer_relocation (0);
1666 /* Return a character corresponding to the code-point CODE of
1670 decode_char (struct charset
*charset
, unsigned int code
)
1673 enum charset_method method
= CHARSET_METHOD (charset
);
1675 if (code
< CHARSET_MIN_CODE (charset
) || code
> CHARSET_MAX_CODE (charset
))
1678 if (method
== CHARSET_METHOD_SUBSET
)
1680 Lisp_Object subset_info
;
1682 subset_info
= CHARSET_SUBSET (charset
);
1683 charset
= CHARSET_FROM_ID (XFASTINT (AREF (subset_info
, 0)));
1684 code
-= XINT (AREF (subset_info
, 3));
1685 if (code
< XFASTINT (AREF (subset_info
, 1))
1686 || code
> XFASTINT (AREF (subset_info
, 2)))
1689 c
= DECODE_CHAR (charset
, code
);
1691 else if (method
== CHARSET_METHOD_SUPERSET
)
1693 Lisp_Object parents
;
1695 parents
= CHARSET_SUPERSET (charset
);
1697 for (; CONSP (parents
); parents
= XCDR (parents
))
1699 int id
= XINT (XCAR (XCAR (parents
)));
1700 int code_offset
= XINT (XCDR (XCAR (parents
)));
1701 unsigned this_code
= code
- code_offset
;
1703 charset
= CHARSET_FROM_ID (id
);
1704 if ((c
= DECODE_CHAR (charset
, this_code
)) >= 0)
1710 char_index
= CODE_POINT_TO_INDEX (charset
, code
);
1714 if (method
== CHARSET_METHOD_MAP
)
1716 Lisp_Object decoder
;
1718 decoder
= CHARSET_DECODER (charset
);
1719 if (! VECTORP (decoder
))
1721 load_charset (charset
, 1);
1722 decoder
= CHARSET_DECODER (charset
);
1724 if (VECTORP (decoder
))
1725 c
= XINT (AREF (decoder
, char_index
));
1727 c
= GET_TEMP_CHARSET_WORK_DECODER (char_index
);
1729 else /* method == CHARSET_METHOD_OFFSET */
1731 c
= char_index
+ CHARSET_CODE_OFFSET (charset
);
1732 if (CHARSET_UNIFIED_P (charset
)
1733 && MAX_UNICODE_CHAR
< c
&& c
<= MAX_5_BYTE_CHAR
)
1735 /* Unify C with a Unicode character if possible. */
1736 Lisp_Object val
= CHAR_TABLE_REF (Vchar_unify_table
, c
);
1737 c
= maybe_unify_char (c
, val
);
1745 /* Variable used temporarily by the macro ENCODE_CHAR. */
1746 Lisp_Object charset_work
;
1748 /* Return a code-point of C in CHARSET. If C doesn't belong to
1749 CHARSET, return CHARSET_INVALID_CODE (CHARSET). If STRICT is true,
1750 use CHARSET's strict_max_char instead of max_char. */
1753 encode_char (struct charset
*charset
, int c
)
1756 enum charset_method method
= CHARSET_METHOD (charset
);
1758 if (CHARSET_UNIFIED_P (charset
))
1760 Lisp_Object deunifier
;
1761 int code_index
= -1;
1763 deunifier
= CHARSET_DEUNIFIER (charset
);
1764 if (! CHAR_TABLE_P (deunifier
))
1766 load_charset (charset
, 2);
1767 deunifier
= CHARSET_DEUNIFIER (charset
);
1769 if (CHAR_TABLE_P (deunifier
))
1771 Lisp_Object deunified
= CHAR_TABLE_REF (deunifier
, c
);
1773 if (INTEGERP (deunified
))
1774 code_index
= XINT (deunified
);
1778 code_index
= GET_TEMP_CHARSET_WORK_ENCODER (c
);
1780 if (code_index
>= 0)
1781 c
= CHARSET_CODE_OFFSET (charset
) + code_index
;
1784 if (method
== CHARSET_METHOD_SUBSET
)
1786 Lisp_Object subset_info
;
1787 struct charset
*this_charset
;
1789 subset_info
= CHARSET_SUBSET (charset
);
1790 this_charset
= CHARSET_FROM_ID (XFASTINT (AREF (subset_info
, 0)));
1791 code
= ENCODE_CHAR (this_charset
, c
);
1792 if (code
== CHARSET_INVALID_CODE (this_charset
)
1793 || code
< XFASTINT (AREF (subset_info
, 1))
1794 || code
> XFASTINT (AREF (subset_info
, 2)))
1795 return CHARSET_INVALID_CODE (charset
);
1796 code
+= XINT (AREF (subset_info
, 3));
1800 if (method
== CHARSET_METHOD_SUPERSET
)
1802 Lisp_Object parents
;
1804 parents
= CHARSET_SUPERSET (charset
);
1805 for (; CONSP (parents
); parents
= XCDR (parents
))
1807 int id
= XINT (XCAR (XCAR (parents
)));
1808 int code_offset
= XINT (XCDR (XCAR (parents
)));
1809 struct charset
*this_charset
= CHARSET_FROM_ID (id
);
1811 code
= ENCODE_CHAR (this_charset
, c
);
1812 if (code
!= CHARSET_INVALID_CODE (this_charset
))
1813 return code
+ code_offset
;
1815 return CHARSET_INVALID_CODE (charset
);
1818 if (! CHARSET_FAST_MAP_REF ((c
), charset
->fast_map
)
1819 || c
< CHARSET_MIN_CHAR (charset
) || c
> CHARSET_MAX_CHAR (charset
))
1820 return CHARSET_INVALID_CODE (charset
);
1822 if (method
== CHARSET_METHOD_MAP
)
1824 Lisp_Object encoder
;
1827 encoder
= CHARSET_ENCODER (charset
);
1828 if (! CHAR_TABLE_P (CHARSET_ENCODER (charset
)))
1830 load_charset (charset
, 2);
1831 encoder
= CHARSET_ENCODER (charset
);
1833 if (CHAR_TABLE_P (encoder
))
1835 val
= CHAR_TABLE_REF (encoder
, c
);
1837 return CHARSET_INVALID_CODE (charset
);
1839 if (! CHARSET_COMPACT_CODES_P (charset
))
1840 code
= INDEX_TO_CODE_POINT (charset
, code
);
1844 code
= GET_TEMP_CHARSET_WORK_ENCODER (c
);
1845 code
= INDEX_TO_CODE_POINT (charset
, code
);
1848 else /* method == CHARSET_METHOD_OFFSET */
1850 unsigned code_index
= c
- CHARSET_CODE_OFFSET (charset
);
1852 code
= INDEX_TO_CODE_POINT (charset
, code_index
);
1859 DEFUN ("decode-char", Fdecode_char
, Sdecode_char
, 2, 3, 0,
1860 doc
: /* Decode the pair of CHARSET and CODE-POINT into a character.
1861 Return nil if CODE-POINT is not valid in CHARSET.
1863 CODE-POINT may be a cons (HIGHER-16-BIT-VALUE . LOWER-16-BIT-VALUE).
1865 Optional argument RESTRICTION specifies a way to map the pair of CCS
1866 and CODE-POINT to a character. Currently not supported and just ignored. */)
1867 (Lisp_Object charset
, Lisp_Object code_point
, Lisp_Object restriction
)
1871 struct charset
*charsetp
;
1873 CHECK_CHARSET_GET_ID (charset
, id
);
1874 code
= cons_to_unsigned (code_point
, UINT_MAX
);
1875 charsetp
= CHARSET_FROM_ID (id
);
1876 c
= DECODE_CHAR (charsetp
, code
);
1877 return (c
>= 0 ? make_number (c
) : Qnil
);
1881 DEFUN ("encode-char", Fencode_char
, Sencode_char
, 2, 3, 0,
1882 doc
: /* Encode the character CH into a code-point of CHARSET.
1883 Return nil if CHARSET doesn't include CH.
1885 Optional argument RESTRICTION specifies a way to map CH to a
1886 code-point in CCS. Currently not supported and just ignored. */)
1887 (Lisp_Object ch
, Lisp_Object charset
, Lisp_Object restriction
)
1891 struct charset
*charsetp
;
1893 CHECK_CHARSET_GET_ID (charset
, id
);
1894 CHECK_CHARACTER (ch
);
1896 charsetp
= CHARSET_FROM_ID (id
);
1897 code
= ENCODE_CHAR (charsetp
, c
);
1898 if (code
== CHARSET_INVALID_CODE (charsetp
))
1900 return INTEGER_TO_CONS (code
);
1904 DEFUN ("make-char", Fmake_char
, Smake_char
, 1, 5, 0,
1906 /* Return a character of CHARSET whose position codes are CODEn.
1908 CODE1 through CODE4 are optional, but if you don't supply sufficient
1909 position codes, it is assumed that the minimum code in each dimension
1911 (Lisp_Object charset
, Lisp_Object code1
, Lisp_Object code2
, Lisp_Object code3
, Lisp_Object code4
)
1914 struct charset
*charsetp
;
1918 CHECK_CHARSET_GET_ID (charset
, id
);
1919 charsetp
= CHARSET_FROM_ID (id
);
1921 dimension
= CHARSET_DIMENSION (charsetp
);
1923 code
= (CHARSET_ASCII_COMPATIBLE_P (charsetp
)
1924 ? 0 : CHARSET_MIN_CODE (charsetp
));
1927 CHECK_NATNUM (code1
);
1928 if (XFASTINT (code1
) >= 0x100)
1929 args_out_of_range (make_number (0xFF), code1
);
1930 code
= XFASTINT (code1
);
1936 code
|= charsetp
->code_space
[(dimension
- 2) * 4];
1939 CHECK_NATNUM (code2
);
1940 if (XFASTINT (code2
) >= 0x100)
1941 args_out_of_range (make_number (0xFF), code2
);
1942 code
|= XFASTINT (code2
);
1949 code
|= charsetp
->code_space
[(dimension
- 3) * 4];
1952 CHECK_NATNUM (code3
);
1953 if (XFASTINT (code3
) >= 0x100)
1954 args_out_of_range (make_number (0xFF), code3
);
1955 code
|= XFASTINT (code3
);
1962 code
|= charsetp
->code_space
[0];
1965 CHECK_NATNUM (code4
);
1966 if (XFASTINT (code4
) >= 0x100)
1967 args_out_of_range (make_number (0xFF), code4
);
1968 code
|= XFASTINT (code4
);
1975 if (CHARSET_ISO_FINAL (charsetp
) >= 0)
1977 c
= DECODE_CHAR (charsetp
, code
);
1979 error ("Invalid code(s)");
1980 return make_number (c
);
1984 /* Return the first charset in CHARSET_LIST that contains C.
1985 CHARSET_LIST is a list of charset IDs. If it is nil, use
1986 Vcharset_ordered_list. */
1989 char_charset (int c
, Lisp_Object charset_list
, unsigned int *code_return
)
1991 bool maybe_null
= 0;
1993 if (NILP (charset_list
))
1994 charset_list
= Vcharset_ordered_list
;
1998 while (CONSP (charset_list
))
2000 struct charset
*charset
= CHARSET_FROM_ID (XINT (XCAR (charset_list
)));
2001 unsigned code
= ENCODE_CHAR (charset
, c
);
2003 if (code
!= CHARSET_INVALID_CODE (charset
))
2006 *code_return
= code
;
2009 charset_list
= XCDR (charset_list
);
2011 && c
<= MAX_UNICODE_CHAR
2012 && EQ (charset_list
, Vcharset_non_preferred_head
))
2013 return CHARSET_FROM_ID (charset_unicode
);
2015 return (maybe_null
? NULL
2016 : c
<= MAX_5_BYTE_CHAR
? CHARSET_FROM_ID (charset_emacs
)
2017 : CHARSET_FROM_ID (charset_eight_bit
));
2021 DEFUN ("split-char", Fsplit_char
, Ssplit_char
, 1, 1, 0,
2023 /*Return list of charset and one to four position-codes of CH.
2024 The charset is decided by the current priority order of charsets.
2025 A position-code is a byte value of each dimension of the code-point of
2026 CH in the charset. */)
2029 struct charset
*charset
;
2034 CHECK_CHARACTER (ch
);
2036 charset
= CHAR_CHARSET (c
);
2039 code
= ENCODE_CHAR (charset
, c
);
2040 if (code
== CHARSET_INVALID_CODE (charset
))
2042 dimension
= CHARSET_DIMENSION (charset
);
2043 for (val
= Qnil
; dimension
> 0; dimension
--)
2045 val
= Fcons (make_number (code
& 0xFF), val
);
2048 return Fcons (CHARSET_NAME (charset
), val
);
2052 DEFUN ("char-charset", Fchar_charset
, Schar_charset
, 1, 2, 0,
2053 doc
: /* Return the charset of highest priority that contains CH.
2054 ASCII characters are an exception: for them, this function always
2056 If optional 2nd arg RESTRICTION is non-nil, it is a list of charsets
2057 from which to find the charset. It may also be a coding system. In
2058 that case, find the charset from what supported by that coding system. */)
2059 (Lisp_Object ch
, Lisp_Object restriction
)
2061 struct charset
*charset
;
2063 CHECK_CHARACTER (ch
);
2064 if (NILP (restriction
))
2065 charset
= CHAR_CHARSET (XINT (ch
));
2068 if (CONSP (restriction
))
2070 int c
= XFASTINT (ch
);
2072 for (; CONSP (restriction
); restriction
= XCDR (restriction
))
2074 struct charset
*rcharset
;
2076 CHECK_CHARSET_GET_CHARSET (XCAR (restriction
), rcharset
);
2077 if (ENCODE_CHAR (rcharset
, c
) != CHARSET_INVALID_CODE (rcharset
))
2078 return XCAR (restriction
);
2082 restriction
= coding_system_charset_list (restriction
);
2083 charset
= char_charset (XINT (ch
), restriction
, NULL
);
2087 return (CHARSET_NAME (charset
));
2091 DEFUN ("charset-after", Fcharset_after
, Scharset_after
, 0, 1, 0,
2093 Return charset of a character in the current buffer at position POS.
2094 If POS is nil, it defaults to the current point.
2095 If POS is out of range, the value is nil. */)
2099 struct charset
*charset
;
2101 ch
= Fchar_after (pos
);
2102 if (! INTEGERP (ch
))
2104 charset
= CHAR_CHARSET (XINT (ch
));
2105 return (CHARSET_NAME (charset
));
2109 DEFUN ("iso-charset", Fiso_charset
, Siso_charset
, 3, 3, 0,
2111 Return charset of ISO's specification DIMENSION, CHARS, and FINAL-CHAR.
2113 ISO 2022's designation sequence (escape sequence) distinguishes charsets
2114 by their DIMENSION, CHARS, and FINAL-CHAR,
2115 whereas Emacs distinguishes them by charset symbol.
2116 See the documentation of the function `charset-info' for the meanings of
2117 DIMENSION, CHARS, and FINAL-CHAR. */)
2118 (Lisp_Object dimension
, Lisp_Object chars
, Lisp_Object final_char
)
2123 check_iso_charset_parameter (dimension
, chars
, final_char
);
2124 chars_flag
= XFASTINT (chars
) == 96;
2125 id
= ISO_CHARSET_TABLE (XFASTINT (dimension
), chars_flag
,
2126 XFASTINT (final_char
));
2127 return (id
>= 0 ? CHARSET_NAME (CHARSET_FROM_ID (id
)) : Qnil
);
2131 DEFUN ("clear-charset-maps", Fclear_charset_maps
, Sclear_charset_maps
,
2135 Clear temporary charset mapping tables.
2136 It should be called only from temacs invoked for dumping. */)
2139 if (temp_charset_work
)
2141 xfree (temp_charset_work
);
2142 temp_charset_work
= NULL
;
2145 if (CHAR_TABLE_P (Vchar_unify_table
))
2146 Foptimize_char_table (Vchar_unify_table
, Qnil
);
2151 DEFUN ("charset-priority-list", Fcharset_priority_list
,
2152 Scharset_priority_list
, 0, 1, 0,
2153 doc
: /* Return the list of charsets ordered by priority.
2154 HIGHESTP non-nil means just return the highest priority one. */)
2155 (Lisp_Object highestp
)
2157 Lisp_Object val
= Qnil
, list
= Vcharset_ordered_list
;
2159 if (!NILP (highestp
))
2160 return CHARSET_NAME (CHARSET_FROM_ID (XINT (Fcar (list
))));
2162 while (!NILP (list
))
2164 val
= Fcons (CHARSET_NAME (CHARSET_FROM_ID (XINT (XCAR (list
)))), val
);
2167 return Fnreverse (val
);
2170 DEFUN ("set-charset-priority", Fset_charset_priority
, Sset_charset_priority
,
2172 doc
: /* Assign higher priority to the charsets given as arguments.
2173 usage: (set-charset-priority &rest charsets) */)
2174 (ptrdiff_t nargs
, Lisp_Object
*args
)
2176 Lisp_Object new_head
, old_list
, arglist
[2];
2177 Lisp_Object list_2022
, list_emacs_mule
;
2181 old_list
= Fcopy_sequence (Vcharset_ordered_list
);
2183 for (i
= 0; i
< nargs
; i
++)
2185 CHECK_CHARSET_GET_ID (args
[i
], id
);
2186 if (! NILP (Fmemq (make_number (id
), old_list
)))
2188 old_list
= Fdelq (make_number (id
), old_list
);
2189 new_head
= Fcons (make_number (id
), new_head
);
2192 arglist
[0] = Fnreverse (new_head
);
2193 arglist
[1] = Vcharset_non_preferred_head
= old_list
;
2194 Vcharset_ordered_list
= Fnconc (2, arglist
);
2195 charset_ordered_list_tick
++;
2197 charset_unibyte
= -1;
2198 for (old_list
= Vcharset_ordered_list
, list_2022
= list_emacs_mule
= Qnil
;
2199 CONSP (old_list
); old_list
= XCDR (old_list
))
2201 if (! NILP (Fmemq (XCAR (old_list
), Viso_2022_charset_list
)))
2202 list_2022
= Fcons (XCAR (old_list
), list_2022
);
2203 if (! NILP (Fmemq (XCAR (old_list
), Vemacs_mule_charset_list
)))
2204 list_emacs_mule
= Fcons (XCAR (old_list
), list_emacs_mule
);
2205 if (charset_unibyte
< 0)
2207 struct charset
*charset
= CHARSET_FROM_ID (XINT (XCAR (old_list
)));
2209 if (CHARSET_DIMENSION (charset
) == 1
2210 && CHARSET_ASCII_COMPATIBLE_P (charset
)
2211 && CHARSET_MAX_CHAR (charset
) >= 0x80)
2212 charset_unibyte
= CHARSET_ID (charset
);
2215 Viso_2022_charset_list
= Fnreverse (list_2022
);
2216 Vemacs_mule_charset_list
= Fnreverse (list_emacs_mule
);
2217 if (charset_unibyte
< 0)
2218 charset_unibyte
= charset_iso_8859_1
;
2223 DEFUN ("charset-id-internal", Fcharset_id_internal
, Scharset_id_internal
,
2225 doc
: /* Internal use only.
2226 Return charset identification number of CHARSET. */)
2227 (Lisp_Object charset
)
2231 CHECK_CHARSET_GET_ID (charset
, id
);
2232 return make_number (id
);
2235 struct charset_sort_data
2237 Lisp_Object charset
;
2243 charset_compare (const void *d1
, const void *d2
)
2245 const struct charset_sort_data
*data1
= d1
, *data2
= d2
;
2246 if (data1
->priority
!= data2
->priority
)
2247 return data1
->priority
< data2
->priority
? -1 : 1;
2251 DEFUN ("sort-charsets", Fsort_charsets
, Ssort_charsets
, 1, 1, 0,
2252 doc
: /* Sort charset list CHARSETS by a priority of each charset.
2253 Return the sorted list. CHARSETS is modified by side effects.
2254 See also `charset-priority-list' and `set-charset-priority'. */)
2255 (Lisp_Object charsets
)
2257 Lisp_Object len
= Flength (charsets
);
2258 ptrdiff_t n
= XFASTINT (len
), i
, j
;
2260 Lisp_Object tail
, elt
, attrs
;
2261 struct charset_sort_data
*sort_data
;
2262 int id
, min_id
= INT_MAX
, max_id
= INT_MIN
;
2267 SAFE_NALLOCA (sort_data
, 1, n
);
2268 for (tail
= charsets
, i
= 0; CONSP (tail
); tail
= XCDR (tail
), i
++)
2271 CHECK_CHARSET_GET_ATTR (elt
, attrs
);
2272 sort_data
[i
].charset
= elt
;
2273 sort_data
[i
].id
= id
= XINT (CHARSET_ATTR_ID (attrs
));
2279 for (done
= 0, tail
= Vcharset_ordered_list
, i
= 0;
2280 done
< n
&& CONSP (tail
); tail
= XCDR (tail
), i
++)
2283 id
= XFASTINT (elt
);
2284 if (id
>= min_id
&& id
<= max_id
)
2285 for (j
= 0; j
< n
; j
++)
2286 if (sort_data
[j
].id
== id
)
2288 sort_data
[j
].priority
= i
;
2292 qsort (sort_data
, n
, sizeof *sort_data
, charset_compare
);
2293 for (i
= 0, tail
= charsets
; CONSP (tail
); tail
= XCDR (tail
), i
++)
2294 XSETCAR (tail
, sort_data
[i
].charset
);
2303 Lisp_Object tempdir
;
2304 tempdir
= Fexpand_file_name (build_string ("charsets"), Vdata_directory
);
2305 if (! file_accessible_directory_p (SSDATA (tempdir
)))
2307 /* This used to be non-fatal (dir_warning), but it should not
2308 happen, and if it does sooner or later it will cause some
2309 obscure problem (eg bug#6401), so better abort. */
2310 fprintf (stderr
, "Error: charsets directory not found:\n\
2312 Emacs will not function correctly without the character map files.\n\
2313 Please check your installation!\n",
2318 Vcharset_map_path
= list1 (tempdir
);
2323 init_charset_once (void)
2327 for (i
= 0; i
< ISO_MAX_DIMENSION
; i
++)
2328 for (j
= 0; j
< ISO_MAX_CHARS
; j
++)
2329 for (k
= 0; k
< ISO_MAX_FINAL
; k
++)
2330 iso_charset_table
[i
][j
][k
] = -1;
2332 for (i
= 0; i
< 256; i
++)
2333 emacs_mule_charset
[i
] = -1;
2335 charset_jisx0201_roman
= -1;
2336 charset_jisx0208_1978
= -1;
2337 charset_jisx0208
= -1;
2338 charset_ksc5601
= -1;
2343 /* Allocate an initial charset table that is large enough to handle
2344 Emacs while it is bootstrapping. As of September 2011, the size
2345 needs to be at least 166; make it a bit bigger to allow for future
2348 Don't make the value so small that the table is reallocated during
2349 bootstrapping, as glibc malloc calls larger than just under 64 KiB
2350 during an initial bootstrap wreak havoc after dumping; see the
2351 M_MMAP_THRESHOLD value in alloc.c, plus there is a extra overhead
2352 internal to glibc malloc and perhaps to Emacs malloc debugging. */
2353 static struct charset charset_table_init
[180];
2356 syms_of_charset (void)
2358 DEFSYM (Qcharsetp
, "charsetp");
2360 DEFSYM (Qascii
, "ascii");
2361 DEFSYM (Qunicode
, "unicode");
2362 DEFSYM (Qemacs
, "emacs");
2363 DEFSYM (Qeight_bit
, "eight-bit");
2364 DEFSYM (Qiso_8859_1
, "iso-8859-1");
2369 staticpro (&Vcharset_ordered_list
);
2370 Vcharset_ordered_list
= Qnil
;
2372 staticpro (&Viso_2022_charset_list
);
2373 Viso_2022_charset_list
= Qnil
;
2375 staticpro (&Vemacs_mule_charset_list
);
2376 Vemacs_mule_charset_list
= Qnil
;
2378 /* Don't staticpro them here. It's done in syms_of_fns. */
2379 QCtest
= intern_c_string (":test");
2380 Qeq
= intern_c_string ("eq");
2382 staticpro (&Vcharset_hash_table
);
2384 Lisp_Object args
[2];
2387 Vcharset_hash_table
= Fmake_hash_table (2, args
);
2390 charset_table
= charset_table_init
;
2391 charset_table_size
= sizeof charset_table_init
/ sizeof *charset_table_init
;
2392 charset_table_used
= 0;
2394 defsubr (&Scharsetp
);
2395 defsubr (&Smap_charset_chars
);
2396 defsubr (&Sdefine_charset_internal
);
2397 defsubr (&Sdefine_charset_alias
);
2398 defsubr (&Scharset_plist
);
2399 defsubr (&Sset_charset_plist
);
2400 defsubr (&Sunify_charset
);
2401 defsubr (&Sget_unused_iso_final_char
);
2402 defsubr (&Sdeclare_equiv_charset
);
2403 defsubr (&Sfind_charset_region
);
2404 defsubr (&Sfind_charset_string
);
2405 defsubr (&Sdecode_char
);
2406 defsubr (&Sencode_char
);
2407 defsubr (&Ssplit_char
);
2408 defsubr (&Smake_char
);
2409 defsubr (&Schar_charset
);
2410 defsubr (&Scharset_after
);
2411 defsubr (&Siso_charset
);
2412 defsubr (&Sclear_charset_maps
);
2413 defsubr (&Scharset_priority_list
);
2414 defsubr (&Sset_charset_priority
);
2415 defsubr (&Scharset_id_internal
);
2416 defsubr (&Ssort_charsets
);
2418 DEFVAR_LISP ("charset-map-path", Vcharset_map_path
,
2419 doc
: /* List of directories to search for charset map files. */);
2420 Vcharset_map_path
= Qnil
;
2422 DEFVAR_BOOL ("inhibit-load-charset-map", inhibit_load_charset_map
,
2423 doc
: /* Inhibit loading of charset maps. Used when dumping Emacs. */);
2424 inhibit_load_charset_map
= 0;
2426 DEFVAR_LISP ("charset-list", Vcharset_list
,
2427 doc
: /* List of all charsets ever defined. */);
2428 Vcharset_list
= Qnil
;
2430 DEFVAR_LISP ("current-iso639-language", Vcurrent_iso639_language
,
2431 doc
: /* ISO639 language mnemonic symbol for the current language environment.
2432 If the current language environment is for multiple languages (e.g. "Latin-1"),
2433 the value may be a list of mnemonics. */);
2434 Vcurrent_iso639_language
= Qnil
;
2437 = define_charset_internal (Qascii
, 1, "\x00\x7F\x00\x00\x00\x00",
2438 0, 127, 'B', -1, 0, 1, 0, 0);
2440 = define_charset_internal (Qiso_8859_1
, 1, "\x00\xFF\x00\x00\x00\x00",
2441 0, 255, -1, -1, -1, 1, 0, 0);
2443 = define_charset_internal (Qunicode
, 3, "\x00\xFF\x00\xFF\x00\x10",
2444 0, MAX_UNICODE_CHAR
, -1, 0, -1, 1, 0, 0);
2446 = define_charset_internal (Qemacs
, 3, "\x00\xFF\x00\xFF\x00\x3F",
2447 0, MAX_5_BYTE_CHAR
, -1, 0, -1, 1, 1, 0);
2449 = define_charset_internal (Qeight_bit
, 1, "\x80\xFF\x00\x00\x00\x00",
2450 128, 255, -1, 0, -1, 0, 1,
2451 MAX_5_BYTE_CHAR
+ 1);
2452 charset_unibyte
= charset_iso_8859_1
;