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 int charset_table_size
;
65 static int charset_table_used
;
67 Lisp_Object Qcharsetp
;
69 /* Special charset symbols. */
71 Lisp_Object Qeight_bit
;
72 Lisp_Object Qiso_8859_1
;
76 /* The corresponding charsets. */
78 int charset_eight_bit
;
79 int charset_iso_8859_1
;
83 /* The other special charsets. */
84 int charset_jisx0201_roman
;
85 int charset_jisx0208_1978
;
89 /* Value of charset attribute `charset-iso-plane'. */
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 ? (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 ? (((((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 /* Convert the character index IDX to code-point CODE for CHARSET.
138 It is assumed that IDX is in a valid range. */
140 #define INDEX_TO_CODE_POINT(charset, idx) \
141 ((charset)->code_linear_p \
142 ? (idx) + (charset)->min_code \
143 : (idx += (charset)->char_index_offset, \
144 (((charset)->code_space[0] + (idx) % (charset)->code_space[2]) \
145 | (((charset)->code_space[4] \
146 + ((idx) / (charset)->code_space[3] % (charset)->code_space[6])) \
148 | (((charset)->code_space[8] \
149 + ((idx) / (charset)->code_space[7] % (charset)->code_space[10])) \
151 | (((charset)->code_space[12] + ((idx) / (charset)->code_space[11])) \
154 /* Structure to hold mapping tables for a charset. Used by temacs
155 invoked for dumping. */
159 /* The current charset for which the following tables are setup. */
160 struct charset
*current
;
162 /* 1 iff the following table is used for encoder. */
165 /* When the following table is used for encoding, mininum and
166 maxinum character of the current charset. */
167 int min_char
, max_char
;
169 /* A Unicode character correspoinding to the code indice 0 (i.e. the
170 minimum code-point) of the current charset, or -1 if the code
171 indice 0 is not a Unicode character. This is checked when
172 table.encoder[CHAR] is zero. */
176 /* Table mapping code-indices (not code-points) of the current
177 charset to Unicode characters. If decoder[CHAR] is -1, CHAR
178 doesn't belong to the current charset. */
179 int decoder
[0x10000];
180 /* Table mapping Unicode characters to code-indices of the current
181 charset. The first 0x10000 elements are for BMP (0..0xFFFF),
182 and the last 0x10000 are for SMP (0x10000..0x1FFFF) or SIP
183 (0x20000..0x2FFFF). Note that there is no charset map that
184 uses both SMP and SIP. */
185 unsigned short encoder
[0x20000];
187 } *temp_charset_work
;
189 #define SET_TEMP_CHARSET_WORK_ENCODER(C, CODE) \
192 temp_charset_work->zero_index_char = (C); \
193 else if ((C) < 0x20000) \
194 temp_charset_work->table.encoder[(C)] = (CODE); \
196 temp_charset_work->table.encoder[(C) - 0x10000] = (CODE); \
199 #define GET_TEMP_CHARSET_WORK_ENCODER(C) \
200 ((C) == temp_charset_work->zero_index_char ? 0 \
201 : (C) < 0x20000 ? (temp_charset_work->table.encoder[(C)] \
202 ? (int) temp_charset_work->table.encoder[(C)] : -1) \
203 : temp_charset_work->table.encoder[(C) - 0x10000] \
204 ? temp_charset_work->table.encoder[(C) - 0x10000] : -1)
206 #define SET_TEMP_CHARSET_WORK_DECODER(C, CODE) \
207 (temp_charset_work->table.decoder[(CODE)] = (C))
209 #define GET_TEMP_CHARSET_WORK_DECODER(CODE) \
210 (temp_charset_work->table.decoder[(CODE)])
213 /* Set to 1 to warn that a charset map is loaded and thus a buffer
214 text and a string data may be relocated. */
215 int charset_map_loaded
;
217 struct charset_map_entries
223 struct charset_map_entries
*next
;
226 /* Load the mapping information of CHARSET from ENTRIES for
227 initializing (CONTROL_FLAG == 0), decoding (CONTROL_FLAG == 1), and
228 encoding (CONTROL_FLAG == 2).
230 If CONTROL_FLAG is 0, setup CHARSET->min_char, CHARSET->max_char,
231 and CHARSET->fast_map.
233 If CONTROL_FLAG is 1, setup the following tables according to
234 CHARSET->method and inhibit_load_charset_map.
236 CHARSET->method | inhibit_lcm == 0 | inhibit_lcm == 1
237 ----------------------+--------------------+---------------------------
238 CHARSET_METHOD_MAP | CHARSET->decoder | temp_charset_work->decoder
239 ----------------------+--------------------+---------------------------
240 CHARSET_METHOD_OFFSET | Vchar_unify_table | temp_charset_work->decoder
242 If CONTROL_FLAG is 2, setup the following tables.
244 CHARSET->method | inhibit_lcm == 0 | inhibit_lcm == 1
245 ----------------------+--------------------+---------------------------
246 CHARSET_METHOD_MAP | CHARSET->encoder | temp_charset_work->encoder
247 ----------------------+--------------------+--------------------------
248 CHARSET_METHOD_OFFSET | CHARSET->deunifier | temp_charset_work->encoder
252 load_charset_map (struct charset
*charset
, struct charset_map_entries
*entries
, int n_entries
, int control_flag
)
254 Lisp_Object vec
IF_LINT (= Qnil
), table
IF_LINT (= Qnil
);
255 unsigned max_code
= CHARSET_MAX_CODE (charset
);
256 int ascii_compatible_p
= charset
->ascii_compatible_p
;
257 int min_char
, max_char
, nonascii_min_char
;
259 unsigned char *fast_map
= charset
->fast_map
;
266 if (! inhibit_load_charset_map
)
268 if (control_flag
== 1)
270 if (charset
->method
== CHARSET_METHOD_MAP
)
272 int n
= CODE_POINT_TO_INDEX (charset
, max_code
) + 1;
274 vec
= CHARSET_DECODER (charset
)
275 = Fmake_vector (make_number (n
), make_number (-1));
279 char_table_set_range (Vchar_unify_table
,
280 charset
->min_char
, charset
->max_char
,
286 table
= Fmake_char_table (Qnil
, Qnil
);
287 if (charset
->method
== CHARSET_METHOD_MAP
)
288 CHARSET_ENCODER (charset
) = table
;
290 CHARSET_DEUNIFIER (charset
) = table
;
295 if (! temp_charset_work
)
296 temp_charset_work
= xmalloc (sizeof (*temp_charset_work
));
297 if (control_flag
== 1)
299 memset (temp_charset_work
->table
.decoder
, -1,
300 sizeof (int) * 0x10000);
304 memset (temp_charset_work
->table
.encoder
, 0,
305 sizeof (unsigned short) * 0x20000);
306 temp_charset_work
->zero_index_char
= -1;
308 temp_charset_work
->current
= charset
;
309 temp_charset_work
->for_encoder
= (control_flag
== 2);
312 charset_map_loaded
= 1;
315 min_char
= max_char
= entries
->entry
[0].c
;
316 nonascii_min_char
= MAX_CHAR
;
317 for (i
= 0; i
< n_entries
; i
++)
320 int from_index
, to_index
;
322 int idx
= i
% 0x10000;
324 if (i
> 0 && idx
== 0)
325 entries
= entries
->next
;
326 from
= entries
->entry
[idx
].from
;
327 to
= entries
->entry
[idx
].to
;
328 from_c
= entries
->entry
[idx
].c
;
329 from_index
= CODE_POINT_TO_INDEX (charset
, from
);
332 to_index
= from_index
;
337 to_index
= CODE_POINT_TO_INDEX (charset
, to
);
338 to_c
= from_c
+ (to_index
- from_index
);
340 if (from_index
< 0 || to_index
< 0)
345 else if (from_c
< min_char
)
348 if (control_flag
== 1)
350 if (charset
->method
== CHARSET_METHOD_MAP
)
351 for (; from_index
<= to_index
; from_index
++, from_c
++)
352 ASET (vec
, from_index
, make_number (from_c
));
354 for (; from_index
<= to_index
; from_index
++, from_c
++)
355 CHAR_TABLE_SET (Vchar_unify_table
,
356 CHARSET_CODE_OFFSET (charset
) + from_index
,
357 make_number (from_c
));
359 else if (control_flag
== 2)
361 if (charset
->method
== CHARSET_METHOD_MAP
362 && CHARSET_COMPACT_CODES_P (charset
))
363 for (; from_index
<= to_index
; from_index
++, from_c
++)
365 unsigned code
= INDEX_TO_CODE_POINT (charset
, from_index
);
367 if (NILP (CHAR_TABLE_REF (table
, from_c
)))
368 CHAR_TABLE_SET (table
, from_c
, make_number (code
));
371 for (; from_index
<= to_index
; from_index
++, from_c
++)
373 if (NILP (CHAR_TABLE_REF (table
, from_c
)))
374 CHAR_TABLE_SET (table
, from_c
, make_number (from_index
));
377 else if (control_flag
== 3)
378 for (; from_index
<= to_index
; from_index
++, from_c
++)
379 SET_TEMP_CHARSET_WORK_DECODER (from_c
, from_index
);
380 else if (control_flag
== 4)
381 for (; from_index
<= to_index
; from_index
++, from_c
++)
382 SET_TEMP_CHARSET_WORK_ENCODER (from_c
, from_index
);
383 else /* control_flag == 0 */
385 if (ascii_compatible_p
)
387 if (! ASCII_BYTE_P (from_c
))
389 if (from_c
< nonascii_min_char
)
390 nonascii_min_char
= from_c
;
392 else if (! ASCII_BYTE_P (to_c
))
394 nonascii_min_char
= 0x80;
398 for (; from_c
<= to_c
; from_c
++)
399 CHARSET_FAST_MAP_SET (from_c
, fast_map
);
403 if (control_flag
== 0)
405 CHARSET_MIN_CHAR (charset
) = (ascii_compatible_p
406 ? nonascii_min_char
: min_char
);
407 CHARSET_MAX_CHAR (charset
) = max_char
;
409 else if (control_flag
== 4)
411 temp_charset_work
->min_char
= min_char
;
412 temp_charset_work
->max_char
= max_char
;
417 /* Read a hexadecimal number (preceded by "0x") from the file FP while
418 paying attention to comment character '#'. */
420 static INLINE
unsigned
421 read_hex (FILE *fp
, int *eof
)
426 while ((c
= getc (fp
)) != EOF
)
430 while ((c
= getc (fp
)) != EOF
&& c
!= '\n');
434 if ((c
= getc (fp
)) == EOF
|| c
== 'x')
446 while ((c
= getc (fp
)) != EOF
&& isxdigit (c
))
448 | (c
<= '9' ? c
- '0' : c
<= 'F' ? c
- 'A' + 10 : c
- 'a' + 10));
450 while ((c
= getc (fp
)) != EOF
&& isdigit (c
))
451 n
= (n
* 10) + c
- '0';
457 /* Return a mapping vector for CHARSET loaded from MAPFILE.
458 Each line of MAPFILE has this form
460 where 0xAAAA is a code-point and 0xCCCC is the corresponding
461 character code, or this form
463 where 0xAAAA and 0xBBBB are code-points specifying a range, and
464 0xCCCC is the first character code of the range.
466 The returned vector has this form:
467 [ CODE1 CHAR1 CODE2 CHAR2 .... ]
468 where CODE1 is a code-point or a cons of code-points specifying a
471 Note that this function uses `openp' to open MAPFILE but ignores
472 `file-name-handler-alist' to avoid running any Lisp code. */
475 load_charset_map_from_file (struct charset
*charset
, Lisp_Object mapfile
, int control_flag
)
477 unsigned min_code
= CHARSET_MIN_CODE (charset
);
478 unsigned max_code
= CHARSET_MAX_CODE (charset
);
482 Lisp_Object suffixes
;
483 struct charset_map_entries
*head
, *entries
;
484 int n_entries
, count
;
487 suffixes
= Fcons (build_string (".map"),
488 Fcons (build_string (".TXT"), Qnil
));
490 count
= SPECPDL_INDEX ();
491 specbind (Qfile_name_handler_alist
, Qnil
);
492 fd
= openp (Vcharset_map_path
, mapfile
, suffixes
, NULL
, Qnil
);
493 unbind_to (count
, Qnil
);
495 || ! (fp
= fdopen (fd
, "r")))
496 error ("Failure in loading charset map: %s", SDATA (mapfile
));
498 /* Use SAFE_ALLOCA instead of alloca, as `charset_map_entries' is
499 large (larger than MAX_ALLOCA). */
500 SAFE_ALLOCA (head
, struct charset_map_entries
*,
501 sizeof (struct charset_map_entries
));
503 memset (entries
, 0, sizeof (struct charset_map_entries
));
513 from
= read_hex (fp
, &eof
);
516 if (getc (fp
) == '-')
517 to
= read_hex (fp
, &eof
);
520 c
= (int) read_hex (fp
, &eof
);
522 if (from
< min_code
|| to
> max_code
|| from
> to
|| c
> MAX_CHAR
)
525 if (n_entries
> 0 && (n_entries
% 0x10000) == 0)
527 SAFE_ALLOCA (entries
->next
, struct charset_map_entries
*,
528 sizeof (struct charset_map_entries
));
529 entries
= entries
->next
;
530 memset (entries
, 0, sizeof (struct charset_map_entries
));
532 idx
= n_entries
% 0x10000;
533 entries
->entry
[idx
].from
= from
;
534 entries
->entry
[idx
].to
= to
;
535 entries
->entry
[idx
].c
= c
;
540 load_charset_map (charset
, head
, n_entries
, control_flag
);
545 load_charset_map_from_vector (struct charset
*charset
, Lisp_Object vec
, int control_flag
)
547 unsigned min_code
= CHARSET_MIN_CODE (charset
);
548 unsigned max_code
= CHARSET_MAX_CODE (charset
);
549 struct charset_map_entries
*head
, *entries
;
551 int len
= ASIZE (vec
);
557 add_to_log ("Failure in loading charset map: %V", vec
, Qnil
);
561 /* Use SAFE_ALLOCA instead of alloca, as `charset_map_entries' is
562 large (larger than MAX_ALLOCA). */
563 SAFE_ALLOCA (head
, struct charset_map_entries
*,
564 sizeof (struct charset_map_entries
));
566 memset (entries
, 0, sizeof (struct charset_map_entries
));
569 for (i
= 0; i
< len
; i
+= 2)
571 Lisp_Object val
, val2
;
583 from
= XFASTINT (val
);
584 to
= XFASTINT (val2
);
589 from
= to
= XFASTINT (val
);
591 val
= AREF (vec
, i
+ 1);
595 if (from
< min_code
|| to
> max_code
|| from
> to
|| c
> MAX_CHAR
)
598 if (n_entries
> 0 && (n_entries
% 0x10000) == 0)
600 SAFE_ALLOCA (entries
->next
, struct charset_map_entries
*,
601 sizeof (struct charset_map_entries
));
602 entries
= entries
->next
;
603 memset (entries
, 0, sizeof (struct charset_map_entries
));
605 idx
= n_entries
% 0x10000;
606 entries
->entry
[idx
].from
= from
;
607 entries
->entry
[idx
].to
= to
;
608 entries
->entry
[idx
].c
= c
;
612 load_charset_map (charset
, head
, n_entries
, control_flag
);
617 /* Load a mapping table for CHARSET. CONTROL-FLAG tells what kind of
618 map it is (see the comment of load_charset_map for the detail). */
621 load_charset (struct charset
*charset
, int control_flag
)
625 if (inhibit_load_charset_map
627 && charset
== temp_charset_work
->current
628 && ((control_flag
== 2) == temp_charset_work
->for_encoder
))
631 if (CHARSET_METHOD (charset
) == CHARSET_METHOD_MAP
)
632 map
= CHARSET_MAP (charset
);
635 if (! CHARSET_UNIFIED_P (charset
))
637 map
= CHARSET_UNIFY_MAP (charset
);
640 load_charset_map_from_file (charset
, map
, control_flag
);
642 load_charset_map_from_vector (charset
, map
, control_flag
);
646 DEFUN ("charsetp", Fcharsetp
, Scharsetp
, 1, 1, 0,
647 doc
: /* Return non-nil if and only if OBJECT is a charset.*/)
650 return (CHARSETP (object
) ? Qt
: Qnil
);
654 void map_charset_for_dump (void (*c_function
) (Lisp_Object
, Lisp_Object
),
655 Lisp_Object function
, Lisp_Object arg
,
656 unsigned from
, unsigned to
);
659 map_charset_for_dump (void (*c_function
) (Lisp_Object
, Lisp_Object
), Lisp_Object function
, Lisp_Object arg
, unsigned int from
, unsigned int to
)
661 int from_idx
= CODE_POINT_TO_INDEX (temp_charset_work
->current
, from
);
662 int to_idx
= CODE_POINT_TO_INDEX (temp_charset_work
->current
, to
);
667 range
= Fcons (Qnil
, Qnil
);
670 c
= temp_charset_work
->min_char
;
671 stop
= (temp_charset_work
->max_char
< 0x20000
672 ? temp_charset_work
->max_char
: 0xFFFF);
676 int idx
= GET_TEMP_CHARSET_WORK_ENCODER (c
);
678 if (idx
>= from_idx
&& idx
<= to_idx
)
680 if (NILP (XCAR (range
)))
681 XSETCAR (range
, make_number (c
));
683 else if (! NILP (XCAR (range
)))
685 XSETCDR (range
, make_number (c
- 1));
687 (*c_function
) (arg
, range
);
689 call2 (function
, range
, arg
);
690 XSETCAR (range
, Qnil
);
694 if (c
== temp_charset_work
->max_char
)
696 if (! NILP (XCAR (range
)))
698 XSETCDR (range
, make_number (c
));
700 (*c_function
) (arg
, range
);
702 call2 (function
, range
, arg
);
707 stop
= temp_charset_work
->max_char
;
715 map_charset_chars (void (*c_function
)(Lisp_Object
, Lisp_Object
), Lisp_Object function
,
716 Lisp_Object arg
, struct charset
*charset
, unsigned from
, unsigned to
)
721 partial
= (from
> CHARSET_MIN_CODE (charset
)
722 || to
< CHARSET_MAX_CODE (charset
));
724 if (CHARSET_METHOD (charset
) == CHARSET_METHOD_OFFSET
)
726 int from_idx
= CODE_POINT_TO_INDEX (charset
, from
);
727 int to_idx
= CODE_POINT_TO_INDEX (charset
, to
);
728 int from_c
= from_idx
+ CHARSET_CODE_OFFSET (charset
);
729 int to_c
= to_idx
+ CHARSET_CODE_OFFSET (charset
);
731 if (CHARSET_UNIFIED_P (charset
))
733 if (! CHAR_TABLE_P (CHARSET_DEUNIFIER (charset
)))
734 load_charset (charset
, 2);
735 if (CHAR_TABLE_P (CHARSET_DEUNIFIER (charset
)))
736 map_char_table_for_charset (c_function
, function
,
737 CHARSET_DEUNIFIER (charset
), arg
,
738 partial
? charset
: NULL
, from
, to
);
740 map_charset_for_dump (c_function
, function
, arg
, from
, to
);
743 range
= Fcons (make_number (from_c
), make_number (to_c
));
745 (*c_function
) (arg
, range
);
747 call2 (function
, range
, arg
);
749 else if (CHARSET_METHOD (charset
) == CHARSET_METHOD_MAP
)
751 if (! CHAR_TABLE_P (CHARSET_ENCODER (charset
)))
752 load_charset (charset
, 2);
753 if (CHAR_TABLE_P (CHARSET_ENCODER (charset
)))
754 map_char_table_for_charset (c_function
, function
,
755 CHARSET_ENCODER (charset
), arg
,
756 partial
? charset
: NULL
, from
, to
);
758 map_charset_for_dump (c_function
, function
, arg
, from
, to
);
760 else if (CHARSET_METHOD (charset
) == CHARSET_METHOD_SUBSET
)
762 Lisp_Object subset_info
;
765 subset_info
= CHARSET_SUBSET (charset
);
766 charset
= CHARSET_FROM_ID (XFASTINT (AREF (subset_info
, 0)));
767 offset
= XINT (AREF (subset_info
, 3));
769 if (from
< XFASTINT (AREF (subset_info
, 1)))
770 from
= XFASTINT (AREF (subset_info
, 1));
772 if (to
> XFASTINT (AREF (subset_info
, 2)))
773 to
= XFASTINT (AREF (subset_info
, 2));
774 map_charset_chars (c_function
, function
, arg
, charset
, from
, to
);
776 else /* i.e. CHARSET_METHOD_SUPERSET */
780 for (parents
= CHARSET_SUPERSET (charset
); CONSP (parents
);
781 parents
= XCDR (parents
))
784 unsigned this_from
, this_to
;
786 charset
= CHARSET_FROM_ID (XFASTINT (XCAR (XCAR (parents
))));
787 offset
= XINT (XCDR (XCAR (parents
)));
788 this_from
= from
> offset
? from
- offset
: 0;
789 this_to
= to
> offset
? to
- offset
: 0;
790 if (this_from
< CHARSET_MIN_CODE (charset
))
791 this_from
= CHARSET_MIN_CODE (charset
);
792 if (this_to
> CHARSET_MAX_CODE (charset
))
793 this_to
= CHARSET_MAX_CODE (charset
);
794 map_charset_chars (c_function
, function
, arg
, charset
,
800 DEFUN ("map-charset-chars", Fmap_charset_chars
, Smap_charset_chars
, 2, 5, 0,
801 doc
: /* Call FUNCTION for all characters in CHARSET.
802 FUNCTION is called with an argument RANGE and the optional 3rd
805 RANGE is a cons (FROM . TO), where FROM and TO indicate a range of
806 characters contained in CHARSET.
808 The optional 4th and 5th arguments FROM-CODE and TO-CODE specify the
809 range of code points (in CHARSET) of target characters. */)
810 (Lisp_Object function
, Lisp_Object charset
, Lisp_Object arg
, Lisp_Object from_code
, Lisp_Object to_code
)
815 CHECK_CHARSET_GET_CHARSET (charset
, cs
);
816 if (NILP (from_code
))
817 from
= CHARSET_MIN_CODE (cs
);
820 CHECK_NATNUM (from_code
);
821 from
= XINT (from_code
);
822 if (from
< CHARSET_MIN_CODE (cs
))
823 from
= CHARSET_MIN_CODE (cs
);
826 to
= CHARSET_MAX_CODE (cs
);
829 CHECK_NATNUM (to_code
);
831 if (to
> CHARSET_MAX_CODE (cs
))
832 to
= CHARSET_MAX_CODE (cs
);
834 map_charset_chars (NULL
, function
, arg
, cs
, from
, to
);
839 /* Define a charset according to the arguments. The Nth argument is
840 the Nth attribute of the charset (the last attribute `charset-id'
841 is not included). See the docstring of `define-charset' for the
844 DEFUN ("define-charset-internal", Fdefine_charset_internal
,
845 Sdefine_charset_internal
, charset_arg_max
, MANY
, 0,
846 doc
: /* For internal use only.
847 usage: (define-charset-internal ...) */)
848 (size_t nargs
, Lisp_Object
*args
)
850 /* Charset attr vector. */
854 struct Lisp_Hash_Table
*hash_table
= XHASH_TABLE (Vcharset_hash_table
);
856 struct charset charset
;
859 int new_definition_p
;
862 if (nargs
!= charset_arg_max
)
863 return Fsignal (Qwrong_number_of_arguments
,
864 Fcons (intern ("define-charset-internal"),
865 make_number (nargs
)));
867 attrs
= Fmake_vector (make_number (charset_attr_max
), Qnil
);
869 CHECK_SYMBOL (args
[charset_arg_name
]);
870 ASET (attrs
, charset_name
, args
[charset_arg_name
]);
872 val
= args
[charset_arg_code_space
];
873 for (i
= 0, dimension
= 0, nchars
= 1; i
< 4; i
++)
875 int min_byte
, max_byte
;
877 min_byte
= XINT (Faref (val
, make_number (i
* 2)));
878 max_byte
= XINT (Faref (val
, make_number (i
* 2 + 1)));
879 if (min_byte
< 0 || min_byte
> max_byte
|| max_byte
>= 256)
880 error ("Invalid :code-space value");
881 charset
.code_space
[i
* 4] = min_byte
;
882 charset
.code_space
[i
* 4 + 1] = max_byte
;
883 charset
.code_space
[i
* 4 + 2] = max_byte
- min_byte
+ 1;
884 nchars
*= charset
.code_space
[i
* 4 + 2];
885 charset
.code_space
[i
* 4 + 3] = nchars
;
890 val
= args
[charset_arg_dimension
];
892 charset
.dimension
= dimension
;
896 charset
.dimension
= XINT (val
);
897 if (charset
.dimension
< 1 || charset
.dimension
> 4)
898 args_out_of_range_3 (val
, make_number (1), make_number (4));
901 charset
.code_linear_p
902 = (charset
.dimension
== 1
903 || (charset
.code_space
[2] == 256
904 && (charset
.dimension
== 2
905 || (charset
.code_space
[6] == 256
906 && (charset
.dimension
== 3
907 || charset
.code_space
[10] == 256)))));
909 if (! charset
.code_linear_p
)
911 charset
.code_space_mask
= (unsigned char *) xmalloc (256);
912 memset (charset
.code_space_mask
, 0, 256);
913 for (i
= 0; i
< 4; i
++)
914 for (j
= charset
.code_space
[i
* 4]; j
<= charset
.code_space
[i
* 4 + 1];
916 charset
.code_space_mask
[j
] |= (1 << i
);
919 charset
.iso_chars_96
= charset
.code_space
[2] == 96;
921 charset
.min_code
= (charset
.code_space
[0]
922 | (charset
.code_space
[4] << 8)
923 | (charset
.code_space
[8] << 16)
924 | (charset
.code_space
[12] << 24));
925 charset
.max_code
= (charset
.code_space
[1]
926 | (charset
.code_space
[5] << 8)
927 | (charset
.code_space
[9] << 16)
928 | (charset
.code_space
[13] << 24));
929 charset
.char_index_offset
= 0;
931 val
= args
[charset_arg_min_code
];
941 CHECK_NUMBER_CAR (val
);
942 CHECK_NUMBER_CDR (val
);
943 code
= (XINT (XCAR (val
)) << 16) | (XINT (XCDR (val
)));
945 if (code
< charset
.min_code
946 || code
> charset
.max_code
)
947 args_out_of_range_3 (make_number (charset
.min_code
),
948 make_number (charset
.max_code
), val
);
949 charset
.char_index_offset
= CODE_POINT_TO_INDEX (&charset
, code
);
950 charset
.min_code
= code
;
953 val
= args
[charset_arg_max_code
];
963 CHECK_NUMBER_CAR (val
);
964 CHECK_NUMBER_CDR (val
);
965 code
= (XINT (XCAR (val
)) << 16) | (XINT (XCDR (val
)));
967 if (code
< charset
.min_code
968 || code
> charset
.max_code
)
969 args_out_of_range_3 (make_number (charset
.min_code
),
970 make_number (charset
.max_code
), val
);
971 charset
.max_code
= code
;
974 charset
.compact_codes_p
= charset
.max_code
< 0x10000;
976 val
= args
[charset_arg_invalid_code
];
979 if (charset
.min_code
> 0)
980 charset
.invalid_code
= 0;
983 XSETINT (val
, charset
.max_code
+ 1);
984 if (XINT (val
) == charset
.max_code
+ 1)
985 charset
.invalid_code
= charset
.max_code
+ 1;
987 error ("Attribute :invalid-code must be specified");
993 charset
.invalid_code
= XFASTINT (val
);
996 val
= args
[charset_arg_iso_final
];
998 charset
.iso_final
= -1;
1002 if (XINT (val
) < '0' || XINT (val
) > 127)
1003 error ("Invalid iso-final-char: %"pEd
, XINT (val
));
1004 charset
.iso_final
= XINT (val
);
1007 val
= args
[charset_arg_iso_revision
];
1009 charset
.iso_revision
= -1;
1013 if (XINT (val
) > 63)
1014 args_out_of_range (make_number (63), val
);
1015 charset
.iso_revision
= XINT (val
);
1018 val
= args
[charset_arg_emacs_mule_id
];
1020 charset
.emacs_mule_id
= -1;
1024 if ((XINT (val
) > 0 && XINT (val
) <= 128) || XINT (val
) >= 256)
1025 error ("Invalid emacs-mule-id: %"pEd
, XINT (val
));
1026 charset
.emacs_mule_id
= XINT (val
);
1029 charset
.ascii_compatible_p
= ! NILP (args
[charset_arg_ascii_compatible_p
]);
1031 charset
.supplementary_p
= ! NILP (args
[charset_arg_supplementary_p
]);
1033 charset
.unified_p
= 0;
1035 memset (charset
.fast_map
, 0, sizeof (charset
.fast_map
));
1037 if (! NILP (args
[charset_arg_code_offset
]))
1039 val
= args
[charset_arg_code_offset
];
1042 charset
.method
= CHARSET_METHOD_OFFSET
;
1043 charset
.code_offset
= XINT (val
);
1045 i
= CODE_POINT_TO_INDEX (&charset
, charset
.min_code
);
1046 charset
.min_char
= i
+ charset
.code_offset
;
1047 i
= CODE_POINT_TO_INDEX (&charset
, charset
.max_code
);
1048 charset
.max_char
= i
+ charset
.code_offset
;
1049 if (charset
.max_char
> MAX_CHAR
)
1050 error ("Unsupported max char: %d", charset
.max_char
);
1052 i
= (charset
.min_char
>> 7) << 7;
1053 for (; i
< 0x10000 && i
<= charset
.max_char
; i
+= 128)
1054 CHARSET_FAST_MAP_SET (i
, charset
.fast_map
);
1055 i
= (i
>> 12) << 12;
1056 for (; i
<= charset
.max_char
; i
+= 0x1000)
1057 CHARSET_FAST_MAP_SET (i
, charset
.fast_map
);
1058 if (charset
.code_offset
== 0 && charset
.max_char
>= 0x80)
1059 charset
.ascii_compatible_p
= 1;
1061 else if (! NILP (args
[charset_arg_map
]))
1063 val
= args
[charset_arg_map
];
1064 ASET (attrs
, charset_map
, val
);
1065 charset
.method
= CHARSET_METHOD_MAP
;
1067 else if (! NILP (args
[charset_arg_subset
]))
1070 Lisp_Object parent_min_code
, parent_max_code
, parent_code_offset
;
1071 struct charset
*parent_charset
;
1073 val
= args
[charset_arg_subset
];
1074 parent
= Fcar (val
);
1075 CHECK_CHARSET_GET_CHARSET (parent
, parent_charset
);
1076 parent_min_code
= Fnth (make_number (1), val
);
1077 CHECK_NATNUM (parent_min_code
);
1078 parent_max_code
= Fnth (make_number (2), val
);
1079 CHECK_NATNUM (parent_max_code
);
1080 parent_code_offset
= Fnth (make_number (3), val
);
1081 CHECK_NUMBER (parent_code_offset
);
1082 val
= Fmake_vector (make_number (4), Qnil
);
1083 ASET (val
, 0, make_number (parent_charset
->id
));
1084 ASET (val
, 1, parent_min_code
);
1085 ASET (val
, 2, parent_max_code
);
1086 ASET (val
, 3, parent_code_offset
);
1087 ASET (attrs
, charset_subset
, val
);
1089 charset
.method
= CHARSET_METHOD_SUBSET
;
1090 /* Here, we just copy the parent's fast_map. It's not accurate,
1091 but at least it works for quickly detecting which character
1092 DOESN'T belong to this charset. */
1093 for (i
= 0; i
< 190; i
++)
1094 charset
.fast_map
[i
] = parent_charset
->fast_map
[i
];
1096 /* We also copy these for parents. */
1097 charset
.min_char
= parent_charset
->min_char
;
1098 charset
.max_char
= parent_charset
->max_char
;
1100 else if (! NILP (args
[charset_arg_superset
]))
1102 val
= args
[charset_arg_superset
];
1103 charset
.method
= CHARSET_METHOD_SUPERSET
;
1104 val
= Fcopy_sequence (val
);
1105 ASET (attrs
, charset_superset
, val
);
1107 charset
.min_char
= MAX_CHAR
;
1108 charset
.max_char
= 0;
1109 for (; ! NILP (val
); val
= Fcdr (val
))
1111 Lisp_Object elt
, car_part
, cdr_part
;
1112 int this_id
, offset
;
1113 struct charset
*this_charset
;
1118 car_part
= XCAR (elt
);
1119 cdr_part
= XCDR (elt
);
1120 CHECK_CHARSET_GET_ID (car_part
, this_id
);
1121 CHECK_NUMBER (cdr_part
);
1122 offset
= XINT (cdr_part
);
1126 CHECK_CHARSET_GET_ID (elt
, this_id
);
1129 XSETCAR (val
, Fcons (make_number (this_id
), make_number (offset
)));
1131 this_charset
= CHARSET_FROM_ID (this_id
);
1132 if (charset
.min_char
> this_charset
->min_char
)
1133 charset
.min_char
= this_charset
->min_char
;
1134 if (charset
.max_char
< this_charset
->max_char
)
1135 charset
.max_char
= this_charset
->max_char
;
1136 for (i
= 0; i
< 190; i
++)
1137 charset
.fast_map
[i
] |= this_charset
->fast_map
[i
];
1141 error ("None of :code-offset, :map, :parents are specified");
1143 val
= args
[charset_arg_unify_map
];
1144 if (! NILP (val
) && !STRINGP (val
))
1146 ASET (attrs
, charset_unify_map
, val
);
1148 CHECK_LIST (args
[charset_arg_plist
]);
1149 ASET (attrs
, charset_plist
, args
[charset_arg_plist
]);
1151 charset
.hash_index
= hash_lookup (hash_table
, args
[charset_arg_name
],
1153 if (charset
.hash_index
>= 0)
1155 new_definition_p
= 0;
1156 id
= XFASTINT (CHARSET_SYMBOL_ID (args
[charset_arg_name
]));
1157 HASH_VALUE (hash_table
, charset
.hash_index
) = attrs
;
1161 charset
.hash_index
= hash_put (hash_table
, args
[charset_arg_name
], attrs
,
1163 if (charset_table_used
== charset_table_size
)
1165 struct charset
*new_table
1166 = (struct charset
*) xmalloc (sizeof (struct charset
)
1167 * (charset_table_size
+ 16));
1168 memcpy (new_table
, charset_table
,
1169 sizeof (struct charset
) * charset_table_size
);
1170 charset_table_size
+= 16;
1171 charset_table
= new_table
;
1173 id
= charset_table_used
++;
1174 new_definition_p
= 1;
1177 ASET (attrs
, charset_id
, make_number (id
));
1179 charset_table
[id
] = charset
;
1181 if (charset
.method
== CHARSET_METHOD_MAP
)
1183 load_charset (&charset
, 0);
1184 charset_table
[id
] = charset
;
1187 if (charset
.iso_final
>= 0)
1189 ISO_CHARSET_TABLE (charset
.dimension
, charset
.iso_chars_96
,
1190 charset
.iso_final
) = id
;
1191 if (new_definition_p
)
1192 Viso_2022_charset_list
= nconc2 (Viso_2022_charset_list
,
1193 Fcons (make_number (id
), Qnil
));
1194 if (ISO_CHARSET_TABLE (1, 0, 'J') == id
)
1195 charset_jisx0201_roman
= id
;
1196 else if (ISO_CHARSET_TABLE (2, 0, '@') == id
)
1197 charset_jisx0208_1978
= id
;
1198 else if (ISO_CHARSET_TABLE (2, 0, 'B') == id
)
1199 charset_jisx0208
= id
;
1200 else if (ISO_CHARSET_TABLE (2, 0, 'C') == id
)
1201 charset_ksc5601
= id
;
1204 if (charset
.emacs_mule_id
>= 0)
1206 emacs_mule_charset
[charset
.emacs_mule_id
] = id
;
1207 if (charset
.emacs_mule_id
< 0xA0)
1208 emacs_mule_bytes
[charset
.emacs_mule_id
] = charset
.dimension
+ 1;
1210 emacs_mule_bytes
[charset
.emacs_mule_id
] = charset
.dimension
+ 2;
1211 if (new_definition_p
)
1212 Vemacs_mule_charset_list
= nconc2 (Vemacs_mule_charset_list
,
1213 Fcons (make_number (id
), Qnil
));
1216 if (new_definition_p
)
1218 Vcharset_list
= Fcons (args
[charset_arg_name
], Vcharset_list
);
1219 if (charset
.supplementary_p
)
1220 Vcharset_ordered_list
= nconc2 (Vcharset_ordered_list
,
1221 Fcons (make_number (id
), Qnil
));
1226 for (tail
= Vcharset_ordered_list
; CONSP (tail
); tail
= XCDR (tail
))
1228 struct charset
*cs
= CHARSET_FROM_ID (XINT (XCAR (tail
)));
1230 if (cs
->supplementary_p
)
1233 if (EQ (tail
, Vcharset_ordered_list
))
1234 Vcharset_ordered_list
= Fcons (make_number (id
),
1235 Vcharset_ordered_list
);
1236 else if (NILP (tail
))
1237 Vcharset_ordered_list
= nconc2 (Vcharset_ordered_list
,
1238 Fcons (make_number (id
), Qnil
));
1241 val
= Fcons (XCAR (tail
), XCDR (tail
));
1242 XSETCDR (tail
, val
);
1243 XSETCAR (tail
, make_number (id
));
1246 charset_ordered_list_tick
++;
1253 /* Same as Fdefine_charset_internal but arguments are more convenient
1254 to call from C (typically in syms_of_charset). This can define a
1255 charset of `offset' method only. Return the ID of the new
1259 define_charset_internal (Lisp_Object name
,
1261 const char *code_space_chars
,
1262 unsigned min_code
, unsigned max_code
,
1263 int iso_final
, int iso_revision
, int emacs_mule_id
,
1264 int ascii_compatible
, int supplementary
,
1267 const unsigned char *code_space
= (const unsigned char *) code_space_chars
;
1268 Lisp_Object args
[charset_arg_max
];
1269 Lisp_Object plist
[14];
1273 args
[charset_arg_name
] = name
;
1274 args
[charset_arg_dimension
] = make_number (dimension
);
1275 val
= Fmake_vector (make_number (8), make_number (0));
1276 for (i
= 0; i
< 8; i
++)
1277 ASET (val
, i
, make_number (code_space
[i
]));
1278 args
[charset_arg_code_space
] = val
;
1279 args
[charset_arg_min_code
] = make_number (min_code
);
1280 args
[charset_arg_max_code
] = make_number (max_code
);
1281 args
[charset_arg_iso_final
]
1282 = (iso_final
< 0 ? Qnil
: make_number (iso_final
));
1283 args
[charset_arg_iso_revision
] = make_number (iso_revision
);
1284 args
[charset_arg_emacs_mule_id
]
1285 = (emacs_mule_id
< 0 ? Qnil
: make_number (emacs_mule_id
));
1286 args
[charset_arg_ascii_compatible_p
] = ascii_compatible
? Qt
: Qnil
;
1287 args
[charset_arg_supplementary_p
] = supplementary
? Qt
: Qnil
;
1288 args
[charset_arg_invalid_code
] = Qnil
;
1289 args
[charset_arg_code_offset
] = make_number (code_offset
);
1290 args
[charset_arg_map
] = Qnil
;
1291 args
[charset_arg_subset
] = Qnil
;
1292 args
[charset_arg_superset
] = Qnil
;
1293 args
[charset_arg_unify_map
] = Qnil
;
1295 plist
[0] = intern_c_string (":name");
1296 plist
[1] = args
[charset_arg_name
];
1297 plist
[2] = intern_c_string (":dimension");
1298 plist
[3] = args
[charset_arg_dimension
];
1299 plist
[4] = intern_c_string (":code-space");
1300 plist
[5] = args
[charset_arg_code_space
];
1301 plist
[6] = intern_c_string (":iso-final-char");
1302 plist
[7] = args
[charset_arg_iso_final
];
1303 plist
[8] = intern_c_string (":emacs-mule-id");
1304 plist
[9] = args
[charset_arg_emacs_mule_id
];
1305 plist
[10] = intern_c_string (":ascii-compatible-p");
1306 plist
[11] = args
[charset_arg_ascii_compatible_p
];
1307 plist
[12] = intern_c_string (":code-offset");
1308 plist
[13] = args
[charset_arg_code_offset
];
1310 args
[charset_arg_plist
] = Flist (14, plist
);
1311 Fdefine_charset_internal (charset_arg_max
, args
);
1313 return XINT (CHARSET_SYMBOL_ID (name
));
1317 DEFUN ("define-charset-alias", Fdefine_charset_alias
,
1318 Sdefine_charset_alias
, 2, 2, 0,
1319 doc
: /* Define ALIAS as an alias for charset CHARSET. */)
1320 (Lisp_Object alias
, Lisp_Object charset
)
1324 CHECK_CHARSET_GET_ATTR (charset
, attr
);
1325 Fputhash (alias
, attr
, Vcharset_hash_table
);
1326 Vcharset_list
= Fcons (alias
, Vcharset_list
);
1331 DEFUN ("charset-plist", Fcharset_plist
, Scharset_plist
, 1, 1, 0,
1332 doc
: /* Return the property list of CHARSET. */)
1333 (Lisp_Object charset
)
1337 CHECK_CHARSET_GET_ATTR (charset
, attrs
);
1338 return CHARSET_ATTR_PLIST (attrs
);
1342 DEFUN ("set-charset-plist", Fset_charset_plist
, Sset_charset_plist
, 2, 2, 0,
1343 doc
: /* Set CHARSET's property list to PLIST. */)
1344 (Lisp_Object charset
, Lisp_Object plist
)
1348 CHECK_CHARSET_GET_ATTR (charset
, attrs
);
1349 CHARSET_ATTR_PLIST (attrs
) = plist
;
1354 DEFUN ("unify-charset", Funify_charset
, Sunify_charset
, 1, 3, 0,
1355 doc
: /* Unify characters of CHARSET with Unicode.
1356 This means reading the relevant file and installing the table defined
1357 by CHARSET's `:unify-map' property.
1359 Optional second arg UNIFY-MAP is a file name string or a vector. It has
1360 the same meaning as the `:unify-map' attribute in the function
1361 `define-charset' (which see).
1363 Optional third argument DEUNIFY, if non-nil, means to de-unify CHARSET. */)
1364 (Lisp_Object charset
, Lisp_Object unify_map
, Lisp_Object deunify
)
1369 CHECK_CHARSET_GET_ID (charset
, id
);
1370 cs
= CHARSET_FROM_ID (id
);
1372 ? CHARSET_UNIFIED_P (cs
) && ! NILP (CHARSET_DEUNIFIER (cs
))
1373 : ! CHARSET_UNIFIED_P (cs
))
1376 CHARSET_UNIFIED_P (cs
) = 0;
1379 if (CHARSET_METHOD (cs
) != CHARSET_METHOD_OFFSET
1380 || CHARSET_CODE_OFFSET (cs
) < 0x110000)
1381 error ("Can't unify charset: %s", SDATA (SYMBOL_NAME (charset
)));
1382 if (NILP (unify_map
))
1383 unify_map
= CHARSET_UNIFY_MAP (cs
);
1386 if (! STRINGP (unify_map
) && ! VECTORP (unify_map
))
1387 signal_error ("Bad unify-map", unify_map
);
1388 CHARSET_UNIFY_MAP (cs
) = unify_map
;
1390 if (NILP (Vchar_unify_table
))
1391 Vchar_unify_table
= Fmake_char_table (Qnil
, Qnil
);
1392 char_table_set_range (Vchar_unify_table
,
1393 cs
->min_char
, cs
->max_char
, charset
);
1394 CHARSET_UNIFIED_P (cs
) = 1;
1396 else if (CHAR_TABLE_P (Vchar_unify_table
))
1398 int min_code
= CHARSET_MIN_CODE (cs
);
1399 int max_code
= CHARSET_MAX_CODE (cs
);
1400 int min_char
= DECODE_CHAR (cs
, min_code
);
1401 int max_char
= DECODE_CHAR (cs
, max_code
);
1403 char_table_set_range (Vchar_unify_table
, min_char
, max_char
, Qnil
);
1409 DEFUN ("get-unused-iso-final-char", Fget_unused_iso_final_char
,
1410 Sget_unused_iso_final_char
, 2, 2, 0,
1412 Return an unused ISO final char for a charset of DIMENSION and CHARS.
1413 DIMENSION is the number of bytes to represent a character: 1 or 2.
1414 CHARS is the number of characters in a dimension: 94 or 96.
1416 This final char is for private use, thus the range is `0' (48) .. `?' (63).
1417 If there's no unused final char for the specified kind of charset,
1419 (Lisp_Object dimension
, Lisp_Object chars
)
1423 CHECK_NUMBER (dimension
);
1424 CHECK_NUMBER (chars
);
1425 if (XINT (dimension
) != 1 && XINT (dimension
) != 2 && XINT (dimension
) != 3)
1426 args_out_of_range_3 (dimension
, make_number (1), make_number (3));
1427 if (XINT (chars
) != 94 && XINT (chars
) != 96)
1428 args_out_of_range_3 (chars
, make_number (94), make_number (96));
1429 for (final_char
= '0'; final_char
<= '?'; final_char
++)
1430 if (ISO_CHARSET_TABLE (XINT (dimension
), XINT (chars
), final_char
) < 0)
1432 return (final_char
<= '?' ? make_number (final_char
) : Qnil
);
1436 check_iso_charset_parameter (Lisp_Object dimension
, Lisp_Object chars
, Lisp_Object final_char
)
1438 CHECK_NATNUM (dimension
);
1439 CHECK_NATNUM (chars
);
1440 CHECK_NATNUM (final_char
);
1442 if (XINT (dimension
) > 3)
1443 error ("Invalid DIMENSION %"pEd
", it should be 1, 2, or 3",
1445 if (XINT (chars
) != 94 && XINT (chars
) != 96)
1446 error ("Invalid CHARS %"pEd
", it should be 94 or 96", XINT (chars
));
1447 if (XINT (final_char
) < '0' || XINT (final_char
) > '~')
1449 unsigned char str
[MAX_MULTIBYTE_LENGTH
+ 1];
1450 int len
= CHAR_STRING (XINT (chars
), str
);
1452 error ("Invalid FINAL-CHAR %s, it should be `0'..`~'", str
);
1457 DEFUN ("declare-equiv-charset", Fdeclare_equiv_charset
, Sdeclare_equiv_charset
,
1459 doc
: /* Declare an equivalent charset for ISO-2022 decoding.
1461 On decoding by an ISO-2022 base coding system, when a charset
1462 specified by DIMENSION, CHARS, and FINAL-CHAR is designated, behave as
1463 if CHARSET is designated instead. */)
1464 (Lisp_Object dimension
, Lisp_Object chars
, Lisp_Object final_char
, Lisp_Object charset
)
1469 CHECK_CHARSET_GET_ID (charset
, id
);
1470 check_iso_charset_parameter (dimension
, chars
, final_char
);
1471 chars_flag
= XINT (chars
) == 96;
1472 ISO_CHARSET_TABLE (XINT (dimension
), chars_flag
, XINT (final_char
)) = id
;
1477 /* Return information about charsets in the text at PTR of NBYTES
1478 bytes, which are NCHARS characters. The value is:
1480 0: Each character is represented by one byte. This is always
1481 true for a unibyte string. For a multibyte string, true if
1482 it contains only ASCII characters.
1484 1: No charsets other than ascii, control-1, and latin-1 are
1491 string_xstring_p (Lisp_Object string
)
1493 const unsigned char *p
= SDATA (string
);
1494 const unsigned char *endp
= p
+ SBYTES (string
);
1496 if (SCHARS (string
) == SBYTES (string
))
1501 int c
= STRING_CHAR_ADVANCE (p
);
1510 /* Find charsets in the string at PTR of NCHARS and NBYTES.
1512 CHARSETS is a vector. If Nth element is non-nil, it means the
1513 charset whose id is N is already found.
1515 It may lookup a translation table TABLE if supplied. */
1518 find_charsets_in_text (const unsigned char *ptr
, EMACS_INT nchars
, EMACS_INT nbytes
, Lisp_Object charsets
, Lisp_Object table
, int multibyte
)
1520 const unsigned char *pend
= ptr
+ nbytes
;
1522 if (nchars
== nbytes
)
1525 ASET (charsets
, charset_ascii
, Qt
);
1532 c
= translate_char (table
, c
);
1533 if (ASCII_BYTE_P (c
))
1534 ASET (charsets
, charset_ascii
, Qt
);
1536 ASET (charsets
, charset_eight_bit
, Qt
);
1543 int c
= STRING_CHAR_ADVANCE (ptr
);
1544 struct charset
*charset
;
1547 c
= translate_char (table
, c
);
1548 charset
= CHAR_CHARSET (c
);
1549 ASET (charsets
, CHARSET_ID (charset
), Qt
);
1554 DEFUN ("find-charset-region", Ffind_charset_region
, Sfind_charset_region
,
1556 doc
: /* Return a list of charsets in the region between BEG and END.
1557 BEG and END are buffer positions.
1558 Optional arg TABLE if non-nil is a translation table to look up.
1560 If the current buffer is unibyte, the returned list may contain
1561 only `ascii', `eight-bit-control', and `eight-bit-graphic'. */)
1562 (Lisp_Object beg
, Lisp_Object end
, Lisp_Object table
)
1564 Lisp_Object charsets
;
1565 EMACS_INT from
, from_byte
, to
, stop
, stop_byte
;
1568 int multibyte
= ! NILP (BVAR (current_buffer
, enable_multibyte_characters
));
1570 validate_region (&beg
, &end
);
1571 from
= XFASTINT (beg
);
1572 stop
= to
= XFASTINT (end
);
1574 if (from
< GPT
&& GPT
< to
)
1577 stop_byte
= GPT_BYTE
;
1580 stop_byte
= CHAR_TO_BYTE (stop
);
1582 from_byte
= CHAR_TO_BYTE (from
);
1584 charsets
= Fmake_vector (make_number (charset_table_used
), Qnil
);
1587 find_charsets_in_text (BYTE_POS_ADDR (from_byte
), stop
- from
,
1588 stop_byte
- from_byte
, charsets
, table
,
1592 from
= stop
, from_byte
= stop_byte
;
1593 stop
= to
, stop_byte
= CHAR_TO_BYTE (stop
);
1600 for (i
= charset_table_used
- 1; i
>= 0; i
--)
1601 if (!NILP (AREF (charsets
, i
)))
1602 val
= Fcons (CHARSET_NAME (charset_table
+ i
), val
);
1606 DEFUN ("find-charset-string", Ffind_charset_string
, Sfind_charset_string
,
1608 doc
: /* Return a list of charsets in STR.
1609 Optional arg TABLE if non-nil is a translation table to look up.
1611 If STR is unibyte, the returned list may contain
1612 only `ascii', `eight-bit-control', and `eight-bit-graphic'. */)
1613 (Lisp_Object str
, Lisp_Object table
)
1615 Lisp_Object charsets
;
1621 charsets
= Fmake_vector (make_number (charset_table_used
), Qnil
);
1622 find_charsets_in_text (SDATA (str
), SCHARS (str
), SBYTES (str
),
1624 STRING_MULTIBYTE (str
));
1626 for (i
= charset_table_used
- 1; i
>= 0; i
--)
1627 if (!NILP (AREF (charsets
, i
)))
1628 val
= Fcons (CHARSET_NAME (charset_table
+ i
), val
);
1634 /* Return a unified character code for C (>= 0x110000). VAL is a
1635 value of Vchar_unify_table for C; i.e. it is nil, an integer, or a
1638 maybe_unify_char (int c
, Lisp_Object val
)
1640 struct charset
*charset
;
1647 CHECK_CHARSET_GET_CHARSET (val
, charset
);
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
);
1667 /* Return a character correponding to the code-point CODE of
1671 decode_char (struct charset
*charset
, unsigned int code
)
1674 enum charset_method method
= CHARSET_METHOD (charset
);
1676 if (code
< CHARSET_MIN_CODE (charset
) || code
> CHARSET_MAX_CODE (charset
))
1679 if (method
== CHARSET_METHOD_SUBSET
)
1681 Lisp_Object subset_info
;
1683 subset_info
= CHARSET_SUBSET (charset
);
1684 charset
= CHARSET_FROM_ID (XFASTINT (AREF (subset_info
, 0)));
1685 code
-= XINT (AREF (subset_info
, 3));
1686 if (code
< XFASTINT (AREF (subset_info
, 1))
1687 || code
> XFASTINT (AREF (subset_info
, 2)))
1690 c
= DECODE_CHAR (charset
, code
);
1692 else if (method
== CHARSET_METHOD_SUPERSET
)
1694 Lisp_Object parents
;
1696 parents
= CHARSET_SUPERSET (charset
);
1698 for (; CONSP (parents
); parents
= XCDR (parents
))
1700 int id
= XINT (XCAR (XCAR (parents
)));
1701 int code_offset
= XINT (XCDR (XCAR (parents
)));
1702 unsigned this_code
= code
- code_offset
;
1704 charset
= CHARSET_FROM_ID (id
);
1705 if ((c
= DECODE_CHAR (charset
, this_code
)) >= 0)
1711 char_index
= CODE_POINT_TO_INDEX (charset
, code
);
1715 if (method
== CHARSET_METHOD_MAP
)
1717 Lisp_Object decoder
;
1719 decoder
= CHARSET_DECODER (charset
);
1720 if (! VECTORP (decoder
))
1722 load_charset (charset
, 1);
1723 decoder
= CHARSET_DECODER (charset
);
1725 if (VECTORP (decoder
))
1726 c
= XINT (AREF (decoder
, char_index
));
1728 c
= GET_TEMP_CHARSET_WORK_DECODER (char_index
);
1730 else /* method == CHARSET_METHOD_OFFSET */
1732 c
= char_index
+ CHARSET_CODE_OFFSET (charset
);
1733 if (CHARSET_UNIFIED_P (charset
)
1734 && c
> MAX_UNICODE_CHAR
)
1735 MAYBE_UNIFY_CHAR (c
);
1742 /* Variable used temporarily by the macro ENCODE_CHAR. */
1743 Lisp_Object charset_work
;
1745 /* Return a code-point of CHAR in CHARSET. If CHAR doesn't belong to
1746 CHARSET, return CHARSET_INVALID_CODE (CHARSET). If STRICT is true,
1747 use CHARSET's strict_max_char instead of max_char. */
1750 encode_char (struct charset
*charset
, int c
)
1753 enum charset_method method
= CHARSET_METHOD (charset
);
1755 if (CHARSET_UNIFIED_P (charset
))
1757 Lisp_Object deunifier
;
1758 int code_index
= -1;
1760 deunifier
= CHARSET_DEUNIFIER (charset
);
1761 if (! CHAR_TABLE_P (deunifier
))
1763 load_charset (charset
, 2);
1764 deunifier
= CHARSET_DEUNIFIER (charset
);
1766 if (CHAR_TABLE_P (deunifier
))
1768 Lisp_Object deunified
= CHAR_TABLE_REF (deunifier
, c
);
1770 if (INTEGERP (deunified
))
1771 code_index
= XINT (deunified
);
1775 code_index
= GET_TEMP_CHARSET_WORK_ENCODER (c
);
1777 if (code_index
>= 0)
1778 c
= CHARSET_CODE_OFFSET (charset
) + code_index
;
1781 if (method
== CHARSET_METHOD_SUBSET
)
1783 Lisp_Object subset_info
;
1784 struct charset
*this_charset
;
1786 subset_info
= CHARSET_SUBSET (charset
);
1787 this_charset
= CHARSET_FROM_ID (XFASTINT (AREF (subset_info
, 0)));
1788 code
= ENCODE_CHAR (this_charset
, c
);
1789 if (code
== CHARSET_INVALID_CODE (this_charset
)
1790 || code
< XFASTINT (AREF (subset_info
, 1))
1791 || code
> XFASTINT (AREF (subset_info
, 2)))
1792 return CHARSET_INVALID_CODE (charset
);
1793 code
+= XINT (AREF (subset_info
, 3));
1797 if (method
== CHARSET_METHOD_SUPERSET
)
1799 Lisp_Object parents
;
1801 parents
= CHARSET_SUPERSET (charset
);
1802 for (; CONSP (parents
); parents
= XCDR (parents
))
1804 int id
= XINT (XCAR (XCAR (parents
)));
1805 int code_offset
= XINT (XCDR (XCAR (parents
)));
1806 struct charset
*this_charset
= CHARSET_FROM_ID (id
);
1808 code
= ENCODE_CHAR (this_charset
, c
);
1809 if (code
!= CHARSET_INVALID_CODE (this_charset
))
1810 return code
+ code_offset
;
1812 return CHARSET_INVALID_CODE (charset
);
1815 if (! CHARSET_FAST_MAP_REF ((c
), charset
->fast_map
)
1816 || c
< CHARSET_MIN_CHAR (charset
) || c
> CHARSET_MAX_CHAR (charset
))
1817 return CHARSET_INVALID_CODE (charset
);
1819 if (method
== CHARSET_METHOD_MAP
)
1821 Lisp_Object encoder
;
1824 encoder
= CHARSET_ENCODER (charset
);
1825 if (! CHAR_TABLE_P (CHARSET_ENCODER (charset
)))
1827 load_charset (charset
, 2);
1828 encoder
= CHARSET_ENCODER (charset
);
1830 if (CHAR_TABLE_P (encoder
))
1832 val
= CHAR_TABLE_REF (encoder
, c
);
1834 return CHARSET_INVALID_CODE (charset
);
1836 if (! CHARSET_COMPACT_CODES_P (charset
))
1837 code
= INDEX_TO_CODE_POINT (charset
, code
);
1841 code
= GET_TEMP_CHARSET_WORK_ENCODER (c
);
1842 code
= INDEX_TO_CODE_POINT (charset
, code
);
1845 else /* method == CHARSET_METHOD_OFFSET */
1847 int code_index
= c
- CHARSET_CODE_OFFSET (charset
);
1849 code
= INDEX_TO_CODE_POINT (charset
, code_index
);
1856 DEFUN ("decode-char", Fdecode_char
, Sdecode_char
, 2, 3, 0,
1857 doc
: /* Decode the pair of CHARSET and CODE-POINT into a character.
1858 Return nil if CODE-POINT is not valid in CHARSET.
1860 CODE-POINT may be a cons (HIGHER-16-BIT-VALUE . LOWER-16-BIT-VALUE).
1862 Optional argument RESTRICTION specifies a way to map the pair of CCS
1863 and CODE-POINT to a character. Currently not supported and just ignored. */)
1864 (Lisp_Object charset
, Lisp_Object code_point
, Lisp_Object restriction
)
1868 struct charset
*charsetp
;
1870 CHECK_CHARSET_GET_ID (charset
, id
);
1871 if (CONSP (code_point
))
1873 CHECK_NATNUM_CAR (code_point
);
1874 CHECK_NATNUM_CDR (code_point
);
1875 code
= (XINT (XCAR (code_point
)) << 16) | (XINT (XCDR (code_point
)));
1879 CHECK_NATNUM (code_point
);
1880 code
= XINT (code_point
);
1882 charsetp
= CHARSET_FROM_ID (id
);
1883 c
= DECODE_CHAR (charsetp
, code
);
1884 return (c
>= 0 ? make_number (c
) : Qnil
);
1888 DEFUN ("encode-char", Fencode_char
, Sencode_char
, 2, 3, 0,
1889 doc
: /* Encode the character CH into a code-point of CHARSET.
1890 Return nil if CHARSET doesn't include CH.
1892 Optional argument RESTRICTION specifies a way to map CH to a
1893 code-point in CCS. Currently not supported and just ignored. */)
1894 (Lisp_Object ch
, Lisp_Object charset
, Lisp_Object restriction
)
1898 struct charset
*charsetp
;
1900 CHECK_CHARSET_GET_ID (charset
, id
);
1902 charsetp
= CHARSET_FROM_ID (id
);
1903 code
= ENCODE_CHAR (charsetp
, XINT (ch
));
1904 if (code
== CHARSET_INVALID_CODE (charsetp
))
1906 if (code
> 0x7FFFFFF)
1907 return Fcons (make_number (code
>> 16), make_number (code
& 0xFFFF));
1908 return make_number (code
);
1912 DEFUN ("make-char", Fmake_char
, Smake_char
, 1, 5, 0,
1914 /* Return a character of CHARSET whose position codes are CODEn.
1916 CODE1 through CODE4 are optional, but if you don't supply sufficient
1917 position codes, it is assumed that the minimum code in each dimension
1919 (Lisp_Object charset
, Lisp_Object code1
, Lisp_Object code2
, Lisp_Object code3
, Lisp_Object code4
)
1922 struct charset
*charsetp
;
1926 CHECK_CHARSET_GET_ID (charset
, id
);
1927 charsetp
= CHARSET_FROM_ID (id
);
1929 dimension
= CHARSET_DIMENSION (charsetp
);
1931 code
= (CHARSET_ASCII_COMPATIBLE_P (charsetp
)
1932 ? 0 : CHARSET_MIN_CODE (charsetp
));
1935 CHECK_NATNUM (code1
);
1936 if (XFASTINT (code1
) >= 0x100)
1937 args_out_of_range (make_number (0xFF), code1
);
1938 code
= XFASTINT (code1
);
1944 code
|= charsetp
->code_space
[(dimension
- 2) * 4];
1947 CHECK_NATNUM (code2
);
1948 if (XFASTINT (code2
) >= 0x100)
1949 args_out_of_range (make_number (0xFF), code2
);
1950 code
|= XFASTINT (code2
);
1957 code
|= charsetp
->code_space
[(dimension
- 3) * 4];
1960 CHECK_NATNUM (code3
);
1961 if (XFASTINT (code3
) >= 0x100)
1962 args_out_of_range (make_number (0xFF), code3
);
1963 code
|= XFASTINT (code3
);
1970 code
|= charsetp
->code_space
[0];
1973 CHECK_NATNUM (code4
);
1974 if (XFASTINT (code4
) >= 0x100)
1975 args_out_of_range (make_number (0xFF), code4
);
1976 code
|= XFASTINT (code4
);
1983 if (CHARSET_ISO_FINAL (charsetp
) >= 0)
1985 c
= DECODE_CHAR (charsetp
, code
);
1987 error ("Invalid code(s)");
1988 return make_number (c
);
1992 /* Return the first charset in CHARSET_LIST that contains C.
1993 CHARSET_LIST is a list of charset IDs. If it is nil, use
1994 Vcharset_ordered_list. */
1997 char_charset (int c
, Lisp_Object charset_list
, unsigned int *code_return
)
2001 if (NILP (charset_list
))
2002 charset_list
= Vcharset_ordered_list
;
2006 while (CONSP (charset_list
))
2008 struct charset
*charset
= CHARSET_FROM_ID (XINT (XCAR (charset_list
)));
2009 unsigned code
= ENCODE_CHAR (charset
, c
);
2011 if (code
!= CHARSET_INVALID_CODE (charset
))
2014 *code_return
= code
;
2017 charset_list
= XCDR (charset_list
);
2019 && c
<= MAX_UNICODE_CHAR
2020 && EQ (charset_list
, Vcharset_non_preferred_head
))
2021 return CHARSET_FROM_ID (charset_unicode
);
2023 return (maybe_null
? NULL
2024 : c
<= MAX_5_BYTE_CHAR
? CHARSET_FROM_ID (charset_emacs
)
2025 : CHARSET_FROM_ID (charset_eight_bit
));
2029 DEFUN ("split-char", Fsplit_char
, Ssplit_char
, 1, 1, 0,
2031 /*Return list of charset and one to four position-codes of CH.
2032 The charset is decided by the current priority order of charsets.
2033 A position-code is a byte value of each dimension of the code-point of
2034 CH in the charset. */)
2037 struct charset
*charset
;
2042 CHECK_CHARACTER (ch
);
2044 charset
= CHAR_CHARSET (c
);
2047 code
= ENCODE_CHAR (charset
, c
);
2048 if (code
== CHARSET_INVALID_CODE (charset
))
2050 dimension
= CHARSET_DIMENSION (charset
);
2051 for (val
= Qnil
; dimension
> 0; dimension
--)
2053 val
= Fcons (make_number (code
& 0xFF), val
);
2056 return Fcons (CHARSET_NAME (charset
), val
);
2060 DEFUN ("char-charset", Fchar_charset
, Schar_charset
, 1, 2, 0,
2061 doc
: /* Return the charset of highest priority that contains CH.
2062 If optional 2nd arg RESTRICTION is non-nil, it is a list of charsets
2063 from which to find the charset. It may also be a coding system. In
2064 that case, find the charset from what supported by that coding system. */)
2065 (Lisp_Object ch
, Lisp_Object restriction
)
2067 struct charset
*charset
;
2069 CHECK_CHARACTER (ch
);
2070 if (NILP (restriction
))
2071 charset
= CHAR_CHARSET (XINT (ch
));
2074 if (CONSP (restriction
))
2076 int c
= XFASTINT (ch
);
2078 for (; CONSP (restriction
); restriction
= XCDR (restriction
))
2080 struct charset
*rcharset
;
2082 CHECK_CHARSET_GET_CHARSET (XCAR (restriction
), rcharset
);
2083 if (ENCODE_CHAR (rcharset
, c
) != CHARSET_INVALID_CODE (rcharset
))
2084 return XCAR (restriction
);
2088 restriction
= coding_system_charset_list (restriction
);
2089 charset
= char_charset (XINT (ch
), restriction
, NULL
);
2093 return (CHARSET_NAME (charset
));
2097 DEFUN ("charset-after", Fcharset_after
, Scharset_after
, 0, 1, 0,
2099 Return charset of a character in the current buffer at position POS.
2100 If POS is nil, it defauls to the current point.
2101 If POS is out of range, the value is nil. */)
2105 struct charset
*charset
;
2107 ch
= Fchar_after (pos
);
2108 if (! INTEGERP (ch
))
2110 charset
= CHAR_CHARSET (XINT (ch
));
2111 return (CHARSET_NAME (charset
));
2115 DEFUN ("iso-charset", Fiso_charset
, Siso_charset
, 3, 3, 0,
2117 Return charset of ISO's specification DIMENSION, CHARS, and FINAL-CHAR.
2119 ISO 2022's designation sequence (escape sequence) distinguishes charsets
2120 by their DIMENSION, CHARS, and FINAL-CHAR,
2121 whereas Emacs distinguishes them by charset symbol.
2122 See the documentation of the function `charset-info' for the meanings of
2123 DIMENSION, CHARS, and FINAL-CHAR. */)
2124 (Lisp_Object dimension
, Lisp_Object chars
, Lisp_Object final_char
)
2129 check_iso_charset_parameter (dimension
, chars
, final_char
);
2130 chars_flag
= XFASTINT (chars
) == 96;
2131 id
= ISO_CHARSET_TABLE (XFASTINT (dimension
), chars_flag
,
2132 XFASTINT (final_char
));
2133 return (id
>= 0 ? CHARSET_NAME (CHARSET_FROM_ID (id
)) : Qnil
);
2137 DEFUN ("clear-charset-maps", Fclear_charset_maps
, Sclear_charset_maps
,
2141 Clear temporary charset mapping tables.
2142 It should be called only from temacs invoked for dumping. */)
2145 if (temp_charset_work
)
2147 free (temp_charset_work
);
2148 temp_charset_work
= NULL
;
2151 if (CHAR_TABLE_P (Vchar_unify_table
))
2152 Foptimize_char_table (Vchar_unify_table
, Qnil
);
2157 DEFUN ("charset-priority-list", Fcharset_priority_list
,
2158 Scharset_priority_list
, 0, 1, 0,
2159 doc
: /* Return the list of charsets ordered by priority.
2160 HIGHESTP non-nil means just return the highest priority one. */)
2161 (Lisp_Object highestp
)
2163 Lisp_Object val
= Qnil
, list
= Vcharset_ordered_list
;
2165 if (!NILP (highestp
))
2166 return CHARSET_NAME (CHARSET_FROM_ID (XINT (Fcar (list
))));
2168 while (!NILP (list
))
2170 val
= Fcons (CHARSET_NAME (CHARSET_FROM_ID (XINT (XCAR (list
)))), val
);
2173 return Fnreverse (val
);
2176 DEFUN ("set-charset-priority", Fset_charset_priority
, Sset_charset_priority
,
2178 doc
: /* Assign higher priority to the charsets given as arguments.
2179 usage: (set-charset-priority &rest charsets) */)
2180 (size_t nargs
, Lisp_Object
*args
)
2182 Lisp_Object new_head
, old_list
, arglist
[2];
2183 Lisp_Object list_2022
, list_emacs_mule
;
2187 old_list
= Fcopy_sequence (Vcharset_ordered_list
);
2189 for (i
= 0; i
< nargs
; i
++)
2191 CHECK_CHARSET_GET_ID (args
[i
], id
);
2192 if (! NILP (Fmemq (make_number (id
), old_list
)))
2194 old_list
= Fdelq (make_number (id
), old_list
);
2195 new_head
= Fcons (make_number (id
), new_head
);
2198 arglist
[0] = Fnreverse (new_head
);
2199 arglist
[1] = Vcharset_non_preferred_head
= old_list
;
2200 Vcharset_ordered_list
= Fnconc (2, arglist
);
2201 charset_ordered_list_tick
++;
2203 charset_unibyte
= -1;
2204 for (old_list
= Vcharset_ordered_list
, list_2022
= list_emacs_mule
= Qnil
;
2205 CONSP (old_list
); old_list
= XCDR (old_list
))
2207 if (! NILP (Fmemq (XCAR (old_list
), Viso_2022_charset_list
)))
2208 list_2022
= Fcons (XCAR (old_list
), list_2022
);
2209 if (! NILP (Fmemq (XCAR (old_list
), Vemacs_mule_charset_list
)))
2210 list_emacs_mule
= Fcons (XCAR (old_list
), list_emacs_mule
);
2211 if (charset_unibyte
< 0)
2213 struct charset
*charset
= CHARSET_FROM_ID (XINT (XCAR (old_list
)));
2215 if (CHARSET_DIMENSION (charset
) == 1
2216 && CHARSET_ASCII_COMPATIBLE_P (charset
)
2217 && CHARSET_MAX_CHAR (charset
) >= 0x80)
2218 charset_unibyte
= CHARSET_ID (charset
);
2221 Viso_2022_charset_list
= Fnreverse (list_2022
);
2222 Vemacs_mule_charset_list
= Fnreverse (list_emacs_mule
);
2223 if (charset_unibyte
< 0)
2224 charset_unibyte
= charset_iso_8859_1
;
2229 DEFUN ("charset-id-internal", Fcharset_id_internal
, Scharset_id_internal
,
2231 doc
: /* Internal use only.
2232 Return charset identification number of CHARSET. */)
2233 (Lisp_Object charset
)
2237 CHECK_CHARSET_GET_ID (charset
, id
);
2238 return make_number (id
);
2241 struct charset_sort_data
2243 Lisp_Object charset
;
2249 charset_compare (const void *d1
, const void *d2
)
2251 const struct charset_sort_data
*data1
= d1
, *data2
= d2
;
2252 return (data1
->priority
- data2
->priority
);
2255 DEFUN ("sort-charsets", Fsort_charsets
, Ssort_charsets
, 1, 1, 0,
2256 doc
: /* Sort charset list CHARSETS by a priority of each charset.
2257 Return the sorted list. CHARSETS is modified by side effects.
2258 See also `charset-priority-list' and `set-charset-priority'. */)
2259 (Lisp_Object charsets
)
2261 Lisp_Object len
= Flength (charsets
);
2262 int n
= XFASTINT (len
), i
, j
, done
;
2263 Lisp_Object tail
, elt
, attrs
;
2264 struct charset_sort_data
*sort_data
;
2265 int id
, min_id
= INT_MAX
, max_id
= INT_MIN
;
2270 SAFE_ALLOCA (sort_data
, struct charset_sort_data
*, sizeof (*sort_data
) * n
);
2271 for (tail
= charsets
, i
= 0; CONSP (tail
); tail
= XCDR (tail
), i
++)
2274 CHECK_CHARSET_GET_ATTR (elt
, attrs
);
2275 sort_data
[i
].charset
= elt
;
2276 sort_data
[i
].id
= id
= XINT (CHARSET_ATTR_ID (attrs
));
2282 for (done
= 0, tail
= Vcharset_ordered_list
, i
= 0;
2283 done
< n
&& CONSP (tail
); tail
= XCDR (tail
), i
++)
2286 id
= XFASTINT (elt
);
2287 if (id
>= min_id
&& id
<= max_id
)
2288 for (j
= 0; j
< n
; j
++)
2289 if (sort_data
[j
].id
== id
)
2291 sort_data
[j
].priority
= i
;
2295 qsort (sort_data
, n
, sizeof *sort_data
, charset_compare
);
2296 for (i
= 0, tail
= charsets
; CONSP (tail
); tail
= XCDR (tail
), i
++)
2297 XSETCAR (tail
, sort_data
[i
].charset
);
2306 Lisp_Object tempdir
;
2307 tempdir
= Fexpand_file_name (build_string ("charsets"), Vdata_directory
);
2308 if (access (SSDATA (tempdir
), 0) < 0)
2310 dir_warning ("Error: charsets directory (%s) does not exist.\n\
2311 Emacs will not function correctly without the character map files.\n\
2312 Please check your installation!\n",
2314 /* TODO should this be a fatal error? (Bug#909) */
2317 Vcharset_map_path
= Fcons (tempdir
, Qnil
);
2322 init_charset_once (void)
2326 for (i
= 0; i
< ISO_MAX_DIMENSION
; i
++)
2327 for (j
= 0; j
< ISO_MAX_CHARS
; j
++)
2328 for (k
= 0; k
< ISO_MAX_FINAL
; k
++)
2329 iso_charset_table
[i
][j
][k
] = -1;
2331 for (i
= 0; i
< 256; i
++)
2332 emacs_mule_charset
[i
] = -1;
2334 charset_jisx0201_roman
= -1;
2335 charset_jisx0208_1978
= -1;
2336 charset_jisx0208
= -1;
2337 charset_ksc5601
= -1;
2343 syms_of_charset (void)
2345 DEFSYM (Qcharsetp
, "charsetp");
2347 DEFSYM (Qascii
, "ascii");
2348 DEFSYM (Qunicode
, "unicode");
2349 DEFSYM (Qemacs
, "emacs");
2350 DEFSYM (Qeight_bit
, "eight-bit");
2351 DEFSYM (Qiso_8859_1
, "iso-8859-1");
2356 staticpro (&Vcharset_ordered_list
);
2357 Vcharset_ordered_list
= Qnil
;
2359 staticpro (&Viso_2022_charset_list
);
2360 Viso_2022_charset_list
= Qnil
;
2362 staticpro (&Vemacs_mule_charset_list
);
2363 Vemacs_mule_charset_list
= Qnil
;
2365 /* Don't staticpro them here. It's done in syms_of_fns. */
2366 QCtest
= intern_c_string (":test");
2367 Qeq
= intern_c_string ("eq");
2369 staticpro (&Vcharset_hash_table
);
2371 Lisp_Object args
[2];
2374 Vcharset_hash_table
= Fmake_hash_table (2, args
);
2377 charset_table_size
= 128;
2378 charset_table
= ((struct charset
*)
2379 xmalloc (sizeof (struct charset
) * charset_table_size
));
2380 charset_table_used
= 0;
2382 defsubr (&Scharsetp
);
2383 defsubr (&Smap_charset_chars
);
2384 defsubr (&Sdefine_charset_internal
);
2385 defsubr (&Sdefine_charset_alias
);
2386 defsubr (&Scharset_plist
);
2387 defsubr (&Sset_charset_plist
);
2388 defsubr (&Sunify_charset
);
2389 defsubr (&Sget_unused_iso_final_char
);
2390 defsubr (&Sdeclare_equiv_charset
);
2391 defsubr (&Sfind_charset_region
);
2392 defsubr (&Sfind_charset_string
);
2393 defsubr (&Sdecode_char
);
2394 defsubr (&Sencode_char
);
2395 defsubr (&Ssplit_char
);
2396 defsubr (&Smake_char
);
2397 defsubr (&Schar_charset
);
2398 defsubr (&Scharset_after
);
2399 defsubr (&Siso_charset
);
2400 defsubr (&Sclear_charset_maps
);
2401 defsubr (&Scharset_priority_list
);
2402 defsubr (&Sset_charset_priority
);
2403 defsubr (&Scharset_id_internal
);
2404 defsubr (&Ssort_charsets
);
2406 DEFVAR_LISP ("charset-map-path", Vcharset_map_path
,
2407 doc
: /* *List of directories to search for charset map files. */);
2408 Vcharset_map_path
= Qnil
;
2410 DEFVAR_BOOL ("inhibit-load-charset-map", inhibit_load_charset_map
,
2411 doc
: /* Inhibit loading of charset maps. Used when dumping Emacs. */);
2412 inhibit_load_charset_map
= 0;
2414 DEFVAR_LISP ("charset-list", Vcharset_list
,
2415 doc
: /* List of all charsets ever defined. */);
2416 Vcharset_list
= Qnil
;
2418 DEFVAR_LISP ("current-iso639-language", Vcurrent_iso639_language
,
2419 doc
: /* ISO639 language mnemonic symbol for the current language environment.
2420 If the current language environment is for multiple languages (e.g. "Latin-1"),
2421 the value may be a list of mnemonics. */);
2422 Vcurrent_iso639_language
= Qnil
;
2425 = define_charset_internal (Qascii
, 1, "\x00\x7F\x00\x00\x00\x00",
2426 0, 127, 'B', -1, 0, 1, 0, 0);
2428 = define_charset_internal (Qiso_8859_1
, 1, "\x00\xFF\x00\x00\x00\x00",
2429 0, 255, -1, -1, -1, 1, 0, 0);
2431 = define_charset_internal (Qunicode
, 3, "\x00\xFF\x00\xFF\x00\x10",
2432 0, MAX_UNICODE_CHAR
, -1, 0, -1, 1, 0, 0);
2434 = define_charset_internal (Qemacs
, 3, "\x00\xFF\x00\xFF\x00\x3F",
2435 0, MAX_5_BYTE_CHAR
, -1, 0, -1, 1, 1, 0);
2437 = define_charset_internal (Qeight_bit
, 1, "\x80\xFF\x00\x00\x00\x00",
2438 128, 255, -1, 0, -1, 0, 1,
2439 MAX_5_BYTE_CHAR
+ 1);
2440 charset_unibyte
= charset_iso_8859_1
;