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
,
484 unsigned min_code
= CHARSET_MIN_CODE (charset
);
485 unsigned max_code
= CHARSET_MAX_CODE (charset
);
488 Lisp_Object suffixes
;
489 struct charset_map_entries
*head
, *entries
;
493 suffixes
= list2 (build_string (".map"), build_string (".TXT"));
495 count
= SPECPDL_INDEX ();
496 record_unwind_protect_ptr (fclose_ptr_unwind
, &fp
);
498 ptrdiff_t count1
= SPECPDL_INDEX ();
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 unbind_to (count1
, Qnil
);
511 /* Use record, as `charset_map_entries' is large (larger than
513 head
= 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
= 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
;
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
);
676 range
= Fcons (Qnil
, Qnil
);
679 c
= temp_charset_work
->min_char
;
680 stop
= (temp_charset_work
->max_char
< 0x20000
681 ? temp_charset_work
->max_char
: 0xFFFF);
685 int idx
= GET_TEMP_CHARSET_WORK_ENCODER (c
);
687 if (idx
>= from_idx
&& idx
<= to_idx
)
689 if (NILP (XCAR (range
)))
690 XSETCAR (range
, make_number (c
));
692 else if (! NILP (XCAR (range
)))
694 XSETCDR (range
, make_number (c
- 1));
696 (*c_function
) (arg
, range
);
698 call2 (function
, range
, arg
);
699 XSETCAR (range
, Qnil
);
703 if (c
== temp_charset_work
->max_char
)
705 if (! NILP (XCAR (range
)))
707 XSETCDR (range
, make_number (c
));
709 (*c_function
) (arg
, range
);
711 call2 (function
, range
, arg
);
716 stop
= temp_charset_work
->max_char
;
724 map_charset_chars (void (*c_function
)(Lisp_Object
, Lisp_Object
), Lisp_Object function
,
725 Lisp_Object arg
, struct charset
*charset
, unsigned from
, unsigned to
)
728 bool partial
= (from
> CHARSET_MIN_CODE (charset
)
729 || to
< CHARSET_MAX_CODE (charset
));
731 if (CHARSET_METHOD (charset
) == CHARSET_METHOD_OFFSET
)
733 int from_idx
= CODE_POINT_TO_INDEX (charset
, from
);
734 int to_idx
= CODE_POINT_TO_INDEX (charset
, to
);
735 int from_c
= from_idx
+ CHARSET_CODE_OFFSET (charset
);
736 int to_c
= to_idx
+ CHARSET_CODE_OFFSET (charset
);
738 if (CHARSET_UNIFIED_P (charset
))
740 if (! CHAR_TABLE_P (CHARSET_DEUNIFIER (charset
)))
741 load_charset (charset
, 2);
742 if (CHAR_TABLE_P (CHARSET_DEUNIFIER (charset
)))
743 map_char_table_for_charset (c_function
, function
,
744 CHARSET_DEUNIFIER (charset
), arg
,
745 partial
? charset
: NULL
, from
, to
);
747 map_charset_for_dump (c_function
, function
, arg
, from
, to
);
750 range
= Fcons (make_number (from_c
), make_number (to_c
));
752 (*c_function
) (arg
, range
);
754 call2 (function
, range
, arg
);
756 else if (CHARSET_METHOD (charset
) == CHARSET_METHOD_MAP
)
758 if (! CHAR_TABLE_P (CHARSET_ENCODER (charset
)))
759 load_charset (charset
, 2);
760 if (CHAR_TABLE_P (CHARSET_ENCODER (charset
)))
761 map_char_table_for_charset (c_function
, function
,
762 CHARSET_ENCODER (charset
), arg
,
763 partial
? charset
: NULL
, from
, to
);
765 map_charset_for_dump (c_function
, function
, arg
, from
, to
);
767 else if (CHARSET_METHOD (charset
) == CHARSET_METHOD_SUBSET
)
769 Lisp_Object subset_info
;
772 subset_info
= CHARSET_SUBSET (charset
);
773 charset
= CHARSET_FROM_ID (XFASTINT (AREF (subset_info
, 0)));
774 offset
= XINT (AREF (subset_info
, 3));
776 if (from
< XFASTINT (AREF (subset_info
, 1)))
777 from
= XFASTINT (AREF (subset_info
, 1));
779 if (to
> XFASTINT (AREF (subset_info
, 2)))
780 to
= XFASTINT (AREF (subset_info
, 2));
781 map_charset_chars (c_function
, function
, arg
, charset
, from
, to
);
783 else /* i.e. CHARSET_METHOD_SUPERSET */
787 for (parents
= CHARSET_SUPERSET (charset
); CONSP (parents
);
788 parents
= XCDR (parents
))
791 unsigned this_from
, this_to
;
793 charset
= CHARSET_FROM_ID (XFASTINT (XCAR (XCAR (parents
))));
794 offset
= XINT (XCDR (XCAR (parents
)));
795 this_from
= from
> offset
? from
- offset
: 0;
796 this_to
= to
> offset
? to
- offset
: 0;
797 if (this_from
< CHARSET_MIN_CODE (charset
))
798 this_from
= CHARSET_MIN_CODE (charset
);
799 if (this_to
> CHARSET_MAX_CODE (charset
))
800 this_to
= CHARSET_MAX_CODE (charset
);
801 map_charset_chars (c_function
, function
, arg
, charset
,
807 DEFUN ("map-charset-chars", Fmap_charset_chars
, Smap_charset_chars
, 2, 5, 0,
808 doc
: /* Call FUNCTION for all characters in CHARSET.
809 FUNCTION is called with an argument RANGE and the optional 3rd
812 RANGE is a cons (FROM . TO), where FROM and TO indicate a range of
813 characters contained in CHARSET.
815 The optional 4th and 5th arguments FROM-CODE and TO-CODE specify the
816 range of code points (in CHARSET) of target characters. */)
817 (Lisp_Object function
, Lisp_Object charset
, Lisp_Object arg
, Lisp_Object from_code
, Lisp_Object to_code
)
822 CHECK_CHARSET_GET_CHARSET (charset
, cs
);
823 if (NILP (from_code
))
824 from
= CHARSET_MIN_CODE (cs
);
827 from
= XINT (from_code
);
828 if (from
< CHARSET_MIN_CODE (cs
))
829 from
= CHARSET_MIN_CODE (cs
);
832 to
= CHARSET_MAX_CODE (cs
);
836 if (to
> CHARSET_MAX_CODE (cs
))
837 to
= CHARSET_MAX_CODE (cs
);
839 map_charset_chars (NULL
, function
, arg
, cs
, from
, to
);
844 /* Define a charset according to the arguments. The Nth argument is
845 the Nth attribute of the charset (the last attribute `charset-id'
846 is not included). See the docstring of `define-charset' for the
849 DEFUN ("define-charset-internal", Fdefine_charset_internal
,
850 Sdefine_charset_internal
, charset_arg_max
, MANY
, 0,
851 doc
: /* For internal use only.
852 usage: (define-charset-internal ...) */)
853 (ptrdiff_t nargs
, Lisp_Object
*args
)
855 /* Charset attr vector. */
858 EMACS_UINT hash_code
;
859 struct Lisp_Hash_Table
*hash_table
= XHASH_TABLE (Vcharset_hash_table
);
861 struct charset charset
;
864 bool new_definition_p
;
867 if (nargs
!= charset_arg_max
)
868 return Fsignal (Qwrong_number_of_arguments
,
869 Fcons (intern ("define-charset-internal"),
870 make_number (nargs
)));
872 attrs
= Fmake_vector (make_number (charset_attr_max
), Qnil
);
874 CHECK_SYMBOL (args
[charset_arg_name
]);
875 ASET (attrs
, charset_name
, args
[charset_arg_name
]);
877 val
= args
[charset_arg_code_space
];
878 for (i
= 0, dimension
= 0, nchars
= 1; ; i
++)
880 Lisp_Object min_byte_obj
, max_byte_obj
;
881 int min_byte
, max_byte
;
883 min_byte_obj
= Faref (val
, make_number (i
* 2));
884 max_byte_obj
= Faref (val
, make_number (i
* 2 + 1));
885 CHECK_RANGED_INTEGER (min_byte_obj
, 0, 255);
886 min_byte
= XINT (min_byte_obj
);
887 CHECK_RANGED_INTEGER (max_byte_obj
, min_byte
, 255);
888 max_byte
= XINT (max_byte_obj
);
889 charset
.code_space
[i
* 4] = min_byte
;
890 charset
.code_space
[i
* 4 + 1] = max_byte
;
891 charset
.code_space
[i
* 4 + 2] = max_byte
- min_byte
+ 1;
896 nchars
*= charset
.code_space
[i
* 4 + 2];
897 charset
.code_space
[i
* 4 + 3] = nchars
;
900 val
= args
[charset_arg_dimension
];
902 charset
.dimension
= dimension
;
905 CHECK_RANGED_INTEGER (val
, 1, 4);
906 charset
.dimension
= XINT (val
);
909 charset
.code_linear_p
910 = (charset
.dimension
== 1
911 || (charset
.code_space
[2] == 256
912 && (charset
.dimension
== 2
913 || (charset
.code_space
[6] == 256
914 && (charset
.dimension
== 3
915 || charset
.code_space
[10] == 256)))));
917 if (! charset
.code_linear_p
)
919 charset
.code_space_mask
= xzalloc_atomic (256);
920 for (i
= 0; i
< 4; i
++)
921 for (j
= charset
.code_space
[i
* 4]; j
<= charset
.code_space
[i
* 4 + 1];
923 charset
.code_space_mask
[j
] |= (1 << i
);
926 charset
.iso_chars_96
= charset
.code_space
[2] == 96;
928 charset
.min_code
= (charset
.code_space
[0]
929 | (charset
.code_space
[4] << 8)
930 | (charset
.code_space
[8] << 16)
931 | ((unsigned) charset
.code_space
[12] << 24));
932 charset
.max_code
= (charset
.code_space
[1]
933 | (charset
.code_space
[5] << 8)
934 | (charset
.code_space
[9] << 16)
935 | ((unsigned) charset
.code_space
[13] << 24));
936 charset
.char_index_offset
= 0;
938 val
= args
[charset_arg_min_code
];
941 unsigned code
= cons_to_unsigned (val
, UINT_MAX
);
943 if (code
< charset
.min_code
944 || code
> charset
.max_code
)
945 args_out_of_range_3 (make_fixnum_or_float (charset
.min_code
),
946 make_fixnum_or_float (charset
.max_code
), val
);
947 charset
.char_index_offset
= CODE_POINT_TO_INDEX (&charset
, code
);
948 charset
.min_code
= code
;
951 val
= args
[charset_arg_max_code
];
954 unsigned code
= cons_to_unsigned (val
, UINT_MAX
);
956 if (code
< charset
.min_code
957 || code
> charset
.max_code
)
958 args_out_of_range_3 (make_fixnum_or_float (charset
.min_code
),
959 make_fixnum_or_float (charset
.max_code
), val
);
960 charset
.max_code
= code
;
963 charset
.compact_codes_p
= charset
.max_code
< 0x10000;
965 val
= args
[charset_arg_invalid_code
];
968 if (charset
.min_code
> 0)
969 charset
.invalid_code
= 0;
972 if (charset
.max_code
< UINT_MAX
)
973 charset
.invalid_code
= charset
.max_code
+ 1;
975 error ("Attribute :invalid-code must be specified");
979 charset
.invalid_code
= cons_to_unsigned (val
, UINT_MAX
);
981 val
= args
[charset_arg_iso_final
];
983 charset
.iso_final
= -1;
987 if (XINT (val
) < '0' || XINT (val
) > 127)
988 error ("Invalid iso-final-char: %"pI
"d", XINT (val
));
989 charset
.iso_final
= XINT (val
);
992 val
= args
[charset_arg_iso_revision
];
994 charset
.iso_revision
= -1;
997 CHECK_RANGED_INTEGER (val
, -1, 63);
998 charset
.iso_revision
= XINT (val
);
1001 val
= args
[charset_arg_emacs_mule_id
];
1003 charset
.emacs_mule_id
= -1;
1007 if ((XINT (val
) > 0 && XINT (val
) <= 128) || XINT (val
) >= 256)
1008 error ("Invalid emacs-mule-id: %"pI
"d", XINT (val
));
1009 charset
.emacs_mule_id
= XINT (val
);
1012 charset
.ascii_compatible_p
= ! NILP (args
[charset_arg_ascii_compatible_p
]);
1014 charset
.supplementary_p
= ! NILP (args
[charset_arg_supplementary_p
]);
1016 charset
.unified_p
= 0;
1018 memset (charset
.fast_map
, 0, sizeof (charset
.fast_map
));
1020 if (! NILP (args
[charset_arg_code_offset
]))
1022 val
= args
[charset_arg_code_offset
];
1023 CHECK_CHARACTER (val
);
1025 charset
.method
= CHARSET_METHOD_OFFSET
;
1026 charset
.code_offset
= XINT (val
);
1028 i
= CODE_POINT_TO_INDEX (&charset
, charset
.max_code
);
1029 if (MAX_CHAR
- charset
.code_offset
< i
)
1030 error ("Unsupported max char: %d", charset
.max_char
);
1031 charset
.max_char
= i
+ charset
.code_offset
;
1032 i
= CODE_POINT_TO_INDEX (&charset
, charset
.min_code
);
1033 charset
.min_char
= i
+ charset
.code_offset
;
1035 i
= (charset
.min_char
>> 7) << 7;
1036 for (; i
< 0x10000 && i
<= charset
.max_char
; i
+= 128)
1037 CHARSET_FAST_MAP_SET (i
, charset
.fast_map
);
1038 i
= (i
>> 12) << 12;
1039 for (; i
<= charset
.max_char
; i
+= 0x1000)
1040 CHARSET_FAST_MAP_SET (i
, charset
.fast_map
);
1041 if (charset
.code_offset
== 0 && charset
.max_char
>= 0x80)
1042 charset
.ascii_compatible_p
= 1;
1044 else if (! NILP (args
[charset_arg_map
]))
1046 val
= args
[charset_arg_map
];
1047 ASET (attrs
, charset_map
, val
);
1048 charset
.method
= CHARSET_METHOD_MAP
;
1050 else if (! NILP (args
[charset_arg_subset
]))
1053 Lisp_Object parent_min_code
, parent_max_code
, parent_code_offset
;
1054 struct charset
*parent_charset
;
1056 val
= args
[charset_arg_subset
];
1057 parent
= Fcar (val
);
1058 CHECK_CHARSET_GET_CHARSET (parent
, parent_charset
);
1059 parent_min_code
= Fnth (make_number (1), val
);
1060 CHECK_NATNUM (parent_min_code
);
1061 parent_max_code
= Fnth (make_number (2), val
);
1062 CHECK_NATNUM (parent_max_code
);
1063 parent_code_offset
= Fnth (make_number (3), val
);
1064 CHECK_NUMBER (parent_code_offset
);
1065 val
= make_uninit_vector (4);
1066 ASET (val
, 0, make_number (parent_charset
->id
));
1067 ASET (val
, 1, parent_min_code
);
1068 ASET (val
, 2, parent_max_code
);
1069 ASET (val
, 3, parent_code_offset
);
1070 ASET (attrs
, charset_subset
, val
);
1072 charset
.method
= CHARSET_METHOD_SUBSET
;
1073 /* Here, we just copy the parent's fast_map. It's not accurate,
1074 but at least it works for quickly detecting which character
1075 DOESN'T belong to this charset. */
1076 for (i
= 0; i
< 190; i
++)
1077 charset
.fast_map
[i
] = parent_charset
->fast_map
[i
];
1079 /* We also copy these for parents. */
1080 charset
.min_char
= parent_charset
->min_char
;
1081 charset
.max_char
= parent_charset
->max_char
;
1083 else if (! NILP (args
[charset_arg_superset
]))
1085 val
= args
[charset_arg_superset
];
1086 charset
.method
= CHARSET_METHOD_SUPERSET
;
1087 val
= Fcopy_sequence (val
);
1088 ASET (attrs
, charset_superset
, val
);
1090 charset
.min_char
= MAX_CHAR
;
1091 charset
.max_char
= 0;
1092 for (; ! NILP (val
); val
= Fcdr (val
))
1094 Lisp_Object elt
, car_part
, cdr_part
;
1095 int this_id
, offset
;
1096 struct charset
*this_charset
;
1101 car_part
= XCAR (elt
);
1102 cdr_part
= XCDR (elt
);
1103 CHECK_CHARSET_GET_ID (car_part
, this_id
);
1104 CHECK_TYPE_RANGED_INTEGER (int, cdr_part
);
1105 offset
= XINT (cdr_part
);
1109 CHECK_CHARSET_GET_ID (elt
, this_id
);
1112 XSETCAR (val
, Fcons (make_number (this_id
), make_number (offset
)));
1114 this_charset
= CHARSET_FROM_ID (this_id
);
1115 if (charset
.min_char
> this_charset
->min_char
)
1116 charset
.min_char
= this_charset
->min_char
;
1117 if (charset
.max_char
< this_charset
->max_char
)
1118 charset
.max_char
= this_charset
->max_char
;
1119 for (i
= 0; i
< 190; i
++)
1120 charset
.fast_map
[i
] |= this_charset
->fast_map
[i
];
1124 error ("None of :code-offset, :map, :parents are specified");
1126 val
= args
[charset_arg_unify_map
];
1127 if (! NILP (val
) && !STRINGP (val
))
1129 ASET (attrs
, charset_unify_map
, val
);
1131 CHECK_LIST (args
[charset_arg_plist
]);
1132 ASET (attrs
, charset_plist
, args
[charset_arg_plist
]);
1134 charset
.hash_index
= hash_lookup (hash_table
, args
[charset_arg_name
],
1136 if (charset
.hash_index
>= 0)
1138 new_definition_p
= 0;
1139 id
= XFASTINT (CHARSET_SYMBOL_ID (args
[charset_arg_name
]));
1140 set_hash_value_slot (hash_table
, charset
.hash_index
, attrs
);
1144 charset
.hash_index
= hash_put (hash_table
, args
[charset_arg_name
], attrs
,
1146 if (charset_table_used
== charset_table_size
)
1148 /* Ensure that charset IDs fit into 'int' as well as into the
1149 restriction imposed by fixnums. Although the 'int' restriction
1150 could be removed, too much other code would need altering; for
1151 example, the IDs are stuffed into struct
1152 coding_system.charbuf[i] entries, which are 'int'. */
1153 int old_size
= charset_table_size
;
1154 ptrdiff_t new_size
= old_size
;
1155 struct charset
*new_table
=
1156 xpalloc (0, &new_size
, 1,
1157 min (INT_MAX
, MOST_POSITIVE_FIXNUM
),
1158 sizeof *charset_table
);
1159 memcpy (new_table
, charset_table
, old_size
* sizeof *new_table
);
1160 charset_table
= new_table
;
1161 charset_table_size
= new_size
;
1162 /* FIXME: This leaks memory, as the old charset_table becomes
1163 unreachable. If the old charset table is charset_table_init
1164 then this leak is intentional; otherwise, it's unclear.
1165 If the latter memory leak is intentional, a
1166 comment should be added to explain this. If not, the old
1167 charset_table should be freed, by passing it as the 1st argument
1168 to xpalloc and removing the memcpy. */
1170 id
= charset_table_used
++;
1171 new_definition_p
= 1;
1174 ASET (attrs
, charset_id
, make_number (id
));
1176 charset_table
[id
] = charset
;
1178 if (charset
.method
== CHARSET_METHOD_MAP
)
1180 load_charset (&charset
, 0);
1181 charset_table
[id
] = charset
;
1184 if (charset
.iso_final
>= 0)
1186 ISO_CHARSET_TABLE (charset
.dimension
, charset
.iso_chars_96
,
1187 charset
.iso_final
) = id
;
1188 if (new_definition_p
)
1189 Viso_2022_charset_list
= nconc2 (Viso_2022_charset_list
,
1190 list1 (make_number (id
)));
1191 if (ISO_CHARSET_TABLE (1, 0, 'J') == id
)
1192 charset_jisx0201_roman
= id
;
1193 else if (ISO_CHARSET_TABLE (2, 0, '@') == id
)
1194 charset_jisx0208_1978
= id
;
1195 else if (ISO_CHARSET_TABLE (2, 0, 'B') == id
)
1196 charset_jisx0208
= id
;
1197 else if (ISO_CHARSET_TABLE (2, 0, 'C') == id
)
1198 charset_ksc5601
= id
;
1201 if (charset
.emacs_mule_id
>= 0)
1203 emacs_mule_charset
[charset
.emacs_mule_id
] = id
;
1204 if (charset
.emacs_mule_id
< 0xA0)
1205 emacs_mule_bytes
[charset
.emacs_mule_id
] = charset
.dimension
+ 1;
1207 emacs_mule_bytes
[charset
.emacs_mule_id
] = charset
.dimension
+ 2;
1208 if (new_definition_p
)
1209 Vemacs_mule_charset_list
= nconc2 (Vemacs_mule_charset_list
,
1210 list1 (make_number (id
)));
1213 if (new_definition_p
)
1215 Vcharset_list
= Fcons (args
[charset_arg_name
], Vcharset_list
);
1216 if (charset
.supplementary_p
)
1217 Vcharset_ordered_list
= nconc2 (Vcharset_ordered_list
,
1218 list1 (make_number (id
)));
1223 for (tail
= Vcharset_ordered_list
; CONSP (tail
); tail
= XCDR (tail
))
1225 struct charset
*cs
= CHARSET_FROM_ID (XINT (XCAR (tail
)));
1227 if (cs
->supplementary_p
)
1230 if (EQ (tail
, Vcharset_ordered_list
))
1231 Vcharset_ordered_list
= Fcons (make_number (id
),
1232 Vcharset_ordered_list
);
1233 else if (NILP (tail
))
1234 Vcharset_ordered_list
= nconc2 (Vcharset_ordered_list
,
1235 list1 (make_number (id
)));
1238 val
= Fcons (XCAR (tail
), XCDR (tail
));
1239 XSETCDR (tail
, val
);
1240 XSETCAR (tail
, make_number (id
));
1243 charset_ordered_list_tick
++;
1250 /* Same as Fdefine_charset_internal but arguments are more convenient
1251 to call from C (typically in syms_of_charset). This can define a
1252 charset of `offset' method only. Return the ID of the new
1256 define_charset_internal (Lisp_Object name
,
1258 const char *code_space_chars
,
1259 unsigned min_code
, unsigned max_code
,
1260 int iso_final
, int iso_revision
, int emacs_mule_id
,
1261 bool ascii_compatible
, bool supplementary
,
1264 const unsigned char *code_space
= (const unsigned char *) code_space_chars
;
1265 Lisp_Object args
[charset_arg_max
];
1269 args
[charset_arg_name
] = name
;
1270 args
[charset_arg_dimension
] = make_number (dimension
);
1271 val
= make_uninit_vector (8);
1272 for (i
= 0; i
< 8; i
++)
1273 ASET (val
, i
, make_number (code_space
[i
]));
1274 args
[charset_arg_code_space
] = val
;
1275 args
[charset_arg_min_code
] = make_number (min_code
);
1276 args
[charset_arg_max_code
] = make_number (max_code
);
1277 args
[charset_arg_iso_final
]
1278 = (iso_final
< 0 ? Qnil
: make_number (iso_final
));
1279 args
[charset_arg_iso_revision
] = make_number (iso_revision
);
1280 args
[charset_arg_emacs_mule_id
]
1281 = (emacs_mule_id
< 0 ? Qnil
: make_number (emacs_mule_id
));
1282 args
[charset_arg_ascii_compatible_p
] = ascii_compatible
? Qt
: Qnil
;
1283 args
[charset_arg_supplementary_p
] = supplementary
? Qt
: Qnil
;
1284 args
[charset_arg_invalid_code
] = Qnil
;
1285 args
[charset_arg_code_offset
] = make_number (code_offset
);
1286 args
[charset_arg_map
] = Qnil
;
1287 args
[charset_arg_subset
] = Qnil
;
1288 args
[charset_arg_superset
] = Qnil
;
1289 args
[charset_arg_unify_map
] = Qnil
;
1291 args
[charset_arg_plist
] =
1292 listn (CONSTYPE_HEAP
, 14,
1293 intern_c_string (":name"),
1294 args
[charset_arg_name
],
1295 intern_c_string (":dimension"),
1296 args
[charset_arg_dimension
],
1297 intern_c_string (":code-space"),
1298 args
[charset_arg_code_space
],
1299 intern_c_string (":iso-final-char"),
1300 args
[charset_arg_iso_final
],
1301 intern_c_string (":emacs-mule-id"),
1302 args
[charset_arg_emacs_mule_id
],
1303 intern_c_string (":ascii-compatible-p"),
1304 args
[charset_arg_ascii_compatible_p
],
1305 intern_c_string (":code-offset"),
1306 args
[charset_arg_code_offset
]);
1307 Fdefine_charset_internal (charset_arg_max
, args
);
1309 return XINT (CHARSET_SYMBOL_ID (name
));
1313 DEFUN ("define-charset-alias", Fdefine_charset_alias
,
1314 Sdefine_charset_alias
, 2, 2, 0,
1315 doc
: /* Define ALIAS as an alias for charset CHARSET. */)
1316 (Lisp_Object alias
, Lisp_Object charset
)
1320 CHECK_CHARSET_GET_ATTR (charset
, attr
);
1321 Fputhash (alias
, attr
, Vcharset_hash_table
);
1322 Vcharset_list
= Fcons (alias
, Vcharset_list
);
1327 DEFUN ("charset-plist", Fcharset_plist
, Scharset_plist
, 1, 1, 0,
1328 doc
: /* Return the property list of CHARSET. */)
1329 (Lisp_Object charset
)
1333 CHECK_CHARSET_GET_ATTR (charset
, attrs
);
1334 return CHARSET_ATTR_PLIST (attrs
);
1338 DEFUN ("set-charset-plist", Fset_charset_plist
, Sset_charset_plist
, 2, 2, 0,
1339 doc
: /* Set CHARSET's property list to PLIST. */)
1340 (Lisp_Object charset
, Lisp_Object plist
)
1344 CHECK_CHARSET_GET_ATTR (charset
, attrs
);
1345 ASET (attrs
, charset_plist
, plist
);
1350 DEFUN ("unify-charset", Funify_charset
, Sunify_charset
, 1, 3, 0,
1351 doc
: /* Unify characters of CHARSET with Unicode.
1352 This means reading the relevant file and installing the table defined
1353 by CHARSET's `:unify-map' property.
1355 Optional second arg UNIFY-MAP is a file name string or a vector. It has
1356 the same meaning as the `:unify-map' attribute in the function
1357 `define-charset' (which see).
1359 Optional third argument DEUNIFY, if non-nil, means to de-unify CHARSET. */)
1360 (Lisp_Object charset
, Lisp_Object unify_map
, Lisp_Object deunify
)
1365 CHECK_CHARSET_GET_ID (charset
, id
);
1366 cs
= CHARSET_FROM_ID (id
);
1368 ? CHARSET_UNIFIED_P (cs
) && ! NILP (CHARSET_DEUNIFIER (cs
))
1369 : ! CHARSET_UNIFIED_P (cs
))
1372 CHARSET_UNIFIED_P (cs
) = 0;
1375 if (CHARSET_METHOD (cs
) != CHARSET_METHOD_OFFSET
1376 || CHARSET_CODE_OFFSET (cs
) < 0x110000)
1377 error ("Can't unify charset: %s", SDATA (SYMBOL_NAME (charset
)));
1378 if (NILP (unify_map
))
1379 unify_map
= CHARSET_UNIFY_MAP (cs
);
1382 if (! STRINGP (unify_map
) && ! VECTORP (unify_map
))
1383 signal_error ("Bad unify-map", unify_map
);
1384 set_charset_attr (cs
, charset_unify_map
, unify_map
);
1386 if (NILP (Vchar_unify_table
))
1387 Vchar_unify_table
= Fmake_char_table (Qnil
, Qnil
);
1388 char_table_set_range (Vchar_unify_table
,
1389 cs
->min_char
, cs
->max_char
, charset
);
1390 CHARSET_UNIFIED_P (cs
) = 1;
1392 else if (CHAR_TABLE_P (Vchar_unify_table
))
1394 unsigned min_code
= CHARSET_MIN_CODE (cs
);
1395 unsigned max_code
= CHARSET_MAX_CODE (cs
);
1396 int min_char
= DECODE_CHAR (cs
, min_code
);
1397 int max_char
= DECODE_CHAR (cs
, max_code
);
1399 char_table_set_range (Vchar_unify_table
, min_char
, max_char
, Qnil
);
1405 DEFUN ("get-unused-iso-final-char", Fget_unused_iso_final_char
,
1406 Sget_unused_iso_final_char
, 2, 2, 0,
1408 Return an unused ISO final char for a charset of DIMENSION and CHARS.
1409 DIMENSION is the number of bytes to represent a character: 1 or 2.
1410 CHARS is the number of characters in a dimension: 94 or 96.
1412 This final char is for private use, thus the range is `0' (48) .. `?' (63).
1413 If there's no unused final char for the specified kind of charset,
1415 (Lisp_Object dimension
, Lisp_Object chars
)
1419 CHECK_NUMBER (dimension
);
1420 CHECK_NUMBER (chars
);
1421 if (XINT (dimension
) != 1 && XINT (dimension
) != 2 && XINT (dimension
) != 3)
1422 args_out_of_range_3 (dimension
, make_number (1), make_number (3));
1423 if (XINT (chars
) != 94 && XINT (chars
) != 96)
1424 args_out_of_range_3 (chars
, make_number (94), make_number (96));
1425 for (final_char
= '0'; final_char
<= '?'; final_char
++)
1426 if (ISO_CHARSET_TABLE (XINT (dimension
), XINT (chars
), final_char
) < 0)
1428 return (final_char
<= '?' ? make_number (final_char
) : Qnil
);
1432 check_iso_charset_parameter (Lisp_Object dimension
, Lisp_Object chars
, Lisp_Object final_char
)
1434 CHECK_NATNUM (dimension
);
1435 CHECK_NATNUM (chars
);
1436 CHECK_CHARACTER (final_char
);
1438 if (XINT (dimension
) > 3)
1439 error ("Invalid DIMENSION %"pI
"d, it should be 1, 2, or 3",
1441 if (XINT (chars
) != 94 && XINT (chars
) != 96)
1442 error ("Invalid CHARS %"pI
"d, it should be 94 or 96", XINT (chars
));
1443 if (XINT (final_char
) < '0' || XINT (final_char
) > '~')
1444 error ("Invalid FINAL-CHAR %c, it should be `0'..`~'",
1445 (int)XINT (final_char
));
1449 DEFUN ("declare-equiv-charset", Fdeclare_equiv_charset
, Sdeclare_equiv_charset
,
1451 doc
: /* Declare an equivalent charset for ISO-2022 decoding.
1453 On decoding by an ISO-2022 base coding system, when a charset
1454 specified by DIMENSION, CHARS, and FINAL-CHAR is designated, behave as
1455 if CHARSET is designated instead. */)
1456 (Lisp_Object dimension
, Lisp_Object chars
, Lisp_Object final_char
, Lisp_Object charset
)
1461 CHECK_CHARSET_GET_ID (charset
, id
);
1462 check_iso_charset_parameter (dimension
, chars
, final_char
);
1463 chars_flag
= XINT (chars
) == 96;
1464 ISO_CHARSET_TABLE (XINT (dimension
), chars_flag
, XINT (final_char
)) = id
;
1469 /* Return information about charsets in the text at PTR of NBYTES
1470 bytes, which are NCHARS characters. The value is:
1472 0: Each character is represented by one byte. This is always
1473 true for a unibyte string. For a multibyte string, true if
1474 it contains only ASCII characters.
1476 1: No charsets other than ascii, control-1, and latin-1 are
1483 string_xstring_p (Lisp_Object string
)
1485 const unsigned char *p
= SDATA (string
);
1486 const unsigned char *endp
= p
+ SBYTES (string
);
1488 if (SCHARS (string
) == SBYTES (string
))
1493 int c
= STRING_CHAR_ADVANCE (p
);
1502 /* Find charsets in the string at PTR of NCHARS and NBYTES.
1504 CHARSETS is a vector. If Nth element is non-nil, it means the
1505 charset whose id is N is already found.
1507 It may lookup a translation table TABLE if supplied. */
1510 find_charsets_in_text (const unsigned char *ptr
, ptrdiff_t nchars
,
1511 ptrdiff_t nbytes
, Lisp_Object charsets
,
1512 Lisp_Object table
, bool multibyte
)
1514 const unsigned char *pend
= ptr
+ nbytes
;
1516 if (nchars
== nbytes
)
1519 ASET (charsets
, charset_ascii
, Qt
);
1526 c
= translate_char (table
, c
);
1527 if (ASCII_CHAR_P (c
))
1528 ASET (charsets
, charset_ascii
, Qt
);
1530 ASET (charsets
, charset_eight_bit
, Qt
);
1537 int c
= STRING_CHAR_ADVANCE (ptr
);
1538 struct charset
*charset
;
1541 c
= translate_char (table
, c
);
1542 charset
= CHAR_CHARSET (c
);
1543 ASET (charsets
, CHARSET_ID (charset
), Qt
);
1548 DEFUN ("find-charset-region", Ffind_charset_region
, Sfind_charset_region
,
1550 doc
: /* Return a list of charsets in the region between BEG and END.
1551 BEG and END are buffer positions.
1552 Optional arg TABLE if non-nil is a translation table to look up.
1554 If the current buffer is unibyte, the returned list may contain
1555 only `ascii', `eight-bit-control', and `eight-bit-graphic'. */)
1556 (Lisp_Object beg
, Lisp_Object end
, Lisp_Object table
)
1558 Lisp_Object charsets
;
1559 ptrdiff_t from
, from_byte
, to
, stop
, stop_byte
;
1562 bool multibyte
= ! NILP (BVAR (current_buffer
, enable_multibyte_characters
));
1564 validate_region (&beg
, &end
);
1565 from
= XFASTINT (beg
);
1566 stop
= to
= XFASTINT (end
);
1568 if (from
< GPT
&& GPT
< to
)
1571 stop_byte
= GPT_BYTE
;
1574 stop_byte
= CHAR_TO_BYTE (stop
);
1576 from_byte
= CHAR_TO_BYTE (from
);
1578 charsets
= Fmake_vector (make_number (charset_table_used
), Qnil
);
1581 find_charsets_in_text (BYTE_POS_ADDR (from_byte
), stop
- from
,
1582 stop_byte
- from_byte
, charsets
, table
,
1586 from
= stop
, from_byte
= stop_byte
;
1587 stop
= to
, stop_byte
= CHAR_TO_BYTE (stop
);
1594 for (i
= charset_table_used
- 1; i
>= 0; i
--)
1595 if (!NILP (AREF (charsets
, i
)))
1596 val
= Fcons (CHARSET_NAME (charset_table
+ i
), val
);
1600 DEFUN ("find-charset-string", Ffind_charset_string
, Sfind_charset_string
,
1602 doc
: /* Return a list of charsets in STR.
1603 Optional arg TABLE if non-nil is a translation table to look up.
1605 If STR is unibyte, the returned list may contain
1606 only `ascii', `eight-bit-control', and `eight-bit-graphic'. */)
1607 (Lisp_Object str
, Lisp_Object table
)
1609 Lisp_Object charsets
;
1615 charsets
= Fmake_vector (make_number (charset_table_used
), Qnil
);
1616 find_charsets_in_text (SDATA (str
), SCHARS (str
), SBYTES (str
),
1618 STRING_MULTIBYTE (str
));
1620 for (i
= charset_table_used
- 1; i
>= 0; i
--)
1621 if (!NILP (AREF (charsets
, i
)))
1622 val
= Fcons (CHARSET_NAME (charset_table
+ i
), val
);
1628 /* Return a unified character code for C (>= 0x110000). VAL is a
1629 value of Vchar_unify_table for C; i.e. it is nil, an integer, or a
1632 maybe_unify_char (int c
, Lisp_Object val
)
1634 struct charset
*charset
;
1637 return XFASTINT (val
);
1641 CHECK_CHARSET_GET_CHARSET (val
, charset
);
1643 /* The call to load_charset below can allocate memory, which screws
1644 callers of this function through STRING_CHAR_* macros that hold C
1645 pointers to buffer text, if REL_ALLOC is used. */
1646 r_alloc_inhibit_buffer_relocation (1);
1648 load_charset (charset
, 1);
1649 if (! inhibit_load_charset_map
)
1651 val
= CHAR_TABLE_REF (Vchar_unify_table
, c
);
1657 int code_index
= c
- CHARSET_CODE_OFFSET (charset
);
1658 int unified
= GET_TEMP_CHARSET_WORK_DECODER (code_index
);
1664 r_alloc_inhibit_buffer_relocation (0);
1670 /* Return a character corresponding to the code-point CODE of
1674 decode_char (struct charset
*charset
, unsigned int code
)
1677 enum charset_method method
= CHARSET_METHOD (charset
);
1679 if (code
< CHARSET_MIN_CODE (charset
) || code
> CHARSET_MAX_CODE (charset
))
1682 if (method
== CHARSET_METHOD_SUBSET
)
1684 Lisp_Object subset_info
;
1686 subset_info
= CHARSET_SUBSET (charset
);
1687 charset
= CHARSET_FROM_ID (XFASTINT (AREF (subset_info
, 0)));
1688 code
-= XINT (AREF (subset_info
, 3));
1689 if (code
< XFASTINT (AREF (subset_info
, 1))
1690 || code
> XFASTINT (AREF (subset_info
, 2)))
1693 c
= DECODE_CHAR (charset
, code
);
1695 else if (method
== CHARSET_METHOD_SUPERSET
)
1697 Lisp_Object parents
;
1699 parents
= CHARSET_SUPERSET (charset
);
1701 for (; CONSP (parents
); parents
= XCDR (parents
))
1703 int id
= XINT (XCAR (XCAR (parents
)));
1704 int code_offset
= XINT (XCDR (XCAR (parents
)));
1705 unsigned this_code
= code
- code_offset
;
1707 charset
= CHARSET_FROM_ID (id
);
1708 if ((c
= DECODE_CHAR (charset
, this_code
)) >= 0)
1714 char_index
= CODE_POINT_TO_INDEX (charset
, code
);
1718 if (method
== CHARSET_METHOD_MAP
)
1720 Lisp_Object decoder
;
1722 decoder
= CHARSET_DECODER (charset
);
1723 if (! VECTORP (decoder
))
1725 load_charset (charset
, 1);
1726 decoder
= CHARSET_DECODER (charset
);
1728 if (VECTORP (decoder
))
1729 c
= XINT (AREF (decoder
, char_index
));
1731 c
= GET_TEMP_CHARSET_WORK_DECODER (char_index
);
1733 else /* method == CHARSET_METHOD_OFFSET */
1735 c
= char_index
+ CHARSET_CODE_OFFSET (charset
);
1736 if (CHARSET_UNIFIED_P (charset
)
1737 && MAX_UNICODE_CHAR
< c
&& c
<= MAX_5_BYTE_CHAR
)
1739 /* Unify C with a Unicode character if possible. */
1740 Lisp_Object val
= CHAR_TABLE_REF (Vchar_unify_table
, c
);
1741 c
= maybe_unify_char (c
, val
);
1749 /* Variable used temporarily by the macro ENCODE_CHAR. */
1750 Lisp_Object charset_work
;
1752 /* Return a code-point of C in CHARSET. If C doesn't belong to
1753 CHARSET, return CHARSET_INVALID_CODE (CHARSET). If STRICT is true,
1754 use CHARSET's strict_max_char instead of max_char. */
1757 encode_char (struct charset
*charset
, int c
)
1760 enum charset_method method
= CHARSET_METHOD (charset
);
1762 if (CHARSET_UNIFIED_P (charset
))
1764 Lisp_Object deunifier
;
1765 int code_index
= -1;
1767 deunifier
= CHARSET_DEUNIFIER (charset
);
1768 if (! CHAR_TABLE_P (deunifier
))
1770 load_charset (charset
, 2);
1771 deunifier
= CHARSET_DEUNIFIER (charset
);
1773 if (CHAR_TABLE_P (deunifier
))
1775 Lisp_Object deunified
= CHAR_TABLE_REF (deunifier
, c
);
1777 if (INTEGERP (deunified
))
1778 code_index
= XINT (deunified
);
1782 code_index
= GET_TEMP_CHARSET_WORK_ENCODER (c
);
1784 if (code_index
>= 0)
1785 c
= CHARSET_CODE_OFFSET (charset
) + code_index
;
1788 if (method
== CHARSET_METHOD_SUBSET
)
1790 Lisp_Object subset_info
;
1791 struct charset
*this_charset
;
1793 subset_info
= CHARSET_SUBSET (charset
);
1794 this_charset
= CHARSET_FROM_ID (XFASTINT (AREF (subset_info
, 0)));
1795 code
= ENCODE_CHAR (this_charset
, c
);
1796 if (code
== CHARSET_INVALID_CODE (this_charset
)
1797 || code
< XFASTINT (AREF (subset_info
, 1))
1798 || code
> XFASTINT (AREF (subset_info
, 2)))
1799 return CHARSET_INVALID_CODE (charset
);
1800 code
+= XINT (AREF (subset_info
, 3));
1804 if (method
== CHARSET_METHOD_SUPERSET
)
1806 Lisp_Object parents
;
1808 parents
= CHARSET_SUPERSET (charset
);
1809 for (; CONSP (parents
); parents
= XCDR (parents
))
1811 int id
= XINT (XCAR (XCAR (parents
)));
1812 int code_offset
= XINT (XCDR (XCAR (parents
)));
1813 struct charset
*this_charset
= CHARSET_FROM_ID (id
);
1815 code
= ENCODE_CHAR (this_charset
, c
);
1816 if (code
!= CHARSET_INVALID_CODE (this_charset
))
1817 return code
+ code_offset
;
1819 return CHARSET_INVALID_CODE (charset
);
1822 if (! CHARSET_FAST_MAP_REF ((c
), charset
->fast_map
)
1823 || c
< CHARSET_MIN_CHAR (charset
) || c
> CHARSET_MAX_CHAR (charset
))
1824 return CHARSET_INVALID_CODE (charset
);
1826 if (method
== CHARSET_METHOD_MAP
)
1828 Lisp_Object encoder
;
1831 encoder
= CHARSET_ENCODER (charset
);
1832 if (! CHAR_TABLE_P (CHARSET_ENCODER (charset
)))
1834 load_charset (charset
, 2);
1835 encoder
= CHARSET_ENCODER (charset
);
1837 if (CHAR_TABLE_P (encoder
))
1839 val
= CHAR_TABLE_REF (encoder
, c
);
1841 return CHARSET_INVALID_CODE (charset
);
1843 if (! CHARSET_COMPACT_CODES_P (charset
))
1844 code
= INDEX_TO_CODE_POINT (charset
, code
);
1848 code
= GET_TEMP_CHARSET_WORK_ENCODER (c
);
1849 code
= INDEX_TO_CODE_POINT (charset
, code
);
1852 else /* method == CHARSET_METHOD_OFFSET */
1854 unsigned code_index
= c
- CHARSET_CODE_OFFSET (charset
);
1856 code
= INDEX_TO_CODE_POINT (charset
, code_index
);
1863 DEFUN ("decode-char", Fdecode_char
, Sdecode_char
, 2, 3, 0,
1864 doc
: /* Decode the pair of CHARSET and CODE-POINT into a character.
1865 Return nil if CODE-POINT is not valid in CHARSET.
1867 CODE-POINT may be a cons (HIGHER-16-BIT-VALUE . LOWER-16-BIT-VALUE). */)
1868 (Lisp_Object charset
, Lisp_Object code_point
, Lisp_Object restriction
)
1872 struct charset
*charsetp
;
1874 CHECK_CHARSET_GET_ID (charset
, id
);
1875 code
= cons_to_unsigned (code_point
, UINT_MAX
);
1876 charsetp
= CHARSET_FROM_ID (id
);
1877 c
= DECODE_CHAR (charsetp
, code
);
1878 return (c
>= 0 ? make_number (c
) : Qnil
);
1882 DEFUN ("encode-char", Fencode_char
, Sencode_char
, 2, 3, 0,
1883 doc
: /* Encode the character CH into a code-point of CHARSET.
1884 Return nil if CHARSET doesn't include CH. */)
1885 (Lisp_Object ch
, Lisp_Object charset
, Lisp_Object restriction
)
1889 struct charset
*charsetp
;
1891 CHECK_CHARSET_GET_ID (charset
, id
);
1892 CHECK_CHARACTER (ch
);
1894 charsetp
= CHARSET_FROM_ID (id
);
1895 code
= ENCODE_CHAR (charsetp
, c
);
1896 if (code
== CHARSET_INVALID_CODE (charsetp
))
1898 return INTEGER_TO_CONS (code
);
1902 DEFUN ("make-char", Fmake_char
, Smake_char
, 1, 5, 0,
1904 /* Return a character of CHARSET whose position codes are CODEn.
1906 CODE1 through CODE4 are optional, but if you don't supply sufficient
1907 position codes, it is assumed that the minimum code in each dimension
1909 (Lisp_Object charset
, Lisp_Object code1
, Lisp_Object code2
, Lisp_Object code3
, Lisp_Object code4
)
1912 struct charset
*charsetp
;
1916 CHECK_CHARSET_GET_ID (charset
, id
);
1917 charsetp
= CHARSET_FROM_ID (id
);
1919 dimension
= CHARSET_DIMENSION (charsetp
);
1921 code
= (CHARSET_ASCII_COMPATIBLE_P (charsetp
)
1922 ? 0 : CHARSET_MIN_CODE (charsetp
));
1925 CHECK_NATNUM (code1
);
1926 if (XFASTINT (code1
) >= 0x100)
1927 args_out_of_range (make_number (0xFF), code1
);
1928 code
= XFASTINT (code1
);
1934 code
|= charsetp
->code_space
[(dimension
- 2) * 4];
1937 CHECK_NATNUM (code2
);
1938 if (XFASTINT (code2
) >= 0x100)
1939 args_out_of_range (make_number (0xFF), code2
);
1940 code
|= XFASTINT (code2
);
1947 code
|= charsetp
->code_space
[(dimension
- 3) * 4];
1950 CHECK_NATNUM (code3
);
1951 if (XFASTINT (code3
) >= 0x100)
1952 args_out_of_range (make_number (0xFF), code3
);
1953 code
|= XFASTINT (code3
);
1960 code
|= charsetp
->code_space
[0];
1963 CHECK_NATNUM (code4
);
1964 if (XFASTINT (code4
) >= 0x100)
1965 args_out_of_range (make_number (0xFF), code4
);
1966 code
|= XFASTINT (code4
);
1973 if (CHARSET_ISO_FINAL (charsetp
) >= 0)
1975 c
= DECODE_CHAR (charsetp
, code
);
1977 error ("Invalid code(s)");
1978 return make_number (c
);
1982 /* Return the first charset in CHARSET_LIST that contains C.
1983 CHARSET_LIST is a list of charset IDs. If it is nil, use
1984 Vcharset_ordered_list. */
1987 char_charset (int c
, Lisp_Object charset_list
, unsigned int *code_return
)
1989 bool maybe_null
= 0;
1991 if (NILP (charset_list
))
1992 charset_list
= Vcharset_ordered_list
;
1996 while (CONSP (charset_list
))
1998 struct charset
*charset
= CHARSET_FROM_ID (XINT (XCAR (charset_list
)));
1999 unsigned code
= ENCODE_CHAR (charset
, c
);
2001 if (code
!= CHARSET_INVALID_CODE (charset
))
2004 *code_return
= code
;
2007 charset_list
= XCDR (charset_list
);
2009 && c
<= MAX_UNICODE_CHAR
2010 && EQ (charset_list
, Vcharset_non_preferred_head
))
2011 return CHARSET_FROM_ID (charset_unicode
);
2013 return (maybe_null
? NULL
2014 : c
<= MAX_5_BYTE_CHAR
? CHARSET_FROM_ID (charset_emacs
)
2015 : CHARSET_FROM_ID (charset_eight_bit
));
2019 DEFUN ("split-char", Fsplit_char
, Ssplit_char
, 1, 1, 0,
2021 /*Return list of charset and one to four position-codes of CH.
2022 The charset is decided by the current priority order of charsets.
2023 A position-code is a byte value of each dimension of the code-point of
2024 CH in the charset. */)
2027 struct charset
*charset
;
2032 CHECK_CHARACTER (ch
);
2034 charset
= CHAR_CHARSET (c
);
2037 code
= ENCODE_CHAR (charset
, c
);
2038 if (code
== CHARSET_INVALID_CODE (charset
))
2040 dimension
= CHARSET_DIMENSION (charset
);
2041 for (val
= Qnil
; dimension
> 0; dimension
--)
2043 val
= Fcons (make_number (code
& 0xFF), val
);
2046 return Fcons (CHARSET_NAME (charset
), val
);
2050 DEFUN ("char-charset", Fchar_charset
, Schar_charset
, 1, 2, 0,
2051 doc
: /* Return the charset of highest priority that contains CH.
2052 ASCII characters are an exception: for them, this function always
2054 If optional 2nd arg RESTRICTION is non-nil, it is a list of charsets
2055 from which to find the charset. It may also be a coding system. In
2056 that case, find the charset from what supported by that coding system. */)
2057 (Lisp_Object ch
, Lisp_Object restriction
)
2059 struct charset
*charset
;
2061 CHECK_CHARACTER (ch
);
2062 if (NILP (restriction
))
2063 charset
= CHAR_CHARSET (XINT (ch
));
2066 if (CONSP (restriction
))
2068 int c
= XFASTINT (ch
);
2070 for (; CONSP (restriction
); restriction
= XCDR (restriction
))
2072 struct charset
*rcharset
;
2074 CHECK_CHARSET_GET_CHARSET (XCAR (restriction
), rcharset
);
2075 if (ENCODE_CHAR (rcharset
, c
) != CHARSET_INVALID_CODE (rcharset
))
2076 return XCAR (restriction
);
2080 restriction
= coding_system_charset_list (restriction
);
2081 charset
= char_charset (XINT (ch
), restriction
, NULL
);
2085 return (CHARSET_NAME (charset
));
2089 DEFUN ("charset-after", Fcharset_after
, Scharset_after
, 0, 1, 0,
2091 Return charset of a character in the current buffer at position POS.
2092 If POS is nil, it defaults to the current point.
2093 If POS is out of range, the value is nil. */)
2097 struct charset
*charset
;
2099 ch
= Fchar_after (pos
);
2100 if (! INTEGERP (ch
))
2102 charset
= CHAR_CHARSET (XINT (ch
));
2103 return (CHARSET_NAME (charset
));
2107 DEFUN ("iso-charset", Fiso_charset
, Siso_charset
, 3, 3, 0,
2109 Return charset of ISO's specification DIMENSION, CHARS, and FINAL-CHAR.
2111 ISO 2022's designation sequence (escape sequence) distinguishes charsets
2112 by their DIMENSION, CHARS, and FINAL-CHAR,
2113 whereas Emacs distinguishes them by charset symbol.
2114 See the documentation of the function `charset-info' for the meanings of
2115 DIMENSION, CHARS, and FINAL-CHAR. */)
2116 (Lisp_Object dimension
, Lisp_Object chars
, Lisp_Object final_char
)
2121 check_iso_charset_parameter (dimension
, chars
, final_char
);
2122 chars_flag
= XFASTINT (chars
) == 96;
2123 id
= ISO_CHARSET_TABLE (XFASTINT (dimension
), chars_flag
,
2124 XFASTINT (final_char
));
2125 return (id
>= 0 ? CHARSET_NAME (CHARSET_FROM_ID (id
)) : Qnil
);
2129 DEFUN ("clear-charset-maps", Fclear_charset_maps
, Sclear_charset_maps
,
2133 Clear temporary charset mapping tables.
2134 It should be called only from temacs invoked for dumping. */)
2137 if (temp_charset_work
)
2139 xfree (temp_charset_work
);
2140 temp_charset_work
= NULL
;
2143 if (CHAR_TABLE_P (Vchar_unify_table
))
2144 Foptimize_char_table (Vchar_unify_table
, Qnil
);
2149 DEFUN ("charset-priority-list", Fcharset_priority_list
,
2150 Scharset_priority_list
, 0, 1, 0,
2151 doc
: /* Return the list of charsets ordered by priority.
2152 HIGHESTP non-nil means just return the highest priority one. */)
2153 (Lisp_Object highestp
)
2155 Lisp_Object val
= Qnil
, list
= Vcharset_ordered_list
;
2157 if (!NILP (highestp
))
2158 return CHARSET_NAME (CHARSET_FROM_ID (XINT (Fcar (list
))));
2160 while (!NILP (list
))
2162 val
= Fcons (CHARSET_NAME (CHARSET_FROM_ID (XINT (XCAR (list
)))), val
);
2165 return Fnreverse (val
);
2168 DEFUN ("set-charset-priority", Fset_charset_priority
, Sset_charset_priority
,
2170 doc
: /* Assign higher priority to the charsets given as arguments.
2171 usage: (set-charset-priority &rest charsets) */)
2172 (ptrdiff_t nargs
, Lisp_Object
*args
)
2174 Lisp_Object new_head
, old_list
, arglist
[2];
2175 Lisp_Object list_2022
, list_emacs_mule
;
2179 old_list
= Fcopy_sequence (Vcharset_ordered_list
);
2181 for (i
= 0; i
< nargs
; i
++)
2183 CHECK_CHARSET_GET_ID (args
[i
], id
);
2184 if (! NILP (Fmemq (make_number (id
), old_list
)))
2186 old_list
= Fdelq (make_number (id
), old_list
);
2187 new_head
= Fcons (make_number (id
), new_head
);
2190 arglist
[0] = Fnreverse (new_head
);
2191 arglist
[1] = Vcharset_non_preferred_head
= old_list
;
2192 Vcharset_ordered_list
= Fnconc (2, arglist
);
2193 charset_ordered_list_tick
++;
2195 charset_unibyte
= -1;
2196 for (old_list
= Vcharset_ordered_list
, list_2022
= list_emacs_mule
= Qnil
;
2197 CONSP (old_list
); old_list
= XCDR (old_list
))
2199 if (! NILP (Fmemq (XCAR (old_list
), Viso_2022_charset_list
)))
2200 list_2022
= Fcons (XCAR (old_list
), list_2022
);
2201 if (! NILP (Fmemq (XCAR (old_list
), Vemacs_mule_charset_list
)))
2202 list_emacs_mule
= Fcons (XCAR (old_list
), list_emacs_mule
);
2203 if (charset_unibyte
< 0)
2205 struct charset
*charset
= CHARSET_FROM_ID (XINT (XCAR (old_list
)));
2207 if (CHARSET_DIMENSION (charset
) == 1
2208 && CHARSET_ASCII_COMPATIBLE_P (charset
)
2209 && CHARSET_MAX_CHAR (charset
) >= 0x80)
2210 charset_unibyte
= CHARSET_ID (charset
);
2213 Viso_2022_charset_list
= Fnreverse (list_2022
);
2214 Vemacs_mule_charset_list
= Fnreverse (list_emacs_mule
);
2215 if (charset_unibyte
< 0)
2216 charset_unibyte
= charset_iso_8859_1
;
2221 DEFUN ("charset-id-internal", Fcharset_id_internal
, Scharset_id_internal
,
2223 doc
: /* Internal use only.
2224 Return charset identification number of CHARSET. */)
2225 (Lisp_Object charset
)
2229 CHECK_CHARSET_GET_ID (charset
, id
);
2230 return make_number (id
);
2233 struct charset_sort_data
2235 Lisp_Object charset
;
2241 charset_compare (const void *d1
, const void *d2
)
2243 const struct charset_sort_data
*data1
= d1
, *data2
= d2
;
2244 if (data1
->priority
!= data2
->priority
)
2245 return data1
->priority
< data2
->priority
? -1 : 1;
2249 DEFUN ("sort-charsets", Fsort_charsets
, Ssort_charsets
, 1, 1, 0,
2250 doc
: /* Sort charset list CHARSETS by a priority of each charset.
2251 Return the sorted list. CHARSETS is modified by side effects.
2252 See also `charset-priority-list' and `set-charset-priority'. */)
2253 (Lisp_Object charsets
)
2255 Lisp_Object len
= Flength (charsets
);
2256 ptrdiff_t n
= XFASTINT (len
), i
, j
;
2258 Lisp_Object tail
, elt
, attrs
;
2259 struct charset_sort_data
*sort_data
;
2260 int id
, min_id
= INT_MAX
, max_id
= INT_MIN
;
2265 SAFE_NALLOCA (sort_data
, 1, n
);
2266 for (tail
= charsets
, i
= 0; CONSP (tail
); tail
= XCDR (tail
), i
++)
2269 CHECK_CHARSET_GET_ATTR (elt
, attrs
);
2270 sort_data
[i
].charset
= elt
;
2271 sort_data
[i
].id
= id
= XINT (CHARSET_ATTR_ID (attrs
));
2277 for (done
= 0, tail
= Vcharset_ordered_list
, i
= 0;
2278 done
< n
&& CONSP (tail
); tail
= XCDR (tail
), i
++)
2281 id
= XFASTINT (elt
);
2282 if (id
>= min_id
&& id
<= max_id
)
2283 for (j
= 0; j
< n
; j
++)
2284 if (sort_data
[j
].id
== id
)
2286 sort_data
[j
].priority
= i
;
2290 qsort (sort_data
, n
, sizeof *sort_data
, charset_compare
);
2291 for (i
= 0, tail
= charsets
; CONSP (tail
); tail
= XCDR (tail
), i
++)
2292 XSETCAR (tail
, sort_data
[i
].charset
);
2301 Lisp_Object tempdir
;
2302 tempdir
= Fexpand_file_name (build_string ("charsets"), Vdata_directory
);
2303 if (! file_accessible_directory_p (SSDATA (tempdir
)))
2305 /* This used to be non-fatal (dir_warning), but it should not
2306 happen, and if it does sooner or later it will cause some
2307 obscure problem (eg bug#6401), so better abort. */
2308 fprintf (stderr
, "Error: charsets directory not found:\n\
2310 Emacs will not function correctly without the character map files.\n%s\
2311 Please check your installation!\n",
2313 egetenv("EMACSDATA") ? "The EMACSDATA environment \
2314 variable is set, maybe it has the wrong value?\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 #include "charset.x"
2360 DEFSYM (Qcharsetp
, "charsetp");
2362 DEFSYM (Qascii
, "ascii");
2363 DEFSYM (Qunicode
, "unicode");
2364 DEFSYM (Qemacs
, "emacs");
2365 DEFSYM (Qeight_bit
, "eight-bit");
2366 DEFSYM (Qiso_8859_1
, "iso-8859-1");
2371 staticpro (&Vcharset_ordered_list
);
2372 Vcharset_ordered_list
= Qnil
;
2374 staticpro (&Viso_2022_charset_list
);
2375 Viso_2022_charset_list
= Qnil
;
2377 staticpro (&Vemacs_mule_charset_list
);
2378 Vemacs_mule_charset_list
= Qnil
;
2380 /* Don't staticpro them here. It's done in syms_of_fns. */
2381 QCtest
= intern_c_string (":test");
2382 Qeq
= intern_c_string ("eq");
2384 staticpro (&Vcharset_hash_table
);
2386 Lisp_Object args
[2];
2389 Vcharset_hash_table
= Fmake_hash_table (2, args
);
2392 charset_table
= charset_table_init
;
2393 charset_table_size
= ARRAYELTS (charset_table_init
);
2394 charset_table_used
= 0;
2396 DEFVAR_LISP ("charset-map-path", Vcharset_map_path
,
2397 doc
: /* List of directories to search for charset map files. */);
2398 Vcharset_map_path
= Qnil
;
2400 DEFVAR_BOOL ("inhibit-load-charset-map", inhibit_load_charset_map
,
2401 doc
: /* Inhibit loading of charset maps. Used when dumping Emacs. */);
2402 inhibit_load_charset_map
= 0;
2404 DEFVAR_LISP ("charset-list", Vcharset_list
,
2405 doc
: /* List of all charsets ever defined. */);
2406 Vcharset_list
= Qnil
;
2408 DEFVAR_LISP ("current-iso639-language", Vcurrent_iso639_language
,
2409 doc
: /* ISO639 language mnemonic symbol for the current language environment.
2410 If the current language environment is for multiple languages (e.g. "Latin-1"),
2411 the value may be a list of mnemonics. */);
2412 Vcurrent_iso639_language
= Qnil
;
2415 = define_charset_internal (Qascii
, 1, "\x00\x7F\0\0\0\0\0",
2416 0, 127, 'B', -1, 0, 1, 0, 0);
2418 = define_charset_internal (Qiso_8859_1
, 1, "\x00\xFF\0\0\0\0\0",
2419 0, 255, -1, -1, -1, 1, 0, 0);
2421 = define_charset_internal (Qunicode
, 3, "\x00\xFF\x00\xFF\x00\x10\0",
2422 0, MAX_UNICODE_CHAR
, -1, 0, -1, 1, 0, 0);
2424 = define_charset_internal (Qemacs
, 3, "\x00\xFF\x00\xFF\x00\x3F\0",
2425 0, MAX_5_BYTE_CHAR
, -1, 0, -1, 1, 1, 0);
2427 = define_charset_internal (Qeight_bit
, 1, "\x80\xFF\0\0\0\0\0",
2428 128, 255, -1, 0, -1, 0, 1,
2429 MAX_5_BYTE_CHAR
+ 1);
2430 charset_unibyte
= charset_iso_8859_1
;