1 /* Basic character set support.
3 Copyright (C) 2001-2014 Free Software Foundation, Inc.
5 Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
6 2005, 2006, 2007, 2008, 2009, 2010, 2011
7 National Institute of Advanced Industrial Science and Technology (AIST)
8 Registration Number H14PRO021
10 Copyright (C) 2003, 2004
11 National Institute of Advanced Industrial Science and Technology (AIST)
12 Registration Number H13PRO009
14 This file is part of GNU Emacs.
16 GNU Emacs is free software: you can redistribute it and/or modify
17 it under the terms of the GNU General Public License as published by
18 the Free Software Foundation, either version 3 of the License, or
19 (at your option) any later version.
21 GNU Emacs is distributed in the hope that it will be useful,
22 but WITHOUT ANY WARRANTY; without even the implied warranty of
23 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24 GNU General Public License for more details.
26 You should have received a copy of the GNU General Public License
27 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
35 #include <sys/types.h>
38 #include "character.h"
44 /*** GENERAL NOTES on CODED CHARACTER SETS (CHARSETS) ***
46 A coded character set ("charset" hereafter) is a meaningful
47 collection (i.e. language, culture, functionality, etc.) of
48 characters. Emacs handles multiple charsets at once. In Emacs Lisp
49 code, a charset is represented by a symbol. In C code, a charset is
50 represented by its ID number or by a pointer to a struct charset.
52 The actual information about each charset is stored in two places.
53 Lispy information is stored in the hash table Vcharset_hash_table as
54 a vector (charset attributes). The other information is stored in
55 charset_table as a struct charset.
59 /* Hash table that contains attributes of each charset. Keys are
60 charset symbols, and values are vectors of charset attributes. */
61 Lisp_Object Vcharset_hash_table
;
63 /* Table of struct charset. */
64 struct charset
*charset_table
;
66 static ptrdiff_t charset_table_size
;
67 static int charset_table_used
;
69 Lisp_Object Qcharsetp
;
71 /* Special charset symbols. */
73 static Lisp_Object Qeight_bit
;
74 static Lisp_Object Qiso_8859_1
;
75 static Lisp_Object Qunicode
;
76 static Lisp_Object Qemacs
;
78 /* The corresponding charsets. */
80 int charset_eight_bit
;
81 static int charset_iso_8859_1
;
83 static int charset_emacs
;
85 /* The other special charsets. */
86 int charset_jisx0201_roman
;
87 int charset_jisx0208_1978
;
91 /* Value of charset attribute `charset-iso-plane'. */
92 static Lisp_Object Qgl
, Qgr
;
94 /* Charset of unibyte characters. */
97 /* List of charsets ordered by the priority. */
98 Lisp_Object Vcharset_ordered_list
;
100 /* Sub-list of Vcharset_ordered_list that contains all non-preferred
102 Lisp_Object Vcharset_non_preferred_head
;
104 /* Incremented everytime we change Vcharset_ordered_list. This is
105 unsigned short so that it fits in Lisp_Int and never matches
107 unsigned short charset_ordered_list_tick
;
109 /* List of iso-2022 charsets. */
110 Lisp_Object Viso_2022_charset_list
;
112 /* List of emacs-mule charsets. */
113 Lisp_Object Vemacs_mule_charset_list
;
115 int emacs_mule_charset
[256];
117 /* Mapping table from ISO2022's charset (specified by DIMENSION,
118 CHARS, and FINAL-CHAR) to Emacs' charset. */
119 int iso_charset_table
[ISO_MAX_DIMENSION
][ISO_MAX_CHARS
][ISO_MAX_FINAL
];
121 #define CODE_POINT_TO_INDEX(charset, code) \
122 ((charset)->code_linear_p \
123 ? (int) ((code) - (charset)->min_code) \
124 : (((charset)->code_space_mask[(code) >> 24] & 0x8) \
125 && ((charset)->code_space_mask[((code) >> 16) & 0xFF] & 0x4) \
126 && ((charset)->code_space_mask[((code) >> 8) & 0xFF] & 0x2) \
127 && ((charset)->code_space_mask[(code) & 0xFF] & 0x1)) \
128 ? (int) (((((code) >> 24) - (charset)->code_space[12]) \
129 * (charset)->code_space[11]) \
130 + (((((code) >> 16) & 0xFF) - (charset)->code_space[8]) \
131 * (charset)->code_space[7]) \
132 + (((((code) >> 8) & 0xFF) - (charset)->code_space[4]) \
133 * (charset)->code_space[3]) \
134 + (((code) & 0xFF) - (charset)->code_space[0]) \
135 - ((charset)->char_index_offset)) \
139 /* Return the code-point for the character index IDX in CHARSET.
140 IDX should be an unsigned int variable in a valid range (which is
141 always in nonnegative int range too). IDX contains garbage afterwards. */
143 #define INDEX_TO_CODE_POINT(charset, idx) \
144 ((charset)->code_linear_p \
145 ? (idx) + (charset)->min_code \
146 : (idx += (charset)->char_index_offset, \
147 (((charset)->code_space[0] + (idx) % (charset)->code_space[2]) \
148 | (((charset)->code_space[4] \
149 + ((idx) / (charset)->code_space[3] % (charset)->code_space[6])) \
151 | (((charset)->code_space[8] \
152 + ((idx) / (charset)->code_space[7] % (charset)->code_space[10])) \
154 | (((charset)->code_space[12] + ((idx) / (charset)->code_space[11])) \
157 /* Structure to hold mapping tables for a charset. Used by temacs
158 invoked for dumping. */
162 /* The current charset for which the following tables are setup. */
163 struct charset
*current
;
165 /* 1 iff the following table is used for encoder. */
168 /* When the following table is used for encoding, minimum and
169 maximum character of the current charset. */
170 int min_char
, max_char
;
172 /* A Unicode character corresponding to the code index 0 (i.e. the
173 minimum code-point) of the current charset, or -1 if the code
174 index 0 is not a Unicode character. This is checked when
175 table.encoder[CHAR] is zero. */
179 /* Table mapping code-indices (not code-points) of the current
180 charset to Unicode characters. If decoder[CHAR] is -1, CHAR
181 doesn't belong to the current charset. */
182 int decoder
[0x10000];
183 /* Table mapping Unicode characters to code-indices of the current
184 charset. The first 0x10000 elements are for BMP (0..0xFFFF),
185 and the last 0x10000 are for SMP (0x10000..0x1FFFF) or SIP
186 (0x20000..0x2FFFF). Note that there is no charset map that
187 uses both SMP and SIP. */
188 unsigned short encoder
[0x20000];
190 } *temp_charset_work
;
192 #define SET_TEMP_CHARSET_WORK_ENCODER(C, CODE) \
195 temp_charset_work->zero_index_char = (C); \
196 else if ((C) < 0x20000) \
197 temp_charset_work->table.encoder[(C)] = (CODE); \
199 temp_charset_work->table.encoder[(C) - 0x10000] = (CODE); \
202 #define GET_TEMP_CHARSET_WORK_ENCODER(C) \
203 ((C) == temp_charset_work->zero_index_char ? 0 \
204 : (C) < 0x20000 ? (temp_charset_work->table.encoder[(C)] \
205 ? (int) temp_charset_work->table.encoder[(C)] : -1) \
206 : temp_charset_work->table.encoder[(C) - 0x10000] \
207 ? temp_charset_work->table.encoder[(C) - 0x10000] : -1)
209 #define SET_TEMP_CHARSET_WORK_DECODER(C, CODE) \
210 (temp_charset_work->table.decoder[(CODE)] = (C))
212 #define GET_TEMP_CHARSET_WORK_DECODER(CODE) \
213 (temp_charset_work->table.decoder[(CODE)])
216 /* Set to 1 to warn that a charset map is loaded and thus a buffer
217 text and a string data may be relocated. */
218 bool charset_map_loaded
;
220 struct charset_map_entries
226 struct charset_map_entries
*next
;
229 /* Load the mapping information of CHARSET from ENTRIES for
230 initializing (CONTROL_FLAG == 0), decoding (CONTROL_FLAG == 1), and
231 encoding (CONTROL_FLAG == 2).
233 If CONTROL_FLAG is 0, setup CHARSET->min_char, CHARSET->max_char,
234 and CHARSET->fast_map.
236 If CONTROL_FLAG is 1, setup the following tables according to
237 CHARSET->method and inhibit_load_charset_map.
239 CHARSET->method | inhibit_lcm == 0 | inhibit_lcm == 1
240 ----------------------+--------------------+---------------------------
241 CHARSET_METHOD_MAP | CHARSET->decoder | temp_charset_work->decoder
242 ----------------------+--------------------+---------------------------
243 CHARSET_METHOD_OFFSET | Vchar_unify_table | temp_charset_work->decoder
245 If CONTROL_FLAG is 2, setup the following tables.
247 CHARSET->method | inhibit_lcm == 0 | inhibit_lcm == 1
248 ----------------------+--------------------+---------------------------
249 CHARSET_METHOD_MAP | CHARSET->encoder | temp_charset_work->encoder
250 ----------------------+--------------------+--------------------------
251 CHARSET_METHOD_OFFSET | CHARSET->deunifier | temp_charset_work->encoder
255 load_charset_map (struct charset
*charset
, struct charset_map_entries
*entries
, int n_entries
, int control_flag
)
257 Lisp_Object vec
IF_LINT (= Qnil
), table
IF_LINT (= Qnil
);
258 unsigned max_code
= CHARSET_MAX_CODE (charset
);
259 bool ascii_compatible_p
= charset
->ascii_compatible_p
;
260 int min_char
, max_char
, nonascii_min_char
;
262 unsigned char *fast_map
= charset
->fast_map
;
269 if (! inhibit_load_charset_map
)
271 if (control_flag
== 1)
273 if (charset
->method
== CHARSET_METHOD_MAP
)
275 int n
= CODE_POINT_TO_INDEX (charset
, max_code
) + 1;
277 vec
= Fmake_vector (make_number (n
), make_number (-1));
278 set_charset_attr (charset
, charset_decoder
, vec
);
282 char_table_set_range (Vchar_unify_table
,
283 charset
->min_char
, charset
->max_char
,
289 table
= Fmake_char_table (Qnil
, Qnil
);
290 set_charset_attr (charset
,
291 (charset
->method
== CHARSET_METHOD_MAP
292 ? charset_encoder
: charset_deunifier
),
298 if (! temp_charset_work
)
299 temp_charset_work
= xmalloc (sizeof *temp_charset_work
);
300 if (control_flag
== 1)
302 memset (temp_charset_work
->table
.decoder
, -1,
303 sizeof (int) * 0x10000);
307 memset (temp_charset_work
->table
.encoder
, 0,
308 sizeof (unsigned short) * 0x20000);
309 temp_charset_work
->zero_index_char
= -1;
311 temp_charset_work
->current
= charset
;
312 temp_charset_work
->for_encoder
= (control_flag
== 2);
315 charset_map_loaded
= 1;
318 min_char
= max_char
= entries
->entry
[0].c
;
319 nonascii_min_char
= MAX_CHAR
;
320 for (i
= 0; i
< n_entries
; i
++)
323 int from_index
, to_index
, lim_index
;
325 int idx
= i
% 0x10000;
327 if (i
> 0 && idx
== 0)
328 entries
= entries
->next
;
329 from
= entries
->entry
[idx
].from
;
330 to
= entries
->entry
[idx
].to
;
331 from_c
= entries
->entry
[idx
].c
;
332 from_index
= CODE_POINT_TO_INDEX (charset
, from
);
335 to_index
= from_index
;
340 to_index
= CODE_POINT_TO_INDEX (charset
, to
);
341 to_c
= from_c
+ (to_index
- from_index
);
343 if (from_index
< 0 || to_index
< 0)
345 lim_index
= to_index
+ 1;
349 else if (from_c
< min_char
)
352 if (control_flag
== 1)
354 if (charset
->method
== CHARSET_METHOD_MAP
)
355 for (; from_index
< lim_index
; from_index
++, from_c
++)
356 ASET (vec
, from_index
, make_number (from_c
));
358 for (; from_index
< lim_index
; from_index
++, from_c
++)
359 CHAR_TABLE_SET (Vchar_unify_table
,
360 CHARSET_CODE_OFFSET (charset
) + from_index
,
361 make_number (from_c
));
363 else if (control_flag
== 2)
365 if (charset
->method
== CHARSET_METHOD_MAP
366 && CHARSET_COMPACT_CODES_P (charset
))
367 for (; from_index
< lim_index
; from_index
++, from_c
++)
369 unsigned code
= from_index
;
370 code
= INDEX_TO_CODE_POINT (charset
, code
);
372 if (NILP (CHAR_TABLE_REF (table
, from_c
)))
373 CHAR_TABLE_SET (table
, from_c
, make_number (code
));
376 for (; from_index
< lim_index
; from_index
++, from_c
++)
378 if (NILP (CHAR_TABLE_REF (table
, from_c
)))
379 CHAR_TABLE_SET (table
, from_c
, make_number (from_index
));
382 else if (control_flag
== 3)
383 for (; from_index
< lim_index
; from_index
++, from_c
++)
384 SET_TEMP_CHARSET_WORK_DECODER (from_c
, from_index
);
385 else if (control_flag
== 4)
386 for (; from_index
< lim_index
; from_index
++, from_c
++)
387 SET_TEMP_CHARSET_WORK_ENCODER (from_c
, from_index
);
388 else /* control_flag == 0 */
390 if (ascii_compatible_p
)
392 if (! ASCII_CHAR_P (from_c
))
394 if (from_c
< nonascii_min_char
)
395 nonascii_min_char
= from_c
;
397 else if (! ASCII_CHAR_P (to_c
))
399 nonascii_min_char
= 0x80;
403 for (; from_c
<= to_c
; from_c
++)
404 CHARSET_FAST_MAP_SET (from_c
, fast_map
);
408 if (control_flag
== 0)
410 CHARSET_MIN_CHAR (charset
) = (ascii_compatible_p
411 ? nonascii_min_char
: min_char
);
412 CHARSET_MAX_CHAR (charset
) = max_char
;
414 else if (control_flag
== 4)
416 temp_charset_work
->min_char
= min_char
;
417 temp_charset_work
->max_char
= max_char
;
422 /* Read a hexadecimal number (preceded by "0x") from the file FP while
423 paying attention to comment character '#'. */
426 read_hex (FILE *fp
, bool *eof
, bool *overflow
)
431 while ((c
= getc (fp
)) != EOF
)
435 while ((c
= getc (fp
)) != EOF
&& c
!= '\n');
439 if ((c
= getc (fp
)) == EOF
|| c
== 'x')
449 while (c_isxdigit (c
= getc (fp
)))
451 if (UINT_MAX
>> 4 < n
)
454 | (c
- ('0' <= c
&& c
<= '9' ? '0'
455 : 'A' <= c
&& c
<= 'F' ? 'A' - 10
463 /* Return a mapping vector for CHARSET loaded from MAPFILE.
464 Each line of MAPFILE has this form
466 where 0xAAAA is a code-point and 0xCCCC is the corresponding
467 character code, or this form
469 where 0xAAAA and 0xBBBB are code-points specifying a range, and
470 0xCCCC is the first character code of the range.
472 The returned vector has this form:
473 [ CODE1 CHAR1 CODE2 CHAR2 .... ]
474 where CODE1 is a code-point or a cons of code-points specifying a
477 Note that this function uses `openp' to open MAPFILE but ignores
478 `file-name-handler-alist' to avoid running any Lisp code. */
481 load_charset_map_from_file (struct charset
*charset
, Lisp_Object mapfile
,
485 unsigned min_code
= CHARSET_MIN_CODE (charset
);
486 unsigned max_code
= CHARSET_MAX_CODE (charset
);
489 Lisp_Object suffixes
;
490 struct charset_map_entries
*head
, *entries
;
494 suffixes
= scoped_list2 (build_local_string (".map"),
495 build_local_string (".TXT"));
497 count
= SPECPDL_INDEX ();
498 record_unwind_protect_nothing ();
499 specbind (Qfile_name_handler_alist
, Qnil
);
500 fd
= openp (Vcharset_map_path
, mapfile
, suffixes
, NULL
, Qnil
, false);
501 fp
= fd
< 0 ? 0 : fdopen (fd
, "r");
504 int open_errno
= errno
;
506 report_file_errno ("Loading charset map", mapfile
, open_errno
);
508 set_unwind_protect_ptr (count
, fclose_unwind
, fp
);
509 unbind_to (count
+ 1, Qnil
);
511 /* Use record_xmalloc, as `charset_map_entries' is
512 large (larger than MAX_ALLOCA). */
513 head
= record_xmalloc (sizeof *head
);
515 memset (entries
, 0, sizeof (struct charset_map_entries
));
520 unsigned from
, to
, c
;
522 bool eof
= 0, overflow
= 0;
524 from
= read_hex (fp
, &eof
, &overflow
);
527 if (getc (fp
) == '-')
528 to
= read_hex (fp
, &eof
, &overflow
);
533 c
= read_hex (fp
, &eof
, &overflow
);
539 if (from
< min_code
|| to
> max_code
|| from
> to
|| c
> MAX_CHAR
)
542 if (n_entries
== 0x10000)
544 entries
->next
= record_xmalloc (sizeof *entries
->next
);
545 entries
= entries
->next
;
546 memset (entries
, 0, sizeof (struct charset_map_entries
));
550 entries
->entry
[idx
].from
= from
;
551 entries
->entry
[idx
].to
= to
;
552 entries
->entry
[idx
].c
= c
;
556 clear_unwind_protect (count
);
558 load_charset_map (charset
, head
, n_entries
, control_flag
);
559 unbind_to (count
, Qnil
);
563 load_charset_map_from_vector (struct charset
*charset
, Lisp_Object vec
, int control_flag
)
565 unsigned min_code
= CHARSET_MIN_CODE (charset
);
566 unsigned max_code
= CHARSET_MAX_CODE (charset
);
567 struct charset_map_entries
*head
, *entries
;
569 int len
= ASIZE (vec
);
575 add_to_log ("Failure in loading charset map: %V", vec
, Qnil
);
579 /* Use SAFE_ALLOCA instead of alloca, as `charset_map_entries' is
580 large (larger than MAX_ALLOCA). */
581 head
= SAFE_ALLOCA (sizeof *head
);
583 memset (entries
, 0, sizeof (struct charset_map_entries
));
586 for (i
= 0; i
< len
; i
+= 2)
588 Lisp_Object val
, val2
;
598 from
= XFASTINT (val
);
599 to
= XFASTINT (val2
);
602 from
= to
= XFASTINT (val
);
603 val
= AREF (vec
, i
+ 1);
607 if (from
< min_code
|| to
> max_code
|| from
> to
|| c
> MAX_CHAR
)
610 if (n_entries
> 0 && (n_entries
% 0x10000) == 0)
612 entries
->next
= SAFE_ALLOCA (sizeof *entries
->next
);
613 entries
= entries
->next
;
614 memset (entries
, 0, sizeof (struct charset_map_entries
));
616 idx
= n_entries
% 0x10000;
617 entries
->entry
[idx
].from
= from
;
618 entries
->entry
[idx
].to
= to
;
619 entries
->entry
[idx
].c
= c
;
623 load_charset_map (charset
, head
, n_entries
, control_flag
);
628 /* Load a mapping table for CHARSET. CONTROL-FLAG tells what kind of
629 map it is (see the comment of load_charset_map for the detail). */
632 load_charset (struct charset
*charset
, int control_flag
)
636 if (inhibit_load_charset_map
638 && charset
== temp_charset_work
->current
639 && ((control_flag
== 2) == temp_charset_work
->for_encoder
))
642 if (CHARSET_METHOD (charset
) == CHARSET_METHOD_MAP
)
643 map
= CHARSET_MAP (charset
);
646 if (! CHARSET_UNIFIED_P (charset
))
648 map
= CHARSET_UNIFY_MAP (charset
);
651 load_charset_map_from_file (charset
, map
, control_flag
);
653 load_charset_map_from_vector (charset
, map
, control_flag
);
657 DEFUN ("charsetp", Fcharsetp
, Scharsetp
, 1, 1, 0,
658 doc
: /* Return non-nil if and only if OBJECT is a charset.*/)
661 return (CHARSETP (object
) ? Qt
: Qnil
);
666 map_charset_for_dump (void (*c_function
) (Lisp_Object
, Lisp_Object
),
667 Lisp_Object function
, Lisp_Object arg
,
668 unsigned int from
, unsigned int to
)
670 int from_idx
= CODE_POINT_TO_INDEX (temp_charset_work
->current
, from
);
671 int to_idx
= CODE_POINT_TO_INDEX (temp_charset_work
->current
, to
);
672 Lisp_Object 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
;
719 map_charset_chars (void (*c_function
)(Lisp_Object
, Lisp_Object
), Lisp_Object function
,
720 Lisp_Object arg
, struct charset
*charset
, unsigned from
, unsigned to
)
723 bool partial
= (from
> CHARSET_MIN_CODE (charset
)
724 || to
< CHARSET_MAX_CODE (charset
));
726 if (CHARSET_METHOD (charset
) == CHARSET_METHOD_OFFSET
)
728 int from_idx
= CODE_POINT_TO_INDEX (charset
, from
);
729 int to_idx
= CODE_POINT_TO_INDEX (charset
, to
);
730 int from_c
= from_idx
+ CHARSET_CODE_OFFSET (charset
);
731 int to_c
= to_idx
+ CHARSET_CODE_OFFSET (charset
);
733 if (CHARSET_UNIFIED_P (charset
))
735 if (! CHAR_TABLE_P (CHARSET_DEUNIFIER (charset
)))
736 load_charset (charset
, 2);
737 if (CHAR_TABLE_P (CHARSET_DEUNIFIER (charset
)))
738 map_char_table_for_charset (c_function
, function
,
739 CHARSET_DEUNIFIER (charset
), arg
,
740 partial
? charset
: NULL
, from
, to
);
742 map_charset_for_dump (c_function
, function
, arg
, from
, to
);
745 range
= Fcons (make_number (from_c
), make_number (to_c
));
747 (*c_function
) (arg
, range
);
749 call2 (function
, range
, arg
);
751 else if (CHARSET_METHOD (charset
) == CHARSET_METHOD_MAP
)
753 if (! CHAR_TABLE_P (CHARSET_ENCODER (charset
)))
754 load_charset (charset
, 2);
755 if (CHAR_TABLE_P (CHARSET_ENCODER (charset
)))
756 map_char_table_for_charset (c_function
, function
,
757 CHARSET_ENCODER (charset
), arg
,
758 partial
? charset
: NULL
, from
, to
);
760 map_charset_for_dump (c_function
, function
, arg
, from
, to
);
762 else if (CHARSET_METHOD (charset
) == CHARSET_METHOD_SUBSET
)
764 Lisp_Object subset_info
;
767 subset_info
= CHARSET_SUBSET (charset
);
768 charset
= CHARSET_FROM_ID (XFASTINT (AREF (subset_info
, 0)));
769 offset
= XINT (AREF (subset_info
, 3));
771 if (from
< XFASTINT (AREF (subset_info
, 1)))
772 from
= XFASTINT (AREF (subset_info
, 1));
774 if (to
> XFASTINT (AREF (subset_info
, 2)))
775 to
= XFASTINT (AREF (subset_info
, 2));
776 map_charset_chars (c_function
, function
, arg
, charset
, from
, to
);
778 else /* i.e. CHARSET_METHOD_SUPERSET */
782 for (parents
= CHARSET_SUPERSET (charset
); CONSP (parents
);
783 parents
= XCDR (parents
))
786 unsigned this_from
, this_to
;
788 charset
= CHARSET_FROM_ID (XFASTINT (XCAR (XCAR (parents
))));
789 offset
= XINT (XCDR (XCAR (parents
)));
790 this_from
= from
> offset
? from
- offset
: 0;
791 this_to
= to
> offset
? to
- offset
: 0;
792 if (this_from
< CHARSET_MIN_CODE (charset
))
793 this_from
= CHARSET_MIN_CODE (charset
);
794 if (this_to
> CHARSET_MAX_CODE (charset
))
795 this_to
= CHARSET_MAX_CODE (charset
);
796 map_charset_chars (c_function
, function
, arg
, charset
,
802 DEFUN ("map-charset-chars", Fmap_charset_chars
, Smap_charset_chars
, 2, 5, 0,
803 doc
: /* Call FUNCTION for all characters in CHARSET.
804 FUNCTION is called with an argument RANGE and the optional 3rd
807 RANGE is a cons (FROM . TO), where FROM and TO indicate a range of
808 characters contained in CHARSET.
810 The optional 4th and 5th arguments FROM-CODE and TO-CODE specify the
811 range of code points (in CHARSET) of target characters. */)
812 (Lisp_Object function
, Lisp_Object charset
, Lisp_Object arg
, Lisp_Object from_code
, Lisp_Object to_code
)
817 CHECK_CHARSET_GET_CHARSET (charset
, cs
);
818 if (NILP (from_code
))
819 from
= CHARSET_MIN_CODE (cs
);
822 from
= XINT (from_code
);
823 if (from
< CHARSET_MIN_CODE (cs
))
824 from
= CHARSET_MIN_CODE (cs
);
827 to
= CHARSET_MAX_CODE (cs
);
831 if (to
> CHARSET_MAX_CODE (cs
))
832 to
= CHARSET_MAX_CODE (cs
);
834 map_charset_chars (NULL
, function
, arg
, cs
, from
, to
);
839 /* Define a charset according to the arguments. The Nth argument is
840 the Nth attribute of the charset (the last attribute `charset-id'
841 is not included). See the docstring of `define-charset' for the
844 DEFUN ("define-charset-internal", Fdefine_charset_internal
,
845 Sdefine_charset_internal
, charset_arg_max
, MANY
, 0,
846 doc
: /* For internal use only.
847 usage: (define-charset-internal ...) */)
848 (ptrdiff_t nargs
, Lisp_Object
*args
)
850 /* Charset attr vector. */
853 EMACS_UINT hash_code
;
854 struct Lisp_Hash_Table
*hash_table
= XHASH_TABLE (Vcharset_hash_table
);
856 struct charset charset
;
859 bool new_definition_p
;
862 if (nargs
!= charset_arg_max
)
863 return Fsignal (Qwrong_number_of_arguments
,
864 Fcons (intern ("define-charset-internal"),
865 make_number (nargs
)));
867 attrs
= Fmake_vector (make_number (charset_attr_max
), Qnil
);
869 CHECK_SYMBOL (args
[charset_arg_name
]);
870 ASET (attrs
, charset_name
, args
[charset_arg_name
]);
872 val
= args
[charset_arg_code_space
];
873 for (i
= 0, dimension
= 0, nchars
= 1; ; i
++)
875 Lisp_Object min_byte_obj
, max_byte_obj
;
876 int min_byte
, max_byte
;
878 min_byte_obj
= Faref (val
, make_number (i
* 2));
879 max_byte_obj
= Faref (val
, make_number (i
* 2 + 1));
880 CHECK_RANGED_INTEGER (min_byte_obj
, 0, 255);
881 min_byte
= XINT (min_byte_obj
);
882 CHECK_RANGED_INTEGER (max_byte_obj
, min_byte
, 255);
883 max_byte
= XINT (max_byte_obj
);
884 charset
.code_space
[i
* 4] = min_byte
;
885 charset
.code_space
[i
* 4 + 1] = max_byte
;
886 charset
.code_space
[i
* 4 + 2] = max_byte
- min_byte
+ 1;
891 nchars
*= charset
.code_space
[i
* 4 + 2];
892 charset
.code_space
[i
* 4 + 3] = nchars
;
895 val
= args
[charset_arg_dimension
];
897 charset
.dimension
= dimension
;
900 CHECK_RANGED_INTEGER (val
, 1, 4);
901 charset
.dimension
= XINT (val
);
904 charset
.code_linear_p
905 = (charset
.dimension
== 1
906 || (charset
.code_space
[2] == 256
907 && (charset
.dimension
== 2
908 || (charset
.code_space
[6] == 256
909 && (charset
.dimension
== 3
910 || charset
.code_space
[10] == 256)))));
912 if (! charset
.code_linear_p
)
914 charset
.code_space_mask
= xzalloc (256);
915 for (i
= 0; i
< 4; i
++)
916 for (j
= charset
.code_space
[i
* 4]; j
<= charset
.code_space
[i
* 4 + 1];
918 charset
.code_space_mask
[j
] |= (1 << i
);
921 charset
.iso_chars_96
= charset
.code_space
[2] == 96;
923 charset
.min_code
= (charset
.code_space
[0]
924 | (charset
.code_space
[4] << 8)
925 | (charset
.code_space
[8] << 16)
926 | ((unsigned) charset
.code_space
[12] << 24));
927 charset
.max_code
= (charset
.code_space
[1]
928 | (charset
.code_space
[5] << 8)
929 | (charset
.code_space
[9] << 16)
930 | ((unsigned) charset
.code_space
[13] << 24));
931 charset
.char_index_offset
= 0;
933 val
= args
[charset_arg_min_code
];
936 unsigned code
= cons_to_unsigned (val
, UINT_MAX
);
938 if (code
< charset
.min_code
939 || code
> charset
.max_code
)
940 args_out_of_range_3 (make_fixnum_or_float (charset
.min_code
),
941 make_fixnum_or_float (charset
.max_code
), val
);
942 charset
.char_index_offset
= CODE_POINT_TO_INDEX (&charset
, code
);
943 charset
.min_code
= code
;
946 val
= args
[charset_arg_max_code
];
949 unsigned code
= cons_to_unsigned (val
, UINT_MAX
);
951 if (code
< charset
.min_code
952 || code
> charset
.max_code
)
953 args_out_of_range_3 (make_fixnum_or_float (charset
.min_code
),
954 make_fixnum_or_float (charset
.max_code
), val
);
955 charset
.max_code
= code
;
958 charset
.compact_codes_p
= charset
.max_code
< 0x10000;
960 val
= args
[charset_arg_invalid_code
];
963 if (charset
.min_code
> 0)
964 charset
.invalid_code
= 0;
967 if (charset
.max_code
< UINT_MAX
)
968 charset
.invalid_code
= charset
.max_code
+ 1;
970 error ("Attribute :invalid-code must be specified");
974 charset
.invalid_code
= cons_to_unsigned (val
, UINT_MAX
);
976 val
= args
[charset_arg_iso_final
];
978 charset
.iso_final
= -1;
982 if (XINT (val
) < '0' || XINT (val
) > 127)
983 error ("Invalid iso-final-char: %"pI
"d", XINT (val
));
984 charset
.iso_final
= XINT (val
);
987 val
= args
[charset_arg_iso_revision
];
989 charset
.iso_revision
= -1;
992 CHECK_RANGED_INTEGER (val
, -1, 63);
993 charset
.iso_revision
= XINT (val
);
996 val
= args
[charset_arg_emacs_mule_id
];
998 charset
.emacs_mule_id
= -1;
1002 if ((XINT (val
) > 0 && XINT (val
) <= 128) || XINT (val
) >= 256)
1003 error ("Invalid emacs-mule-id: %"pI
"d", XINT (val
));
1004 charset
.emacs_mule_id
= XINT (val
);
1007 charset
.ascii_compatible_p
= ! NILP (args
[charset_arg_ascii_compatible_p
]);
1009 charset
.supplementary_p
= ! NILP (args
[charset_arg_supplementary_p
]);
1011 charset
.unified_p
= 0;
1013 memset (charset
.fast_map
, 0, sizeof (charset
.fast_map
));
1015 if (! NILP (args
[charset_arg_code_offset
]))
1017 val
= args
[charset_arg_code_offset
];
1018 CHECK_CHARACTER (val
);
1020 charset
.method
= CHARSET_METHOD_OFFSET
;
1021 charset
.code_offset
= XINT (val
);
1023 i
= CODE_POINT_TO_INDEX (&charset
, charset
.max_code
);
1024 if (MAX_CHAR
- charset
.code_offset
< i
)
1025 error ("Unsupported max char: %d", charset
.max_char
);
1026 charset
.max_char
= i
+ charset
.code_offset
;
1027 i
= CODE_POINT_TO_INDEX (&charset
, charset
.min_code
);
1028 charset
.min_char
= i
+ charset
.code_offset
;
1030 i
= (charset
.min_char
>> 7) << 7;
1031 for (; i
< 0x10000 && i
<= charset
.max_char
; i
+= 128)
1032 CHARSET_FAST_MAP_SET (i
, charset
.fast_map
);
1033 i
= (i
>> 12) << 12;
1034 for (; i
<= charset
.max_char
; i
+= 0x1000)
1035 CHARSET_FAST_MAP_SET (i
, charset
.fast_map
);
1036 if (charset
.code_offset
== 0 && charset
.max_char
>= 0x80)
1037 charset
.ascii_compatible_p
= 1;
1039 else if (! NILP (args
[charset_arg_map
]))
1041 val
= args
[charset_arg_map
];
1042 ASET (attrs
, charset_map
, val
);
1043 charset
.method
= CHARSET_METHOD_MAP
;
1045 else if (! NILP (args
[charset_arg_subset
]))
1048 Lisp_Object parent_min_code
, parent_max_code
, parent_code_offset
;
1049 struct charset
*parent_charset
;
1051 val
= args
[charset_arg_subset
];
1052 parent
= Fcar (val
);
1053 CHECK_CHARSET_GET_CHARSET (parent
, parent_charset
);
1054 parent_min_code
= Fnth (make_number (1), val
);
1055 CHECK_NATNUM (parent_min_code
);
1056 parent_max_code
= Fnth (make_number (2), val
);
1057 CHECK_NATNUM (parent_max_code
);
1058 parent_code_offset
= Fnth (make_number (3), val
);
1059 CHECK_NUMBER (parent_code_offset
);
1060 val
= make_uninit_vector (4);
1061 ASET (val
, 0, make_number (parent_charset
->id
));
1062 ASET (val
, 1, parent_min_code
);
1063 ASET (val
, 2, parent_max_code
);
1064 ASET (val
, 3, parent_code_offset
);
1065 ASET (attrs
, charset_subset
, val
);
1067 charset
.method
= CHARSET_METHOD_SUBSET
;
1068 /* Here, we just copy the parent's fast_map. It's not accurate,
1069 but at least it works for quickly detecting which character
1070 DOESN'T belong to this charset. */
1071 for (i
= 0; i
< 190; i
++)
1072 charset
.fast_map
[i
] = parent_charset
->fast_map
[i
];
1074 /* We also copy these for parents. */
1075 charset
.min_char
= parent_charset
->min_char
;
1076 charset
.max_char
= parent_charset
->max_char
;
1078 else if (! NILP (args
[charset_arg_superset
]))
1080 val
= args
[charset_arg_superset
];
1081 charset
.method
= CHARSET_METHOD_SUPERSET
;
1082 val
= Fcopy_sequence (val
);
1083 ASET (attrs
, charset_superset
, val
);
1085 charset
.min_char
= MAX_CHAR
;
1086 charset
.max_char
= 0;
1087 for (; ! NILP (val
); val
= Fcdr (val
))
1089 Lisp_Object elt
, car_part
, cdr_part
;
1090 int this_id
, offset
;
1091 struct charset
*this_charset
;
1096 car_part
= XCAR (elt
);
1097 cdr_part
= XCDR (elt
);
1098 CHECK_CHARSET_GET_ID (car_part
, this_id
);
1099 CHECK_TYPE_RANGED_INTEGER (int, cdr_part
);
1100 offset
= XINT (cdr_part
);
1104 CHECK_CHARSET_GET_ID (elt
, this_id
);
1107 XSETCAR (val
, Fcons (make_number (this_id
), make_number (offset
)));
1109 this_charset
= CHARSET_FROM_ID (this_id
);
1110 if (charset
.min_char
> this_charset
->min_char
)
1111 charset
.min_char
= this_charset
->min_char
;
1112 if (charset
.max_char
< this_charset
->max_char
)
1113 charset
.max_char
= this_charset
->max_char
;
1114 for (i
= 0; i
< 190; i
++)
1115 charset
.fast_map
[i
] |= this_charset
->fast_map
[i
];
1119 error ("None of :code-offset, :map, :parents are specified");
1121 val
= args
[charset_arg_unify_map
];
1122 if (! NILP (val
) && !STRINGP (val
))
1124 ASET (attrs
, charset_unify_map
, val
);
1126 CHECK_LIST (args
[charset_arg_plist
]);
1127 ASET (attrs
, charset_plist
, args
[charset_arg_plist
]);
1129 charset
.hash_index
= hash_lookup (hash_table
, args
[charset_arg_name
],
1131 if (charset
.hash_index
>= 0)
1133 new_definition_p
= 0;
1134 id
= XFASTINT (CHARSET_SYMBOL_ID (args
[charset_arg_name
]));
1135 set_hash_value_slot (hash_table
, charset
.hash_index
, attrs
);
1139 charset
.hash_index
= hash_put (hash_table
, args
[charset_arg_name
], attrs
,
1141 if (charset_table_used
== charset_table_size
)
1143 /* Ensure that charset IDs fit into 'int' as well as into the
1144 restriction imposed by fixnums. Although the 'int' restriction
1145 could be removed, too much other code would need altering; for
1146 example, the IDs are stuffed into struct
1147 coding_system.charbuf[i] entries, which are 'int'. */
1148 int old_size
= charset_table_size
;
1149 ptrdiff_t new_size
= old_size
;
1150 struct charset
*new_table
=
1151 xpalloc (0, &new_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 charset_table_size
= new_size
;
1157 /* FIXME: This leaks memory, as the old charset_table becomes
1158 unreachable. If the old charset table is charset_table_init
1159 then this leak is intentional; otherwise, it's unclear.
1160 If the latter memory leak is intentional, a
1161 comment should be added to explain this. If not, the old
1162 charset_table should be freed, by passing it as the 1st argument
1163 to xpalloc and removing the memcpy. */
1165 id
= charset_table_used
++;
1166 new_definition_p
= 1;
1169 ASET (attrs
, charset_id
, make_number (id
));
1171 charset_table
[id
] = charset
;
1173 if (charset
.method
== CHARSET_METHOD_MAP
)
1175 load_charset (&charset
, 0);
1176 charset_table
[id
] = charset
;
1179 if (charset
.iso_final
>= 0)
1181 ISO_CHARSET_TABLE (charset
.dimension
, charset
.iso_chars_96
,
1182 charset
.iso_final
) = id
;
1183 if (new_definition_p
)
1184 Viso_2022_charset_list
= nconc2 (Viso_2022_charset_list
,
1185 list1 (make_number (id
)));
1186 if (ISO_CHARSET_TABLE (1, 0, 'J') == id
)
1187 charset_jisx0201_roman
= id
;
1188 else if (ISO_CHARSET_TABLE (2, 0, '@') == id
)
1189 charset_jisx0208_1978
= id
;
1190 else if (ISO_CHARSET_TABLE (2, 0, 'B') == id
)
1191 charset_jisx0208
= id
;
1192 else if (ISO_CHARSET_TABLE (2, 0, 'C') == id
)
1193 charset_ksc5601
= id
;
1196 if (charset
.emacs_mule_id
>= 0)
1198 emacs_mule_charset
[charset
.emacs_mule_id
] = id
;
1199 if (charset
.emacs_mule_id
< 0xA0)
1200 emacs_mule_bytes
[charset
.emacs_mule_id
] = charset
.dimension
+ 1;
1202 emacs_mule_bytes
[charset
.emacs_mule_id
] = charset
.dimension
+ 2;
1203 if (new_definition_p
)
1204 Vemacs_mule_charset_list
= nconc2 (Vemacs_mule_charset_list
,
1205 list1 (make_number (id
)));
1208 if (new_definition_p
)
1210 Vcharset_list
= Fcons (args
[charset_arg_name
], Vcharset_list
);
1211 if (charset
.supplementary_p
)
1212 Vcharset_ordered_list
= nconc2 (Vcharset_ordered_list
,
1213 list1 (make_number (id
)));
1218 for (tail
= Vcharset_ordered_list
; CONSP (tail
); tail
= XCDR (tail
))
1220 struct charset
*cs
= CHARSET_FROM_ID (XINT (XCAR (tail
)));
1222 if (cs
->supplementary_p
)
1225 if (EQ (tail
, Vcharset_ordered_list
))
1226 Vcharset_ordered_list
= Fcons (make_number (id
),
1227 Vcharset_ordered_list
);
1228 else if (NILP (tail
))
1229 Vcharset_ordered_list
= nconc2 (Vcharset_ordered_list
,
1230 list1 (make_number (id
)));
1233 val
= Fcons (XCAR (tail
), XCDR (tail
));
1234 XSETCDR (tail
, val
);
1235 XSETCAR (tail
, make_number (id
));
1238 charset_ordered_list_tick
++;
1245 /* Same as Fdefine_charset_internal but arguments are more convenient
1246 to call from C (typically in syms_of_charset). This can define a
1247 charset of `offset' method only. Return the ID of the new
1251 define_charset_internal (Lisp_Object name
,
1253 const char *code_space_chars
,
1254 unsigned min_code
, unsigned max_code
,
1255 int iso_final
, int iso_revision
, int emacs_mule_id
,
1256 bool ascii_compatible
, bool supplementary
,
1259 const unsigned char *code_space
= (const unsigned char *) code_space_chars
;
1260 Lisp_Object args
[charset_arg_max
];
1264 args
[charset_arg_name
] = name
;
1265 args
[charset_arg_dimension
] = make_number (dimension
);
1266 val
= make_uninit_vector (8);
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 args
[charset_arg_plist
] =
1287 listn (CONSTYPE_HEAP
, 14,
1288 intern_c_string (":name"),
1289 args
[charset_arg_name
],
1290 intern_c_string (":dimension"),
1291 args
[charset_arg_dimension
],
1292 intern_c_string (":code-space"),
1293 args
[charset_arg_code_space
],
1294 intern_c_string (":iso-final-char"),
1295 args
[charset_arg_iso_final
],
1296 intern_c_string (":emacs-mule-id"),
1297 args
[charset_arg_emacs_mule_id
],
1298 intern_c_string (":ascii-compatible-p"),
1299 args
[charset_arg_ascii_compatible_p
],
1300 intern_c_string (":code-offset"),
1301 args
[charset_arg_code_offset
]);
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 ASET (attrs
, charset_plist
, 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 set_charset_attr (cs
, charset_unify_map
, 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 /* Check that DIMENSION, CHARS, and FINAL_CHAR specify a valid ISO charset.
1401 Return true if it's a 96-character set, false if 94. */
1404 check_iso_charset_parameter (Lisp_Object dimension
, Lisp_Object chars
,
1405 Lisp_Object final_char
)
1407 CHECK_NUMBER (dimension
);
1408 CHECK_NUMBER (chars
);
1409 CHECK_CHARACTER (final_char
);
1411 if (! (1 <= XINT (dimension
) && XINT (dimension
) <= 3))
1412 error ("Invalid DIMENSION %"pI
"d, it should be 1, 2, or 3",
1415 bool chars_flag
= XINT (chars
) == 96;
1416 if (! (chars_flag
|| XINT (chars
) == 94))
1417 error ("Invalid CHARS %"pI
"d, it should be 94 or 96", XINT (chars
));
1419 int final_ch
= XFASTINT (final_char
);
1420 if (! ('0' <= final_ch
&& final_ch
<= '~'))
1421 error ("Invalid FINAL-CHAR '%c', it should be '0'..'~'", final_ch
);
1426 DEFUN ("get-unused-iso-final-char", Fget_unused_iso_final_char
,
1427 Sget_unused_iso_final_char
, 2, 2, 0,
1429 Return an unused ISO final char for a charset of DIMENSION and CHARS.
1430 DIMENSION is the number of bytes to represent a character: 1 or 2.
1431 CHARS is the number of characters in a dimension: 94 or 96.
1433 This final char is for private use, thus the range is `0' (48) .. `?' (63).
1434 If there's no unused final char for the specified kind of charset,
1436 (Lisp_Object dimension
, Lisp_Object chars
)
1438 bool chars_flag
= check_iso_charset_parameter (dimension
, chars
,
1440 for (int final_char
= '0'; final_char
<= '?'; final_char
++)
1441 if (ISO_CHARSET_TABLE (XINT (dimension
), chars_flag
, final_char
) < 0)
1442 return make_number (final_char
);
1447 DEFUN ("declare-equiv-charset", Fdeclare_equiv_charset
, Sdeclare_equiv_charset
,
1449 doc
: /* Declare an equivalent charset for ISO-2022 decoding.
1451 On decoding by an ISO-2022 base coding system, when a charset
1452 specified by DIMENSION, CHARS, and FINAL-CHAR is designated, behave as
1453 if CHARSET is designated instead. */)
1454 (Lisp_Object dimension
, Lisp_Object chars
, Lisp_Object final_char
, Lisp_Object charset
)
1458 CHECK_CHARSET_GET_ID (charset
, id
);
1459 bool chars_flag
= check_iso_charset_parameter (dimension
, chars
, final_char
);
1460 ISO_CHARSET_TABLE (XINT (dimension
), chars_flag
, XFASTINT (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_CHAR_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
)
1555 Lisp_Object charsets
;
1556 ptrdiff_t from
, from_byte
, to
, stop
, stop_byte
;
1559 bool multibyte
= ! NILP (BVAR (current_buffer
, enable_multibyte_characters
));
1561 validate_region (&beg
, &end
);
1562 from
= XFASTINT (beg
);
1563 stop
= to
= XFASTINT (end
);
1565 if (from
< GPT
&& GPT
< to
)
1568 stop_byte
= GPT_BYTE
;
1571 stop_byte
= CHAR_TO_BYTE (stop
);
1573 from_byte
= CHAR_TO_BYTE (from
);
1575 charsets
= make_local_vector (charset_table_used
, Qnil
);
1578 find_charsets_in_text (BYTE_POS_ADDR (from_byte
), stop
- from
,
1579 stop_byte
- from_byte
, charsets
, table
,
1583 from
= stop
, from_byte
= stop_byte
;
1584 stop
= to
, stop_byte
= CHAR_TO_BYTE (stop
);
1591 for (i
= charset_table_used
- 1; i
>= 0; i
--)
1592 if (!NILP (AREF (charsets
, i
)))
1593 val
= Fcons (CHARSET_NAME (charset_table
+ i
), val
);
1597 DEFUN ("find-charset-string", Ffind_charset_string
, Sfind_charset_string
,
1599 doc
: /* Return a list of charsets in STR.
1600 Optional arg TABLE if non-nil is a translation table to look up.
1602 If STR is unibyte, the returned list may contain
1603 only `ascii', `eight-bit-control', and `eight-bit-graphic'. */)
1604 (Lisp_Object str
, Lisp_Object table
)
1607 Lisp_Object charsets
;
1613 charsets
= make_local_vector (charset_table_used
, Qnil
);
1614 find_charsets_in_text (SDATA (str
), SCHARS (str
), SBYTES (str
),
1616 STRING_MULTIBYTE (str
));
1618 for (i
= charset_table_used
- 1; i
>= 0; i
--)
1619 if (!NILP (AREF (charsets
, i
)))
1620 val
= Fcons (CHARSET_NAME (charset_table
+ i
), val
);
1626 /* Return a unified character code for C (>= 0x110000). VAL is a
1627 value of Vchar_unify_table for C; i.e. it is nil, an integer, or a
1630 maybe_unify_char (int c
, Lisp_Object val
)
1632 struct charset
*charset
;
1635 return XFASTINT (val
);
1639 CHECK_CHARSET_GET_CHARSET (val
, charset
);
1641 /* The call to load_charset below can allocate memory, which screws
1642 callers of this function through STRING_CHAR_* macros that hold C
1643 pointers to buffer text, if REL_ALLOC is used. */
1644 r_alloc_inhibit_buffer_relocation (1);
1646 load_charset (charset
, 1);
1647 if (! inhibit_load_charset_map
)
1649 val
= CHAR_TABLE_REF (Vchar_unify_table
, c
);
1655 int code_index
= c
- CHARSET_CODE_OFFSET (charset
);
1656 int unified
= GET_TEMP_CHARSET_WORK_DECODER (code_index
);
1662 r_alloc_inhibit_buffer_relocation (0);
1668 /* Return a character corresponding to the code-point CODE of
1672 decode_char (struct charset
*charset
, unsigned int code
)
1675 enum charset_method method
= CHARSET_METHOD (charset
);
1677 if (code
< CHARSET_MIN_CODE (charset
) || code
> CHARSET_MAX_CODE (charset
))
1680 if (method
== CHARSET_METHOD_SUBSET
)
1682 Lisp_Object subset_info
;
1684 subset_info
= CHARSET_SUBSET (charset
);
1685 charset
= CHARSET_FROM_ID (XFASTINT (AREF (subset_info
, 0)));
1686 code
-= XINT (AREF (subset_info
, 3));
1687 if (code
< XFASTINT (AREF (subset_info
, 1))
1688 || code
> XFASTINT (AREF (subset_info
, 2)))
1691 c
= DECODE_CHAR (charset
, code
);
1693 else if (method
== CHARSET_METHOD_SUPERSET
)
1695 Lisp_Object parents
;
1697 parents
= CHARSET_SUPERSET (charset
);
1699 for (; CONSP (parents
); parents
= XCDR (parents
))
1701 int id
= XINT (XCAR (XCAR (parents
)));
1702 int code_offset
= XINT (XCDR (XCAR (parents
)));
1703 unsigned this_code
= code
- code_offset
;
1705 charset
= CHARSET_FROM_ID (id
);
1706 if ((c
= DECODE_CHAR (charset
, this_code
)) >= 0)
1712 char_index
= CODE_POINT_TO_INDEX (charset
, code
);
1716 if (method
== CHARSET_METHOD_MAP
)
1718 Lisp_Object decoder
;
1720 decoder
= CHARSET_DECODER (charset
);
1721 if (! VECTORP (decoder
))
1723 load_charset (charset
, 1);
1724 decoder
= CHARSET_DECODER (charset
);
1726 if (VECTORP (decoder
))
1727 c
= XINT (AREF (decoder
, char_index
));
1729 c
= GET_TEMP_CHARSET_WORK_DECODER (char_index
);
1731 else /* method == CHARSET_METHOD_OFFSET */
1733 c
= char_index
+ CHARSET_CODE_OFFSET (charset
);
1734 if (CHARSET_UNIFIED_P (charset
)
1735 && MAX_UNICODE_CHAR
< c
&& c
<= MAX_5_BYTE_CHAR
)
1737 /* Unify C with a Unicode character if possible. */
1738 Lisp_Object val
= CHAR_TABLE_REF (Vchar_unify_table
, c
);
1739 c
= maybe_unify_char (c
, val
);
1747 /* Variable used temporarily by the macro ENCODE_CHAR. */
1748 Lisp_Object charset_work
;
1750 /* Return a code-point of C in CHARSET. If C doesn't belong to
1751 CHARSET, return CHARSET_INVALID_CODE (CHARSET). If STRICT is true,
1752 use CHARSET's strict_max_char instead of max_char. */
1755 encode_char (struct charset
*charset
, int c
)
1758 enum charset_method method
= CHARSET_METHOD (charset
);
1760 if (CHARSET_UNIFIED_P (charset
))
1762 Lisp_Object deunifier
;
1763 int code_index
= -1;
1765 deunifier
= CHARSET_DEUNIFIER (charset
);
1766 if (! CHAR_TABLE_P (deunifier
))
1768 load_charset (charset
, 2);
1769 deunifier
= CHARSET_DEUNIFIER (charset
);
1771 if (CHAR_TABLE_P (deunifier
))
1773 Lisp_Object deunified
= CHAR_TABLE_REF (deunifier
, c
);
1775 if (INTEGERP (deunified
))
1776 code_index
= XINT (deunified
);
1780 code_index
= GET_TEMP_CHARSET_WORK_ENCODER (c
);
1782 if (code_index
>= 0)
1783 c
= CHARSET_CODE_OFFSET (charset
) + code_index
;
1786 if (method
== CHARSET_METHOD_SUBSET
)
1788 Lisp_Object subset_info
;
1789 struct charset
*this_charset
;
1791 subset_info
= CHARSET_SUBSET (charset
);
1792 this_charset
= CHARSET_FROM_ID (XFASTINT (AREF (subset_info
, 0)));
1793 code
= ENCODE_CHAR (this_charset
, c
);
1794 if (code
== CHARSET_INVALID_CODE (this_charset
)
1795 || code
< XFASTINT (AREF (subset_info
, 1))
1796 || code
> XFASTINT (AREF (subset_info
, 2)))
1797 return CHARSET_INVALID_CODE (charset
);
1798 code
+= XINT (AREF (subset_info
, 3));
1802 if (method
== CHARSET_METHOD_SUPERSET
)
1804 Lisp_Object parents
;
1806 parents
= CHARSET_SUPERSET (charset
);
1807 for (; CONSP (parents
); parents
= XCDR (parents
))
1809 int id
= XINT (XCAR (XCAR (parents
)));
1810 int code_offset
= XINT (XCDR (XCAR (parents
)));
1811 struct charset
*this_charset
= CHARSET_FROM_ID (id
);
1813 code
= ENCODE_CHAR (this_charset
, c
);
1814 if (code
!= CHARSET_INVALID_CODE (this_charset
))
1815 return code
+ code_offset
;
1817 return CHARSET_INVALID_CODE (charset
);
1820 if (! CHARSET_FAST_MAP_REF ((c
), charset
->fast_map
)
1821 || c
< CHARSET_MIN_CHAR (charset
) || c
> CHARSET_MAX_CHAR (charset
))
1822 return CHARSET_INVALID_CODE (charset
);
1824 if (method
== CHARSET_METHOD_MAP
)
1826 Lisp_Object encoder
;
1829 encoder
= CHARSET_ENCODER (charset
);
1830 if (! CHAR_TABLE_P (CHARSET_ENCODER (charset
)))
1832 load_charset (charset
, 2);
1833 encoder
= CHARSET_ENCODER (charset
);
1835 if (CHAR_TABLE_P (encoder
))
1837 val
= CHAR_TABLE_REF (encoder
, c
);
1839 return CHARSET_INVALID_CODE (charset
);
1841 if (! CHARSET_COMPACT_CODES_P (charset
))
1842 code
= INDEX_TO_CODE_POINT (charset
, code
);
1846 code
= GET_TEMP_CHARSET_WORK_ENCODER (c
);
1847 code
= INDEX_TO_CODE_POINT (charset
, code
);
1850 else /* method == CHARSET_METHOD_OFFSET */
1852 unsigned code_index
= c
- CHARSET_CODE_OFFSET (charset
);
1854 code
= INDEX_TO_CODE_POINT (charset
, code_index
);
1861 DEFUN ("decode-char", Fdecode_char
, Sdecode_char
, 2, 3, 0,
1862 doc
: /* Decode the pair of CHARSET and CODE-POINT into a character.
1863 Return nil if CODE-POINT is not valid in CHARSET.
1865 CODE-POINT may be a cons (HIGHER-16-BIT-VALUE . LOWER-16-BIT-VALUE). */)
1866 (Lisp_Object charset
, Lisp_Object code_point
, Lisp_Object restriction
)
1870 struct charset
*charsetp
;
1872 CHECK_CHARSET_GET_ID (charset
, id
);
1873 code
= cons_to_unsigned (code_point
, UINT_MAX
);
1874 charsetp
= CHARSET_FROM_ID (id
);
1875 c
= DECODE_CHAR (charsetp
, code
);
1876 return (c
>= 0 ? make_number (c
) : Qnil
);
1880 DEFUN ("encode-char", Fencode_char
, Sencode_char
, 2, 3, 0,
1881 doc
: /* Encode the character CH into a code-point of CHARSET.
1882 Return nil if CHARSET doesn't include CH. */)
1883 (Lisp_Object ch
, Lisp_Object charset
, Lisp_Object restriction
)
1887 struct charset
*charsetp
;
1889 CHECK_CHARSET_GET_ID (charset
, id
);
1890 CHECK_CHARACTER (ch
);
1892 charsetp
= CHARSET_FROM_ID (id
);
1893 code
= ENCODE_CHAR (charsetp
, c
);
1894 if (code
== CHARSET_INVALID_CODE (charsetp
))
1896 return INTEGER_TO_CONS (code
);
1900 DEFUN ("make-char", Fmake_char
, Smake_char
, 1, 5, 0,
1902 /* Return a character of CHARSET whose position codes are CODEn.
1904 CODE1 through CODE4 are optional, but if you don't supply sufficient
1905 position codes, it is assumed that the minimum code in each dimension
1907 (Lisp_Object charset
, Lisp_Object code1
, Lisp_Object code2
, Lisp_Object code3
, Lisp_Object code4
)
1910 struct charset
*charsetp
;
1914 CHECK_CHARSET_GET_ID (charset
, id
);
1915 charsetp
= CHARSET_FROM_ID (id
);
1917 dimension
= CHARSET_DIMENSION (charsetp
);
1919 code
= (CHARSET_ASCII_COMPATIBLE_P (charsetp
)
1920 ? 0 : CHARSET_MIN_CODE (charsetp
));
1923 CHECK_NATNUM (code1
);
1924 if (XFASTINT (code1
) >= 0x100)
1925 args_out_of_range (make_number (0xFF), code1
);
1926 code
= XFASTINT (code1
);
1932 code
|= charsetp
->code_space
[(dimension
- 2) * 4];
1935 CHECK_NATNUM (code2
);
1936 if (XFASTINT (code2
) >= 0x100)
1937 args_out_of_range (make_number (0xFF), code2
);
1938 code
|= XFASTINT (code2
);
1945 code
|= charsetp
->code_space
[(dimension
- 3) * 4];
1948 CHECK_NATNUM (code3
);
1949 if (XFASTINT (code3
) >= 0x100)
1950 args_out_of_range (make_number (0xFF), code3
);
1951 code
|= XFASTINT (code3
);
1958 code
|= charsetp
->code_space
[0];
1961 CHECK_NATNUM (code4
);
1962 if (XFASTINT (code4
) >= 0x100)
1963 args_out_of_range (make_number (0xFF), code4
);
1964 code
|= XFASTINT (code4
);
1971 if (CHARSET_ISO_FINAL (charsetp
) >= 0)
1973 c
= DECODE_CHAR (charsetp
, code
);
1975 error ("Invalid code(s)");
1976 return make_number (c
);
1980 /* Return the first charset in CHARSET_LIST that contains C.
1981 CHARSET_LIST is a list of charset IDs. If it is nil, use
1982 Vcharset_ordered_list. */
1985 char_charset (int c
, Lisp_Object charset_list
, unsigned int *code_return
)
1987 bool maybe_null
= 0;
1989 if (NILP (charset_list
))
1990 charset_list
= Vcharset_ordered_list
;
1994 while (CONSP (charset_list
))
1996 struct charset
*charset
= CHARSET_FROM_ID (XINT (XCAR (charset_list
)));
1997 unsigned code
= ENCODE_CHAR (charset
, c
);
1999 if (code
!= CHARSET_INVALID_CODE (charset
))
2002 *code_return
= code
;
2005 charset_list
= XCDR (charset_list
);
2007 && c
<= MAX_UNICODE_CHAR
2008 && EQ (charset_list
, Vcharset_non_preferred_head
))
2009 return CHARSET_FROM_ID (charset_unicode
);
2011 return (maybe_null
? NULL
2012 : c
<= MAX_5_BYTE_CHAR
? CHARSET_FROM_ID (charset_emacs
)
2013 : CHARSET_FROM_ID (charset_eight_bit
));
2017 DEFUN ("split-char", Fsplit_char
, Ssplit_char
, 1, 1, 0,
2019 /*Return list of charset and one to four position-codes of CH.
2020 The charset is decided by the current priority order of charsets.
2021 A position-code is a byte value of each dimension of the code-point of
2022 CH in the charset. */)
2025 struct charset
*charset
;
2030 CHECK_CHARACTER (ch
);
2032 charset
= CHAR_CHARSET (c
);
2035 code
= ENCODE_CHAR (charset
, c
);
2036 if (code
== CHARSET_INVALID_CODE (charset
))
2038 dimension
= CHARSET_DIMENSION (charset
);
2039 for (val
= Qnil
; dimension
> 0; dimension
--)
2041 val
= Fcons (make_number (code
& 0xFF), val
);
2044 return Fcons (CHARSET_NAME (charset
), val
);
2048 DEFUN ("char-charset", Fchar_charset
, Schar_charset
, 1, 2, 0,
2049 doc
: /* Return the charset of highest priority that contains CH.
2050 ASCII characters are an exception: for them, this function always
2052 If optional 2nd arg RESTRICTION is non-nil, it is a list of charsets
2053 from which to find the charset. It may also be a coding system. In
2054 that case, find the charset from what supported by that coding system. */)
2055 (Lisp_Object ch
, Lisp_Object restriction
)
2057 struct charset
*charset
;
2059 CHECK_CHARACTER (ch
);
2060 if (NILP (restriction
))
2061 charset
= CHAR_CHARSET (XINT (ch
));
2064 if (CONSP (restriction
))
2066 int c
= XFASTINT (ch
);
2068 for (; CONSP (restriction
); restriction
= XCDR (restriction
))
2070 struct charset
*rcharset
;
2072 CHECK_CHARSET_GET_CHARSET (XCAR (restriction
), rcharset
);
2073 if (ENCODE_CHAR (rcharset
, c
) != CHARSET_INVALID_CODE (rcharset
))
2074 return XCAR (restriction
);
2078 restriction
= coding_system_charset_list (restriction
);
2079 charset
= char_charset (XINT (ch
), restriction
, NULL
);
2083 return (CHARSET_NAME (charset
));
2087 DEFUN ("charset-after", Fcharset_after
, Scharset_after
, 0, 1, 0,
2089 Return charset of a character in the current buffer at position POS.
2090 If POS is nil, it defaults to the current point.
2091 If POS is out of range, the value is nil. */)
2095 struct charset
*charset
;
2097 ch
= Fchar_after (pos
);
2098 if (! INTEGERP (ch
))
2100 charset
= CHAR_CHARSET (XINT (ch
));
2101 return (CHARSET_NAME (charset
));
2105 DEFUN ("iso-charset", Fiso_charset
, Siso_charset
, 3, 3, 0,
2107 Return charset of ISO's specification DIMENSION, CHARS, and FINAL-CHAR.
2109 ISO 2022's designation sequence (escape sequence) distinguishes charsets
2110 by their DIMENSION, CHARS, and FINAL-CHAR,
2111 whereas Emacs distinguishes them by charset symbol.
2112 See the documentation of the function `charset-info' for the meanings of
2113 DIMENSION, CHARS, and FINAL-CHAR. */)
2114 (Lisp_Object dimension
, Lisp_Object chars
, Lisp_Object final_char
)
2116 bool chars_flag
= check_iso_charset_parameter (dimension
, chars
, final_char
);
2117 int id
= ISO_CHARSET_TABLE (XINT (dimension
), chars_flag
,
2118 XFASTINT (final_char
));
2119 return (id
>= 0 ? CHARSET_NAME (CHARSET_FROM_ID (id
)) : Qnil
);
2123 DEFUN ("clear-charset-maps", Fclear_charset_maps
, Sclear_charset_maps
,
2127 Clear temporary charset mapping tables.
2128 It should be called only from temacs invoked for dumping. */)
2131 if (temp_charset_work
)
2133 xfree (temp_charset_work
);
2134 temp_charset_work
= NULL
;
2137 if (CHAR_TABLE_P (Vchar_unify_table
))
2138 Foptimize_char_table (Vchar_unify_table
, Qnil
);
2143 DEFUN ("charset-priority-list", Fcharset_priority_list
,
2144 Scharset_priority_list
, 0, 1, 0,
2145 doc
: /* Return the list of charsets ordered by priority.
2146 HIGHESTP non-nil means just return the highest priority one. */)
2147 (Lisp_Object highestp
)
2149 Lisp_Object val
= Qnil
, list
= Vcharset_ordered_list
;
2151 if (!NILP (highestp
))
2152 return CHARSET_NAME (CHARSET_FROM_ID (XINT (Fcar (list
))));
2154 while (!NILP (list
))
2156 val
= Fcons (CHARSET_NAME (CHARSET_FROM_ID (XINT (XCAR (list
)))), val
);
2159 return Fnreverse (val
);
2162 DEFUN ("set-charset-priority", Fset_charset_priority
, Sset_charset_priority
,
2164 doc
: /* Assign higher priority to the charsets given as arguments.
2165 usage: (set-charset-priority &rest charsets) */)
2166 (ptrdiff_t nargs
, Lisp_Object
*args
)
2168 Lisp_Object new_head
, old_list
, arglist
[2];
2169 Lisp_Object list_2022
, list_emacs_mule
;
2173 old_list
= Fcopy_sequence (Vcharset_ordered_list
);
2175 for (i
= 0; i
< nargs
; i
++)
2177 CHECK_CHARSET_GET_ID (args
[i
], id
);
2178 if (! NILP (Fmemq (make_number (id
), old_list
)))
2180 old_list
= Fdelq (make_number (id
), old_list
);
2181 new_head
= Fcons (make_number (id
), new_head
);
2184 arglist
[0] = Fnreverse (new_head
);
2185 arglist
[1] = Vcharset_non_preferred_head
= old_list
;
2186 Vcharset_ordered_list
= Fnconc (2, arglist
);
2187 charset_ordered_list_tick
++;
2189 charset_unibyte
= -1;
2190 for (old_list
= Vcharset_ordered_list
, list_2022
= list_emacs_mule
= Qnil
;
2191 CONSP (old_list
); old_list
= XCDR (old_list
))
2193 if (! NILP (Fmemq (XCAR (old_list
), Viso_2022_charset_list
)))
2194 list_2022
= Fcons (XCAR (old_list
), list_2022
);
2195 if (! NILP (Fmemq (XCAR (old_list
), Vemacs_mule_charset_list
)))
2196 list_emacs_mule
= Fcons (XCAR (old_list
), list_emacs_mule
);
2197 if (charset_unibyte
< 0)
2199 struct charset
*charset
= CHARSET_FROM_ID (XINT (XCAR (old_list
)));
2201 if (CHARSET_DIMENSION (charset
) == 1
2202 && CHARSET_ASCII_COMPATIBLE_P (charset
)
2203 && CHARSET_MAX_CHAR (charset
) >= 0x80)
2204 charset_unibyte
= CHARSET_ID (charset
);
2207 Viso_2022_charset_list
= Fnreverse (list_2022
);
2208 Vemacs_mule_charset_list
= Fnreverse (list_emacs_mule
);
2209 if (charset_unibyte
< 0)
2210 charset_unibyte
= charset_iso_8859_1
;
2215 DEFUN ("charset-id-internal", Fcharset_id_internal
, Scharset_id_internal
,
2217 doc
: /* Internal use only.
2218 Return charset identification number of CHARSET. */)
2219 (Lisp_Object charset
)
2223 CHECK_CHARSET_GET_ID (charset
, id
);
2224 return make_number (id
);
2227 struct charset_sort_data
2229 Lisp_Object charset
;
2235 charset_compare (const void *d1
, const void *d2
)
2237 const struct charset_sort_data
*data1
= d1
, *data2
= d2
;
2238 if (data1
->priority
!= data2
->priority
)
2239 return data1
->priority
< data2
->priority
? -1 : 1;
2243 DEFUN ("sort-charsets", Fsort_charsets
, Ssort_charsets
, 1, 1, 0,
2244 doc
: /* Sort charset list CHARSETS by a priority of each charset.
2245 Return the sorted list. CHARSETS is modified by side effects.
2246 See also `charset-priority-list' and `set-charset-priority'. */)
2247 (Lisp_Object charsets
)
2249 Lisp_Object len
= Flength (charsets
);
2250 ptrdiff_t n
= XFASTINT (len
), i
, j
;
2252 Lisp_Object tail
, elt
, attrs
;
2253 struct charset_sort_data
*sort_data
;
2254 int id
, min_id
= INT_MAX
, max_id
= INT_MIN
;
2259 SAFE_NALLOCA (sort_data
, 1, n
);
2260 for (tail
= charsets
, i
= 0; CONSP (tail
); tail
= XCDR (tail
), i
++)
2263 CHECK_CHARSET_GET_ATTR (elt
, attrs
);
2264 sort_data
[i
].charset
= elt
;
2265 sort_data
[i
].id
= id
= XINT (CHARSET_ATTR_ID (attrs
));
2271 for (done
= 0, tail
= Vcharset_ordered_list
, i
= 0;
2272 done
< n
&& CONSP (tail
); tail
= XCDR (tail
), i
++)
2275 id
= XFASTINT (elt
);
2276 if (id
>= min_id
&& id
<= max_id
)
2277 for (j
= 0; j
< n
; j
++)
2278 if (sort_data
[j
].id
== id
)
2280 sort_data
[j
].priority
= i
;
2284 qsort (sort_data
, n
, sizeof *sort_data
, charset_compare
);
2285 for (i
= 0, tail
= charsets
; CONSP (tail
); tail
= XCDR (tail
), i
++)
2286 XSETCAR (tail
, sort_data
[i
].charset
);
2295 Lisp_Object tempdir
;
2296 tempdir
= Fexpand_file_name (build_string ("charsets"), Vdata_directory
);
2297 if (! file_accessible_directory_p (tempdir
))
2299 /* This used to be non-fatal (dir_warning), but it should not
2300 happen, and if it does sooner or later it will cause some
2301 obscure problem (eg bug#6401), so better abort. */
2302 fprintf (stderr
, "Error: charsets directory not found:\n\
2304 Emacs will not function correctly without the character map files.\n%s\
2305 Please check your installation!\n",
2307 egetenv("EMACSDATA") ? "The EMACSDATA environment \
2308 variable is set, maybe it has the wrong value?\n" : "");
2312 Vcharset_map_path
= list1 (tempdir
);
2317 init_charset_once (void)
2321 for (i
= 0; i
< ISO_MAX_DIMENSION
; i
++)
2322 for (j
= 0; j
< ISO_MAX_CHARS
; j
++)
2323 for (k
= 0; k
< ISO_MAX_FINAL
; k
++)
2324 iso_charset_table
[i
][j
][k
] = -1;
2326 for (i
= 0; i
< 256; i
++)
2327 emacs_mule_charset
[i
] = -1;
2329 charset_jisx0201_roman
= -1;
2330 charset_jisx0208_1978
= -1;
2331 charset_jisx0208
= -1;
2332 charset_ksc5601
= -1;
2337 /* Allocate an initial charset table that is large enough to handle
2338 Emacs while it is bootstrapping. As of September 2011, the size
2339 needs to be at least 166; make it a bit bigger to allow for future
2342 Don't make the value so small that the table is reallocated during
2343 bootstrapping, as glibc malloc calls larger than just under 64 KiB
2344 during an initial bootstrap wreak havoc after dumping; see the
2345 M_MMAP_THRESHOLD value in alloc.c, plus there is a extra overhead
2346 internal to glibc malloc and perhaps to Emacs malloc debugging. */
2347 static struct charset charset_table_init
[180];
2350 syms_of_charset (void)
2352 DEFSYM (Qcharsetp
, "charsetp");
2354 DEFSYM (Qascii
, "ascii");
2355 DEFSYM (Qunicode
, "unicode");
2356 DEFSYM (Qemacs
, "emacs");
2357 DEFSYM (Qeight_bit
, "eight-bit");
2358 DEFSYM (Qiso_8859_1
, "iso-8859-1");
2363 staticpro (&Vcharset_ordered_list
);
2364 Vcharset_ordered_list
= Qnil
;
2366 staticpro (&Viso_2022_charset_list
);
2367 Viso_2022_charset_list
= Qnil
;
2369 staticpro (&Vemacs_mule_charset_list
);
2370 Vemacs_mule_charset_list
= Qnil
;
2372 /* Don't staticpro them here. It's done in syms_of_fns. */
2373 QCtest
= intern_c_string (":test");
2374 Qeq
= intern_c_string ("eq");
2376 staticpro (&Vcharset_hash_table
);
2378 Lisp_Object args
[2];
2381 Vcharset_hash_table
= Fmake_hash_table (2, args
);
2384 charset_table
= charset_table_init
;
2385 charset_table_size
= ARRAYELTS (charset_table_init
);
2386 charset_table_used
= 0;
2388 defsubr (&Scharsetp
);
2389 defsubr (&Smap_charset_chars
);
2390 defsubr (&Sdefine_charset_internal
);
2391 defsubr (&Sdefine_charset_alias
);
2392 defsubr (&Scharset_plist
);
2393 defsubr (&Sset_charset_plist
);
2394 defsubr (&Sunify_charset
);
2395 defsubr (&Sget_unused_iso_final_char
);
2396 defsubr (&Sdeclare_equiv_charset
);
2397 defsubr (&Sfind_charset_region
);
2398 defsubr (&Sfind_charset_string
);
2399 defsubr (&Sdecode_char
);
2400 defsubr (&Sencode_char
);
2401 defsubr (&Ssplit_char
);
2402 defsubr (&Smake_char
);
2403 defsubr (&Schar_charset
);
2404 defsubr (&Scharset_after
);
2405 defsubr (&Siso_charset
);
2406 defsubr (&Sclear_charset_maps
);
2407 defsubr (&Scharset_priority_list
);
2408 defsubr (&Sset_charset_priority
);
2409 defsubr (&Scharset_id_internal
);
2410 defsubr (&Ssort_charsets
);
2412 DEFVAR_LISP ("charset-map-path", Vcharset_map_path
,
2413 doc
: /* List of directories to search for charset map files. */);
2414 Vcharset_map_path
= Qnil
;
2416 DEFVAR_BOOL ("inhibit-load-charset-map", inhibit_load_charset_map
,
2417 doc
: /* Inhibit loading of charset maps. Used when dumping Emacs. */);
2418 inhibit_load_charset_map
= 0;
2420 DEFVAR_LISP ("charset-list", Vcharset_list
,
2421 doc
: /* List of all charsets ever defined. */);
2422 Vcharset_list
= Qnil
;
2424 DEFVAR_LISP ("current-iso639-language", Vcurrent_iso639_language
,
2425 doc
: /* ISO639 language mnemonic symbol for the current language environment.
2426 If the current language environment is for multiple languages (e.g. "Latin-1"),
2427 the value may be a list of mnemonics. */);
2428 Vcurrent_iso639_language
= Qnil
;
2431 = define_charset_internal (Qascii
, 1, "\x00\x7F\0\0\0\0\0",
2432 0, 127, 'B', -1, 0, 1, 0, 0);
2434 = define_charset_internal (Qiso_8859_1
, 1, "\x00\xFF\0\0\0\0\0",
2435 0, 255, -1, -1, -1, 1, 0, 0);
2437 = define_charset_internal (Qunicode
, 3, "\x00\xFF\x00\xFF\x00\x10\0",
2438 0, MAX_UNICODE_CHAR
, -1, 0, -1, 1, 0, 0);
2440 = define_charset_internal (Qemacs
, 3, "\x00\xFF\x00\xFF\x00\x3F\0",
2441 0, MAX_5_BYTE_CHAR
, -1, 0, -1, 1, 1, 0);
2443 = define_charset_internal (Qeight_bit
, 1, "\x80\xFF\0\0\0\0\0",
2444 128, 255, -1, 0, -1, 0, 1,
2445 MAX_5_BYTE_CHAR
+ 1);
2446 charset_unibyte
= charset_iso_8859_1
;