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 static Lisp_Object Qeight_bit
;
72 static Lisp_Object Qiso_8859_1
;
73 static Lisp_Object Qunicode
;
74 static Lisp_Object Qemacs
;
76 /* The corresponding charsets. */
78 int charset_eight_bit
;
79 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'. */
90 static Lisp_Object Qgl
, Qgr
;
92 /* Charset of unibyte characters. */
95 /* List of charsets ordered by the priority. */
96 Lisp_Object Vcharset_ordered_list
;
98 /* Sub-list of Vcharset_ordered_list that contains all non-preferred
100 Lisp_Object Vcharset_non_preferred_head
;
102 /* Incremented everytime we change Vcharset_ordered_list. This is
103 unsigned short so that it fits in Lisp_Int and never matches
105 unsigned short charset_ordered_list_tick
;
107 /* List of iso-2022 charsets. */
108 Lisp_Object Viso_2022_charset_list
;
110 /* List of emacs-mule charsets. */
111 Lisp_Object Vemacs_mule_charset_list
;
113 int emacs_mule_charset
[256];
115 /* Mapping table from ISO2022's charset (specified by DIMENSION,
116 CHARS, and FINAL-CHAR) to Emacs' charset. */
117 int iso_charset_table
[ISO_MAX_DIMENSION
][ISO_MAX_CHARS
][ISO_MAX_FINAL
];
119 #define CODE_POINT_TO_INDEX(charset, code) \
120 ((charset)->code_linear_p \
121 ? (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
, lim_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)
342 lim_index
= to_index
+ 1;
346 else if (from_c
< min_char
)
349 if (control_flag
== 1)
351 if (charset
->method
== CHARSET_METHOD_MAP
)
352 for (; from_index
< lim_index
; from_index
++, from_c
++)
353 ASET (vec
, from_index
, make_number (from_c
));
355 for (; from_index
< lim_index
; from_index
++, from_c
++)
356 CHAR_TABLE_SET (Vchar_unify_table
,
357 CHARSET_CODE_OFFSET (charset
) + from_index
,
358 make_number (from_c
));
360 else if (control_flag
== 2)
362 if (charset
->method
== CHARSET_METHOD_MAP
363 && CHARSET_COMPACT_CODES_P (charset
))
364 for (; from_index
< lim_index
; from_index
++, from_c
++)
366 unsigned code
= INDEX_TO_CODE_POINT (charset
, from_index
);
368 if (NILP (CHAR_TABLE_REF (table
, from_c
)))
369 CHAR_TABLE_SET (table
, from_c
, make_number (code
));
372 for (; from_index
< lim_index
; from_index
++, from_c
++)
374 if (NILP (CHAR_TABLE_REF (table
, from_c
)))
375 CHAR_TABLE_SET (table
, from_c
, make_number (from_index
));
378 else if (control_flag
== 3)
379 for (; from_index
< lim_index
; from_index
++, from_c
++)
380 SET_TEMP_CHARSET_WORK_DECODER (from_c
, from_index
);
381 else if (control_flag
== 4)
382 for (; from_index
< lim_index
; from_index
++, from_c
++)
383 SET_TEMP_CHARSET_WORK_ENCODER (from_c
, from_index
);
384 else /* control_flag == 0 */
386 if (ascii_compatible_p
)
388 if (! ASCII_BYTE_P (from_c
))
390 if (from_c
< nonascii_min_char
)
391 nonascii_min_char
= from_c
;
393 else if (! ASCII_BYTE_P (to_c
))
395 nonascii_min_char
= 0x80;
399 for (; from_c
<= to_c
; from_c
++)
400 CHARSET_FAST_MAP_SET (from_c
, fast_map
);
404 if (control_flag
== 0)
406 CHARSET_MIN_CHAR (charset
) = (ascii_compatible_p
407 ? nonascii_min_char
: min_char
);
408 CHARSET_MAX_CHAR (charset
) = max_char
;
410 else if (control_flag
== 4)
412 temp_charset_work
->min_char
= min_char
;
413 temp_charset_work
->max_char
= max_char
;
418 /* Read a hexadecimal number (preceded by "0x") from the file FP while
419 paying attention to comment character '#'. */
421 static INLINE
unsigned
422 read_hex (FILE *fp
, int *eof
)
427 while ((c
= getc (fp
)) != EOF
)
431 while ((c
= getc (fp
)) != EOF
&& c
!= '\n');
435 if ((c
= getc (fp
)) == EOF
|| c
== 'x')
447 while ((c
= getc (fp
)) != EOF
&& isxdigit (c
))
449 | (c
<= '9' ? c
- '0' : c
<= 'F' ? c
- 'A' + 10 : c
- 'a' + 10));
451 while ((c
= getc (fp
)) != EOF
&& isdigit (c
))
452 n
= (n
* 10) + c
- '0';
458 /* Return a mapping vector for CHARSET loaded from MAPFILE.
459 Each line of MAPFILE has this form
461 where 0xAAAA is a code-point and 0xCCCC is the corresponding
462 character code, or this form
464 where 0xAAAA and 0xBBBB are code-points specifying a range, and
465 0xCCCC is the first character code of the range.
467 The returned vector has this form:
468 [ CODE1 CHAR1 CODE2 CHAR2 .... ]
469 where CODE1 is a code-point or a cons of code-points specifying a
472 Note that this function uses `openp' to open MAPFILE but ignores
473 `file-name-handler-alist' to avoid running any Lisp code. */
476 load_charset_map_from_file (struct charset
*charset
, Lisp_Object mapfile
, int control_flag
)
478 unsigned min_code
= CHARSET_MIN_CODE (charset
);
479 unsigned max_code
= CHARSET_MAX_CODE (charset
);
483 Lisp_Object suffixes
;
484 struct charset_map_entries
*head
, *entries
;
485 int n_entries
, count
;
488 suffixes
= Fcons (build_string (".map"),
489 Fcons (build_string (".TXT"), Qnil
));
491 count
= SPECPDL_INDEX ();
492 specbind (Qfile_name_handler_alist
, Qnil
);
493 fd
= openp (Vcharset_map_path
, mapfile
, suffixes
, NULL
, Qnil
);
494 unbind_to (count
, Qnil
);
496 || ! (fp
= fdopen (fd
, "r")))
497 error ("Failure in loading charset map: %s", SDATA (mapfile
));
499 /* Use SAFE_ALLOCA instead of alloca, as `charset_map_entries' is
500 large (larger than MAX_ALLOCA). */
501 SAFE_ALLOCA (head
, struct charset_map_entries
*,
502 sizeof (struct charset_map_entries
));
504 memset (entries
, 0, sizeof (struct charset_map_entries
));
514 from
= read_hex (fp
, &eof
);
517 if (getc (fp
) == '-')
518 to
= read_hex (fp
, &eof
);
521 c
= (int) read_hex (fp
, &eof
);
523 if (from
< min_code
|| to
> max_code
|| from
> to
|| c
> MAX_CHAR
)
526 if (n_entries
> 0 && (n_entries
% 0x10000) == 0)
528 SAFE_ALLOCA (entries
->next
, struct charset_map_entries
*,
529 sizeof (struct charset_map_entries
));
530 entries
= entries
->next
;
531 memset (entries
, 0, sizeof (struct charset_map_entries
));
533 idx
= n_entries
% 0x10000;
534 entries
->entry
[idx
].from
= from
;
535 entries
->entry
[idx
].to
= to
;
536 entries
->entry
[idx
].c
= c
;
541 load_charset_map (charset
, head
, n_entries
, control_flag
);
546 load_charset_map_from_vector (struct charset
*charset
, Lisp_Object vec
, int control_flag
)
548 unsigned min_code
= CHARSET_MIN_CODE (charset
);
549 unsigned max_code
= CHARSET_MAX_CODE (charset
);
550 struct charset_map_entries
*head
, *entries
;
552 int len
= ASIZE (vec
);
558 add_to_log ("Failure in loading charset map: %V", vec
, Qnil
);
562 /* Use SAFE_ALLOCA instead of alloca, as `charset_map_entries' is
563 large (larger than MAX_ALLOCA). */
564 SAFE_ALLOCA (head
, struct charset_map_entries
*,
565 sizeof (struct charset_map_entries
));
567 memset (entries
, 0, sizeof (struct charset_map_entries
));
570 for (i
= 0; i
< len
; i
+= 2)
572 Lisp_Object val
, val2
;
584 from
= XFASTINT (val
);
585 to
= XFASTINT (val2
);
590 from
= to
= XFASTINT (val
);
592 val
= AREF (vec
, i
+ 1);
596 if (from
< min_code
|| to
> max_code
|| from
> to
|| c
> MAX_CHAR
)
599 if (n_entries
> 0 && (n_entries
% 0x10000) == 0)
601 SAFE_ALLOCA (entries
->next
, struct charset_map_entries
*,
602 sizeof (struct charset_map_entries
));
603 entries
= entries
->next
;
604 memset (entries
, 0, sizeof (struct charset_map_entries
));
606 idx
= n_entries
% 0x10000;
607 entries
->entry
[idx
].from
= from
;
608 entries
->entry
[idx
].to
= to
;
609 entries
->entry
[idx
].c
= c
;
613 load_charset_map (charset
, head
, n_entries
, control_flag
);
618 /* Load a mapping table for CHARSET. CONTROL-FLAG tells what kind of
619 map it is (see the comment of load_charset_map for the detail). */
622 load_charset (struct charset
*charset
, int control_flag
)
626 if (inhibit_load_charset_map
628 && charset
== temp_charset_work
->current
629 && ((control_flag
== 2) == temp_charset_work
->for_encoder
))
632 if (CHARSET_METHOD (charset
) == CHARSET_METHOD_MAP
)
633 map
= CHARSET_MAP (charset
);
636 if (! CHARSET_UNIFIED_P (charset
))
638 map
= CHARSET_UNIFY_MAP (charset
);
641 load_charset_map_from_file (charset
, map
, control_flag
);
643 load_charset_map_from_vector (charset
, map
, control_flag
);
647 DEFUN ("charsetp", Fcharsetp
, Scharsetp
, 1, 1, 0,
648 doc
: /* Return non-nil if and only if OBJECT is a charset.*/)
651 return (CHARSETP (object
) ? Qt
: Qnil
);
655 void map_charset_for_dump (void (*c_function
) (Lisp_Object
, Lisp_Object
),
656 Lisp_Object function
, Lisp_Object arg
,
657 unsigned from
, unsigned to
);
660 map_charset_for_dump (void (*c_function
) (Lisp_Object
, Lisp_Object
), Lisp_Object function
, Lisp_Object arg
, unsigned int from
, unsigned int to
)
662 int from_idx
= CODE_POINT_TO_INDEX (temp_charset_work
->current
, from
);
663 int to_idx
= CODE_POINT_TO_INDEX (temp_charset_work
->current
, to
);
668 range
= Fcons (Qnil
, Qnil
);
671 c
= temp_charset_work
->min_char
;
672 stop
= (temp_charset_work
->max_char
< 0x20000
673 ? temp_charset_work
->max_char
: 0xFFFF);
677 int idx
= GET_TEMP_CHARSET_WORK_ENCODER (c
);
679 if (idx
>= from_idx
&& idx
<= to_idx
)
681 if (NILP (XCAR (range
)))
682 XSETCAR (range
, make_number (c
));
684 else if (! NILP (XCAR (range
)))
686 XSETCDR (range
, make_number (c
- 1));
688 (*c_function
) (arg
, range
);
690 call2 (function
, range
, arg
);
691 XSETCAR (range
, Qnil
);
695 if (c
== temp_charset_work
->max_char
)
697 if (! NILP (XCAR (range
)))
699 XSETCDR (range
, make_number (c
));
701 (*c_function
) (arg
, range
);
703 call2 (function
, range
, arg
);
708 stop
= temp_charset_work
->max_char
;
716 map_charset_chars (void (*c_function
)(Lisp_Object
, Lisp_Object
), Lisp_Object function
,
717 Lisp_Object arg
, struct charset
*charset
, unsigned from
, unsigned to
)
722 partial
= (from
> CHARSET_MIN_CODE (charset
)
723 || to
< CHARSET_MAX_CODE (charset
));
725 if (CHARSET_METHOD (charset
) == CHARSET_METHOD_OFFSET
)
727 int from_idx
= CODE_POINT_TO_INDEX (charset
, from
);
728 int to_idx
= CODE_POINT_TO_INDEX (charset
, to
);
729 int from_c
= from_idx
+ CHARSET_CODE_OFFSET (charset
);
730 int to_c
= to_idx
+ CHARSET_CODE_OFFSET (charset
);
732 if (CHARSET_UNIFIED_P (charset
))
734 if (! CHAR_TABLE_P (CHARSET_DEUNIFIER (charset
)))
735 load_charset (charset
, 2);
736 if (CHAR_TABLE_P (CHARSET_DEUNIFIER (charset
)))
737 map_char_table_for_charset (c_function
, function
,
738 CHARSET_DEUNIFIER (charset
), arg
,
739 partial
? charset
: NULL
, from
, to
);
741 map_charset_for_dump (c_function
, function
, arg
, from
, to
);
744 range
= Fcons (make_number (from_c
), make_number (to_c
));
746 (*c_function
) (arg
, range
);
748 call2 (function
, range
, arg
);
750 else if (CHARSET_METHOD (charset
) == CHARSET_METHOD_MAP
)
752 if (! CHAR_TABLE_P (CHARSET_ENCODER (charset
)))
753 load_charset (charset
, 2);
754 if (CHAR_TABLE_P (CHARSET_ENCODER (charset
)))
755 map_char_table_for_charset (c_function
, function
,
756 CHARSET_ENCODER (charset
), arg
,
757 partial
? charset
: NULL
, from
, to
);
759 map_charset_for_dump (c_function
, function
, arg
, from
, to
);
761 else if (CHARSET_METHOD (charset
) == CHARSET_METHOD_SUBSET
)
763 Lisp_Object subset_info
;
766 subset_info
= CHARSET_SUBSET (charset
);
767 charset
= CHARSET_FROM_ID (XFASTINT (AREF (subset_info
, 0)));
768 offset
= XINT (AREF (subset_info
, 3));
770 if (from
< XFASTINT (AREF (subset_info
, 1)))
771 from
= XFASTINT (AREF (subset_info
, 1));
773 if (to
> XFASTINT (AREF (subset_info
, 2)))
774 to
= XFASTINT (AREF (subset_info
, 2));
775 map_charset_chars (c_function
, function
, arg
, charset
, from
, to
);
777 else /* i.e. CHARSET_METHOD_SUPERSET */
781 for (parents
= CHARSET_SUPERSET (charset
); CONSP (parents
);
782 parents
= XCDR (parents
))
785 unsigned this_from
, this_to
;
787 charset
= CHARSET_FROM_ID (XFASTINT (XCAR (XCAR (parents
))));
788 offset
= XINT (XCDR (XCAR (parents
)));
789 this_from
= from
> offset
? from
- offset
: 0;
790 this_to
= to
> offset
? to
- offset
: 0;
791 if (this_from
< CHARSET_MIN_CODE (charset
))
792 this_from
= CHARSET_MIN_CODE (charset
);
793 if (this_to
> CHARSET_MAX_CODE (charset
))
794 this_to
= CHARSET_MAX_CODE (charset
);
795 map_charset_chars (c_function
, function
, arg
, charset
,
801 DEFUN ("map-charset-chars", Fmap_charset_chars
, Smap_charset_chars
, 2, 5, 0,
802 doc
: /* Call FUNCTION for all characters in CHARSET.
803 FUNCTION is called with an argument RANGE and the optional 3rd
806 RANGE is a cons (FROM . TO), where FROM and TO indicate a range of
807 characters contained in CHARSET.
809 The optional 4th and 5th arguments FROM-CODE and TO-CODE specify the
810 range of code points (in CHARSET) of target characters. */)
811 (Lisp_Object function
, Lisp_Object charset
, Lisp_Object arg
, Lisp_Object from_code
, Lisp_Object to_code
)
816 CHECK_CHARSET_GET_CHARSET (charset
, cs
);
817 if (NILP (from_code
))
818 from
= CHARSET_MIN_CODE (cs
);
821 CHECK_NATNUM (from_code
);
822 from
= XINT (from_code
);
823 if (from
< CHARSET_MIN_CODE (cs
))
824 from
= CHARSET_MIN_CODE (cs
);
827 to
= CHARSET_MAX_CODE (cs
);
830 CHECK_NATNUM (to_code
);
832 if (to
> CHARSET_MAX_CODE (cs
))
833 to
= CHARSET_MAX_CODE (cs
);
835 map_charset_chars (NULL
, function
, arg
, cs
, from
, to
);
840 /* Define a charset according to the arguments. The Nth argument is
841 the Nth attribute of the charset (the last attribute `charset-id'
842 is not included). See the docstring of `define-charset' for the
845 DEFUN ("define-charset-internal", Fdefine_charset_internal
,
846 Sdefine_charset_internal
, charset_arg_max
, MANY
, 0,
847 doc
: /* For internal use only.
848 usage: (define-charset-internal ...) */)
849 (size_t nargs
, Lisp_Object
*args
)
851 /* Charset attr vector. */
855 struct Lisp_Hash_Table
*hash_table
= XHASH_TABLE (Vcharset_hash_table
);
857 struct charset charset
;
860 int new_definition_p
;
863 if (nargs
!= charset_arg_max
)
864 return Fsignal (Qwrong_number_of_arguments
,
865 Fcons (intern ("define-charset-internal"),
866 make_number (nargs
)));
868 attrs
= Fmake_vector (make_number (charset_attr_max
), Qnil
);
870 CHECK_SYMBOL (args
[charset_arg_name
]);
871 ASET (attrs
, charset_name
, args
[charset_arg_name
]);
873 val
= args
[charset_arg_code_space
];
874 for (i
= 0, dimension
= 0, nchars
= 1; i
< 4; i
++)
876 int min_byte
, max_byte
;
878 min_byte
= XINT (Faref (val
, make_number (i
* 2)));
879 max_byte
= XINT (Faref (val
, make_number (i
* 2 + 1)));
880 if (min_byte
< 0 || min_byte
> max_byte
|| max_byte
>= 256)
881 error ("Invalid :code-space value");
882 charset
.code_space
[i
* 4] = min_byte
;
883 charset
.code_space
[i
* 4 + 1] = max_byte
;
884 charset
.code_space
[i
* 4 + 2] = max_byte
- min_byte
+ 1;
885 nchars
*= charset
.code_space
[i
* 4 + 2];
886 charset
.code_space
[i
* 4 + 3] = nchars
;
891 val
= args
[charset_arg_dimension
];
893 charset
.dimension
= dimension
;
897 charset
.dimension
= XINT (val
);
898 if (charset
.dimension
< 1 || charset
.dimension
> 4)
899 args_out_of_range_3 (val
, make_number (1), make_number (4));
902 charset
.code_linear_p
903 = (charset
.dimension
== 1
904 || (charset
.code_space
[2] == 256
905 && (charset
.dimension
== 2
906 || (charset
.code_space
[6] == 256
907 && (charset
.dimension
== 3
908 || charset
.code_space
[10] == 256)))));
910 if (! charset
.code_linear_p
)
912 charset
.code_space_mask
= (unsigned char *) xmalloc (256);
913 memset (charset
.code_space_mask
, 0, 256);
914 for (i
= 0; i
< 4; i
++)
915 for (j
= charset
.code_space
[i
* 4]; j
<= charset
.code_space
[i
* 4 + 1];
917 charset
.code_space_mask
[j
] |= (1 << i
);
920 charset
.iso_chars_96
= charset
.code_space
[2] == 96;
922 charset
.min_code
= (charset
.code_space
[0]
923 | (charset
.code_space
[4] << 8)
924 | (charset
.code_space
[8] << 16)
925 | (charset
.code_space
[12] << 24));
926 charset
.max_code
= (charset
.code_space
[1]
927 | (charset
.code_space
[5] << 8)
928 | (charset
.code_space
[9] << 16)
929 | (charset
.code_space
[13] << 24));
930 charset
.char_index_offset
= 0;
932 val
= args
[charset_arg_min_code
];
942 CHECK_NUMBER_CAR (val
);
943 CHECK_NUMBER_CDR (val
);
944 code
= (XINT (XCAR (val
)) << 16) | (XINT (XCDR (val
)));
946 if (code
< charset
.min_code
947 || code
> charset
.max_code
)
948 args_out_of_range_3 (make_number (charset
.min_code
),
949 make_number (charset
.max_code
), val
);
950 charset
.char_index_offset
= CODE_POINT_TO_INDEX (&charset
, code
);
951 charset
.min_code
= code
;
954 val
= args
[charset_arg_max_code
];
964 CHECK_NUMBER_CAR (val
);
965 CHECK_NUMBER_CDR (val
);
966 code
= (XINT (XCAR (val
)) << 16) | (XINT (XCDR (val
)));
968 if (code
< charset
.min_code
969 || code
> charset
.max_code
)
970 args_out_of_range_3 (make_number (charset
.min_code
),
971 make_number (charset
.max_code
), val
);
972 charset
.max_code
= code
;
975 charset
.compact_codes_p
= charset
.max_code
< 0x10000;
977 val
= args
[charset_arg_invalid_code
];
980 if (charset
.min_code
> 0)
981 charset
.invalid_code
= 0;
984 XSETINT (val
, charset
.max_code
+ 1);
985 if (XINT (val
) == charset
.max_code
+ 1)
986 charset
.invalid_code
= charset
.max_code
+ 1;
988 error ("Attribute :invalid-code must be specified");
994 charset
.invalid_code
= XFASTINT (val
);
997 val
= args
[charset_arg_iso_final
];
999 charset
.iso_final
= -1;
1003 if (XINT (val
) < '0' || XINT (val
) > 127)
1004 error ("Invalid iso-final-char: %"pEd
, XINT (val
));
1005 charset
.iso_final
= XINT (val
);
1008 val
= args
[charset_arg_iso_revision
];
1010 charset
.iso_revision
= -1;
1014 if (XINT (val
) > 63)
1015 args_out_of_range (make_number (63), val
);
1016 charset
.iso_revision
= XINT (val
);
1019 val
= args
[charset_arg_emacs_mule_id
];
1021 charset
.emacs_mule_id
= -1;
1025 if ((XINT (val
) > 0 && XINT (val
) <= 128) || XINT (val
) >= 256)
1026 error ("Invalid emacs-mule-id: %"pEd
, XINT (val
));
1027 charset
.emacs_mule_id
= XINT (val
);
1030 charset
.ascii_compatible_p
= ! NILP (args
[charset_arg_ascii_compatible_p
]);
1032 charset
.supplementary_p
= ! NILP (args
[charset_arg_supplementary_p
]);
1034 charset
.unified_p
= 0;
1036 memset (charset
.fast_map
, 0, sizeof (charset
.fast_map
));
1038 if (! NILP (args
[charset_arg_code_offset
]))
1040 val
= args
[charset_arg_code_offset
];
1043 charset
.method
= CHARSET_METHOD_OFFSET
;
1044 charset
.code_offset
= XINT (val
);
1046 i
= CODE_POINT_TO_INDEX (&charset
, charset
.min_code
);
1047 charset
.min_char
= i
+ charset
.code_offset
;
1048 i
= CODE_POINT_TO_INDEX (&charset
, charset
.max_code
);
1049 charset
.max_char
= i
+ charset
.code_offset
;
1050 if (charset
.max_char
> MAX_CHAR
)
1051 error ("Unsupported max char: %d", charset
.max_char
);
1053 i
= (charset
.min_char
>> 7) << 7;
1054 for (; i
< 0x10000 && i
<= charset
.max_char
; i
+= 128)
1055 CHARSET_FAST_MAP_SET (i
, charset
.fast_map
);
1056 i
= (i
>> 12) << 12;
1057 for (; i
<= charset
.max_char
; i
+= 0x1000)
1058 CHARSET_FAST_MAP_SET (i
, charset
.fast_map
);
1059 if (charset
.code_offset
== 0 && charset
.max_char
>= 0x80)
1060 charset
.ascii_compatible_p
= 1;
1062 else if (! NILP (args
[charset_arg_map
]))
1064 val
= args
[charset_arg_map
];
1065 ASET (attrs
, charset_map
, val
);
1066 charset
.method
= CHARSET_METHOD_MAP
;
1068 else if (! NILP (args
[charset_arg_subset
]))
1071 Lisp_Object parent_min_code
, parent_max_code
, parent_code_offset
;
1072 struct charset
*parent_charset
;
1074 val
= args
[charset_arg_subset
];
1075 parent
= Fcar (val
);
1076 CHECK_CHARSET_GET_CHARSET (parent
, parent_charset
);
1077 parent_min_code
= Fnth (make_number (1), val
);
1078 CHECK_NATNUM (parent_min_code
);
1079 parent_max_code
= Fnth (make_number (2), val
);
1080 CHECK_NATNUM (parent_max_code
);
1081 parent_code_offset
= Fnth (make_number (3), val
);
1082 CHECK_NUMBER (parent_code_offset
);
1083 val
= Fmake_vector (make_number (4), Qnil
);
1084 ASET (val
, 0, make_number (parent_charset
->id
));
1085 ASET (val
, 1, parent_min_code
);
1086 ASET (val
, 2, parent_max_code
);
1087 ASET (val
, 3, parent_code_offset
);
1088 ASET (attrs
, charset_subset
, val
);
1090 charset
.method
= CHARSET_METHOD_SUBSET
;
1091 /* Here, we just copy the parent's fast_map. It's not accurate,
1092 but at least it works for quickly detecting which character
1093 DOESN'T belong to this charset. */
1094 for (i
= 0; i
< 190; i
++)
1095 charset
.fast_map
[i
] = parent_charset
->fast_map
[i
];
1097 /* We also copy these for parents. */
1098 charset
.min_char
= parent_charset
->min_char
;
1099 charset
.max_char
= parent_charset
->max_char
;
1101 else if (! NILP (args
[charset_arg_superset
]))
1103 val
= args
[charset_arg_superset
];
1104 charset
.method
= CHARSET_METHOD_SUPERSET
;
1105 val
= Fcopy_sequence (val
);
1106 ASET (attrs
, charset_superset
, val
);
1108 charset
.min_char
= MAX_CHAR
;
1109 charset
.max_char
= 0;
1110 for (; ! NILP (val
); val
= Fcdr (val
))
1112 Lisp_Object elt
, car_part
, cdr_part
;
1113 int this_id
, offset
;
1114 struct charset
*this_charset
;
1119 car_part
= XCAR (elt
);
1120 cdr_part
= XCDR (elt
);
1121 CHECK_CHARSET_GET_ID (car_part
, this_id
);
1122 CHECK_NUMBER (cdr_part
);
1123 offset
= XINT (cdr_part
);
1127 CHECK_CHARSET_GET_ID (elt
, this_id
);
1130 XSETCAR (val
, Fcons (make_number (this_id
), make_number (offset
)));
1132 this_charset
= CHARSET_FROM_ID (this_id
);
1133 if (charset
.min_char
> this_charset
->min_char
)
1134 charset
.min_char
= this_charset
->min_char
;
1135 if (charset
.max_char
< this_charset
->max_char
)
1136 charset
.max_char
= this_charset
->max_char
;
1137 for (i
= 0; i
< 190; i
++)
1138 charset
.fast_map
[i
] |= this_charset
->fast_map
[i
];
1142 error ("None of :code-offset, :map, :parents are specified");
1144 val
= args
[charset_arg_unify_map
];
1145 if (! NILP (val
) && !STRINGP (val
))
1147 ASET (attrs
, charset_unify_map
, val
);
1149 CHECK_LIST (args
[charset_arg_plist
]);
1150 ASET (attrs
, charset_plist
, args
[charset_arg_plist
]);
1152 charset
.hash_index
= hash_lookup (hash_table
, args
[charset_arg_name
],
1154 if (charset
.hash_index
>= 0)
1156 new_definition_p
= 0;
1157 id
= XFASTINT (CHARSET_SYMBOL_ID (args
[charset_arg_name
]));
1158 HASH_VALUE (hash_table
, charset
.hash_index
) = attrs
;
1162 charset
.hash_index
= hash_put (hash_table
, args
[charset_arg_name
], attrs
,
1164 if (charset_table_used
== charset_table_size
)
1166 struct charset
*new_table
1167 = (struct charset
*) xmalloc (sizeof (struct charset
)
1168 * (charset_table_size
+ 16));
1169 memcpy (new_table
, charset_table
,
1170 sizeof (struct charset
) * charset_table_size
);
1171 charset_table_size
+= 16;
1172 charset_table
= new_table
;
1174 id
= charset_table_used
++;
1175 new_definition_p
= 1;
1178 ASET (attrs
, charset_id
, make_number (id
));
1180 charset_table
[id
] = charset
;
1182 if (charset
.method
== CHARSET_METHOD_MAP
)
1184 load_charset (&charset
, 0);
1185 charset_table
[id
] = charset
;
1188 if (charset
.iso_final
>= 0)
1190 ISO_CHARSET_TABLE (charset
.dimension
, charset
.iso_chars_96
,
1191 charset
.iso_final
) = id
;
1192 if (new_definition_p
)
1193 Viso_2022_charset_list
= nconc2 (Viso_2022_charset_list
,
1194 Fcons (make_number (id
), Qnil
));
1195 if (ISO_CHARSET_TABLE (1, 0, 'J') == id
)
1196 charset_jisx0201_roman
= id
;
1197 else if (ISO_CHARSET_TABLE (2, 0, '@') == id
)
1198 charset_jisx0208_1978
= id
;
1199 else if (ISO_CHARSET_TABLE (2, 0, 'B') == id
)
1200 charset_jisx0208
= id
;
1201 else if (ISO_CHARSET_TABLE (2, 0, 'C') == id
)
1202 charset_ksc5601
= id
;
1205 if (charset
.emacs_mule_id
>= 0)
1207 emacs_mule_charset
[charset
.emacs_mule_id
] = id
;
1208 if (charset
.emacs_mule_id
< 0xA0)
1209 emacs_mule_bytes
[charset
.emacs_mule_id
] = charset
.dimension
+ 1;
1211 emacs_mule_bytes
[charset
.emacs_mule_id
] = charset
.dimension
+ 2;
1212 if (new_definition_p
)
1213 Vemacs_mule_charset_list
= nconc2 (Vemacs_mule_charset_list
,
1214 Fcons (make_number (id
), Qnil
));
1217 if (new_definition_p
)
1219 Vcharset_list
= Fcons (args
[charset_arg_name
], Vcharset_list
);
1220 if (charset
.supplementary_p
)
1221 Vcharset_ordered_list
= nconc2 (Vcharset_ordered_list
,
1222 Fcons (make_number (id
), Qnil
));
1227 for (tail
= Vcharset_ordered_list
; CONSP (tail
); tail
= XCDR (tail
))
1229 struct charset
*cs
= CHARSET_FROM_ID (XINT (XCAR (tail
)));
1231 if (cs
->supplementary_p
)
1234 if (EQ (tail
, Vcharset_ordered_list
))
1235 Vcharset_ordered_list
= Fcons (make_number (id
),
1236 Vcharset_ordered_list
);
1237 else if (NILP (tail
))
1238 Vcharset_ordered_list
= nconc2 (Vcharset_ordered_list
,
1239 Fcons (make_number (id
), Qnil
));
1242 val
= Fcons (XCAR (tail
), XCDR (tail
));
1243 XSETCDR (tail
, val
);
1244 XSETCAR (tail
, make_number (id
));
1247 charset_ordered_list_tick
++;
1254 /* Same as Fdefine_charset_internal but arguments are more convenient
1255 to call from C (typically in syms_of_charset). This can define a
1256 charset of `offset' method only. Return the ID of the new
1260 define_charset_internal (Lisp_Object name
,
1262 const char *code_space_chars
,
1263 unsigned min_code
, unsigned max_code
,
1264 int iso_final
, int iso_revision
, int emacs_mule_id
,
1265 int ascii_compatible
, int supplementary
,
1268 const unsigned char *code_space
= (const unsigned char *) code_space_chars
;
1269 Lisp_Object args
[charset_arg_max
];
1270 Lisp_Object plist
[14];
1274 args
[charset_arg_name
] = name
;
1275 args
[charset_arg_dimension
] = make_number (dimension
);
1276 val
= Fmake_vector (make_number (8), make_number (0));
1277 for (i
= 0; i
< 8; i
++)
1278 ASET (val
, i
, make_number (code_space
[i
]));
1279 args
[charset_arg_code_space
] = val
;
1280 args
[charset_arg_min_code
] = make_number (min_code
);
1281 args
[charset_arg_max_code
] = make_number (max_code
);
1282 args
[charset_arg_iso_final
]
1283 = (iso_final
< 0 ? Qnil
: make_number (iso_final
));
1284 args
[charset_arg_iso_revision
] = make_number (iso_revision
);
1285 args
[charset_arg_emacs_mule_id
]
1286 = (emacs_mule_id
< 0 ? Qnil
: make_number (emacs_mule_id
));
1287 args
[charset_arg_ascii_compatible_p
] = ascii_compatible
? Qt
: Qnil
;
1288 args
[charset_arg_supplementary_p
] = supplementary
? Qt
: Qnil
;
1289 args
[charset_arg_invalid_code
] = Qnil
;
1290 args
[charset_arg_code_offset
] = make_number (code_offset
);
1291 args
[charset_arg_map
] = Qnil
;
1292 args
[charset_arg_subset
] = Qnil
;
1293 args
[charset_arg_superset
] = Qnil
;
1294 args
[charset_arg_unify_map
] = Qnil
;
1296 plist
[0] = intern_c_string (":name");
1297 plist
[1] = args
[charset_arg_name
];
1298 plist
[2] = intern_c_string (":dimension");
1299 plist
[3] = args
[charset_arg_dimension
];
1300 plist
[4] = intern_c_string (":code-space");
1301 plist
[5] = args
[charset_arg_code_space
];
1302 plist
[6] = intern_c_string (":iso-final-char");
1303 plist
[7] = args
[charset_arg_iso_final
];
1304 plist
[8] = intern_c_string (":emacs-mule-id");
1305 plist
[9] = args
[charset_arg_emacs_mule_id
];
1306 plist
[10] = intern_c_string (":ascii-compatible-p");
1307 plist
[11] = args
[charset_arg_ascii_compatible_p
];
1308 plist
[12] = intern_c_string (":code-offset");
1309 plist
[13] = args
[charset_arg_code_offset
];
1311 args
[charset_arg_plist
] = Flist (14, plist
);
1312 Fdefine_charset_internal (charset_arg_max
, args
);
1314 return XINT (CHARSET_SYMBOL_ID (name
));
1318 DEFUN ("define-charset-alias", Fdefine_charset_alias
,
1319 Sdefine_charset_alias
, 2, 2, 0,
1320 doc
: /* Define ALIAS as an alias for charset CHARSET. */)
1321 (Lisp_Object alias
, Lisp_Object charset
)
1325 CHECK_CHARSET_GET_ATTR (charset
, attr
);
1326 Fputhash (alias
, attr
, Vcharset_hash_table
);
1327 Vcharset_list
= Fcons (alias
, Vcharset_list
);
1332 DEFUN ("charset-plist", Fcharset_plist
, Scharset_plist
, 1, 1, 0,
1333 doc
: /* Return the property list of CHARSET. */)
1334 (Lisp_Object charset
)
1338 CHECK_CHARSET_GET_ATTR (charset
, attrs
);
1339 return CHARSET_ATTR_PLIST (attrs
);
1343 DEFUN ("set-charset-plist", Fset_charset_plist
, Sset_charset_plist
, 2, 2, 0,
1344 doc
: /* Set CHARSET's property list to PLIST. */)
1345 (Lisp_Object charset
, Lisp_Object plist
)
1349 CHECK_CHARSET_GET_ATTR (charset
, attrs
);
1350 CHARSET_ATTR_PLIST (attrs
) = plist
;
1355 DEFUN ("unify-charset", Funify_charset
, Sunify_charset
, 1, 3, 0,
1356 doc
: /* Unify characters of CHARSET with Unicode.
1357 This means reading the relevant file and installing the table defined
1358 by CHARSET's `:unify-map' property.
1360 Optional second arg UNIFY-MAP is a file name string or a vector. It has
1361 the same meaning as the `:unify-map' attribute in the function
1362 `define-charset' (which see).
1364 Optional third argument DEUNIFY, if non-nil, means to de-unify CHARSET. */)
1365 (Lisp_Object charset
, Lisp_Object unify_map
, Lisp_Object deunify
)
1370 CHECK_CHARSET_GET_ID (charset
, id
);
1371 cs
= CHARSET_FROM_ID (id
);
1373 ? CHARSET_UNIFIED_P (cs
) && ! NILP (CHARSET_DEUNIFIER (cs
))
1374 : ! CHARSET_UNIFIED_P (cs
))
1377 CHARSET_UNIFIED_P (cs
) = 0;
1380 if (CHARSET_METHOD (cs
) != CHARSET_METHOD_OFFSET
1381 || CHARSET_CODE_OFFSET (cs
) < 0x110000)
1382 error ("Can't unify charset: %s", SDATA (SYMBOL_NAME (charset
)));
1383 if (NILP (unify_map
))
1384 unify_map
= CHARSET_UNIFY_MAP (cs
);
1387 if (! STRINGP (unify_map
) && ! VECTORP (unify_map
))
1388 signal_error ("Bad unify-map", unify_map
);
1389 CHARSET_UNIFY_MAP (cs
) = unify_map
;
1391 if (NILP (Vchar_unify_table
))
1392 Vchar_unify_table
= Fmake_char_table (Qnil
, Qnil
);
1393 char_table_set_range (Vchar_unify_table
,
1394 cs
->min_char
, cs
->max_char
, charset
);
1395 CHARSET_UNIFIED_P (cs
) = 1;
1397 else if (CHAR_TABLE_P (Vchar_unify_table
))
1399 int min_code
= CHARSET_MIN_CODE (cs
);
1400 int max_code
= CHARSET_MAX_CODE (cs
);
1401 int min_char
= DECODE_CHAR (cs
, min_code
);
1402 int max_char
= DECODE_CHAR (cs
, max_code
);
1404 char_table_set_range (Vchar_unify_table
, min_char
, max_char
, Qnil
);
1410 DEFUN ("get-unused-iso-final-char", Fget_unused_iso_final_char
,
1411 Sget_unused_iso_final_char
, 2, 2, 0,
1413 Return an unused ISO final char for a charset of DIMENSION and CHARS.
1414 DIMENSION is the number of bytes to represent a character: 1 or 2.
1415 CHARS is the number of characters in a dimension: 94 or 96.
1417 This final char is for private use, thus the range is `0' (48) .. `?' (63).
1418 If there's no unused final char for the specified kind of charset,
1420 (Lisp_Object dimension
, Lisp_Object chars
)
1424 CHECK_NUMBER (dimension
);
1425 CHECK_NUMBER (chars
);
1426 if (XINT (dimension
) != 1 && XINT (dimension
) != 2 && XINT (dimension
) != 3)
1427 args_out_of_range_3 (dimension
, make_number (1), make_number (3));
1428 if (XINT (chars
) != 94 && XINT (chars
) != 96)
1429 args_out_of_range_3 (chars
, make_number (94), make_number (96));
1430 for (final_char
= '0'; final_char
<= '?'; final_char
++)
1431 if (ISO_CHARSET_TABLE (XINT (dimension
), XINT (chars
), final_char
) < 0)
1433 return (final_char
<= '?' ? make_number (final_char
) : Qnil
);
1437 check_iso_charset_parameter (Lisp_Object dimension
, Lisp_Object chars
, Lisp_Object final_char
)
1439 CHECK_NATNUM (dimension
);
1440 CHECK_NATNUM (chars
);
1441 CHECK_NATNUM (final_char
);
1443 if (XINT (dimension
) > 3)
1444 error ("Invalid DIMENSION %"pEd
", it should be 1, 2, or 3",
1446 if (XINT (chars
) != 94 && XINT (chars
) != 96)
1447 error ("Invalid CHARS %"pEd
", it should be 94 or 96", XINT (chars
));
1448 if (XINT (final_char
) < '0' || XINT (final_char
) > '~')
1450 unsigned char str
[MAX_MULTIBYTE_LENGTH
+ 1];
1451 int len
= CHAR_STRING (XINT (chars
), str
);
1453 error ("Invalid FINAL-CHAR %s, it should be `0'..`~'", str
);
1458 DEFUN ("declare-equiv-charset", Fdeclare_equiv_charset
, Sdeclare_equiv_charset
,
1460 doc
: /* Declare an equivalent charset for ISO-2022 decoding.
1462 On decoding by an ISO-2022 base coding system, when a charset
1463 specified by DIMENSION, CHARS, and FINAL-CHAR is designated, behave as
1464 if CHARSET is designated instead. */)
1465 (Lisp_Object dimension
, Lisp_Object chars
, Lisp_Object final_char
, Lisp_Object charset
)
1470 CHECK_CHARSET_GET_ID (charset
, id
);
1471 check_iso_charset_parameter (dimension
, chars
, final_char
);
1472 chars_flag
= XINT (chars
) == 96;
1473 ISO_CHARSET_TABLE (XINT (dimension
), chars_flag
, XINT (final_char
)) = id
;
1478 /* Return information about charsets in the text at PTR of NBYTES
1479 bytes, which are NCHARS characters. The value is:
1481 0: Each character is represented by one byte. This is always
1482 true for a unibyte string. For a multibyte string, true if
1483 it contains only ASCII characters.
1485 1: No charsets other than ascii, control-1, and latin-1 are
1492 string_xstring_p (Lisp_Object string
)
1494 const unsigned char *p
= SDATA (string
);
1495 const unsigned char *endp
= p
+ SBYTES (string
);
1497 if (SCHARS (string
) == SBYTES (string
))
1502 int c
= STRING_CHAR_ADVANCE (p
);
1511 /* Find charsets in the string at PTR of NCHARS and NBYTES.
1513 CHARSETS is a vector. If Nth element is non-nil, it means the
1514 charset whose id is N is already found.
1516 It may lookup a translation table TABLE if supplied. */
1519 find_charsets_in_text (const unsigned char *ptr
, EMACS_INT nchars
, EMACS_INT nbytes
, Lisp_Object charsets
, Lisp_Object table
, int multibyte
)
1521 const unsigned char *pend
= ptr
+ nbytes
;
1523 if (nchars
== nbytes
)
1526 ASET (charsets
, charset_ascii
, Qt
);
1533 c
= translate_char (table
, c
);
1534 if (ASCII_BYTE_P (c
))
1535 ASET (charsets
, charset_ascii
, Qt
);
1537 ASET (charsets
, charset_eight_bit
, Qt
);
1544 int c
= STRING_CHAR_ADVANCE (ptr
);
1545 struct charset
*charset
;
1548 c
= translate_char (table
, c
);
1549 charset
= CHAR_CHARSET (c
);
1550 ASET (charsets
, CHARSET_ID (charset
), Qt
);
1555 DEFUN ("find-charset-region", Ffind_charset_region
, Sfind_charset_region
,
1557 doc
: /* Return a list of charsets in the region between BEG and END.
1558 BEG and END are buffer positions.
1559 Optional arg TABLE if non-nil is a translation table to look up.
1561 If the current buffer is unibyte, the returned list may contain
1562 only `ascii', `eight-bit-control', and `eight-bit-graphic'. */)
1563 (Lisp_Object beg
, Lisp_Object end
, Lisp_Object table
)
1565 Lisp_Object charsets
;
1566 EMACS_INT from
, from_byte
, to
, stop
, stop_byte
;
1569 int multibyte
= ! NILP (BVAR (current_buffer
, enable_multibyte_characters
));
1571 validate_region (&beg
, &end
);
1572 from
= XFASTINT (beg
);
1573 stop
= to
= XFASTINT (end
);
1575 if (from
< GPT
&& GPT
< to
)
1578 stop_byte
= GPT_BYTE
;
1581 stop_byte
= CHAR_TO_BYTE (stop
);
1583 from_byte
= CHAR_TO_BYTE (from
);
1585 charsets
= Fmake_vector (make_number (charset_table_used
), Qnil
);
1588 find_charsets_in_text (BYTE_POS_ADDR (from_byte
), stop
- from
,
1589 stop_byte
- from_byte
, charsets
, table
,
1593 from
= stop
, from_byte
= stop_byte
;
1594 stop
= to
, stop_byte
= CHAR_TO_BYTE (stop
);
1601 for (i
= charset_table_used
- 1; i
>= 0; i
--)
1602 if (!NILP (AREF (charsets
, i
)))
1603 val
= Fcons (CHARSET_NAME (charset_table
+ i
), val
);
1607 DEFUN ("find-charset-string", Ffind_charset_string
, Sfind_charset_string
,
1609 doc
: /* Return a list of charsets in STR.
1610 Optional arg TABLE if non-nil is a translation table to look up.
1612 If STR is unibyte, the returned list may contain
1613 only `ascii', `eight-bit-control', and `eight-bit-graphic'. */)
1614 (Lisp_Object str
, Lisp_Object table
)
1616 Lisp_Object charsets
;
1622 charsets
= Fmake_vector (make_number (charset_table_used
), Qnil
);
1623 find_charsets_in_text (SDATA (str
), SCHARS (str
), SBYTES (str
),
1625 STRING_MULTIBYTE (str
));
1627 for (i
= charset_table_used
- 1; i
>= 0; i
--)
1628 if (!NILP (AREF (charsets
, i
)))
1629 val
= Fcons (CHARSET_NAME (charset_table
+ i
), val
);
1635 /* Return a unified character code for C (>= 0x110000). VAL is a
1636 value of Vchar_unify_table for C; i.e. it is nil, an integer, or a
1639 maybe_unify_char (int c
, Lisp_Object val
)
1641 struct charset
*charset
;
1648 CHECK_CHARSET_GET_CHARSET (val
, charset
);
1649 load_charset (charset
, 1);
1650 if (! inhibit_load_charset_map
)
1652 val
= CHAR_TABLE_REF (Vchar_unify_table
, c
);
1658 int code_index
= c
- CHARSET_CODE_OFFSET (charset
);
1659 int unified
= GET_TEMP_CHARSET_WORK_DECODER (code_index
);
1668 /* Return a character correponding to the code-point CODE of
1672 decode_char (struct charset
*charset
, unsigned int code
)
1675 enum charset_method method
= CHARSET_METHOD (charset
);
1677 if (code
< CHARSET_MIN_CODE (charset
) || code
> CHARSET_MAX_CODE (charset
))
1680 if (method
== CHARSET_METHOD_SUBSET
)
1682 Lisp_Object subset_info
;
1684 subset_info
= CHARSET_SUBSET (charset
);
1685 charset
= CHARSET_FROM_ID (XFASTINT (AREF (subset_info
, 0)));
1686 code
-= XINT (AREF (subset_info
, 3));
1687 if (code
< XFASTINT (AREF (subset_info
, 1))
1688 || code
> XFASTINT (AREF (subset_info
, 2)))
1691 c
= DECODE_CHAR (charset
, code
);
1693 else if (method
== CHARSET_METHOD_SUPERSET
)
1695 Lisp_Object parents
;
1697 parents
= CHARSET_SUPERSET (charset
);
1699 for (; CONSP (parents
); parents
= XCDR (parents
))
1701 int id
= XINT (XCAR (XCAR (parents
)));
1702 int code_offset
= XINT (XCDR (XCAR (parents
)));
1703 unsigned this_code
= code
- code_offset
;
1705 charset
= CHARSET_FROM_ID (id
);
1706 if ((c
= DECODE_CHAR (charset
, this_code
)) >= 0)
1712 char_index
= CODE_POINT_TO_INDEX (charset
, code
);
1716 if (method
== CHARSET_METHOD_MAP
)
1718 Lisp_Object decoder
;
1720 decoder
= CHARSET_DECODER (charset
);
1721 if (! VECTORP (decoder
))
1723 load_charset (charset
, 1);
1724 decoder
= CHARSET_DECODER (charset
);
1726 if (VECTORP (decoder
))
1727 c
= XINT (AREF (decoder
, char_index
));
1729 c
= GET_TEMP_CHARSET_WORK_DECODER (char_index
);
1731 else /* method == CHARSET_METHOD_OFFSET */
1733 c
= char_index
+ CHARSET_CODE_OFFSET (charset
);
1734 if (CHARSET_UNIFIED_P (charset
)
1735 && c
> MAX_UNICODE_CHAR
)
1736 MAYBE_UNIFY_CHAR (c
);
1743 /* Variable used temporarily by the macro ENCODE_CHAR. */
1744 Lisp_Object charset_work
;
1746 /* Return a code-point of CHAR in CHARSET. If CHAR doesn't belong to
1747 CHARSET, return CHARSET_INVALID_CODE (CHARSET). If STRICT is true,
1748 use CHARSET's strict_max_char instead of max_char. */
1751 encode_char (struct charset
*charset
, int c
)
1754 enum charset_method method
= CHARSET_METHOD (charset
);
1756 if (CHARSET_UNIFIED_P (charset
))
1758 Lisp_Object deunifier
;
1759 int code_index
= -1;
1761 deunifier
= CHARSET_DEUNIFIER (charset
);
1762 if (! CHAR_TABLE_P (deunifier
))
1764 load_charset (charset
, 2);
1765 deunifier
= CHARSET_DEUNIFIER (charset
);
1767 if (CHAR_TABLE_P (deunifier
))
1769 Lisp_Object deunified
= CHAR_TABLE_REF (deunifier
, c
);
1771 if (INTEGERP (deunified
))
1772 code_index
= XINT (deunified
);
1776 code_index
= GET_TEMP_CHARSET_WORK_ENCODER (c
);
1778 if (code_index
>= 0)
1779 c
= CHARSET_CODE_OFFSET (charset
) + code_index
;
1782 if (method
== CHARSET_METHOD_SUBSET
)
1784 Lisp_Object subset_info
;
1785 struct charset
*this_charset
;
1787 subset_info
= CHARSET_SUBSET (charset
);
1788 this_charset
= CHARSET_FROM_ID (XFASTINT (AREF (subset_info
, 0)));
1789 code
= ENCODE_CHAR (this_charset
, c
);
1790 if (code
== CHARSET_INVALID_CODE (this_charset
)
1791 || code
< XFASTINT (AREF (subset_info
, 1))
1792 || code
> XFASTINT (AREF (subset_info
, 2)))
1793 return CHARSET_INVALID_CODE (charset
);
1794 code
+= XINT (AREF (subset_info
, 3));
1798 if (method
== CHARSET_METHOD_SUPERSET
)
1800 Lisp_Object parents
;
1802 parents
= CHARSET_SUPERSET (charset
);
1803 for (; CONSP (parents
); parents
= XCDR (parents
))
1805 int id
= XINT (XCAR (XCAR (parents
)));
1806 int code_offset
= XINT (XCDR (XCAR (parents
)));
1807 struct charset
*this_charset
= CHARSET_FROM_ID (id
);
1809 code
= ENCODE_CHAR (this_charset
, c
);
1810 if (code
!= CHARSET_INVALID_CODE (this_charset
))
1811 return code
+ code_offset
;
1813 return CHARSET_INVALID_CODE (charset
);
1816 if (! CHARSET_FAST_MAP_REF ((c
), charset
->fast_map
)
1817 || c
< CHARSET_MIN_CHAR (charset
) || c
> CHARSET_MAX_CHAR (charset
))
1818 return CHARSET_INVALID_CODE (charset
);
1820 if (method
== CHARSET_METHOD_MAP
)
1822 Lisp_Object encoder
;
1825 encoder
= CHARSET_ENCODER (charset
);
1826 if (! CHAR_TABLE_P (CHARSET_ENCODER (charset
)))
1828 load_charset (charset
, 2);
1829 encoder
= CHARSET_ENCODER (charset
);
1831 if (CHAR_TABLE_P (encoder
))
1833 val
= CHAR_TABLE_REF (encoder
, c
);
1835 return CHARSET_INVALID_CODE (charset
);
1837 if (! CHARSET_COMPACT_CODES_P (charset
))
1838 code
= INDEX_TO_CODE_POINT (charset
, code
);
1842 code
= GET_TEMP_CHARSET_WORK_ENCODER (c
);
1843 code
= INDEX_TO_CODE_POINT (charset
, code
);
1846 else /* method == CHARSET_METHOD_OFFSET */
1848 int code_index
= c
- CHARSET_CODE_OFFSET (charset
);
1850 code
= INDEX_TO_CODE_POINT (charset
, code_index
);
1857 DEFUN ("decode-char", Fdecode_char
, Sdecode_char
, 2, 3, 0,
1858 doc
: /* Decode the pair of CHARSET and CODE-POINT into a character.
1859 Return nil if CODE-POINT is not valid in CHARSET.
1861 CODE-POINT may be a cons (HIGHER-16-BIT-VALUE . LOWER-16-BIT-VALUE).
1863 Optional argument RESTRICTION specifies a way to map the pair of CCS
1864 and CODE-POINT to a character. Currently not supported and just ignored. */)
1865 (Lisp_Object charset
, Lisp_Object code_point
, Lisp_Object restriction
)
1869 struct charset
*charsetp
;
1871 CHECK_CHARSET_GET_ID (charset
, id
);
1872 if (CONSP (code_point
))
1874 CHECK_NATNUM_CAR (code_point
);
1875 CHECK_NATNUM_CDR (code_point
);
1876 code
= (XINT (XCAR (code_point
)) << 16) | (XINT (XCDR (code_point
)));
1880 CHECK_NATNUM (code_point
);
1881 code
= XINT (code_point
);
1883 charsetp
= CHARSET_FROM_ID (id
);
1884 c
= DECODE_CHAR (charsetp
, code
);
1885 return (c
>= 0 ? make_number (c
) : Qnil
);
1889 DEFUN ("encode-char", Fencode_char
, Sencode_char
, 2, 3, 0,
1890 doc
: /* Encode the character CH into a code-point of CHARSET.
1891 Return nil if CHARSET doesn't include CH.
1893 Optional argument RESTRICTION specifies a way to map CH to a
1894 code-point in CCS. Currently not supported and just ignored. */)
1895 (Lisp_Object ch
, Lisp_Object charset
, Lisp_Object restriction
)
1899 struct charset
*charsetp
;
1901 CHECK_CHARSET_GET_ID (charset
, id
);
1903 charsetp
= CHARSET_FROM_ID (id
);
1904 code
= ENCODE_CHAR (charsetp
, XINT (ch
));
1905 if (code
== CHARSET_INVALID_CODE (charsetp
))
1907 if (code
> 0x7FFFFFF)
1908 return Fcons (make_number (code
>> 16), make_number (code
& 0xFFFF));
1909 return make_number (code
);
1913 DEFUN ("make-char", Fmake_char
, Smake_char
, 1, 5, 0,
1915 /* Return a character of CHARSET whose position codes are CODEn.
1917 CODE1 through CODE4 are optional, but if you don't supply sufficient
1918 position codes, it is assumed that the minimum code in each dimension
1920 (Lisp_Object charset
, Lisp_Object code1
, Lisp_Object code2
, Lisp_Object code3
, Lisp_Object code4
)
1923 struct charset
*charsetp
;
1927 CHECK_CHARSET_GET_ID (charset
, id
);
1928 charsetp
= CHARSET_FROM_ID (id
);
1930 dimension
= CHARSET_DIMENSION (charsetp
);
1932 code
= (CHARSET_ASCII_COMPATIBLE_P (charsetp
)
1933 ? 0 : CHARSET_MIN_CODE (charsetp
));
1936 CHECK_NATNUM (code1
);
1937 if (XFASTINT (code1
) >= 0x100)
1938 args_out_of_range (make_number (0xFF), code1
);
1939 code
= XFASTINT (code1
);
1945 code
|= charsetp
->code_space
[(dimension
- 2) * 4];
1948 CHECK_NATNUM (code2
);
1949 if (XFASTINT (code2
) >= 0x100)
1950 args_out_of_range (make_number (0xFF), code2
);
1951 code
|= XFASTINT (code2
);
1958 code
|= charsetp
->code_space
[(dimension
- 3) * 4];
1961 CHECK_NATNUM (code3
);
1962 if (XFASTINT (code3
) >= 0x100)
1963 args_out_of_range (make_number (0xFF), code3
);
1964 code
|= XFASTINT (code3
);
1971 code
|= charsetp
->code_space
[0];
1974 CHECK_NATNUM (code4
);
1975 if (XFASTINT (code4
) >= 0x100)
1976 args_out_of_range (make_number (0xFF), code4
);
1977 code
|= XFASTINT (code4
);
1984 if (CHARSET_ISO_FINAL (charsetp
) >= 0)
1986 c
= DECODE_CHAR (charsetp
, code
);
1988 error ("Invalid code(s)");
1989 return make_number (c
);
1993 /* Return the first charset in CHARSET_LIST that contains C.
1994 CHARSET_LIST is a list of charset IDs. If it is nil, use
1995 Vcharset_ordered_list. */
1998 char_charset (int c
, Lisp_Object charset_list
, unsigned int *code_return
)
2002 if (NILP (charset_list
))
2003 charset_list
= Vcharset_ordered_list
;
2007 while (CONSP (charset_list
))
2009 struct charset
*charset
= CHARSET_FROM_ID (XINT (XCAR (charset_list
)));
2010 unsigned code
= ENCODE_CHAR (charset
, c
);
2012 if (code
!= CHARSET_INVALID_CODE (charset
))
2015 *code_return
= code
;
2018 charset_list
= XCDR (charset_list
);
2020 && c
<= MAX_UNICODE_CHAR
2021 && EQ (charset_list
, Vcharset_non_preferred_head
))
2022 return CHARSET_FROM_ID (charset_unicode
);
2024 return (maybe_null
? NULL
2025 : c
<= MAX_5_BYTE_CHAR
? CHARSET_FROM_ID (charset_emacs
)
2026 : CHARSET_FROM_ID (charset_eight_bit
));
2030 DEFUN ("split-char", Fsplit_char
, Ssplit_char
, 1, 1, 0,
2032 /*Return list of charset and one to four position-codes of CH.
2033 The charset is decided by the current priority order of charsets.
2034 A position-code is a byte value of each dimension of the code-point of
2035 CH in the charset. */)
2038 struct charset
*charset
;
2043 CHECK_CHARACTER (ch
);
2045 charset
= CHAR_CHARSET (c
);
2048 code
= ENCODE_CHAR (charset
, c
);
2049 if (code
== CHARSET_INVALID_CODE (charset
))
2051 dimension
= CHARSET_DIMENSION (charset
);
2052 for (val
= Qnil
; dimension
> 0; dimension
--)
2054 val
= Fcons (make_number (code
& 0xFF), val
);
2057 return Fcons (CHARSET_NAME (charset
), val
);
2061 DEFUN ("char-charset", Fchar_charset
, Schar_charset
, 1, 2, 0,
2062 doc
: /* Return the charset of highest priority that contains CH.
2063 If optional 2nd arg RESTRICTION is non-nil, it is a list of charsets
2064 from which to find the charset. It may also be a coding system. In
2065 that case, find the charset from what supported by that coding system. */)
2066 (Lisp_Object ch
, Lisp_Object restriction
)
2068 struct charset
*charset
;
2070 CHECK_CHARACTER (ch
);
2071 if (NILP (restriction
))
2072 charset
= CHAR_CHARSET (XINT (ch
));
2075 if (CONSP (restriction
))
2077 int c
= XFASTINT (ch
);
2079 for (; CONSP (restriction
); restriction
= XCDR (restriction
))
2081 struct charset
*rcharset
;
2083 CHECK_CHARSET_GET_CHARSET (XCAR (restriction
), rcharset
);
2084 if (ENCODE_CHAR (rcharset
, c
) != CHARSET_INVALID_CODE (rcharset
))
2085 return XCAR (restriction
);
2089 restriction
= coding_system_charset_list (restriction
);
2090 charset
= char_charset (XINT (ch
), restriction
, NULL
);
2094 return (CHARSET_NAME (charset
));
2098 DEFUN ("charset-after", Fcharset_after
, Scharset_after
, 0, 1, 0,
2100 Return charset of a character in the current buffer at position POS.
2101 If POS is nil, it defauls to the current point.
2102 If POS is out of range, the value is nil. */)
2106 struct charset
*charset
;
2108 ch
= Fchar_after (pos
);
2109 if (! INTEGERP (ch
))
2111 charset
= CHAR_CHARSET (XINT (ch
));
2112 return (CHARSET_NAME (charset
));
2116 DEFUN ("iso-charset", Fiso_charset
, Siso_charset
, 3, 3, 0,
2118 Return charset of ISO's specification DIMENSION, CHARS, and FINAL-CHAR.
2120 ISO 2022's designation sequence (escape sequence) distinguishes charsets
2121 by their DIMENSION, CHARS, and FINAL-CHAR,
2122 whereas Emacs distinguishes them by charset symbol.
2123 See the documentation of the function `charset-info' for the meanings of
2124 DIMENSION, CHARS, and FINAL-CHAR. */)
2125 (Lisp_Object dimension
, Lisp_Object chars
, Lisp_Object final_char
)
2130 check_iso_charset_parameter (dimension
, chars
, final_char
);
2131 chars_flag
= XFASTINT (chars
) == 96;
2132 id
= ISO_CHARSET_TABLE (XFASTINT (dimension
), chars_flag
,
2133 XFASTINT (final_char
));
2134 return (id
>= 0 ? CHARSET_NAME (CHARSET_FROM_ID (id
)) : Qnil
);
2138 DEFUN ("clear-charset-maps", Fclear_charset_maps
, Sclear_charset_maps
,
2142 Clear temporary charset mapping tables.
2143 It should be called only from temacs invoked for dumping. */)
2146 if (temp_charset_work
)
2148 free (temp_charset_work
);
2149 temp_charset_work
= NULL
;
2152 if (CHAR_TABLE_P (Vchar_unify_table
))
2153 Foptimize_char_table (Vchar_unify_table
, Qnil
);
2158 DEFUN ("charset-priority-list", Fcharset_priority_list
,
2159 Scharset_priority_list
, 0, 1, 0,
2160 doc
: /* Return the list of charsets ordered by priority.
2161 HIGHESTP non-nil means just return the highest priority one. */)
2162 (Lisp_Object highestp
)
2164 Lisp_Object val
= Qnil
, list
= Vcharset_ordered_list
;
2166 if (!NILP (highestp
))
2167 return CHARSET_NAME (CHARSET_FROM_ID (XINT (Fcar (list
))));
2169 while (!NILP (list
))
2171 val
= Fcons (CHARSET_NAME (CHARSET_FROM_ID (XINT (XCAR (list
)))), val
);
2174 return Fnreverse (val
);
2177 DEFUN ("set-charset-priority", Fset_charset_priority
, Sset_charset_priority
,
2179 doc
: /* Assign higher priority to the charsets given as arguments.
2180 usage: (set-charset-priority &rest charsets) */)
2181 (size_t nargs
, Lisp_Object
*args
)
2183 Lisp_Object new_head
, old_list
, arglist
[2];
2184 Lisp_Object list_2022
, list_emacs_mule
;
2188 old_list
= Fcopy_sequence (Vcharset_ordered_list
);
2190 for (i
= 0; i
< nargs
; i
++)
2192 CHECK_CHARSET_GET_ID (args
[i
], id
);
2193 if (! NILP (Fmemq (make_number (id
), old_list
)))
2195 old_list
= Fdelq (make_number (id
), old_list
);
2196 new_head
= Fcons (make_number (id
), new_head
);
2199 arglist
[0] = Fnreverse (new_head
);
2200 arglist
[1] = Vcharset_non_preferred_head
= old_list
;
2201 Vcharset_ordered_list
= Fnconc (2, arglist
);
2202 charset_ordered_list_tick
++;
2204 charset_unibyte
= -1;
2205 for (old_list
= Vcharset_ordered_list
, list_2022
= list_emacs_mule
= Qnil
;
2206 CONSP (old_list
); old_list
= XCDR (old_list
))
2208 if (! NILP (Fmemq (XCAR (old_list
), Viso_2022_charset_list
)))
2209 list_2022
= Fcons (XCAR (old_list
), list_2022
);
2210 if (! NILP (Fmemq (XCAR (old_list
), Vemacs_mule_charset_list
)))
2211 list_emacs_mule
= Fcons (XCAR (old_list
), list_emacs_mule
);
2212 if (charset_unibyte
< 0)
2214 struct charset
*charset
= CHARSET_FROM_ID (XINT (XCAR (old_list
)));
2216 if (CHARSET_DIMENSION (charset
) == 1
2217 && CHARSET_ASCII_COMPATIBLE_P (charset
)
2218 && CHARSET_MAX_CHAR (charset
) >= 0x80)
2219 charset_unibyte
= CHARSET_ID (charset
);
2222 Viso_2022_charset_list
= Fnreverse (list_2022
);
2223 Vemacs_mule_charset_list
= Fnreverse (list_emacs_mule
);
2224 if (charset_unibyte
< 0)
2225 charset_unibyte
= charset_iso_8859_1
;
2230 DEFUN ("charset-id-internal", Fcharset_id_internal
, Scharset_id_internal
,
2232 doc
: /* Internal use only.
2233 Return charset identification number of CHARSET. */)
2234 (Lisp_Object charset
)
2238 CHECK_CHARSET_GET_ID (charset
, id
);
2239 return make_number (id
);
2242 struct charset_sort_data
2244 Lisp_Object charset
;
2250 charset_compare (const void *d1
, const void *d2
)
2252 const struct charset_sort_data
*data1
= d1
, *data2
= d2
;
2253 return (data1
->priority
- data2
->priority
);
2256 DEFUN ("sort-charsets", Fsort_charsets
, Ssort_charsets
, 1, 1, 0,
2257 doc
: /* Sort charset list CHARSETS by a priority of each charset.
2258 Return the sorted list. CHARSETS is modified by side effects.
2259 See also `charset-priority-list' and `set-charset-priority'. */)
2260 (Lisp_Object charsets
)
2262 Lisp_Object len
= Flength (charsets
);
2263 int n
= XFASTINT (len
), i
, j
, done
;
2264 Lisp_Object tail
, elt
, attrs
;
2265 struct charset_sort_data
*sort_data
;
2266 int id
, min_id
= INT_MAX
, max_id
= INT_MIN
;
2271 SAFE_ALLOCA (sort_data
, struct charset_sort_data
*, sizeof (*sort_data
) * n
);
2272 for (tail
= charsets
, i
= 0; CONSP (tail
); tail
= XCDR (tail
), i
++)
2275 CHECK_CHARSET_GET_ATTR (elt
, attrs
);
2276 sort_data
[i
].charset
= elt
;
2277 sort_data
[i
].id
= id
= XINT (CHARSET_ATTR_ID (attrs
));
2283 for (done
= 0, tail
= Vcharset_ordered_list
, i
= 0;
2284 done
< n
&& CONSP (tail
); tail
= XCDR (tail
), i
++)
2287 id
= XFASTINT (elt
);
2288 if (id
>= min_id
&& id
<= max_id
)
2289 for (j
= 0; j
< n
; j
++)
2290 if (sort_data
[j
].id
== id
)
2292 sort_data
[j
].priority
= i
;
2296 qsort (sort_data
, n
, sizeof *sort_data
, charset_compare
);
2297 for (i
= 0, tail
= charsets
; CONSP (tail
); tail
= XCDR (tail
), i
++)
2298 XSETCAR (tail
, sort_data
[i
].charset
);
2307 Lisp_Object tempdir
;
2308 tempdir
= Fexpand_file_name (build_string ("charsets"), Vdata_directory
);
2309 if (access (SSDATA (tempdir
), 0) < 0)
2311 dir_warning ("Error: charsets directory (%s) does not exist.\n\
2312 Emacs will not function correctly without the character map files.\n\
2313 Please check your installation!\n",
2315 /* TODO should this be a fatal error? (Bug#909) */
2318 Vcharset_map_path
= Fcons (tempdir
, Qnil
);
2323 init_charset_once (void)
2327 for (i
= 0; i
< ISO_MAX_DIMENSION
; i
++)
2328 for (j
= 0; j
< ISO_MAX_CHARS
; j
++)
2329 for (k
= 0; k
< ISO_MAX_FINAL
; k
++)
2330 iso_charset_table
[i
][j
][k
] = -1;
2332 for (i
= 0; i
< 256; i
++)
2333 emacs_mule_charset
[i
] = -1;
2335 charset_jisx0201_roman
= -1;
2336 charset_jisx0208_1978
= -1;
2337 charset_jisx0208
= -1;
2338 charset_ksc5601
= -1;
2344 syms_of_charset (void)
2346 DEFSYM (Qcharsetp
, "charsetp");
2348 DEFSYM (Qascii
, "ascii");
2349 DEFSYM (Qunicode
, "unicode");
2350 DEFSYM (Qemacs
, "emacs");
2351 DEFSYM (Qeight_bit
, "eight-bit");
2352 DEFSYM (Qiso_8859_1
, "iso-8859-1");
2357 staticpro (&Vcharset_ordered_list
);
2358 Vcharset_ordered_list
= Qnil
;
2360 staticpro (&Viso_2022_charset_list
);
2361 Viso_2022_charset_list
= Qnil
;
2363 staticpro (&Vemacs_mule_charset_list
);
2364 Vemacs_mule_charset_list
= Qnil
;
2366 /* Don't staticpro them here. It's done in syms_of_fns. */
2367 QCtest
= intern_c_string (":test");
2368 Qeq
= intern_c_string ("eq");
2370 staticpro (&Vcharset_hash_table
);
2372 Lisp_Object args
[2];
2375 Vcharset_hash_table
= Fmake_hash_table (2, args
);
2378 charset_table_size
= 128;
2379 charset_table
= ((struct charset
*)
2380 xmalloc (sizeof (struct charset
) * charset_table_size
));
2381 charset_table_used
= 0;
2383 defsubr (&Scharsetp
);
2384 defsubr (&Smap_charset_chars
);
2385 defsubr (&Sdefine_charset_internal
);
2386 defsubr (&Sdefine_charset_alias
);
2387 defsubr (&Scharset_plist
);
2388 defsubr (&Sset_charset_plist
);
2389 defsubr (&Sunify_charset
);
2390 defsubr (&Sget_unused_iso_final_char
);
2391 defsubr (&Sdeclare_equiv_charset
);
2392 defsubr (&Sfind_charset_region
);
2393 defsubr (&Sfind_charset_string
);
2394 defsubr (&Sdecode_char
);
2395 defsubr (&Sencode_char
);
2396 defsubr (&Ssplit_char
);
2397 defsubr (&Smake_char
);
2398 defsubr (&Schar_charset
);
2399 defsubr (&Scharset_after
);
2400 defsubr (&Siso_charset
);
2401 defsubr (&Sclear_charset_maps
);
2402 defsubr (&Scharset_priority_list
);
2403 defsubr (&Sset_charset_priority
);
2404 defsubr (&Scharset_id_internal
);
2405 defsubr (&Ssort_charsets
);
2407 DEFVAR_LISP ("charset-map-path", Vcharset_map_path
,
2408 doc
: /* *List of directories to search for charset map files. */);
2409 Vcharset_map_path
= Qnil
;
2411 DEFVAR_BOOL ("inhibit-load-charset-map", inhibit_load_charset_map
,
2412 doc
: /* Inhibit loading of charset maps. Used when dumping Emacs. */);
2413 inhibit_load_charset_map
= 0;
2415 DEFVAR_LISP ("charset-list", Vcharset_list
,
2416 doc
: /* List of all charsets ever defined. */);
2417 Vcharset_list
= Qnil
;
2419 DEFVAR_LISP ("current-iso639-language", Vcurrent_iso639_language
,
2420 doc
: /* ISO639 language mnemonic symbol for the current language environment.
2421 If the current language environment is for multiple languages (e.g. "Latin-1"),
2422 the value may be a list of mnemonics. */);
2423 Vcurrent_iso639_language
= Qnil
;
2426 = define_charset_internal (Qascii
, 1, "\x00\x7F\x00\x00\x00\x00",
2427 0, 127, 'B', -1, 0, 1, 0, 0);
2429 = define_charset_internal (Qiso_8859_1
, 1, "\x00\xFF\x00\x00\x00\x00",
2430 0, 255, -1, -1, -1, 1, 0, 0);
2432 = define_charset_internal (Qunicode
, 3, "\x00\xFF\x00\xFF\x00\x10",
2433 0, MAX_UNICODE_CHAR
, -1, 0, -1, 1, 0, 0);
2435 = define_charset_internal (Qemacs
, 3, "\x00\xFF\x00\xFF\x00\x3F",
2436 0, MAX_5_BYTE_CHAR
, -1, 0, -1, 1, 1, 0);
2438 = define_charset_internal (Qeight_bit
, 1, "\x80\xFF\x00\x00\x00\x00",
2439 128, 255, -1, 0, -1, 0, 1,
2440 MAX_5_BYTE_CHAR
+ 1);
2441 charset_unibyte
= charset_iso_8859_1
;