1 /* Basic character set support.
2 Copyright (C) 2001-2011 Free Software Foundation, Inc.
3 Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 2005, 2006, 2007, 2008, 2009, 2010, 2011
5 National Institute of Advanced Industrial Science and Technology (AIST)
6 Registration Number H14PRO021
8 Copyright (C) 2003, 2004
9 National Institute of Advanced Industrial Science and Technology (AIST)
10 Registration Number H13PRO009
12 This file is part of GNU Emacs.
14 GNU Emacs is free software: you can redistribute it and/or modify
15 it under the terms of the GNU General Public License as published by
16 the Free Software Foundation, either version 3 of the License, or
17 (at your option) any later version.
19 GNU Emacs is distributed in the hope that it will be useful,
20 but WITHOUT ANY WARRANTY; without even the implied warranty of
21 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 GNU General Public License for more details.
24 You should have received a copy of the GNU General Public License
25 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
33 #include <sys/types.h>
36 #include "character.h"
42 /*** GENERAL NOTES on CODED CHARACTER SETS (CHARSETS) ***
44 A coded character set ("charset" hereafter) is a meaningful
45 collection (i.e. language, culture, functionality, etc.) of
46 characters. Emacs handles multiple charsets at once. In Emacs Lisp
47 code, a charset is represented by a symbol. In C code, a charset is
48 represented by its ID number or by a pointer to a struct charset.
50 The actual information about each charset is stored in two places.
51 Lispy information is stored in the hash table Vcharset_hash_table as
52 a vector (charset attributes). The other information is stored in
53 charset_table as a struct charset.
57 /* Hash table that contains attributes of each charset. Keys are
58 charset symbols, and values are vectors of charset attributes. */
59 Lisp_Object Vcharset_hash_table
;
61 /* Table of struct charset. */
62 struct charset
*charset_table
;
64 static ptrdiff_t charset_table_size
;
65 static int charset_table_used
;
67 Lisp_Object Qcharsetp
;
69 /* Special charset symbols. */
71 static Lisp_Object Qeight_bit
;
72 static Lisp_Object Qiso_8859_1
;
73 static Lisp_Object Qunicode
;
74 static Lisp_Object Qemacs
;
76 /* The corresponding charsets. */
78 int charset_eight_bit
;
79 static int charset_iso_8859_1
;
81 static int charset_emacs
;
83 /* The other special charsets. */
84 int charset_jisx0201_roman
;
85 int charset_jisx0208_1978
;
89 /* Value of charset attribute `charset-iso-plane'. */
90 static Lisp_Object Qgl
, Qgr
;
92 /* Charset of unibyte characters. */
95 /* List of charsets ordered by the priority. */
96 Lisp_Object Vcharset_ordered_list
;
98 /* Sub-list of Vcharset_ordered_list that contains all non-preferred
100 Lisp_Object Vcharset_non_preferred_head
;
102 /* Incremented everytime we change Vcharset_ordered_list. This is
103 unsigned short so that it fits in Lisp_Int and never matches
105 unsigned short charset_ordered_list_tick
;
107 /* List of iso-2022 charsets. */
108 Lisp_Object Viso_2022_charset_list
;
110 /* List of emacs-mule charsets. */
111 Lisp_Object Vemacs_mule_charset_list
;
113 int emacs_mule_charset
[256];
115 /* Mapping table from ISO2022's charset (specified by DIMENSION,
116 CHARS, and FINAL-CHAR) to Emacs' charset. */
117 int iso_charset_table
[ISO_MAX_DIMENSION
][ISO_MAX_CHARS
][ISO_MAX_FINAL
];
119 #define CODE_POINT_TO_INDEX(charset, code) \
120 ((charset)->code_linear_p \
121 ? (int) ((code) - (charset)->min_code) \
122 : (((charset)->code_space_mask[(code) >> 24] & 0x8) \
123 && ((charset)->code_space_mask[((code) >> 16) & 0xFF] & 0x4) \
124 && ((charset)->code_space_mask[((code) >> 8) & 0xFF] & 0x2) \
125 && ((charset)->code_space_mask[(code) & 0xFF] & 0x1)) \
126 ? (int) (((((code) >> 24) - (charset)->code_space[12]) \
127 * (charset)->code_space[11]) \
128 + (((((code) >> 16) & 0xFF) - (charset)->code_space[8]) \
129 * (charset)->code_space[7]) \
130 + (((((code) >> 8) & 0xFF) - (charset)->code_space[4]) \
131 * (charset)->code_space[3]) \
132 + (((code) & 0xFF) - (charset)->code_space[0]) \
133 - ((charset)->char_index_offset)) \
137 /* Return the code-point for the character index IDX in CHARSET.
138 IDX should be an unsigned int variable in a valid range (which is
139 always in nonnegative int range too). IDX contains garbage afterwards. */
141 #define INDEX_TO_CODE_POINT(charset, idx) \
142 ((charset)->code_linear_p \
143 ? (idx) + (charset)->min_code \
144 : (idx += (charset)->char_index_offset, \
145 (((charset)->code_space[0] + (idx) % (charset)->code_space[2]) \
146 | (((charset)->code_space[4] \
147 + ((idx) / (charset)->code_space[3] % (charset)->code_space[6])) \
149 | (((charset)->code_space[8] \
150 + ((idx) / (charset)->code_space[7] % (charset)->code_space[10])) \
152 | (((charset)->code_space[12] + ((idx) / (charset)->code_space[11])) \
155 /* Structure to hold mapping tables for a charset. Used by temacs
156 invoked for dumping. */
160 /* The current charset for which the following tables are setup. */
161 struct charset
*current
;
163 /* 1 iff the following table is used for encoder. */
166 /* When the following table is used for encoding, mininum and
167 maxinum character of the current charset. */
168 int min_char
, max_char
;
170 /* A Unicode character correspoinding to the code indice 0 (i.e. the
171 minimum code-point) of the current charset, or -1 if the code
172 indice 0 is not a Unicode character. This is checked when
173 table.encoder[CHAR] is zero. */
177 /* Table mapping code-indices (not code-points) of the current
178 charset to Unicode characters. If decoder[CHAR] is -1, CHAR
179 doesn't belong to the current charset. */
180 int decoder
[0x10000];
181 /* Table mapping Unicode characters to code-indices of the current
182 charset. The first 0x10000 elements are for BMP (0..0xFFFF),
183 and the last 0x10000 are for SMP (0x10000..0x1FFFF) or SIP
184 (0x20000..0x2FFFF). Note that there is no charset map that
185 uses both SMP and SIP. */
186 unsigned short encoder
[0x20000];
188 } *temp_charset_work
;
190 #define SET_TEMP_CHARSET_WORK_ENCODER(C, CODE) \
193 temp_charset_work->zero_index_char = (C); \
194 else if ((C) < 0x20000) \
195 temp_charset_work->table.encoder[(C)] = (CODE); \
197 temp_charset_work->table.encoder[(C) - 0x10000] = (CODE); \
200 #define GET_TEMP_CHARSET_WORK_ENCODER(C) \
201 ((C) == temp_charset_work->zero_index_char ? 0 \
202 : (C) < 0x20000 ? (temp_charset_work->table.encoder[(C)] \
203 ? (int) temp_charset_work->table.encoder[(C)] : -1) \
204 : temp_charset_work->table.encoder[(C) - 0x10000] \
205 ? temp_charset_work->table.encoder[(C) - 0x10000] : -1)
207 #define SET_TEMP_CHARSET_WORK_DECODER(C, CODE) \
208 (temp_charset_work->table.decoder[(CODE)] = (C))
210 #define GET_TEMP_CHARSET_WORK_DECODER(CODE) \
211 (temp_charset_work->table.decoder[(CODE)])
214 /* Set to 1 to warn that a charset map is loaded and thus a buffer
215 text and a string data may be relocated. */
216 int charset_map_loaded
;
218 struct charset_map_entries
224 struct charset_map_entries
*next
;
227 /* Load the mapping information of CHARSET from ENTRIES for
228 initializing (CONTROL_FLAG == 0), decoding (CONTROL_FLAG == 1), and
229 encoding (CONTROL_FLAG == 2).
231 If CONTROL_FLAG is 0, setup CHARSET->min_char, CHARSET->max_char,
232 and CHARSET->fast_map.
234 If CONTROL_FLAG is 1, setup the following tables according to
235 CHARSET->method and inhibit_load_charset_map.
237 CHARSET->method | inhibit_lcm == 0 | inhibit_lcm == 1
238 ----------------------+--------------------+---------------------------
239 CHARSET_METHOD_MAP | CHARSET->decoder | temp_charset_work->decoder
240 ----------------------+--------------------+---------------------------
241 CHARSET_METHOD_OFFSET | Vchar_unify_table | temp_charset_work->decoder
243 If CONTROL_FLAG is 2, setup the following tables.
245 CHARSET->method | inhibit_lcm == 0 | inhibit_lcm == 1
246 ----------------------+--------------------+---------------------------
247 CHARSET_METHOD_MAP | CHARSET->encoder | temp_charset_work->encoder
248 ----------------------+--------------------+--------------------------
249 CHARSET_METHOD_OFFSET | CHARSET->deunifier | temp_charset_work->encoder
253 load_charset_map (struct charset
*charset
, struct charset_map_entries
*entries
, int n_entries
, int control_flag
)
255 Lisp_Object vec
IF_LINT (= Qnil
), table
IF_LINT (= Qnil
);
256 unsigned max_code
= CHARSET_MAX_CODE (charset
);
257 int ascii_compatible_p
= charset
->ascii_compatible_p
;
258 int min_char
, max_char
, nonascii_min_char
;
260 unsigned char *fast_map
= charset
->fast_map
;
267 if (! inhibit_load_charset_map
)
269 if (control_flag
== 1)
271 if (charset
->method
== CHARSET_METHOD_MAP
)
273 int n
= CODE_POINT_TO_INDEX (charset
, max_code
) + 1;
275 vec
= CHARSET_DECODER (charset
)
276 = Fmake_vector (make_number (n
), make_number (-1));
280 char_table_set_range (Vchar_unify_table
,
281 charset
->min_char
, charset
->max_char
,
287 table
= Fmake_char_table (Qnil
, Qnil
);
288 if (charset
->method
== CHARSET_METHOD_MAP
)
289 CHARSET_ENCODER (charset
) = table
;
291 CHARSET_DEUNIFIER (charset
) = table
;
296 if (! temp_charset_work
)
297 temp_charset_work
= xmalloc (sizeof (*temp_charset_work
));
298 if (control_flag
== 1)
300 memset (temp_charset_work
->table
.decoder
, -1,
301 sizeof (int) * 0x10000);
305 memset (temp_charset_work
->table
.encoder
, 0,
306 sizeof (unsigned short) * 0x20000);
307 temp_charset_work
->zero_index_char
= -1;
309 temp_charset_work
->current
= charset
;
310 temp_charset_work
->for_encoder
= (control_flag
== 2);
313 charset_map_loaded
= 1;
316 min_char
= max_char
= entries
->entry
[0].c
;
317 nonascii_min_char
= MAX_CHAR
;
318 for (i
= 0; i
< n_entries
; i
++)
321 int from_index
, to_index
, lim_index
;
323 int idx
= i
% 0x10000;
325 if (i
> 0 && idx
== 0)
326 entries
= entries
->next
;
327 from
= entries
->entry
[idx
].from
;
328 to
= entries
->entry
[idx
].to
;
329 from_c
= entries
->entry
[idx
].c
;
330 from_index
= CODE_POINT_TO_INDEX (charset
, from
);
333 to_index
= from_index
;
338 to_index
= CODE_POINT_TO_INDEX (charset
, to
);
339 to_c
= from_c
+ (to_index
- from_index
);
341 if (from_index
< 0 || to_index
< 0)
343 lim_index
= to_index
+ 1;
347 else if (from_c
< min_char
)
350 if (control_flag
== 1)
352 if (charset
->method
== CHARSET_METHOD_MAP
)
353 for (; from_index
< lim_index
; from_index
++, from_c
++)
354 ASET (vec
, from_index
, make_number (from_c
));
356 for (; from_index
< lim_index
; from_index
++, from_c
++)
357 CHAR_TABLE_SET (Vchar_unify_table
,
358 CHARSET_CODE_OFFSET (charset
) + from_index
,
359 make_number (from_c
));
361 else if (control_flag
== 2)
363 if (charset
->method
== CHARSET_METHOD_MAP
364 && CHARSET_COMPACT_CODES_P (charset
))
365 for (; from_index
< lim_index
; from_index
++, from_c
++)
367 unsigned code
= from_index
;
368 code
= INDEX_TO_CODE_POINT (charset
, code
);
370 if (NILP (CHAR_TABLE_REF (table
, from_c
)))
371 CHAR_TABLE_SET (table
, from_c
, make_number (code
));
374 for (; from_index
< lim_index
; from_index
++, from_c
++)
376 if (NILP (CHAR_TABLE_REF (table
, from_c
)))
377 CHAR_TABLE_SET (table
, from_c
, make_number (from_index
));
380 else if (control_flag
== 3)
381 for (; from_index
< lim_index
; from_index
++, from_c
++)
382 SET_TEMP_CHARSET_WORK_DECODER (from_c
, from_index
);
383 else if (control_flag
== 4)
384 for (; from_index
< lim_index
; from_index
++, from_c
++)
385 SET_TEMP_CHARSET_WORK_ENCODER (from_c
, from_index
);
386 else /* control_flag == 0 */
388 if (ascii_compatible_p
)
390 if (! ASCII_BYTE_P (from_c
))
392 if (from_c
< nonascii_min_char
)
393 nonascii_min_char
= from_c
;
395 else if (! ASCII_BYTE_P (to_c
))
397 nonascii_min_char
= 0x80;
401 for (; from_c
<= to_c
; from_c
++)
402 CHARSET_FAST_MAP_SET (from_c
, fast_map
);
406 if (control_flag
== 0)
408 CHARSET_MIN_CHAR (charset
) = (ascii_compatible_p
409 ? nonascii_min_char
: min_char
);
410 CHARSET_MAX_CHAR (charset
) = max_char
;
412 else if (control_flag
== 4)
414 temp_charset_work
->min_char
= min_char
;
415 temp_charset_work
->max_char
= max_char
;
420 /* Read a hexadecimal number (preceded by "0x") from the file FP while
421 paying attention to comment character '#'. */
423 static inline unsigned
424 read_hex (FILE *fp
, int *eof
, int *overflow
)
429 while ((c
= getc (fp
)) != EOF
)
433 while ((c
= getc (fp
)) != EOF
&& c
!= '\n');
437 if ((c
= getc (fp
)) == EOF
|| c
== 'x')
447 while (isxdigit (c
= getc (fp
)))
449 if (UINT_MAX
>> 4 < n
)
452 | (c
- ('0' <= c
&& c
<= '9' ? '0'
453 : 'A' <= c
&& c
<= 'F' ? 'A' - 10
461 /* Return a mapping vector for CHARSET loaded from MAPFILE.
462 Each line of MAPFILE has this form
464 where 0xAAAA is a code-point and 0xCCCC is the corresponding
465 character code, or this form
467 where 0xAAAA and 0xBBBB are code-points specifying a range, and
468 0xCCCC is the first character code of the range.
470 The returned vector has this form:
471 [ CODE1 CHAR1 CODE2 CHAR2 .... ]
472 where CODE1 is a code-point or a cons of code-points specifying a
475 Note that this function uses `openp' to open MAPFILE but ignores
476 `file-name-handler-alist' to avoid running any Lisp code. */
479 load_charset_map_from_file (struct charset
*charset
, Lisp_Object mapfile
, int control_flag
)
481 unsigned min_code
= CHARSET_MIN_CODE (charset
);
482 unsigned max_code
= CHARSET_MAX_CODE (charset
);
485 Lisp_Object suffixes
;
486 struct charset_map_entries
*head
, *entries
;
491 suffixes
= Fcons (build_string (".map"),
492 Fcons (build_string (".TXT"), Qnil
));
494 count
= SPECPDL_INDEX ();
495 specbind (Qfile_name_handler_alist
, Qnil
);
496 fd
= openp (Vcharset_map_path
, mapfile
, suffixes
, NULL
, Qnil
);
497 unbind_to (count
, Qnil
);
499 || ! (fp
= fdopen (fd
, "r")))
500 error ("Failure in loading charset map: %s", SDATA (mapfile
));
502 /* Use SAFE_ALLOCA instead of alloca, as `charset_map_entries' is
503 large (larger than MAX_ALLOCA). */
504 SAFE_ALLOCA (head
, struct charset_map_entries
*,
505 sizeof (struct charset_map_entries
));
507 memset (entries
, 0, sizeof (struct charset_map_entries
));
512 unsigned from
, to
, c
;
514 int eof
= 0, overflow
= 0;
516 from
= read_hex (fp
, &eof
, &overflow
);
519 if (getc (fp
) == '-')
520 to
= read_hex (fp
, &eof
, &overflow
);
525 c
= read_hex (fp
, &eof
, &overflow
);
531 if (from
< min_code
|| to
> max_code
|| from
> to
|| c
> MAX_CHAR
)
534 if (n_entries
> 0 && (n_entries
% 0x10000) == 0)
536 SAFE_ALLOCA (entries
->next
, struct charset_map_entries
*,
537 sizeof (struct charset_map_entries
));
538 entries
= entries
->next
;
539 memset (entries
, 0, sizeof (struct charset_map_entries
));
543 entries
->entry
[idx
].from
= from
;
544 entries
->entry
[idx
].to
= to
;
545 entries
->entry
[idx
].c
= c
;
550 load_charset_map (charset
, head
, n_entries
, control_flag
);
555 load_charset_map_from_vector (struct charset
*charset
, Lisp_Object vec
, int control_flag
)
557 unsigned min_code
= CHARSET_MIN_CODE (charset
);
558 unsigned max_code
= CHARSET_MAX_CODE (charset
);
559 struct charset_map_entries
*head
, *entries
;
561 int len
= ASIZE (vec
);
567 add_to_log ("Failure in loading charset map: %V", vec
, Qnil
);
571 /* Use SAFE_ALLOCA instead of alloca, as `charset_map_entries' is
572 large (larger than MAX_ALLOCA). */
573 SAFE_ALLOCA (head
, struct charset_map_entries
*,
574 sizeof (struct charset_map_entries
));
576 memset (entries
, 0, sizeof (struct charset_map_entries
));
579 for (i
= 0; i
< len
; i
+= 2)
581 Lisp_Object val
, val2
;
591 from
= XFASTINT (val
);
592 to
= XFASTINT (val2
);
595 from
= to
= XFASTINT (val
);
596 val
= AREF (vec
, i
+ 1);
600 if (from
< min_code
|| to
> max_code
|| from
> to
|| c
> MAX_CHAR
)
603 if (n_entries
> 0 && (n_entries
% 0x10000) == 0)
605 SAFE_ALLOCA (entries
->next
, struct charset_map_entries
*,
606 sizeof (struct charset_map_entries
));
607 entries
= entries
->next
;
608 memset (entries
, 0, sizeof (struct charset_map_entries
));
610 idx
= n_entries
% 0x10000;
611 entries
->entry
[idx
].from
= from
;
612 entries
->entry
[idx
].to
= to
;
613 entries
->entry
[idx
].c
= c
;
617 load_charset_map (charset
, head
, n_entries
, control_flag
);
622 /* Load a mapping table for CHARSET. CONTROL-FLAG tells what kind of
623 map it is (see the comment of load_charset_map for the detail). */
626 load_charset (struct charset
*charset
, int control_flag
)
630 if (inhibit_load_charset_map
632 && charset
== temp_charset_work
->current
633 && ((control_flag
== 2) == temp_charset_work
->for_encoder
))
636 if (CHARSET_METHOD (charset
) == CHARSET_METHOD_MAP
)
637 map
= CHARSET_MAP (charset
);
640 if (! CHARSET_UNIFIED_P (charset
))
642 map
= CHARSET_UNIFY_MAP (charset
);
645 load_charset_map_from_file (charset
, map
, control_flag
);
647 load_charset_map_from_vector (charset
, map
, control_flag
);
651 DEFUN ("charsetp", Fcharsetp
, Scharsetp
, 1, 1, 0,
652 doc
: /* Return non-nil if and only if OBJECT is a charset.*/)
655 return (CHARSETP (object
) ? Qt
: Qnil
);
660 map_charset_for_dump (void (*c_function
) (Lisp_Object
, Lisp_Object
),
661 Lisp_Object function
, Lisp_Object arg
,
662 unsigned int from
, unsigned int to
)
664 int from_idx
= CODE_POINT_TO_INDEX (temp_charset_work
->current
, from
);
665 int to_idx
= CODE_POINT_TO_INDEX (temp_charset_work
->current
, to
);
670 range
= Fcons (Qnil
, Qnil
);
673 c
= temp_charset_work
->min_char
;
674 stop
= (temp_charset_work
->max_char
< 0x20000
675 ? temp_charset_work
->max_char
: 0xFFFF);
679 int idx
= GET_TEMP_CHARSET_WORK_ENCODER (c
);
681 if (idx
>= from_idx
&& idx
<= to_idx
)
683 if (NILP (XCAR (range
)))
684 XSETCAR (range
, make_number (c
));
686 else if (! NILP (XCAR (range
)))
688 XSETCDR (range
, make_number (c
- 1));
690 (*c_function
) (arg
, range
);
692 call2 (function
, range
, arg
);
693 XSETCAR (range
, Qnil
);
697 if (c
== temp_charset_work
->max_char
)
699 if (! NILP (XCAR (range
)))
701 XSETCDR (range
, make_number (c
));
703 (*c_function
) (arg
, range
);
705 call2 (function
, range
, arg
);
710 stop
= temp_charset_work
->max_char
;
718 map_charset_chars (void (*c_function
)(Lisp_Object
, Lisp_Object
), Lisp_Object function
,
719 Lisp_Object arg
, struct charset
*charset
, unsigned from
, unsigned to
)
724 partial
= (from
> CHARSET_MIN_CODE (charset
)
725 || to
< CHARSET_MAX_CODE (charset
));
727 if (CHARSET_METHOD (charset
) == CHARSET_METHOD_OFFSET
)
729 int from_idx
= CODE_POINT_TO_INDEX (charset
, from
);
730 int to_idx
= CODE_POINT_TO_INDEX (charset
, to
);
731 int from_c
= from_idx
+ CHARSET_CODE_OFFSET (charset
);
732 int to_c
= to_idx
+ CHARSET_CODE_OFFSET (charset
);
734 if (CHARSET_UNIFIED_P (charset
))
736 if (! CHAR_TABLE_P (CHARSET_DEUNIFIER (charset
)))
737 load_charset (charset
, 2);
738 if (CHAR_TABLE_P (CHARSET_DEUNIFIER (charset
)))
739 map_char_table_for_charset (c_function
, function
,
740 CHARSET_DEUNIFIER (charset
), arg
,
741 partial
? charset
: NULL
, from
, to
);
743 map_charset_for_dump (c_function
, function
, arg
, from
, to
);
746 range
= Fcons (make_number (from_c
), make_number (to_c
));
748 (*c_function
) (arg
, range
);
750 call2 (function
, range
, arg
);
752 else if (CHARSET_METHOD (charset
) == CHARSET_METHOD_MAP
)
754 if (! CHAR_TABLE_P (CHARSET_ENCODER (charset
)))
755 load_charset (charset
, 2);
756 if (CHAR_TABLE_P (CHARSET_ENCODER (charset
)))
757 map_char_table_for_charset (c_function
, function
,
758 CHARSET_ENCODER (charset
), arg
,
759 partial
? charset
: NULL
, from
, to
);
761 map_charset_for_dump (c_function
, function
, arg
, from
, to
);
763 else if (CHARSET_METHOD (charset
) == CHARSET_METHOD_SUBSET
)
765 Lisp_Object subset_info
;
768 subset_info
= CHARSET_SUBSET (charset
);
769 charset
= CHARSET_FROM_ID (XFASTINT (AREF (subset_info
, 0)));
770 offset
= XINT (AREF (subset_info
, 3));
772 if (from
< XFASTINT (AREF (subset_info
, 1)))
773 from
= XFASTINT (AREF (subset_info
, 1));
775 if (to
> XFASTINT (AREF (subset_info
, 2)))
776 to
= XFASTINT (AREF (subset_info
, 2));
777 map_charset_chars (c_function
, function
, arg
, charset
, from
, to
);
779 else /* i.e. CHARSET_METHOD_SUPERSET */
783 for (parents
= CHARSET_SUPERSET (charset
); CONSP (parents
);
784 parents
= XCDR (parents
))
787 unsigned this_from
, this_to
;
789 charset
= CHARSET_FROM_ID (XFASTINT (XCAR (XCAR (parents
))));
790 offset
= XINT (XCDR (XCAR (parents
)));
791 this_from
= from
> offset
? from
- offset
: 0;
792 this_to
= to
> offset
? to
- offset
: 0;
793 if (this_from
< CHARSET_MIN_CODE (charset
))
794 this_from
= CHARSET_MIN_CODE (charset
);
795 if (this_to
> CHARSET_MAX_CODE (charset
))
796 this_to
= CHARSET_MAX_CODE (charset
);
797 map_charset_chars (c_function
, function
, arg
, charset
,
803 DEFUN ("map-charset-chars", Fmap_charset_chars
, Smap_charset_chars
, 2, 5, 0,
804 doc
: /* Call FUNCTION for all characters in CHARSET.
805 FUNCTION is called with an argument RANGE and the optional 3rd
808 RANGE is a cons (FROM . TO), where FROM and TO indicate a range of
809 characters contained in CHARSET.
811 The optional 4th and 5th arguments FROM-CODE and TO-CODE specify the
812 range of code points (in CHARSET) of target characters. */)
813 (Lisp_Object function
, Lisp_Object charset
, Lisp_Object arg
, Lisp_Object from_code
, Lisp_Object to_code
)
818 CHECK_CHARSET_GET_CHARSET (charset
, cs
);
819 if (NILP (from_code
))
820 from
= CHARSET_MIN_CODE (cs
);
823 from
= XINT (from_code
);
824 if (from
< CHARSET_MIN_CODE (cs
))
825 from
= CHARSET_MIN_CODE (cs
);
828 to
= CHARSET_MAX_CODE (cs
);
832 if (to
> CHARSET_MAX_CODE (cs
))
833 to
= CHARSET_MAX_CODE (cs
);
835 map_charset_chars (NULL
, function
, arg
, cs
, from
, to
);
840 /* Define a charset according to the arguments. The Nth argument is
841 the Nth attribute of the charset (the last attribute `charset-id'
842 is not included). See the docstring of `define-charset' for the
845 DEFUN ("define-charset-internal", Fdefine_charset_internal
,
846 Sdefine_charset_internal
, charset_arg_max
, MANY
, 0,
847 doc
: /* For internal use only.
848 usage: (define-charset-internal ...) */)
849 (ptrdiff_t nargs
, Lisp_Object
*args
)
851 /* Charset attr vector. */
854 EMACS_UINT hash_code
;
855 struct Lisp_Hash_Table
*hash_table
= XHASH_TABLE (Vcharset_hash_table
);
857 struct charset charset
;
860 int new_definition_p
;
863 if (nargs
!= charset_arg_max
)
864 return Fsignal (Qwrong_number_of_arguments
,
865 Fcons (intern ("define-charset-internal"),
866 make_number (nargs
)));
868 attrs
= Fmake_vector (make_number (charset_attr_max
), Qnil
);
870 CHECK_SYMBOL (args
[charset_arg_name
]);
871 ASET (attrs
, charset_name
, args
[charset_arg_name
]);
873 val
= args
[charset_arg_code_space
];
874 for (i
= 0, dimension
= 0, nchars
= 1; ; i
++)
876 Lisp_Object min_byte_obj
, max_byte_obj
;
877 int min_byte
, max_byte
;
879 min_byte_obj
= Faref (val
, make_number (i
* 2));
880 max_byte_obj
= Faref (val
, make_number (i
* 2 + 1));
881 CHECK_RANGED_INTEGER (0, min_byte_obj
, 255);
882 min_byte
= XINT (min_byte_obj
);
883 CHECK_RANGED_INTEGER (min_byte
, max_byte_obj
, 255);
884 max_byte
= XINT (max_byte_obj
);
885 charset
.code_space
[i
* 4] = min_byte
;
886 charset
.code_space
[i
* 4 + 1] = max_byte
;
887 charset
.code_space
[i
* 4 + 2] = max_byte
- min_byte
+ 1;
892 nchars
*= charset
.code_space
[i
* 4 + 2];
893 charset
.code_space
[i
* 4 + 3] = nchars
;
896 val
= args
[charset_arg_dimension
];
898 charset
.dimension
= dimension
;
901 CHECK_RANGED_INTEGER (1, val
, 4);
902 charset
.dimension
= XINT (val
);
905 charset
.code_linear_p
906 = (charset
.dimension
== 1
907 || (charset
.code_space
[2] == 256
908 && (charset
.dimension
== 2
909 || (charset
.code_space
[6] == 256
910 && (charset
.dimension
== 3
911 || charset
.code_space
[10] == 256)))));
913 if (! charset
.code_linear_p
)
915 charset
.code_space_mask
= (unsigned char *) xmalloc (256);
916 memset (charset
.code_space_mask
, 0, 256);
917 for (i
= 0; i
< 4; i
++)
918 for (j
= charset
.code_space
[i
* 4]; j
<= charset
.code_space
[i
* 4 + 1];
920 charset
.code_space_mask
[j
] |= (1 << i
);
923 charset
.iso_chars_96
= charset
.code_space
[2] == 96;
925 charset
.min_code
= (charset
.code_space
[0]
926 | (charset
.code_space
[4] << 8)
927 | (charset
.code_space
[8] << 16)
928 | ((unsigned) charset
.code_space
[12] << 24));
929 charset
.max_code
= (charset
.code_space
[1]
930 | (charset
.code_space
[5] << 8)
931 | (charset
.code_space
[9] << 16)
932 | ((unsigned) charset
.code_space
[13] << 24));
933 charset
.char_index_offset
= 0;
935 val
= args
[charset_arg_min_code
];
938 unsigned code
= cons_to_unsigned (val
, UINT_MAX
);
940 if (code
< charset
.min_code
941 || code
> charset
.max_code
)
942 args_out_of_range_3 (make_fixnum_or_float (charset
.min_code
),
943 make_fixnum_or_float (charset
.max_code
), val
);
944 charset
.char_index_offset
= CODE_POINT_TO_INDEX (&charset
, code
);
945 charset
.min_code
= code
;
948 val
= args
[charset_arg_max_code
];
951 unsigned code
= cons_to_unsigned (val
, UINT_MAX
);
953 if (code
< charset
.min_code
954 || code
> charset
.max_code
)
955 args_out_of_range_3 (make_fixnum_or_float (charset
.min_code
),
956 make_fixnum_or_float (charset
.max_code
), val
);
957 charset
.max_code
= code
;
960 charset
.compact_codes_p
= charset
.max_code
< 0x10000;
962 val
= args
[charset_arg_invalid_code
];
965 if (charset
.min_code
> 0)
966 charset
.invalid_code
= 0;
969 if (charset
.max_code
< UINT_MAX
)
970 charset
.invalid_code
= charset
.max_code
+ 1;
972 error ("Attribute :invalid-code must be specified");
976 charset
.invalid_code
= cons_to_unsigned (val
, UINT_MAX
);
978 val
= args
[charset_arg_iso_final
];
980 charset
.iso_final
= -1;
984 if (XINT (val
) < '0' || XINT (val
) > 127)
985 error ("Invalid iso-final-char: %"pI
"d", XINT (val
));
986 charset
.iso_final
= XINT (val
);
989 val
= args
[charset_arg_iso_revision
];
991 charset
.iso_revision
= -1;
994 CHECK_RANGED_INTEGER (-1, val
, 63);
995 charset
.iso_revision
= XINT (val
);
998 val
= args
[charset_arg_emacs_mule_id
];
1000 charset
.emacs_mule_id
= -1;
1004 if ((XINT (val
) > 0 && XINT (val
) <= 128) || XINT (val
) >= 256)
1005 error ("Invalid emacs-mule-id: %"pI
"d", XINT (val
));
1006 charset
.emacs_mule_id
= XINT (val
);
1009 charset
.ascii_compatible_p
= ! NILP (args
[charset_arg_ascii_compatible_p
]);
1011 charset
.supplementary_p
= ! NILP (args
[charset_arg_supplementary_p
]);
1013 charset
.unified_p
= 0;
1015 memset (charset
.fast_map
, 0, sizeof (charset
.fast_map
));
1017 if (! NILP (args
[charset_arg_code_offset
]))
1019 val
= args
[charset_arg_code_offset
];
1020 CHECK_CHARACTER (val
);
1022 charset
.method
= CHARSET_METHOD_OFFSET
;
1023 charset
.code_offset
= XINT (val
);
1025 i
= CODE_POINT_TO_INDEX (&charset
, charset
.max_code
);
1026 if (MAX_CHAR
- charset
.code_offset
< i
)
1027 error ("Unsupported max char: %d", charset
.max_char
);
1028 charset
.max_char
= i
+ charset
.code_offset
;
1029 i
= CODE_POINT_TO_INDEX (&charset
, charset
.min_code
);
1030 charset
.min_char
= i
+ charset
.code_offset
;
1032 i
= (charset
.min_char
>> 7) << 7;
1033 for (; i
< 0x10000 && i
<= charset
.max_char
; i
+= 128)
1034 CHARSET_FAST_MAP_SET (i
, charset
.fast_map
);
1035 i
= (i
>> 12) << 12;
1036 for (; i
<= charset
.max_char
; i
+= 0x1000)
1037 CHARSET_FAST_MAP_SET (i
, charset
.fast_map
);
1038 if (charset
.code_offset
== 0 && charset
.max_char
>= 0x80)
1039 charset
.ascii_compatible_p
= 1;
1041 else if (! NILP (args
[charset_arg_map
]))
1043 val
= args
[charset_arg_map
];
1044 ASET (attrs
, charset_map
, val
);
1045 charset
.method
= CHARSET_METHOD_MAP
;
1047 else if (! NILP (args
[charset_arg_subset
]))
1050 Lisp_Object parent_min_code
, parent_max_code
, parent_code_offset
;
1051 struct charset
*parent_charset
;
1053 val
= args
[charset_arg_subset
];
1054 parent
= Fcar (val
);
1055 CHECK_CHARSET_GET_CHARSET (parent
, parent_charset
);
1056 parent_min_code
= Fnth (make_number (1), val
);
1057 CHECK_NATNUM (parent_min_code
);
1058 parent_max_code
= Fnth (make_number (2), val
);
1059 CHECK_NATNUM (parent_max_code
);
1060 parent_code_offset
= Fnth (make_number (3), val
);
1061 CHECK_NUMBER (parent_code_offset
);
1062 val
= Fmake_vector (make_number (4), Qnil
);
1063 ASET (val
, 0, make_number (parent_charset
->id
));
1064 ASET (val
, 1, parent_min_code
);
1065 ASET (val
, 2, parent_max_code
);
1066 ASET (val
, 3, parent_code_offset
);
1067 ASET (attrs
, charset_subset
, val
);
1069 charset
.method
= CHARSET_METHOD_SUBSET
;
1070 /* Here, we just copy the parent's fast_map. It's not accurate,
1071 but at least it works for quickly detecting which character
1072 DOESN'T belong to this charset. */
1073 for (i
= 0; i
< 190; i
++)
1074 charset
.fast_map
[i
] = parent_charset
->fast_map
[i
];
1076 /* We also copy these for parents. */
1077 charset
.min_char
= parent_charset
->min_char
;
1078 charset
.max_char
= parent_charset
->max_char
;
1080 else if (! NILP (args
[charset_arg_superset
]))
1082 val
= args
[charset_arg_superset
];
1083 charset
.method
= CHARSET_METHOD_SUPERSET
;
1084 val
= Fcopy_sequence (val
);
1085 ASET (attrs
, charset_superset
, val
);
1087 charset
.min_char
= MAX_CHAR
;
1088 charset
.max_char
= 0;
1089 for (; ! NILP (val
); val
= Fcdr (val
))
1091 Lisp_Object elt
, car_part
, cdr_part
;
1092 int this_id
, offset
;
1093 struct charset
*this_charset
;
1098 car_part
= XCAR (elt
);
1099 cdr_part
= XCDR (elt
);
1100 CHECK_CHARSET_GET_ID (car_part
, this_id
);
1101 CHECK_TYPE_RANGED_INTEGER (int, cdr_part
);
1102 offset
= XINT (cdr_part
);
1106 CHECK_CHARSET_GET_ID (elt
, this_id
);
1109 XSETCAR (val
, Fcons (make_number (this_id
), make_number (offset
)));
1111 this_charset
= CHARSET_FROM_ID (this_id
);
1112 if (charset
.min_char
> this_charset
->min_char
)
1113 charset
.min_char
= this_charset
->min_char
;
1114 if (charset
.max_char
< this_charset
->max_char
)
1115 charset
.max_char
= this_charset
->max_char
;
1116 for (i
= 0; i
< 190; i
++)
1117 charset
.fast_map
[i
] |= this_charset
->fast_map
[i
];
1121 error ("None of :code-offset, :map, :parents are specified");
1123 val
= args
[charset_arg_unify_map
];
1124 if (! NILP (val
) && !STRINGP (val
))
1126 ASET (attrs
, charset_unify_map
, val
);
1128 CHECK_LIST (args
[charset_arg_plist
]);
1129 ASET (attrs
, charset_plist
, args
[charset_arg_plist
]);
1131 charset
.hash_index
= hash_lookup (hash_table
, args
[charset_arg_name
],
1133 if (charset
.hash_index
>= 0)
1135 new_definition_p
= 0;
1136 id
= XFASTINT (CHARSET_SYMBOL_ID (args
[charset_arg_name
]));
1137 HASH_VALUE (hash_table
, charset
.hash_index
) = attrs
;
1141 charset
.hash_index
= hash_put (hash_table
, args
[charset_arg_name
], attrs
,
1143 if (charset_table_used
== charset_table_size
)
1145 /* Ensure that charset IDs fit into 'int' as well as into the
1146 restriction imposed by fixnums. Although the 'int' restriction
1147 could be removed, too much other code would need altering; for
1148 example, the IDs are stuffed into struct
1149 coding_system.charbuf[i] entries, which are 'int'. */
1150 int old_size
= charset_table_size
;
1151 struct charset
*new_table
=
1152 xpalloc (0, &charset_table_size
, 1,
1153 min (INT_MAX
, MOST_POSITIVE_FIXNUM
),
1154 sizeof *charset_table
);
1155 memcpy (new_table
, charset_table
, old_size
* sizeof *new_table
);
1156 charset_table
= new_table
;
1157 /* 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 Fcons (make_number (id
), Qnil
));
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 Fcons (make_number (id
), Qnil
));
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 Fcons (make_number (id
), Qnil
));
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 Fcons (make_number (id
), Qnil
));
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 int ascii_compatible
, int supplementary
,
1259 const unsigned char *code_space
= (const unsigned char *) code_space_chars
;
1260 Lisp_Object args
[charset_arg_max
];
1261 Lisp_Object plist
[14];
1265 args
[charset_arg_name
] = name
;
1266 args
[charset_arg_dimension
] = make_number (dimension
);
1267 val
= Fmake_vector (make_number (8), make_number (0));
1268 for (i
= 0; i
< 8; i
++)
1269 ASET (val
, i
, make_number (code_space
[i
]));
1270 args
[charset_arg_code_space
] = val
;
1271 args
[charset_arg_min_code
] = make_number (min_code
);
1272 args
[charset_arg_max_code
] = make_number (max_code
);
1273 args
[charset_arg_iso_final
]
1274 = (iso_final
< 0 ? Qnil
: make_number (iso_final
));
1275 args
[charset_arg_iso_revision
] = make_number (iso_revision
);
1276 args
[charset_arg_emacs_mule_id
]
1277 = (emacs_mule_id
< 0 ? Qnil
: make_number (emacs_mule_id
));
1278 args
[charset_arg_ascii_compatible_p
] = ascii_compatible
? Qt
: Qnil
;
1279 args
[charset_arg_supplementary_p
] = supplementary
? Qt
: Qnil
;
1280 args
[charset_arg_invalid_code
] = Qnil
;
1281 args
[charset_arg_code_offset
] = make_number (code_offset
);
1282 args
[charset_arg_map
] = Qnil
;
1283 args
[charset_arg_subset
] = Qnil
;
1284 args
[charset_arg_superset
] = Qnil
;
1285 args
[charset_arg_unify_map
] = Qnil
;
1287 plist
[0] = intern_c_string (":name");
1288 plist
[1] = args
[charset_arg_name
];
1289 plist
[2] = intern_c_string (":dimension");
1290 plist
[3] = args
[charset_arg_dimension
];
1291 plist
[4] = intern_c_string (":code-space");
1292 plist
[5] = args
[charset_arg_code_space
];
1293 plist
[6] = intern_c_string (":iso-final-char");
1294 plist
[7] = args
[charset_arg_iso_final
];
1295 plist
[8] = intern_c_string (":emacs-mule-id");
1296 plist
[9] = args
[charset_arg_emacs_mule_id
];
1297 plist
[10] = intern_c_string (":ascii-compatible-p");
1298 plist
[11] = args
[charset_arg_ascii_compatible_p
];
1299 plist
[12] = intern_c_string (":code-offset");
1300 plist
[13] = args
[charset_arg_code_offset
];
1302 args
[charset_arg_plist
] = Flist (14, plist
);
1303 Fdefine_charset_internal (charset_arg_max
, args
);
1305 return XINT (CHARSET_SYMBOL_ID (name
));
1309 DEFUN ("define-charset-alias", Fdefine_charset_alias
,
1310 Sdefine_charset_alias
, 2, 2, 0,
1311 doc
: /* Define ALIAS as an alias for charset CHARSET. */)
1312 (Lisp_Object alias
, Lisp_Object charset
)
1316 CHECK_CHARSET_GET_ATTR (charset
, attr
);
1317 Fputhash (alias
, attr
, Vcharset_hash_table
);
1318 Vcharset_list
= Fcons (alias
, Vcharset_list
);
1323 DEFUN ("charset-plist", Fcharset_plist
, Scharset_plist
, 1, 1, 0,
1324 doc
: /* Return the property list of CHARSET. */)
1325 (Lisp_Object charset
)
1329 CHECK_CHARSET_GET_ATTR (charset
, attrs
);
1330 return CHARSET_ATTR_PLIST (attrs
);
1334 DEFUN ("set-charset-plist", Fset_charset_plist
, Sset_charset_plist
, 2, 2, 0,
1335 doc
: /* Set CHARSET's property list to PLIST. */)
1336 (Lisp_Object charset
, Lisp_Object plist
)
1340 CHECK_CHARSET_GET_ATTR (charset
, attrs
);
1341 CHARSET_ATTR_PLIST (attrs
) = plist
;
1346 DEFUN ("unify-charset", Funify_charset
, Sunify_charset
, 1, 3, 0,
1347 doc
: /* Unify characters of CHARSET with Unicode.
1348 This means reading the relevant file and installing the table defined
1349 by CHARSET's `:unify-map' property.
1351 Optional second arg UNIFY-MAP is a file name string or a vector. It has
1352 the same meaning as the `:unify-map' attribute in the function
1353 `define-charset' (which see).
1355 Optional third argument DEUNIFY, if non-nil, means to de-unify CHARSET. */)
1356 (Lisp_Object charset
, Lisp_Object unify_map
, Lisp_Object deunify
)
1361 CHECK_CHARSET_GET_ID (charset
, id
);
1362 cs
= CHARSET_FROM_ID (id
);
1364 ? CHARSET_UNIFIED_P (cs
) && ! NILP (CHARSET_DEUNIFIER (cs
))
1365 : ! CHARSET_UNIFIED_P (cs
))
1368 CHARSET_UNIFIED_P (cs
) = 0;
1371 if (CHARSET_METHOD (cs
) != CHARSET_METHOD_OFFSET
1372 || CHARSET_CODE_OFFSET (cs
) < 0x110000)
1373 error ("Can't unify charset: %s", SDATA (SYMBOL_NAME (charset
)));
1374 if (NILP (unify_map
))
1375 unify_map
= CHARSET_UNIFY_MAP (cs
);
1378 if (! STRINGP (unify_map
) && ! VECTORP (unify_map
))
1379 signal_error ("Bad unify-map", unify_map
);
1380 CHARSET_UNIFY_MAP (cs
) = unify_map
;
1382 if (NILP (Vchar_unify_table
))
1383 Vchar_unify_table
= Fmake_char_table (Qnil
, Qnil
);
1384 char_table_set_range (Vchar_unify_table
,
1385 cs
->min_char
, cs
->max_char
, charset
);
1386 CHARSET_UNIFIED_P (cs
) = 1;
1388 else if (CHAR_TABLE_P (Vchar_unify_table
))
1390 unsigned min_code
= CHARSET_MIN_CODE (cs
);
1391 unsigned max_code
= CHARSET_MAX_CODE (cs
);
1392 int min_char
= DECODE_CHAR (cs
, min_code
);
1393 int max_char
= DECODE_CHAR (cs
, max_code
);
1395 char_table_set_range (Vchar_unify_table
, min_char
, max_char
, Qnil
);
1401 DEFUN ("get-unused-iso-final-char", Fget_unused_iso_final_char
,
1402 Sget_unused_iso_final_char
, 2, 2, 0,
1404 Return an unused ISO final char for a charset of DIMENSION and CHARS.
1405 DIMENSION is the number of bytes to represent a character: 1 or 2.
1406 CHARS is the number of characters in a dimension: 94 or 96.
1408 This final char is for private use, thus the range is `0' (48) .. `?' (63).
1409 If there's no unused final char for the specified kind of charset,
1411 (Lisp_Object dimension
, Lisp_Object chars
)
1415 CHECK_NUMBER (dimension
);
1416 CHECK_NUMBER (chars
);
1417 if (XINT (dimension
) != 1 && XINT (dimension
) != 2 && XINT (dimension
) != 3)
1418 args_out_of_range_3 (dimension
, make_number (1), make_number (3));
1419 if (XINT (chars
) != 94 && XINT (chars
) != 96)
1420 args_out_of_range_3 (chars
, make_number (94), make_number (96));
1421 for (final_char
= '0'; final_char
<= '?'; final_char
++)
1422 if (ISO_CHARSET_TABLE (XINT (dimension
), XINT (chars
), final_char
) < 0)
1424 return (final_char
<= '?' ? make_number (final_char
) : Qnil
);
1428 check_iso_charset_parameter (Lisp_Object dimension
, Lisp_Object chars
, Lisp_Object final_char
)
1430 CHECK_NATNUM (dimension
);
1431 CHECK_NATNUM (chars
);
1432 CHECK_CHARACTER (final_char
);
1434 if (XINT (dimension
) > 3)
1435 error ("Invalid DIMENSION %"pI
"d, it should be 1, 2, or 3",
1437 if (XINT (chars
) != 94 && XINT (chars
) != 96)
1438 error ("Invalid CHARS %"pI
"d, it should be 94 or 96", XINT (chars
));
1439 if (XINT (final_char
) < '0' || XINT (final_char
) > '~')
1440 error ("Invalid FINAL-CHAR %c, it should be `0'..`~'",
1441 (int)XINT (final_char
));
1445 DEFUN ("declare-equiv-charset", Fdeclare_equiv_charset
, Sdeclare_equiv_charset
,
1447 doc
: /* Declare an equivalent charset for ISO-2022 decoding.
1449 On decoding by an ISO-2022 base coding system, when a charset
1450 specified by DIMENSION, CHARS, and FINAL-CHAR is designated, behave as
1451 if CHARSET is designated instead. */)
1452 (Lisp_Object dimension
, Lisp_Object chars
, Lisp_Object final_char
, Lisp_Object charset
)
1457 CHECK_CHARSET_GET_ID (charset
, id
);
1458 check_iso_charset_parameter (dimension
, chars
, final_char
);
1459 chars_flag
= XINT (chars
) == 96;
1460 ISO_CHARSET_TABLE (XINT (dimension
), chars_flag
, XINT (final_char
)) = id
;
1465 /* Return information about charsets in the text at PTR of NBYTES
1466 bytes, which are NCHARS characters. The value is:
1468 0: Each character is represented by one byte. This is always
1469 true for a unibyte string. For a multibyte string, true if
1470 it contains only ASCII characters.
1472 1: No charsets other than ascii, control-1, and latin-1 are
1479 string_xstring_p (Lisp_Object string
)
1481 const unsigned char *p
= SDATA (string
);
1482 const unsigned char *endp
= p
+ SBYTES (string
);
1484 if (SCHARS (string
) == SBYTES (string
))
1489 int c
= STRING_CHAR_ADVANCE (p
);
1498 /* Find charsets in the string at PTR of NCHARS and NBYTES.
1500 CHARSETS is a vector. If Nth element is non-nil, it means the
1501 charset whose id is N is already found.
1503 It may lookup a translation table TABLE if supplied. */
1506 find_charsets_in_text (const unsigned char *ptr
, ptrdiff_t nchars
, ptrdiff_t nbytes
, Lisp_Object charsets
, Lisp_Object table
, int multibyte
)
1508 const unsigned char *pend
= ptr
+ nbytes
;
1510 if (nchars
== nbytes
)
1513 ASET (charsets
, charset_ascii
, Qt
);
1520 c
= translate_char (table
, c
);
1521 if (ASCII_BYTE_P (c
))
1522 ASET (charsets
, charset_ascii
, Qt
);
1524 ASET (charsets
, charset_eight_bit
, Qt
);
1531 int c
= STRING_CHAR_ADVANCE (ptr
);
1532 struct charset
*charset
;
1535 c
= translate_char (table
, c
);
1536 charset
= CHAR_CHARSET (c
);
1537 ASET (charsets
, CHARSET_ID (charset
), Qt
);
1542 DEFUN ("find-charset-region", Ffind_charset_region
, Sfind_charset_region
,
1544 doc
: /* Return a list of charsets in the region between BEG and END.
1545 BEG and END are buffer positions.
1546 Optional arg TABLE if non-nil is a translation table to look up.
1548 If the current buffer is unibyte, the returned list may contain
1549 only `ascii', `eight-bit-control', and `eight-bit-graphic'. */)
1550 (Lisp_Object beg
, Lisp_Object end
, Lisp_Object table
)
1552 Lisp_Object charsets
;
1553 ptrdiff_t from
, from_byte
, to
, stop
, stop_byte
;
1556 int multibyte
= ! NILP (BVAR (current_buffer
, enable_multibyte_characters
));
1558 validate_region (&beg
, &end
);
1559 from
= XFASTINT (beg
);
1560 stop
= to
= XFASTINT (end
);
1562 if (from
< GPT
&& GPT
< to
)
1565 stop_byte
= GPT_BYTE
;
1568 stop_byte
= CHAR_TO_BYTE (stop
);
1570 from_byte
= CHAR_TO_BYTE (from
);
1572 charsets
= Fmake_vector (make_number (charset_table_used
), Qnil
);
1575 find_charsets_in_text (BYTE_POS_ADDR (from_byte
), stop
- from
,
1576 stop_byte
- from_byte
, charsets
, table
,
1580 from
= stop
, from_byte
= stop_byte
;
1581 stop
= to
, stop_byte
= CHAR_TO_BYTE (stop
);
1588 for (i
= charset_table_used
- 1; i
>= 0; i
--)
1589 if (!NILP (AREF (charsets
, i
)))
1590 val
= Fcons (CHARSET_NAME (charset_table
+ i
), val
);
1594 DEFUN ("find-charset-string", Ffind_charset_string
, Sfind_charset_string
,
1596 doc
: /* Return a list of charsets in STR.
1597 Optional arg TABLE if non-nil is a translation table to look up.
1599 If STR is unibyte, the returned list may contain
1600 only `ascii', `eight-bit-control', and `eight-bit-graphic'. */)
1601 (Lisp_Object str
, Lisp_Object table
)
1603 Lisp_Object charsets
;
1609 charsets
= Fmake_vector (make_number (charset_table_used
), Qnil
);
1610 find_charsets_in_text (SDATA (str
), SCHARS (str
), SBYTES (str
),
1612 STRING_MULTIBYTE (str
));
1614 for (i
= charset_table_used
- 1; i
>= 0; i
--)
1615 if (!NILP (AREF (charsets
, i
)))
1616 val
= Fcons (CHARSET_NAME (charset_table
+ i
), val
);
1622 /* Return a unified character code for C (>= 0x110000). VAL is a
1623 value of Vchar_unify_table for C; i.e. it is nil, an integer, or a
1626 maybe_unify_char (int c
, Lisp_Object val
)
1628 struct charset
*charset
;
1631 return XFASTINT (val
);
1635 CHECK_CHARSET_GET_CHARSET (val
, charset
);
1636 load_charset (charset
, 1);
1637 if (! inhibit_load_charset_map
)
1639 val
= CHAR_TABLE_REF (Vchar_unify_table
, c
);
1645 int code_index
= c
- CHARSET_CODE_OFFSET (charset
);
1646 int unified
= GET_TEMP_CHARSET_WORK_DECODER (code_index
);
1655 /* Return a character correponding to the code-point CODE of
1659 decode_char (struct charset
*charset
, unsigned int code
)
1662 enum charset_method method
= CHARSET_METHOD (charset
);
1664 if (code
< CHARSET_MIN_CODE (charset
) || code
> CHARSET_MAX_CODE (charset
))
1667 if (method
== CHARSET_METHOD_SUBSET
)
1669 Lisp_Object subset_info
;
1671 subset_info
= CHARSET_SUBSET (charset
);
1672 charset
= CHARSET_FROM_ID (XFASTINT (AREF (subset_info
, 0)));
1673 code
-= XINT (AREF (subset_info
, 3));
1674 if (code
< XFASTINT (AREF (subset_info
, 1))
1675 || code
> XFASTINT (AREF (subset_info
, 2)))
1678 c
= DECODE_CHAR (charset
, code
);
1680 else if (method
== CHARSET_METHOD_SUPERSET
)
1682 Lisp_Object parents
;
1684 parents
= CHARSET_SUPERSET (charset
);
1686 for (; CONSP (parents
); parents
= XCDR (parents
))
1688 int id
= XINT (XCAR (XCAR (parents
)));
1689 int code_offset
= XINT (XCDR (XCAR (parents
)));
1690 unsigned this_code
= code
- code_offset
;
1692 charset
= CHARSET_FROM_ID (id
);
1693 if ((c
= DECODE_CHAR (charset
, this_code
)) >= 0)
1699 char_index
= CODE_POINT_TO_INDEX (charset
, code
);
1703 if (method
== CHARSET_METHOD_MAP
)
1705 Lisp_Object decoder
;
1707 decoder
= CHARSET_DECODER (charset
);
1708 if (! VECTORP (decoder
))
1710 load_charset (charset
, 1);
1711 decoder
= CHARSET_DECODER (charset
);
1713 if (VECTORP (decoder
))
1714 c
= XINT (AREF (decoder
, char_index
));
1716 c
= GET_TEMP_CHARSET_WORK_DECODER (char_index
);
1718 else /* method == CHARSET_METHOD_OFFSET */
1720 c
= char_index
+ CHARSET_CODE_OFFSET (charset
);
1721 if (CHARSET_UNIFIED_P (charset
)
1722 && c
> MAX_UNICODE_CHAR
)
1723 MAYBE_UNIFY_CHAR (c
);
1730 /* Variable used temporarily by the macro ENCODE_CHAR. */
1731 Lisp_Object charset_work
;
1733 /* Return a code-point of CHAR in CHARSET. If CHAR doesn't belong to
1734 CHARSET, return CHARSET_INVALID_CODE (CHARSET). If STRICT is true,
1735 use CHARSET's strict_max_char instead of max_char. */
1738 encode_char (struct charset
*charset
, int c
)
1741 enum charset_method method
= CHARSET_METHOD (charset
);
1743 if (CHARSET_UNIFIED_P (charset
))
1745 Lisp_Object deunifier
;
1746 int code_index
= -1;
1748 deunifier
= CHARSET_DEUNIFIER (charset
);
1749 if (! CHAR_TABLE_P (deunifier
))
1751 load_charset (charset
, 2);
1752 deunifier
= CHARSET_DEUNIFIER (charset
);
1754 if (CHAR_TABLE_P (deunifier
))
1756 Lisp_Object deunified
= CHAR_TABLE_REF (deunifier
, c
);
1758 if (INTEGERP (deunified
))
1759 code_index
= XINT (deunified
);
1763 code_index
= GET_TEMP_CHARSET_WORK_ENCODER (c
);
1765 if (code_index
>= 0)
1766 c
= CHARSET_CODE_OFFSET (charset
) + code_index
;
1769 if (method
== CHARSET_METHOD_SUBSET
)
1771 Lisp_Object subset_info
;
1772 struct charset
*this_charset
;
1774 subset_info
= CHARSET_SUBSET (charset
);
1775 this_charset
= CHARSET_FROM_ID (XFASTINT (AREF (subset_info
, 0)));
1776 code
= ENCODE_CHAR (this_charset
, c
);
1777 if (code
== CHARSET_INVALID_CODE (this_charset
)
1778 || code
< XFASTINT (AREF (subset_info
, 1))
1779 || code
> XFASTINT (AREF (subset_info
, 2)))
1780 return CHARSET_INVALID_CODE (charset
);
1781 code
+= XINT (AREF (subset_info
, 3));
1785 if (method
== CHARSET_METHOD_SUPERSET
)
1787 Lisp_Object parents
;
1789 parents
= CHARSET_SUPERSET (charset
);
1790 for (; CONSP (parents
); parents
= XCDR (parents
))
1792 int id
= XINT (XCAR (XCAR (parents
)));
1793 int code_offset
= XINT (XCDR (XCAR (parents
)));
1794 struct charset
*this_charset
= CHARSET_FROM_ID (id
);
1796 code
= ENCODE_CHAR (this_charset
, c
);
1797 if (code
!= CHARSET_INVALID_CODE (this_charset
))
1798 return code
+ code_offset
;
1800 return CHARSET_INVALID_CODE (charset
);
1803 if (! CHARSET_FAST_MAP_REF ((c
), charset
->fast_map
)
1804 || c
< CHARSET_MIN_CHAR (charset
) || c
> CHARSET_MAX_CHAR (charset
))
1805 return CHARSET_INVALID_CODE (charset
);
1807 if (method
== CHARSET_METHOD_MAP
)
1809 Lisp_Object encoder
;
1812 encoder
= CHARSET_ENCODER (charset
);
1813 if (! CHAR_TABLE_P (CHARSET_ENCODER (charset
)))
1815 load_charset (charset
, 2);
1816 encoder
= CHARSET_ENCODER (charset
);
1818 if (CHAR_TABLE_P (encoder
))
1820 val
= CHAR_TABLE_REF (encoder
, c
);
1822 return CHARSET_INVALID_CODE (charset
);
1824 if (! CHARSET_COMPACT_CODES_P (charset
))
1825 code
= INDEX_TO_CODE_POINT (charset
, code
);
1829 code
= GET_TEMP_CHARSET_WORK_ENCODER (c
);
1830 code
= INDEX_TO_CODE_POINT (charset
, code
);
1833 else /* method == CHARSET_METHOD_OFFSET */
1835 code
= c
- CHARSET_CODE_OFFSET (charset
);
1836 code
= INDEX_TO_CODE_POINT (charset
, code
);
1843 DEFUN ("decode-char", Fdecode_char
, Sdecode_char
, 2, 3, 0,
1844 doc
: /* Decode the pair of CHARSET and CODE-POINT into a character.
1845 Return nil if CODE-POINT is not valid in CHARSET.
1847 CODE-POINT may be a cons (HIGHER-16-BIT-VALUE . LOWER-16-BIT-VALUE).
1849 Optional argument RESTRICTION specifies a way to map the pair of CCS
1850 and CODE-POINT to a character. Currently not supported and just ignored. */)
1851 (Lisp_Object charset
, Lisp_Object code_point
, Lisp_Object restriction
)
1855 struct charset
*charsetp
;
1857 CHECK_CHARSET_GET_ID (charset
, id
);
1858 code
= cons_to_unsigned (code_point
, UINT_MAX
);
1859 charsetp
= CHARSET_FROM_ID (id
);
1860 c
= DECODE_CHAR (charsetp
, code
);
1861 return (c
>= 0 ? make_number (c
) : Qnil
);
1865 DEFUN ("encode-char", Fencode_char
, Sencode_char
, 2, 3, 0,
1866 doc
: /* Encode the character CH into a code-point of CHARSET.
1867 Return nil if CHARSET doesn't include CH.
1869 Optional argument RESTRICTION specifies a way to map CH to a
1870 code-point in CCS. Currently not supported and just ignored. */)
1871 (Lisp_Object ch
, Lisp_Object charset
, Lisp_Object restriction
)
1875 struct charset
*charsetp
;
1877 CHECK_CHARSET_GET_ID (charset
, id
);
1878 CHECK_CHARACTER (ch
);
1880 charsetp
= CHARSET_FROM_ID (id
);
1881 code
= ENCODE_CHAR (charsetp
, c
);
1882 if (code
== CHARSET_INVALID_CODE (charsetp
))
1884 return INTEGER_TO_CONS (code
);
1888 DEFUN ("make-char", Fmake_char
, Smake_char
, 1, 5, 0,
1890 /* Return a character of CHARSET whose position codes are CODEn.
1892 CODE1 through CODE4 are optional, but if you don't supply sufficient
1893 position codes, it is assumed that the minimum code in each dimension
1895 (Lisp_Object charset
, Lisp_Object code1
, Lisp_Object code2
, Lisp_Object code3
, Lisp_Object code4
)
1898 struct charset
*charsetp
;
1902 CHECK_CHARSET_GET_ID (charset
, id
);
1903 charsetp
= CHARSET_FROM_ID (id
);
1905 dimension
= CHARSET_DIMENSION (charsetp
);
1907 code
= (CHARSET_ASCII_COMPATIBLE_P (charsetp
)
1908 ? 0 : CHARSET_MIN_CODE (charsetp
));
1911 CHECK_NATNUM (code1
);
1912 if (XFASTINT (code1
) >= 0x100)
1913 args_out_of_range (make_number (0xFF), code1
);
1914 code
= XFASTINT (code1
);
1920 code
|= charsetp
->code_space
[(dimension
- 2) * 4];
1923 CHECK_NATNUM (code2
);
1924 if (XFASTINT (code2
) >= 0x100)
1925 args_out_of_range (make_number (0xFF), code2
);
1926 code
|= XFASTINT (code2
);
1933 code
|= charsetp
->code_space
[(dimension
- 3) * 4];
1936 CHECK_NATNUM (code3
);
1937 if (XFASTINT (code3
) >= 0x100)
1938 args_out_of_range (make_number (0xFF), code3
);
1939 code
|= XFASTINT (code3
);
1946 code
|= charsetp
->code_space
[0];
1949 CHECK_NATNUM (code4
);
1950 if (XFASTINT (code4
) >= 0x100)
1951 args_out_of_range (make_number (0xFF), code4
);
1952 code
|= XFASTINT (code4
);
1959 if (CHARSET_ISO_FINAL (charsetp
) >= 0)
1961 c
= DECODE_CHAR (charsetp
, code
);
1963 error ("Invalid code(s)");
1964 return make_number (c
);
1968 /* Return the first charset in CHARSET_LIST that contains C.
1969 CHARSET_LIST is a list of charset IDs. If it is nil, use
1970 Vcharset_ordered_list. */
1973 char_charset (int c
, Lisp_Object charset_list
, unsigned int *code_return
)
1977 if (NILP (charset_list
))
1978 charset_list
= Vcharset_ordered_list
;
1982 while (CONSP (charset_list
))
1984 struct charset
*charset
= CHARSET_FROM_ID (XINT (XCAR (charset_list
)));
1985 unsigned code
= ENCODE_CHAR (charset
, c
);
1987 if (code
!= CHARSET_INVALID_CODE (charset
))
1990 *code_return
= code
;
1993 charset_list
= XCDR (charset_list
);
1995 && c
<= MAX_UNICODE_CHAR
1996 && EQ (charset_list
, Vcharset_non_preferred_head
))
1997 return CHARSET_FROM_ID (charset_unicode
);
1999 return (maybe_null
? NULL
2000 : c
<= MAX_5_BYTE_CHAR
? CHARSET_FROM_ID (charset_emacs
)
2001 : CHARSET_FROM_ID (charset_eight_bit
));
2005 DEFUN ("split-char", Fsplit_char
, Ssplit_char
, 1, 1, 0,
2007 /*Return list of charset and one to four position-codes of CH.
2008 The charset is decided by the current priority order of charsets.
2009 A position-code is a byte value of each dimension of the code-point of
2010 CH in the charset. */)
2013 struct charset
*charset
;
2018 CHECK_CHARACTER (ch
);
2020 charset
= CHAR_CHARSET (c
);
2023 code
= ENCODE_CHAR (charset
, c
);
2024 if (code
== CHARSET_INVALID_CODE (charset
))
2026 dimension
= CHARSET_DIMENSION (charset
);
2027 for (val
= Qnil
; dimension
> 0; dimension
--)
2029 val
= Fcons (make_number (code
& 0xFF), val
);
2032 return Fcons (CHARSET_NAME (charset
), val
);
2036 DEFUN ("char-charset", Fchar_charset
, Schar_charset
, 1, 2, 0,
2037 doc
: /* Return the charset of highest priority that contains CH.
2038 If optional 2nd arg RESTRICTION is non-nil, it is a list of charsets
2039 from which to find the charset. It may also be a coding system. In
2040 that case, find the charset from what supported by that coding system. */)
2041 (Lisp_Object ch
, Lisp_Object restriction
)
2043 struct charset
*charset
;
2045 CHECK_CHARACTER (ch
);
2046 if (NILP (restriction
))
2047 charset
= CHAR_CHARSET (XINT (ch
));
2050 if (CONSP (restriction
))
2052 int c
= XFASTINT (ch
);
2054 for (; CONSP (restriction
); restriction
= XCDR (restriction
))
2056 struct charset
*rcharset
;
2058 CHECK_CHARSET_GET_CHARSET (XCAR (restriction
), rcharset
);
2059 if (ENCODE_CHAR (rcharset
, c
) != CHARSET_INVALID_CODE (rcharset
))
2060 return XCAR (restriction
);
2064 restriction
= coding_system_charset_list (restriction
);
2065 charset
= char_charset (XINT (ch
), restriction
, NULL
);
2069 return (CHARSET_NAME (charset
));
2073 DEFUN ("charset-after", Fcharset_after
, Scharset_after
, 0, 1, 0,
2075 Return charset of a character in the current buffer at position POS.
2076 If POS is nil, it defauls to the current point.
2077 If POS is out of range, the value is nil. */)
2081 struct charset
*charset
;
2083 ch
= Fchar_after (pos
);
2084 if (! INTEGERP (ch
))
2086 charset
= CHAR_CHARSET (XINT (ch
));
2087 return (CHARSET_NAME (charset
));
2091 DEFUN ("iso-charset", Fiso_charset
, Siso_charset
, 3, 3, 0,
2093 Return charset of ISO's specification DIMENSION, CHARS, and FINAL-CHAR.
2095 ISO 2022's designation sequence (escape sequence) distinguishes charsets
2096 by their DIMENSION, CHARS, and FINAL-CHAR,
2097 whereas Emacs distinguishes them by charset symbol.
2098 See the documentation of the function `charset-info' for the meanings of
2099 DIMENSION, CHARS, and FINAL-CHAR. */)
2100 (Lisp_Object dimension
, Lisp_Object chars
, Lisp_Object final_char
)
2105 check_iso_charset_parameter (dimension
, chars
, final_char
);
2106 chars_flag
= XFASTINT (chars
) == 96;
2107 id
= ISO_CHARSET_TABLE (XFASTINT (dimension
), chars_flag
,
2108 XFASTINT (final_char
));
2109 return (id
>= 0 ? CHARSET_NAME (CHARSET_FROM_ID (id
)) : Qnil
);
2113 DEFUN ("clear-charset-maps", Fclear_charset_maps
, Sclear_charset_maps
,
2117 Clear temporary charset mapping tables.
2118 It should be called only from temacs invoked for dumping. */)
2121 if (temp_charset_work
)
2123 xfree (temp_charset_work
);
2124 temp_charset_work
= NULL
;
2127 if (CHAR_TABLE_P (Vchar_unify_table
))
2128 Foptimize_char_table (Vchar_unify_table
, Qnil
);
2133 DEFUN ("charset-priority-list", Fcharset_priority_list
,
2134 Scharset_priority_list
, 0, 1, 0,
2135 doc
: /* Return the list of charsets ordered by priority.
2136 HIGHESTP non-nil means just return the highest priority one. */)
2137 (Lisp_Object highestp
)
2139 Lisp_Object val
= Qnil
, list
= Vcharset_ordered_list
;
2141 if (!NILP (highestp
))
2142 return CHARSET_NAME (CHARSET_FROM_ID (XINT (Fcar (list
))));
2144 while (!NILP (list
))
2146 val
= Fcons (CHARSET_NAME (CHARSET_FROM_ID (XINT (XCAR (list
)))), val
);
2149 return Fnreverse (val
);
2152 DEFUN ("set-charset-priority", Fset_charset_priority
, Sset_charset_priority
,
2154 doc
: /* Assign higher priority to the charsets given as arguments.
2155 usage: (set-charset-priority &rest charsets) */)
2156 (ptrdiff_t nargs
, Lisp_Object
*args
)
2158 Lisp_Object new_head
, old_list
, arglist
[2];
2159 Lisp_Object list_2022
, list_emacs_mule
;
2163 old_list
= Fcopy_sequence (Vcharset_ordered_list
);
2165 for (i
= 0; i
< nargs
; i
++)
2167 CHECK_CHARSET_GET_ID (args
[i
], id
);
2168 if (! NILP (Fmemq (make_number (id
), old_list
)))
2170 old_list
= Fdelq (make_number (id
), old_list
);
2171 new_head
= Fcons (make_number (id
), new_head
);
2174 arglist
[0] = Fnreverse (new_head
);
2175 arglist
[1] = Vcharset_non_preferred_head
= old_list
;
2176 Vcharset_ordered_list
= Fnconc (2, arglist
);
2177 charset_ordered_list_tick
++;
2179 charset_unibyte
= -1;
2180 for (old_list
= Vcharset_ordered_list
, list_2022
= list_emacs_mule
= Qnil
;
2181 CONSP (old_list
); old_list
= XCDR (old_list
))
2183 if (! NILP (Fmemq (XCAR (old_list
), Viso_2022_charset_list
)))
2184 list_2022
= Fcons (XCAR (old_list
), list_2022
);
2185 if (! NILP (Fmemq (XCAR (old_list
), Vemacs_mule_charset_list
)))
2186 list_emacs_mule
= Fcons (XCAR (old_list
), list_emacs_mule
);
2187 if (charset_unibyte
< 0)
2189 struct charset
*charset
= CHARSET_FROM_ID (XINT (XCAR (old_list
)));
2191 if (CHARSET_DIMENSION (charset
) == 1
2192 && CHARSET_ASCII_COMPATIBLE_P (charset
)
2193 && CHARSET_MAX_CHAR (charset
) >= 0x80)
2194 charset_unibyte
= CHARSET_ID (charset
);
2197 Viso_2022_charset_list
= Fnreverse (list_2022
);
2198 Vemacs_mule_charset_list
= Fnreverse (list_emacs_mule
);
2199 if (charset_unibyte
< 0)
2200 charset_unibyte
= charset_iso_8859_1
;
2205 DEFUN ("charset-id-internal", Fcharset_id_internal
, Scharset_id_internal
,
2207 doc
: /* Internal use only.
2208 Return charset identification number of CHARSET. */)
2209 (Lisp_Object charset
)
2213 CHECK_CHARSET_GET_ID (charset
, id
);
2214 return make_number (id
);
2217 struct charset_sort_data
2219 Lisp_Object charset
;
2225 charset_compare (const void *d1
, const void *d2
)
2227 const struct charset_sort_data
*data1
= d1
, *data2
= d2
;
2228 if (data1
->priority
!= data2
->priority
)
2229 return data1
->priority
< data2
->priority
? -1 : 1;
2233 DEFUN ("sort-charsets", Fsort_charsets
, Ssort_charsets
, 1, 1, 0,
2234 doc
: /* Sort charset list CHARSETS by a priority of each charset.
2235 Return the sorted list. CHARSETS is modified by side effects.
2236 See also `charset-priority-list' and `set-charset-priority'. */)
2237 (Lisp_Object charsets
)
2239 Lisp_Object len
= Flength (charsets
);
2240 ptrdiff_t n
= XFASTINT (len
), i
, j
;
2242 Lisp_Object tail
, elt
, attrs
;
2243 struct charset_sort_data
*sort_data
;
2244 int id
, min_id
= INT_MAX
, max_id
= INT_MIN
;
2249 SAFE_NALLOCA (sort_data
, 1, n
);
2250 for (tail
= charsets
, i
= 0; CONSP (tail
); tail
= XCDR (tail
), i
++)
2253 CHECK_CHARSET_GET_ATTR (elt
, attrs
);
2254 sort_data
[i
].charset
= elt
;
2255 sort_data
[i
].id
= id
= XINT (CHARSET_ATTR_ID (attrs
));
2261 for (done
= 0, tail
= Vcharset_ordered_list
, i
= 0;
2262 done
< n
&& CONSP (tail
); tail
= XCDR (tail
), i
++)
2265 id
= XFASTINT (elt
);
2266 if (id
>= min_id
&& id
<= max_id
)
2267 for (j
= 0; j
< n
; j
++)
2268 if (sort_data
[j
].id
== id
)
2270 sort_data
[j
].priority
= i
;
2274 qsort (sort_data
, n
, sizeof *sort_data
, charset_compare
);
2275 for (i
= 0, tail
= charsets
; CONSP (tail
); tail
= XCDR (tail
), i
++)
2276 XSETCAR (tail
, sort_data
[i
].charset
);
2285 Lisp_Object tempdir
;
2286 tempdir
= Fexpand_file_name (build_string ("charsets"), Vdata_directory
);
2287 if (access (SSDATA (tempdir
), 0) < 0)
2289 dir_warning ("Error: charsets directory (%s) does not exist.\n\
2290 Emacs will not function correctly without the character map files.\n\
2291 Please check your installation!\n",
2293 /* TODO should this be a fatal error? (Bug#909) */
2296 Vcharset_map_path
= Fcons (tempdir
, Qnil
);
2301 init_charset_once (void)
2305 for (i
= 0; i
< ISO_MAX_DIMENSION
; i
++)
2306 for (j
= 0; j
< ISO_MAX_CHARS
; j
++)
2307 for (k
= 0; k
< ISO_MAX_FINAL
; k
++)
2308 iso_charset_table
[i
][j
][k
] = -1;
2310 for (i
= 0; i
< 256; i
++)
2311 emacs_mule_charset
[i
] = -1;
2313 charset_jisx0201_roman
= -1;
2314 charset_jisx0208_1978
= -1;
2315 charset_jisx0208
= -1;
2316 charset_ksc5601
= -1;
2321 /* Allocate an initial charset table that is large enough to handle
2322 Emacs while it is bootstrapping. As of September 2011, the size
2323 needs to be at least 166; make it a bit bigger to allow for future
2326 Don't make the value so small that the table is reallocated during
2327 bootstrapping, as glibc malloc calls larger than just under 64 KiB
2328 during an initial bootstrap wreak havoc after dumping; see the
2329 M_MMAP_THRESHOLD value in alloc.c, plus there is a extra overhead
2330 internal to glibc malloc and perhaps to Emacs malloc debugging. */
2331 static struct charset charset_table_init
[180];
2334 syms_of_charset (void)
2336 DEFSYM (Qcharsetp
, "charsetp");
2338 DEFSYM (Qascii
, "ascii");
2339 DEFSYM (Qunicode
, "unicode");
2340 DEFSYM (Qemacs
, "emacs");
2341 DEFSYM (Qeight_bit
, "eight-bit");
2342 DEFSYM (Qiso_8859_1
, "iso-8859-1");
2347 staticpro (&Vcharset_ordered_list
);
2348 Vcharset_ordered_list
= Qnil
;
2350 staticpro (&Viso_2022_charset_list
);
2351 Viso_2022_charset_list
= Qnil
;
2353 staticpro (&Vemacs_mule_charset_list
);
2354 Vemacs_mule_charset_list
= Qnil
;
2356 /* Don't staticpro them here. It's done in syms_of_fns. */
2357 QCtest
= intern_c_string (":test");
2358 Qeq
= intern_c_string ("eq");
2360 staticpro (&Vcharset_hash_table
);
2362 Lisp_Object args
[2];
2365 Vcharset_hash_table
= Fmake_hash_table (2, args
);
2368 charset_table
= charset_table_init
;
2369 charset_table_size
= sizeof charset_table_init
/ sizeof *charset_table_init
;
2370 charset_table_used
= 0;
2372 defsubr (&Scharsetp
);
2373 defsubr (&Smap_charset_chars
);
2374 defsubr (&Sdefine_charset_internal
);
2375 defsubr (&Sdefine_charset_alias
);
2376 defsubr (&Scharset_plist
);
2377 defsubr (&Sset_charset_plist
);
2378 defsubr (&Sunify_charset
);
2379 defsubr (&Sget_unused_iso_final_char
);
2380 defsubr (&Sdeclare_equiv_charset
);
2381 defsubr (&Sfind_charset_region
);
2382 defsubr (&Sfind_charset_string
);
2383 defsubr (&Sdecode_char
);
2384 defsubr (&Sencode_char
);
2385 defsubr (&Ssplit_char
);
2386 defsubr (&Smake_char
);
2387 defsubr (&Schar_charset
);
2388 defsubr (&Scharset_after
);
2389 defsubr (&Siso_charset
);
2390 defsubr (&Sclear_charset_maps
);
2391 defsubr (&Scharset_priority_list
);
2392 defsubr (&Sset_charset_priority
);
2393 defsubr (&Scharset_id_internal
);
2394 defsubr (&Ssort_charsets
);
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\x00\x00\x00\x00",
2416 0, 127, 'B', -1, 0, 1, 0, 0);
2418 = define_charset_internal (Qiso_8859_1
, 1, "\x00\xFF\x00\x00\x00\x00",
2419 0, 255, -1, -1, -1, 1, 0, 0);
2421 = define_charset_internal (Qunicode
, 3, "\x00\xFF\x00\xFF\x00\x10",
2422 0, MAX_UNICODE_CHAR
, -1, 0, -1, 1, 0, 0);
2424 = define_charset_internal (Qemacs
, 3, "\x00\xFF\x00\xFF\x00\x3F",
2425 0, MAX_5_BYTE_CHAR
, -1, 0, -1, 1, 1, 0);
2427 = define_charset_internal (Qeight_bit
, 1, "\x80\xFF\x00\x00\x00\x00",
2428 128, 255, -1, 0, -1, 0, 1,
2429 MAX_5_BYTE_CHAR
+ 1);
2430 charset_unibyte
= charset_iso_8859_1
;