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 (int 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: %d", 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: %d", 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 %d, it should be 1, 2, or 3", XINT (dimension
));
1444 if (XINT (chars
) != 94 && XINT (chars
) != 96)
1445 error ("Invalid CHARS %d, it should be 94 or 96", XINT (chars
));
1446 if (XINT (final_char
) < '0' || XINT (final_char
) > '~')
1447 error ("Invalid FINAL-CHAR %c, it should be `0'..`~'", XINT (chars
));
1451 DEFUN ("declare-equiv-charset", Fdeclare_equiv_charset
, Sdeclare_equiv_charset
,
1453 doc
: /* Declare an equivalent charset for ISO-2022 decoding.
1455 On decoding by an ISO-2022 base coding system, when a charset
1456 specified by DIMENSION, CHARS, and FINAL-CHAR is designated, behave as
1457 if CHARSET is designated instead. */)
1458 (Lisp_Object dimension
, Lisp_Object chars
, Lisp_Object final_char
, Lisp_Object charset
)
1463 CHECK_CHARSET_GET_ID (charset
, id
);
1464 check_iso_charset_parameter (dimension
, chars
, final_char
);
1465 chars_flag
= XINT (chars
) == 96;
1466 ISO_CHARSET_TABLE (XINT (dimension
), chars_flag
, XINT (final_char
)) = id
;
1471 /* Return information about charsets in the text at PTR of NBYTES
1472 bytes, which are NCHARS characters. The value is:
1474 0: Each character is represented by one byte. This is always
1475 true for a unibyte string. For a multibyte string, true if
1476 it contains only ASCII characters.
1478 1: No charsets other than ascii, control-1, and latin-1 are
1485 string_xstring_p (Lisp_Object string
)
1487 const unsigned char *p
= SDATA (string
);
1488 const unsigned char *endp
= p
+ SBYTES (string
);
1490 if (SCHARS (string
) == SBYTES (string
))
1495 int c
= STRING_CHAR_ADVANCE (p
);
1504 /* Find charsets in the string at PTR of NCHARS and NBYTES.
1506 CHARSETS is a vector. If Nth element is non-nil, it means the
1507 charset whose id is N is already found.
1509 It may lookup a translation table TABLE if supplied. */
1512 find_charsets_in_text (const unsigned char *ptr
, EMACS_INT nchars
, EMACS_INT nbytes
, Lisp_Object charsets
, Lisp_Object table
, int multibyte
)
1514 const unsigned char *pend
= ptr
+ nbytes
;
1516 if (nchars
== nbytes
)
1519 ASET (charsets
, charset_ascii
, Qt
);
1526 c
= translate_char (table
, c
);
1527 if (ASCII_BYTE_P (c
))
1528 ASET (charsets
, charset_ascii
, Qt
);
1530 ASET (charsets
, charset_eight_bit
, Qt
);
1537 int c
= STRING_CHAR_ADVANCE (ptr
);
1538 struct charset
*charset
;
1541 c
= translate_char (table
, c
);
1542 charset
= CHAR_CHARSET (c
);
1543 ASET (charsets
, CHARSET_ID (charset
), Qt
);
1548 DEFUN ("find-charset-region", Ffind_charset_region
, Sfind_charset_region
,
1550 doc
: /* Return a list of charsets in the region between BEG and END.
1551 BEG and END are buffer positions.
1552 Optional arg TABLE if non-nil is a translation table to look up.
1554 If the current buffer is unibyte, the returned list may contain
1555 only `ascii', `eight-bit-control', and `eight-bit-graphic'. */)
1556 (Lisp_Object beg
, Lisp_Object end
, Lisp_Object table
)
1558 Lisp_Object charsets
;
1559 EMACS_INT from
, from_byte
, to
, stop
, stop_byte
;
1562 int multibyte
= ! NILP (BVAR (current_buffer
, enable_multibyte_characters
));
1564 validate_region (&beg
, &end
);
1565 from
= XFASTINT (beg
);
1566 stop
= to
= XFASTINT (end
);
1568 if (from
< GPT
&& GPT
< to
)
1571 stop_byte
= GPT_BYTE
;
1574 stop_byte
= CHAR_TO_BYTE (stop
);
1576 from_byte
= CHAR_TO_BYTE (from
);
1578 charsets
= Fmake_vector (make_number (charset_table_used
), Qnil
);
1581 find_charsets_in_text (BYTE_POS_ADDR (from_byte
), stop
- from
,
1582 stop_byte
- from_byte
, charsets
, table
,
1586 from
= stop
, from_byte
= stop_byte
;
1587 stop
= to
, stop_byte
= CHAR_TO_BYTE (stop
);
1594 for (i
= charset_table_used
- 1; i
>= 0; i
--)
1595 if (!NILP (AREF (charsets
, i
)))
1596 val
= Fcons (CHARSET_NAME (charset_table
+ i
), val
);
1600 DEFUN ("find-charset-string", Ffind_charset_string
, Sfind_charset_string
,
1602 doc
: /* Return a list of charsets in STR.
1603 Optional arg TABLE if non-nil is a translation table to look up.
1605 If STR is unibyte, the returned list may contain
1606 only `ascii', `eight-bit-control', and `eight-bit-graphic'. */)
1607 (Lisp_Object str
, Lisp_Object table
)
1609 Lisp_Object charsets
;
1615 charsets
= Fmake_vector (make_number (charset_table_used
), Qnil
);
1616 find_charsets_in_text (SDATA (str
), SCHARS (str
), SBYTES (str
),
1618 STRING_MULTIBYTE (str
));
1620 for (i
= charset_table_used
- 1; i
>= 0; i
--)
1621 if (!NILP (AREF (charsets
, i
)))
1622 val
= Fcons (CHARSET_NAME (charset_table
+ i
), val
);
1628 /* Return a unified character code for C (>= 0x110000). VAL is a
1629 value of Vchar_unify_table for C; i.e. it is nil, an integer, or a
1632 maybe_unify_char (int c
, Lisp_Object val
)
1634 struct charset
*charset
;
1641 CHECK_CHARSET_GET_CHARSET (val
, charset
);
1642 load_charset (charset
, 1);
1643 if (! inhibit_load_charset_map
)
1645 val
= CHAR_TABLE_REF (Vchar_unify_table
, c
);
1651 int code_index
= c
- CHARSET_CODE_OFFSET (charset
);
1652 int unified
= GET_TEMP_CHARSET_WORK_DECODER (code_index
);
1661 /* Return a character correponding to the code-point CODE of
1665 decode_char (struct charset
*charset
, unsigned int code
)
1668 enum charset_method method
= CHARSET_METHOD (charset
);
1670 if (code
< CHARSET_MIN_CODE (charset
) || code
> CHARSET_MAX_CODE (charset
))
1673 if (method
== CHARSET_METHOD_SUBSET
)
1675 Lisp_Object subset_info
;
1677 subset_info
= CHARSET_SUBSET (charset
);
1678 charset
= CHARSET_FROM_ID (XFASTINT (AREF (subset_info
, 0)));
1679 code
-= XINT (AREF (subset_info
, 3));
1680 if (code
< XFASTINT (AREF (subset_info
, 1))
1681 || code
> XFASTINT (AREF (subset_info
, 2)))
1684 c
= DECODE_CHAR (charset
, code
);
1686 else if (method
== CHARSET_METHOD_SUPERSET
)
1688 Lisp_Object parents
;
1690 parents
= CHARSET_SUPERSET (charset
);
1692 for (; CONSP (parents
); parents
= XCDR (parents
))
1694 int id
= XINT (XCAR (XCAR (parents
)));
1695 int code_offset
= XINT (XCDR (XCAR (parents
)));
1696 unsigned this_code
= code
- code_offset
;
1698 charset
= CHARSET_FROM_ID (id
);
1699 if ((c
= DECODE_CHAR (charset
, this_code
)) >= 0)
1705 char_index
= CODE_POINT_TO_INDEX (charset
, code
);
1709 if (method
== CHARSET_METHOD_MAP
)
1711 Lisp_Object decoder
;
1713 decoder
= CHARSET_DECODER (charset
);
1714 if (! VECTORP (decoder
))
1716 load_charset (charset
, 1);
1717 decoder
= CHARSET_DECODER (charset
);
1719 if (VECTORP (decoder
))
1720 c
= XINT (AREF (decoder
, char_index
));
1722 c
= GET_TEMP_CHARSET_WORK_DECODER (char_index
);
1724 else /* method == CHARSET_METHOD_OFFSET */
1726 c
= char_index
+ CHARSET_CODE_OFFSET (charset
);
1727 if (CHARSET_UNIFIED_P (charset
)
1728 && c
> MAX_UNICODE_CHAR
)
1729 MAYBE_UNIFY_CHAR (c
);
1736 /* Variable used temporarily by the macro ENCODE_CHAR. */
1737 Lisp_Object charset_work
;
1739 /* Return a code-point of CHAR in CHARSET. If CHAR doesn't belong to
1740 CHARSET, return CHARSET_INVALID_CODE (CHARSET). If STRICT is true,
1741 use CHARSET's strict_max_char instead of max_char. */
1744 encode_char (struct charset
*charset
, int c
)
1747 enum charset_method method
= CHARSET_METHOD (charset
);
1749 if (CHARSET_UNIFIED_P (charset
))
1751 Lisp_Object deunifier
;
1752 int code_index
= -1;
1754 deunifier
= CHARSET_DEUNIFIER (charset
);
1755 if (! CHAR_TABLE_P (deunifier
))
1757 load_charset (charset
, 2);
1758 deunifier
= CHARSET_DEUNIFIER (charset
);
1760 if (CHAR_TABLE_P (deunifier
))
1762 Lisp_Object deunified
= CHAR_TABLE_REF (deunifier
, c
);
1764 if (INTEGERP (deunified
))
1765 code_index
= XINT (deunified
);
1769 code_index
= GET_TEMP_CHARSET_WORK_ENCODER (c
);
1771 if (code_index
>= 0)
1772 c
= CHARSET_CODE_OFFSET (charset
) + code_index
;
1775 if (method
== CHARSET_METHOD_SUBSET
)
1777 Lisp_Object subset_info
;
1778 struct charset
*this_charset
;
1780 subset_info
= CHARSET_SUBSET (charset
);
1781 this_charset
= CHARSET_FROM_ID (XFASTINT (AREF (subset_info
, 0)));
1782 code
= ENCODE_CHAR (this_charset
, c
);
1783 if (code
== CHARSET_INVALID_CODE (this_charset
)
1784 || code
< XFASTINT (AREF (subset_info
, 1))
1785 || code
> XFASTINT (AREF (subset_info
, 2)))
1786 return CHARSET_INVALID_CODE (charset
);
1787 code
+= XINT (AREF (subset_info
, 3));
1791 if (method
== CHARSET_METHOD_SUPERSET
)
1793 Lisp_Object parents
;
1795 parents
= CHARSET_SUPERSET (charset
);
1796 for (; CONSP (parents
); parents
= XCDR (parents
))
1798 int id
= XINT (XCAR (XCAR (parents
)));
1799 int code_offset
= XINT (XCDR (XCAR (parents
)));
1800 struct charset
*this_charset
= CHARSET_FROM_ID (id
);
1802 code
= ENCODE_CHAR (this_charset
, c
);
1803 if (code
!= CHARSET_INVALID_CODE (this_charset
))
1804 return code
+ code_offset
;
1806 return CHARSET_INVALID_CODE (charset
);
1809 if (! CHARSET_FAST_MAP_REF ((c
), charset
->fast_map
)
1810 || c
< CHARSET_MIN_CHAR (charset
) || c
> CHARSET_MAX_CHAR (charset
))
1811 return CHARSET_INVALID_CODE (charset
);
1813 if (method
== CHARSET_METHOD_MAP
)
1815 Lisp_Object encoder
;
1818 encoder
= CHARSET_ENCODER (charset
);
1819 if (! CHAR_TABLE_P (CHARSET_ENCODER (charset
)))
1821 load_charset (charset
, 2);
1822 encoder
= CHARSET_ENCODER (charset
);
1824 if (CHAR_TABLE_P (encoder
))
1826 val
= CHAR_TABLE_REF (encoder
, c
);
1828 return CHARSET_INVALID_CODE (charset
);
1830 if (! CHARSET_COMPACT_CODES_P (charset
))
1831 code
= INDEX_TO_CODE_POINT (charset
, code
);
1835 code
= GET_TEMP_CHARSET_WORK_ENCODER (c
);
1836 code
= INDEX_TO_CODE_POINT (charset
, code
);
1839 else /* method == CHARSET_METHOD_OFFSET */
1841 int code_index
= c
- CHARSET_CODE_OFFSET (charset
);
1843 code
= INDEX_TO_CODE_POINT (charset
, code_index
);
1850 DEFUN ("decode-char", Fdecode_char
, Sdecode_char
, 2, 3, 0,
1851 doc
: /* Decode the pair of CHARSET and CODE-POINT into a character.
1852 Return nil if CODE-POINT is not valid in CHARSET.
1854 CODE-POINT may be a cons (HIGHER-16-BIT-VALUE . LOWER-16-BIT-VALUE).
1856 Optional argument RESTRICTION specifies a way to map the pair of CCS
1857 and CODE-POINT to a character. Currently not supported and just ignored. */)
1858 (Lisp_Object charset
, Lisp_Object code_point
, Lisp_Object restriction
)
1862 struct charset
*charsetp
;
1864 CHECK_CHARSET_GET_ID (charset
, id
);
1865 if (CONSP (code_point
))
1867 CHECK_NATNUM_CAR (code_point
);
1868 CHECK_NATNUM_CDR (code_point
);
1869 code
= (XINT (XCAR (code_point
)) << 16) | (XINT (XCDR (code_point
)));
1873 CHECK_NATNUM (code_point
);
1874 code
= XINT (code_point
);
1876 charsetp
= CHARSET_FROM_ID (id
);
1877 c
= DECODE_CHAR (charsetp
, code
);
1878 return (c
>= 0 ? make_number (c
) : Qnil
);
1882 DEFUN ("encode-char", Fencode_char
, Sencode_char
, 2, 3, 0,
1883 doc
: /* Encode the character CH into a code-point of CHARSET.
1884 Return nil if CHARSET doesn't include CH.
1886 Optional argument RESTRICTION specifies a way to map CH to a
1887 code-point in CCS. Currently not supported and just ignored. */)
1888 (Lisp_Object ch
, Lisp_Object charset
, Lisp_Object restriction
)
1892 struct charset
*charsetp
;
1894 CHECK_CHARSET_GET_ID (charset
, id
);
1896 charsetp
= CHARSET_FROM_ID (id
);
1897 code
= ENCODE_CHAR (charsetp
, XINT (ch
));
1898 if (code
== CHARSET_INVALID_CODE (charsetp
))
1900 if (code
> 0x7FFFFFF)
1901 return Fcons (make_number (code
>> 16), make_number (code
& 0xFFFF));
1902 return make_number (code
);
1906 DEFUN ("make-char", Fmake_char
, Smake_char
, 1, 5, 0,
1908 /* Return a character of CHARSET whose position codes are CODEn.
1910 CODE1 through CODE4 are optional, but if you don't supply sufficient
1911 position codes, it is assumed that the minimum code in each dimension
1913 (Lisp_Object charset
, Lisp_Object code1
, Lisp_Object code2
, Lisp_Object code3
, Lisp_Object code4
)
1916 struct charset
*charsetp
;
1920 CHECK_CHARSET_GET_ID (charset
, id
);
1921 charsetp
= CHARSET_FROM_ID (id
);
1923 dimension
= CHARSET_DIMENSION (charsetp
);
1925 code
= (CHARSET_ASCII_COMPATIBLE_P (charsetp
)
1926 ? 0 : CHARSET_MIN_CODE (charsetp
));
1929 CHECK_NATNUM (code1
);
1930 if (XFASTINT (code1
) >= 0x100)
1931 args_out_of_range (make_number (0xFF), code1
);
1932 code
= XFASTINT (code1
);
1938 code
|= charsetp
->code_space
[(dimension
- 2) * 4];
1941 CHECK_NATNUM (code2
);
1942 if (XFASTINT (code2
) >= 0x100)
1943 args_out_of_range (make_number (0xFF), code2
);
1944 code
|= XFASTINT (code2
);
1951 code
|= charsetp
->code_space
[(dimension
- 3) * 4];
1954 CHECK_NATNUM (code3
);
1955 if (XFASTINT (code3
) >= 0x100)
1956 args_out_of_range (make_number (0xFF), code3
);
1957 code
|= XFASTINT (code3
);
1964 code
|= charsetp
->code_space
[0];
1967 CHECK_NATNUM (code4
);
1968 if (XFASTINT (code4
) >= 0x100)
1969 args_out_of_range (make_number (0xFF), code4
);
1970 code
|= XFASTINT (code4
);
1977 if (CHARSET_ISO_FINAL (charsetp
) >= 0)
1979 c
= DECODE_CHAR (charsetp
, code
);
1981 error ("Invalid code(s)");
1982 return make_number (c
);
1986 /* Return the first charset in CHARSET_LIST that contains C.
1987 CHARSET_LIST is a list of charset IDs. If it is nil, use
1988 Vcharset_ordered_list. */
1991 char_charset (int c
, Lisp_Object charset_list
, unsigned int *code_return
)
1995 if (NILP (charset_list
))
1996 charset_list
= Vcharset_ordered_list
;
2000 while (CONSP (charset_list
))
2002 struct charset
*charset
= CHARSET_FROM_ID (XINT (XCAR (charset_list
)));
2003 unsigned code
= ENCODE_CHAR (charset
, c
);
2005 if (code
!= CHARSET_INVALID_CODE (charset
))
2008 *code_return
= code
;
2011 charset_list
= XCDR (charset_list
);
2013 && c
<= MAX_UNICODE_CHAR
2014 && EQ (charset_list
, Vcharset_non_preferred_head
))
2015 return CHARSET_FROM_ID (charset_unicode
);
2017 return (maybe_null
? NULL
2018 : c
<= MAX_5_BYTE_CHAR
? CHARSET_FROM_ID (charset_emacs
)
2019 : CHARSET_FROM_ID (charset_eight_bit
));
2023 DEFUN ("split-char", Fsplit_char
, Ssplit_char
, 1, 1, 0,
2025 /*Return list of charset and one to four position-codes of CH.
2026 The charset is decided by the current priority order of charsets.
2027 A position-code is a byte value of each dimension of the code-point of
2028 CH in the charset. */)
2031 struct charset
*charset
;
2036 CHECK_CHARACTER (ch
);
2038 charset
= CHAR_CHARSET (c
);
2041 code
= ENCODE_CHAR (charset
, c
);
2042 if (code
== CHARSET_INVALID_CODE (charset
))
2044 dimension
= CHARSET_DIMENSION (charset
);
2045 for (val
= Qnil
; dimension
> 0; dimension
--)
2047 val
= Fcons (make_number (code
& 0xFF), val
);
2050 return Fcons (CHARSET_NAME (charset
), val
);
2054 DEFUN ("char-charset", Fchar_charset
, Schar_charset
, 1, 2, 0,
2055 doc
: /* Return the charset of highest priority that contains CH.
2056 If optional 2nd arg RESTRICTION is non-nil, it is a list of charsets
2057 from which to find the charset. It may also be a coding system. In
2058 that case, find the charset from what supported by that coding system. */)
2059 (Lisp_Object ch
, Lisp_Object restriction
)
2061 struct charset
*charset
;
2063 CHECK_CHARACTER (ch
);
2064 if (NILP (restriction
))
2065 charset
= CHAR_CHARSET (XINT (ch
));
2068 if (CONSP (restriction
))
2070 int c
= XFASTINT (ch
);
2072 for (; CONSP (restriction
); restriction
= XCDR (restriction
))
2074 struct charset
*rcharset
;
2076 CHECK_CHARSET_GET_CHARSET (XCAR (restriction
), rcharset
);
2077 if (ENCODE_CHAR (rcharset
, c
) != CHARSET_INVALID_CODE (rcharset
))
2078 return XCAR (restriction
);
2082 restriction
= coding_system_charset_list (restriction
);
2083 charset
= char_charset (XINT (ch
), restriction
, NULL
);
2087 return (CHARSET_NAME (charset
));
2091 DEFUN ("charset-after", Fcharset_after
, Scharset_after
, 0, 1, 0,
2093 Return charset of a character in the current buffer at position POS.
2094 If POS is nil, it defauls to the current point.
2095 If POS is out of range, the value is nil. */)
2099 struct charset
*charset
;
2101 ch
= Fchar_after (pos
);
2102 if (! INTEGERP (ch
))
2104 charset
= CHAR_CHARSET (XINT (ch
));
2105 return (CHARSET_NAME (charset
));
2109 DEFUN ("iso-charset", Fiso_charset
, Siso_charset
, 3, 3, 0,
2111 Return charset of ISO's specification DIMENSION, CHARS, and FINAL-CHAR.
2113 ISO 2022's designation sequence (escape sequence) distinguishes charsets
2114 by their DIMENSION, CHARS, and FINAL-CHAR,
2115 whereas Emacs distinguishes them by charset symbol.
2116 See the documentation of the function `charset-info' for the meanings of
2117 DIMENSION, CHARS, and FINAL-CHAR. */)
2118 (Lisp_Object dimension
, Lisp_Object chars
, Lisp_Object final_char
)
2123 check_iso_charset_parameter (dimension
, chars
, final_char
);
2124 chars_flag
= XFASTINT (chars
) == 96;
2125 id
= ISO_CHARSET_TABLE (XFASTINT (dimension
), chars_flag
,
2126 XFASTINT (final_char
));
2127 return (id
>= 0 ? CHARSET_NAME (CHARSET_FROM_ID (id
)) : Qnil
);
2131 DEFUN ("clear-charset-maps", Fclear_charset_maps
, Sclear_charset_maps
,
2135 Clear temporary charset mapping tables.
2136 It should be called only from temacs invoked for dumping. */)
2139 if (temp_charset_work
)
2141 free (temp_charset_work
);
2142 temp_charset_work
= NULL
;
2145 if (CHAR_TABLE_P (Vchar_unify_table
))
2146 Foptimize_char_table (Vchar_unify_table
, Qnil
);
2151 DEFUN ("charset-priority-list", Fcharset_priority_list
,
2152 Scharset_priority_list
, 0, 1, 0,
2153 doc
: /* Return the list of charsets ordered by priority.
2154 HIGHESTP non-nil means just return the highest priority one. */)
2155 (Lisp_Object highestp
)
2157 Lisp_Object val
= Qnil
, list
= Vcharset_ordered_list
;
2159 if (!NILP (highestp
))
2160 return CHARSET_NAME (CHARSET_FROM_ID (XINT (Fcar (list
))));
2162 while (!NILP (list
))
2164 val
= Fcons (CHARSET_NAME (CHARSET_FROM_ID (XINT (XCAR (list
)))), val
);
2167 return Fnreverse (val
);
2170 DEFUN ("set-charset-priority", Fset_charset_priority
, Sset_charset_priority
,
2172 doc
: /* Assign higher priority to the charsets given as arguments.
2173 usage: (set-charset-priority &rest charsets) */)
2174 (int nargs
, Lisp_Object
*args
)
2176 Lisp_Object new_head
, old_list
, arglist
[2];
2177 Lisp_Object list_2022
, list_emacs_mule
;
2180 old_list
= Fcopy_sequence (Vcharset_ordered_list
);
2182 for (i
= 0; i
< nargs
; i
++)
2184 CHECK_CHARSET_GET_ID (args
[i
], id
);
2185 if (! NILP (Fmemq (make_number (id
), old_list
)))
2187 old_list
= Fdelq (make_number (id
), old_list
);
2188 new_head
= Fcons (make_number (id
), new_head
);
2191 arglist
[0] = Fnreverse (new_head
);
2192 arglist
[1] = Vcharset_non_preferred_head
= old_list
;
2193 Vcharset_ordered_list
= Fnconc (2, arglist
);
2194 charset_ordered_list_tick
++;
2196 charset_unibyte
= -1;
2197 for (old_list
= Vcharset_ordered_list
, list_2022
= list_emacs_mule
= Qnil
;
2198 CONSP (old_list
); old_list
= XCDR (old_list
))
2200 if (! NILP (Fmemq (XCAR (old_list
), Viso_2022_charset_list
)))
2201 list_2022
= Fcons (XCAR (old_list
), list_2022
);
2202 if (! NILP (Fmemq (XCAR (old_list
), Vemacs_mule_charset_list
)))
2203 list_emacs_mule
= Fcons (XCAR (old_list
), list_emacs_mule
);
2204 if (charset_unibyte
< 0)
2206 struct charset
*charset
= CHARSET_FROM_ID (XINT (XCAR (old_list
)));
2208 if (CHARSET_DIMENSION (charset
) == 1
2209 && CHARSET_ASCII_COMPATIBLE_P (charset
)
2210 && CHARSET_MAX_CHAR (charset
) >= 0x80)
2211 charset_unibyte
= CHARSET_ID (charset
);
2214 Viso_2022_charset_list
= Fnreverse (list_2022
);
2215 Vemacs_mule_charset_list
= Fnreverse (list_emacs_mule
);
2216 if (charset_unibyte
< 0)
2217 charset_unibyte
= charset_iso_8859_1
;
2222 DEFUN ("charset-id-internal", Fcharset_id_internal
, Scharset_id_internal
,
2224 doc
: /* Internal use only.
2225 Return charset identification number of CHARSET. */)
2226 (Lisp_Object charset
)
2230 CHECK_CHARSET_GET_ID (charset
, id
);
2231 return make_number (id
);
2234 struct charset_sort_data
2236 Lisp_Object charset
;
2242 charset_compare (const void *d1
, const void *d2
)
2244 const struct charset_sort_data
*data1
= d1
, *data2
= d2
;
2245 return (data1
->priority
- data2
->priority
);
2248 DEFUN ("sort-charsets", Fsort_charsets
, Ssort_charsets
, 1, 1, 0,
2249 doc
: /* Sort charset list CHARSETS by a priority of each charset.
2250 Return the sorted list. CHARSETS is modified by side effects.
2251 See also `charset-priority-list' and `set-charset-priority'. */)
2252 (Lisp_Object charsets
)
2254 Lisp_Object len
= Flength (charsets
);
2255 int n
= XFASTINT (len
), i
, j
, done
;
2256 Lisp_Object tail
, elt
, attrs
;
2257 struct charset_sort_data
*sort_data
;
2258 int id
, min_id
= INT_MAX
, max_id
= INT_MIN
;
2263 SAFE_ALLOCA (sort_data
, struct charset_sort_data
*, sizeof (*sort_data
) * n
);
2264 for (tail
= charsets
, i
= 0; CONSP (tail
); tail
= XCDR (tail
), i
++)
2267 CHECK_CHARSET_GET_ATTR (elt
, attrs
);
2268 sort_data
[i
].charset
= elt
;
2269 sort_data
[i
].id
= id
= XINT (CHARSET_ATTR_ID (attrs
));
2275 for (done
= 0, tail
= Vcharset_ordered_list
, i
= 0;
2276 done
< n
&& CONSP (tail
); tail
= XCDR (tail
), i
++)
2279 id
= XFASTINT (elt
);
2280 if (id
>= min_id
&& id
<= max_id
)
2281 for (j
= 0; j
< n
; j
++)
2282 if (sort_data
[j
].id
== id
)
2284 sort_data
[j
].priority
= i
;
2288 qsort (sort_data
, n
, sizeof *sort_data
, charset_compare
);
2289 for (i
= 0, tail
= charsets
; CONSP (tail
); tail
= XCDR (tail
), i
++)
2290 XSETCAR (tail
, sort_data
[i
].charset
);
2299 Lisp_Object tempdir
;
2300 tempdir
= Fexpand_file_name (build_string ("charsets"), Vdata_directory
);
2301 if (access (SSDATA (tempdir
), 0) < 0)
2303 dir_warning ("Error: charsets directory (%s) does not exist.\n\
2304 Emacs will not function correctly without the character map files.\n\
2305 Please check your installation!\n",
2307 /* TODO should this be a fatal error? (Bug#909) */
2310 Vcharset_map_path
= Fcons (tempdir
, Qnil
);
2315 init_charset_once (void)
2319 for (i
= 0; i
< ISO_MAX_DIMENSION
; i
++)
2320 for (j
= 0; j
< ISO_MAX_CHARS
; j
++)
2321 for (k
= 0; k
< ISO_MAX_FINAL
; k
++)
2322 iso_charset_table
[i
][j
][k
] = -1;
2324 for (i
= 0; i
< 256; i
++)
2325 emacs_mule_charset
[i
] = -1;
2327 charset_jisx0201_roman
= -1;
2328 charset_jisx0208_1978
= -1;
2329 charset_jisx0208
= -1;
2330 charset_ksc5601
= -1;
2336 syms_of_charset (void)
2338 DEFSYM (Qcharsetp
, "charsetp");
2340 DEFSYM (Qascii
, "ascii");
2341 DEFSYM (Qunicode
, "unicode");
2342 DEFSYM (Qemacs
, "emacs");
2343 DEFSYM (Qeight_bit
, "eight-bit");
2344 DEFSYM (Qiso_8859_1
, "iso-8859-1");
2349 staticpro (&Vcharset_ordered_list
);
2350 Vcharset_ordered_list
= Qnil
;
2352 staticpro (&Viso_2022_charset_list
);
2353 Viso_2022_charset_list
= Qnil
;
2355 staticpro (&Vemacs_mule_charset_list
);
2356 Vemacs_mule_charset_list
= Qnil
;
2358 /* Don't staticpro them here. It's done in syms_of_fns. */
2359 QCtest
= intern_c_string (":test");
2360 Qeq
= intern_c_string ("eq");
2362 staticpro (&Vcharset_hash_table
);
2364 Lisp_Object args
[2];
2367 Vcharset_hash_table
= Fmake_hash_table (2, args
);
2370 charset_table_size
= 128;
2371 charset_table
= ((struct charset
*)
2372 xmalloc (sizeof (struct charset
) * charset_table_size
));
2373 charset_table_used
= 0;
2375 defsubr (&Scharsetp
);
2376 defsubr (&Smap_charset_chars
);
2377 defsubr (&Sdefine_charset_internal
);
2378 defsubr (&Sdefine_charset_alias
);
2379 defsubr (&Scharset_plist
);
2380 defsubr (&Sset_charset_plist
);
2381 defsubr (&Sunify_charset
);
2382 defsubr (&Sget_unused_iso_final_char
);
2383 defsubr (&Sdeclare_equiv_charset
);
2384 defsubr (&Sfind_charset_region
);
2385 defsubr (&Sfind_charset_string
);
2386 defsubr (&Sdecode_char
);
2387 defsubr (&Sencode_char
);
2388 defsubr (&Ssplit_char
);
2389 defsubr (&Smake_char
);
2390 defsubr (&Schar_charset
);
2391 defsubr (&Scharset_after
);
2392 defsubr (&Siso_charset
);
2393 defsubr (&Sclear_charset_maps
);
2394 defsubr (&Scharset_priority_list
);
2395 defsubr (&Sset_charset_priority
);
2396 defsubr (&Scharset_id_internal
);
2397 defsubr (&Ssort_charsets
);
2399 DEFVAR_LISP ("charset-map-path", Vcharset_map_path
,
2400 doc
: /* *List of directories to search for charset map files. */);
2401 Vcharset_map_path
= Qnil
;
2403 DEFVAR_BOOL ("inhibit-load-charset-map", inhibit_load_charset_map
,
2404 doc
: /* Inhibit loading of charset maps. Used when dumping Emacs. */);
2405 inhibit_load_charset_map
= 0;
2407 DEFVAR_LISP ("charset-list", Vcharset_list
,
2408 doc
: /* List of all charsets ever defined. */);
2409 Vcharset_list
= Qnil
;
2411 DEFVAR_LISP ("current-iso639-language", Vcurrent_iso639_language
,
2412 doc
: /* ISO639 language mnemonic symbol for the current language environment.
2413 If the current language environment is for multiple languages (e.g. "Latin-1"),
2414 the value may be a list of mnemonics. */);
2415 Vcurrent_iso639_language
= Qnil
;
2418 = define_charset_internal (Qascii
, 1, "\x00\x7F\x00\x00\x00\x00",
2419 0, 127, 'B', -1, 0, 1, 0, 0);
2421 = define_charset_internal (Qiso_8859_1
, 1, "\x00\xFF\x00\x00\x00\x00",
2422 0, 255, -1, -1, -1, 1, 0, 0);
2424 = define_charset_internal (Qunicode
, 3, "\x00\xFF\x00\xFF\x00\x10",
2425 0, MAX_UNICODE_CHAR
, -1, 0, -1, 1, 0, 0);
2427 = define_charset_internal (Qemacs
, 3, "\x00\xFF\x00\xFF\x00\x3F",
2428 0, MAX_5_BYTE_CHAR
, -1, 0, -1, 1, 1, 0);
2430 = define_charset_internal (Qeight_bit
, 1, "\x80\xFF\x00\x00\x00\x00",
2431 128, 255, -1, 0, -1, 0, 1,
2432 MAX_5_BYTE_CHAR
+ 1);
2433 charset_unibyte
= charset_iso_8859_1
;