1 /* Basic multilingual character support.
2 Copyright (C) 1995, 1997, 1998 Electrotechnical Laboratory, JAPAN.
3 Licensed to the Free Software Foundation.
4 Copyright (C) 2001 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 2, or (at your option)
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
21 Boston, MA 02111-1307, USA. */
23 /* At first, see the document in `charset.h' to understand the code in
34 #include <sys/types.h>
38 #include "composite.h"
48 Lisp_Object Qcharset
, Qascii
, Qeight_bit_control
, Qeight_bit_graphic
;
51 /* Declaration of special leading-codes. */
52 int leading_code_private_11
; /* for private DIMENSION1 of 1-column */
53 int leading_code_private_12
; /* for private DIMENSION1 of 2-column */
54 int leading_code_private_21
; /* for private DIMENSION2 of 1-column */
55 int leading_code_private_22
; /* for private DIMENSION2 of 2-column */
57 /* Declaration of special charsets. The values are set by
58 Fsetup_special_charsets. */
59 int charset_latin_iso8859_1
; /* ISO8859-1 (Latin-1) */
60 int charset_jisx0208_1978
; /* JISX0208.1978 (Japanese Kanji old set) */
61 int charset_jisx0208
; /* JISX0208.1983 (Japanese Kanji) */
62 int charset_katakana_jisx0201
; /* JISX0201.Kana (Japanese Katakana) */
63 int charset_latin_jisx0201
; /* JISX0201.Roman (Japanese Roman) */
64 int charset_big5_1
; /* Big5 Level 1 (Chinese Traditional) */
65 int charset_big5_2
; /* Big5 Level 2 (Chinese Traditional) */
67 Lisp_Object Qcharset_table
;
69 /* A char-table containing information of each character set. */
70 Lisp_Object Vcharset_table
;
72 /* A vector of charset symbol indexed by charset-id. This is used
73 only for returning charset symbol from C functions. */
74 Lisp_Object Vcharset_symbol_table
;
76 /* A list of charset symbols ever defined. */
77 Lisp_Object Vcharset_list
;
79 /* Vector of translation table ever defined.
80 ID of a translation table is used to index this vector. */
81 Lisp_Object Vtranslation_table_vector
;
83 /* A char-table for characters which may invoke auto-filling. */
84 Lisp_Object Vauto_fill_chars
;
86 Lisp_Object Qauto_fill_chars
;
88 /* Tables used by macros BYTES_BY_CHAR_HEAD and WIDTH_BY_CHAR_HEAD. */
89 int bytes_by_char_head
[256];
90 int width_by_char_head
[256];
92 /* Mapping table from ISO2022's charset (specified by DIMENSION,
93 CHARS, and FINAL-CHAR) to Emacs' charset. */
94 int iso_charset_table
[2][2][128];
96 /* Variables used locally in the macro FETCH_MULTIBYTE_CHAR. */
97 unsigned char *_fetch_multibyte_char_p
;
98 int _fetch_multibyte_char_len
;
100 /* Offset to add to a non-ASCII value when inserting it. */
101 int nonascii_insert_offset
;
103 /* Translation table for converting non-ASCII unibyte characters
104 to multibyte codes, or nil. */
105 Lisp_Object Vnonascii_translation_table
;
107 /* List of all possible generic characters. */
108 Lisp_Object Vgeneric_character_list
;
112 invalid_character (c
)
115 error ("Invalid character: 0%o, %d, 0x%x", c
, c
, c
);
118 /* Parse string STR of length LENGTH and fetch information of a
119 character at STR. Set BYTES to the byte length the character
120 occupies, CHARSET, C1, C2 to proper values of the character. */
122 #define SPLIT_MULTIBYTE_SEQ(str, length, bytes, charset, c1, c2) \
125 (bytes) = BYTES_BY_CHAR_HEAD (c1); \
127 (charset) = ASCII_BYTE_P (c1) ? CHARSET_ASCII : CHARSET_8_BIT_GRAPHIC; \
128 else if ((bytes) == 2) \
130 if ((c1) == LEADING_CODE_8_BIT_CONTROL) \
131 (charset) = CHARSET_8_BIT_CONTROL, (c1) = (str)[1] - 0x20; \
133 (charset) = (c1), (c1) = (str)[1] & 0x7F; \
135 else if ((bytes) == 3) \
137 if ((c1) < LEADING_CODE_PRIVATE_11) \
138 (charset) = (c1), (c1) = (str)[1] & 0x7F, (c2) = (str)[2] & 0x7F; \
140 (charset) = (str)[1], (c1) = (str)[2] & 0x7F; \
143 (charset) = (str)[1], (c1) = (str)[2] & 0x7F, (c2) = (str)[3] & 0x7F; \
146 /* 1 if CHARSET, C1, and C2 compose a valid character, else 0. */
147 #define CHAR_COMPONENTS_VALID_P(charset, c1, c2) \
148 ((charset) == CHARSET_ASCII \
149 ? ((c1) >= 0 && (c1) <= 0x7F) \
150 : ((charset) == CHARSET_8_BIT_CONTROL \
151 ? ((c1) >= 0x80 && (c1) <= 0x9F) \
152 : ((charset) == CHARSET_8_BIT_GRAPHIC \
153 ? ((c1) >= 0x80 && (c1) <= 0xFF) \
154 : (CHARSET_DIMENSION (charset) == 1 \
155 ? ((c1) >= 0x20 && (c1) <= 0x7F) \
156 : ((c1) >= 0x20 && (c1) <= 0x7F \
157 && (c2) >= 0x20 && (c2) <= 0x7F)))))
159 /* Store multi-byte form of the character C in STR. The caller should
160 allocate at least 4-byte area at STR in advance. Returns the
161 length of the multi-byte form. If C is an invalid character code,
165 char_to_string_1 (c
, str
)
169 unsigned char *p
= str
;
171 if (c
& CHAR_MODIFIER_MASK
) /* This includes the case C is negative. */
173 /* Multibyte character can't have a modifier bit. */
174 if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
177 /* For Meta, Shift, and Control modifiers, we need special care. */
180 /* Move the meta bit to the right place for a string. */
181 c
= (c
& ~CHAR_META
) | 0x80;
185 /* Shift modifier is valid only with [A-Za-z]. */
186 if ((c
& 0377) >= 'A' && (c
& 0377) <= 'Z')
188 else if ((c
& 0377) >= 'a' && (c
& 0377) <= 'z')
189 c
= (c
& ~CHAR_SHIFT
) - ('a' - 'A');
193 /* Simulate the code in lread.c. */
194 /* Allow `\C- ' and `\C-?'. */
195 if (c
== (CHAR_CTL
| ' '))
197 else if (c
== (CHAR_CTL
| '?'))
199 /* ASCII control chars are made from letters (both cases),
200 as well as the non-letters within 0100...0137. */
201 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
202 c
&= (037 | (~0177 & ~CHAR_CTL
));
203 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
204 c
&= (037 | (~0177 & ~CHAR_CTL
));
207 /* If C still has any modifier bits, just ignore it. */
208 c
&= ~CHAR_MODIFIER_MASK
;
211 if (SINGLE_BYTE_CHAR_P (c
))
213 if (ASCII_BYTE_P (c
) || c
>= 0xA0)
217 *p
++ = LEADING_CODE_8_BIT_CONTROL
;
221 else if (CHAR_VALID_P (c
, 0))
225 SPLIT_CHAR (c
, charset
, c1
, c2
);
227 if (charset
>= LEADING_CODE_EXT_11
)
228 *p
++ = (charset
< LEADING_CODE_EXT_12
229 ? LEADING_CODE_PRIVATE_11
230 : (charset
< LEADING_CODE_EXT_21
231 ? LEADING_CODE_PRIVATE_12
232 : (charset
< LEADING_CODE_EXT_22
233 ? LEADING_CODE_PRIVATE_21
234 : LEADING_CODE_PRIVATE_22
)));
236 if ((c1
> 0 && c1
< 32) || (c2
> 0 && c2
< 32))
252 /* Store multi-byte form of the character C in STR. The caller should
253 allocate at least 4-byte area at STR in advance. Returns the
254 length of the multi-byte form. If C is an invalid character code,
257 Use macro `CHAR_STRING (C, STR)' instead of calling this function
258 directly if C can be an ASCII character. */
261 char_to_string (c
, str
)
266 len
= char_to_string_1 (c
, str
);
268 invalid_character (c
);
273 /* Return the non-ASCII character corresponding to multi-byte form at
274 STR of length LEN. If ACTUAL_LEN is not NULL, store the byte
275 length of the multibyte form in *ACTUAL_LEN.
277 Use macros STRING_CHAR or STRING_CHAR_AND_LENGTH instead of calling
278 this function directly if you want ot handle ASCII characters as
282 string_to_char (str
, len
, actual_len
)
283 const unsigned char *str
;
284 int len
, *actual_len
;
286 int c
, bytes
, charset
, c1
, c2
;
288 SPLIT_MULTIBYTE_SEQ (str
, len
, bytes
, charset
, c1
, c2
);
289 c
= MAKE_CHAR (charset
, c1
, c2
);
295 /* Return the length of the multi-byte form at string STR of length LEN.
296 Use the macro MULTIBYTE_FORM_LENGTH instead. */
298 multibyte_form_length (str
, len
)
299 const unsigned char *str
;
304 PARSE_MULTIBYTE_SEQ (str
, len
, bytes
);
308 /* Check multibyte form at string STR of length LEN and set variables
309 pointed by CHARSET, C1, and C2 to charset and position codes of the
310 character at STR, and return 0. If there's no multibyte character,
311 return -1. This should be used only in the macro SPLIT_STRING
312 which checks range of STR in advance. */
315 split_string (str
, len
, charset
, c1
, c2
)
316 const unsigned char *str
;
317 unsigned char *c1
, *c2
;
320 register int bytes
, cs
, code1
, code2
= -1;
322 SPLIT_MULTIBYTE_SEQ (str
, len
, bytes
, cs
, code1
, code2
);
323 if (cs
== CHARSET_ASCII
)
331 /* Return 1 iff character C has valid printable glyph.
332 Use the macro CHAR_PRINTABLE_P instead. */
339 if (ASCII_BYTE_P (c
))
341 else if (SINGLE_BYTE_CHAR_P (c
))
343 else if (c
>= MAX_CHAR
)
346 SPLIT_CHAR (c
, charset
, c1
, c2
);
347 if (! CHARSET_DEFINED_P (charset
))
349 if (CHARSET_CHARS (charset
) == 94
350 ? c1
<= 32 || c1
>= 127
353 if (CHARSET_DIMENSION (charset
) == 2
354 && (CHARSET_CHARS (charset
) == 94
355 ? c2
<= 32 || c2
>= 127
361 /* Translate character C by translation table TABLE. If C
362 is negative, translate a character specified by CHARSET, C1, and C2
363 (C1 and C2 are code points of the character). If no translation is
364 found in TABLE, return C. */
366 translate_char (table
, c
, charset
, c1
, c2
)
368 int c
, charset
, c1
, c2
;
371 int alt_charset
, alt_c1
, alt_c2
, dimension
;
373 if (c
< 0) c
= MAKE_CHAR (charset
, (c1
& 0x7F) , (c2
& 0x7F));
374 if (!CHAR_TABLE_P (table
)
375 || (ch
= Faref (table
, make_number (c
)), !NATNUMP (ch
)))
378 SPLIT_CHAR (XFASTINT (ch
), alt_charset
, alt_c1
, alt_c2
);
379 dimension
= CHARSET_DIMENSION (alt_charset
);
380 if ((dimension
== 1 && alt_c1
> 0) || (dimension
== 2 && alt_c2
> 0))
381 /* CH is not a generic character, just return it. */
382 return XFASTINT (ch
);
384 /* Since CH is a generic character, we must return a specific
385 charater which has the same position codes as C from CH. */
387 SPLIT_CHAR (c
, charset
, c1
, c2
);
388 if (dimension
!= CHARSET_DIMENSION (charset
))
389 /* We can't make such a character because of dimension mismatch. */
391 return MAKE_CHAR (alt_charset
, c1
, c2
);
394 /* Convert the unibyte character C to multibyte based on
395 Vnonascii_translation_table or nonascii_insert_offset. If they can't
396 convert C to a valid multibyte character, convert it based on
397 DEFAULT_NONASCII_INSERT_OFFSET which makes C a Latin-1 character. */
400 unibyte_char_to_multibyte (c
)
403 if (c
< 0400 && c
>= 0200)
407 if (! NILP (Vnonascii_translation_table
))
409 c
= XINT (Faref (Vnonascii_translation_table
, make_number (c
)));
410 if (c
>= 0400 && ! char_valid_p (c
, 0))
411 c
= c_save
+ DEFAULT_NONASCII_INSERT_OFFSET
;
413 else if (c
>= 0240 && nonascii_insert_offset
> 0)
415 c
+= nonascii_insert_offset
;
416 if (c
< 0400 || ! char_valid_p (c
, 0))
417 c
= c_save
+ DEFAULT_NONASCII_INSERT_OFFSET
;
420 c
= c_save
+ DEFAULT_NONASCII_INSERT_OFFSET
;
426 /* Convert the multibyte character C to unibyte 8-bit character based
427 on Vnonascii_translation_table or nonascii_insert_offset. If
428 REV_TBL is non-nil, it should be a reverse table of
429 Vnonascii_translation_table, i.e. what given by:
430 Fchar_table_extra_slot (Vnonascii_translation_table, make_number (0)) */
433 multibyte_char_to_unibyte (c
, rev_tbl
)
437 if (!SINGLE_BYTE_CHAR_P (c
))
441 if (! CHAR_TABLE_P (rev_tbl
)
442 && CHAR_TABLE_P (Vnonascii_translation_table
))
443 rev_tbl
= Fchar_table_extra_slot (Vnonascii_translation_table
,
445 if (CHAR_TABLE_P (rev_tbl
))
448 temp
= Faref (rev_tbl
, make_number (c
));
452 c
= (c_save
& 0177) + 0200;
456 if (nonascii_insert_offset
> 0)
457 c
-= nonascii_insert_offset
;
458 if (c
< 128 || c
>= 256)
459 c
= (c_save
& 0177) + 0200;
467 /* Update the table Vcharset_table with the given arguments (see the
468 document of `define-charset' for the meaning of each argument).
469 Several other table contents are also updated. The caller should
470 check the validity of CHARSET-ID and the remaining arguments in
474 update_charset_table (charset_id
, dimension
, chars
, width
, direction
,
475 iso_final_char
, iso_graphic_plane
,
476 short_name
, long_name
, description
)
477 Lisp_Object charset_id
, dimension
, chars
, width
, direction
;
478 Lisp_Object iso_final_char
, iso_graphic_plane
;
479 Lisp_Object short_name
, long_name
, description
;
481 int charset
= XINT (charset_id
);
483 unsigned char leading_code_base
, leading_code_ext
;
485 if (NILP (CHARSET_TABLE_ENTRY (charset
)))
486 CHARSET_TABLE_ENTRY (charset
)
487 = Fmake_vector (make_number (CHARSET_MAX_IDX
), Qnil
);
489 if (NILP (long_name
))
490 long_name
= short_name
;
491 if (NILP (description
))
492 description
= long_name
;
494 /* Get byte length of multibyte form, base leading-code, and
495 extended leading-code of the charset. See the comment under the
496 title "GENERAL NOTE on CHARACTER SET (CHARSET)" in charset.h. */
497 bytes
= XINT (dimension
);
498 if (charset
< MIN_CHARSET_PRIVATE_DIMENSION1
)
500 /* Official charset, it doesn't have an extended leading-code. */
501 if (charset
!= CHARSET_ASCII
&& charset
!= CHARSET_8_BIT_GRAPHIC
)
502 bytes
+= 1; /* For a base leading-code. */
503 leading_code_base
= charset
;
504 leading_code_ext
= 0;
508 /* Private charset. */
509 bytes
+= 2; /* For base and extended leading-codes. */
511 = (charset
< LEADING_CODE_EXT_12
512 ? LEADING_CODE_PRIVATE_11
513 : (charset
< LEADING_CODE_EXT_21
514 ? LEADING_CODE_PRIVATE_12
515 : (charset
< LEADING_CODE_EXT_22
516 ? LEADING_CODE_PRIVATE_21
517 : LEADING_CODE_PRIVATE_22
)));
518 leading_code_ext
= charset
;
519 if (BYTES_BY_CHAR_HEAD (leading_code_base
) != bytes
)
520 error ("Invalid dimension for the charset-ID %d", charset
);
523 CHARSET_TABLE_INFO (charset
, CHARSET_ID_IDX
) = charset_id
;
524 CHARSET_TABLE_INFO (charset
, CHARSET_BYTES_IDX
) = make_number (bytes
);
525 CHARSET_TABLE_INFO (charset
, CHARSET_DIMENSION_IDX
) = dimension
;
526 CHARSET_TABLE_INFO (charset
, CHARSET_CHARS_IDX
) = chars
;
527 CHARSET_TABLE_INFO (charset
, CHARSET_WIDTH_IDX
) = width
;
528 CHARSET_TABLE_INFO (charset
, CHARSET_DIRECTION_IDX
) = direction
;
529 CHARSET_TABLE_INFO (charset
, CHARSET_LEADING_CODE_BASE_IDX
)
530 = make_number (leading_code_base
);
531 CHARSET_TABLE_INFO (charset
, CHARSET_LEADING_CODE_EXT_IDX
)
532 = make_number (leading_code_ext
);
533 CHARSET_TABLE_INFO (charset
, CHARSET_ISO_FINAL_CHAR_IDX
) = iso_final_char
;
534 CHARSET_TABLE_INFO (charset
, CHARSET_ISO_GRAPHIC_PLANE_IDX
)
536 CHARSET_TABLE_INFO (charset
, CHARSET_SHORT_NAME_IDX
) = short_name
;
537 CHARSET_TABLE_INFO (charset
, CHARSET_LONG_NAME_IDX
) = long_name
;
538 CHARSET_TABLE_INFO (charset
, CHARSET_DESCRIPTION_IDX
) = description
;
539 CHARSET_TABLE_INFO (charset
, CHARSET_PLIST_IDX
) = Qnil
;
542 /* If we have already defined a charset which has the same
543 DIMENSION, CHARS and ISO-FINAL-CHAR but the different
544 DIRECTION, we must update the entry REVERSE-CHARSET of both
545 charsets. If there's no such charset, the value of the entry
549 for (i
= 0; i
<= MAX_CHARSET
; i
++)
550 if (!NILP (CHARSET_TABLE_ENTRY (i
)))
552 if (CHARSET_DIMENSION (i
) == XINT (dimension
)
553 && CHARSET_CHARS (i
) == XINT (chars
)
554 && CHARSET_ISO_FINAL_CHAR (i
) == XINT (iso_final_char
)
555 && CHARSET_DIRECTION (i
) != XINT (direction
))
557 CHARSET_TABLE_INFO (charset
, CHARSET_REVERSE_CHARSET_IDX
)
559 CHARSET_TABLE_INFO (i
, CHARSET_REVERSE_CHARSET_IDX
) = charset_id
;
564 /* No such a charset. */
565 CHARSET_TABLE_INFO (charset
, CHARSET_REVERSE_CHARSET_IDX
)
569 if (charset
!= CHARSET_ASCII
&& charset
!= CHARSET_8_BIT_GRAPHIC
570 && charset
< MIN_CHARSET_PRIVATE_DIMENSION1
)
572 bytes_by_char_head
[leading_code_base
] = bytes
;
573 width_by_char_head
[leading_code_base
] = XINT (width
);
575 /* Update table emacs_code_class. */
576 emacs_code_class
[charset
] = (bytes
== 2
577 ? EMACS_leading_code_2
579 ? EMACS_leading_code_3
580 : EMACS_leading_code_4
));
583 /* Update table iso_charset_table. */
584 if (XINT (iso_final_char
) >= 0
585 && ISO_CHARSET_TABLE (dimension
, chars
, iso_final_char
) < 0)
586 ISO_CHARSET_TABLE (dimension
, chars
, iso_final_char
) = charset
;
591 /* Return charset id of CHARSET_SYMBOL, or return -1 if CHARSET_SYMBOL
594 get_charset_id (charset_symbol
)
595 Lisp_Object charset_symbol
;
600 return ((SYMBOLP (charset_symbol
)
601 && (val
= Fget (charset_symbol
, Qcharset
), VECTORP (val
))
602 && (charset
= XINT (XVECTOR (val
)->contents
[CHARSET_ID_IDX
]),
603 CHARSET_VALID_P (charset
)))
607 /* Return an identification number for a new private charset of
608 DIMENSION and WIDTH. If there's no more room for the new charset,
611 get_new_private_charset_id (dimension
, width
)
612 int dimension
, width
;
614 int charset
, from
, to
;
618 from
= LEADING_CODE_EXT_11
;
619 to
= LEADING_CODE_EXT_21
;
623 from
= LEADING_CODE_EXT_21
;
624 to
= LEADING_CODE_EXT_MAX
+ 1;
627 for (charset
= from
; charset
< to
; charset
++)
628 if (!CHARSET_DEFINED_P (charset
)) break;
630 return make_number (charset
< to
? charset
: 0);
633 DEFUN ("define-charset", Fdefine_charset
, Sdefine_charset
, 3, 3, 0,
634 doc
: /* Define CHARSET-ID as the identification number of CHARSET with INFO-VECTOR.
635 If CHARSET-ID is nil, it is decided automatically, which means CHARSET is
636 treated as a private charset.
637 INFO-VECTOR is a vector of the format:
638 [DIMENSION CHARS WIDTH DIRECTION ISO-FINAL-CHAR ISO-GRAPHIC-PLANE
639 SHORT-NAME LONG-NAME DESCRIPTION]
640 The meanings of each elements is as follows:
641 DIMENSION (integer) is the number of bytes to represent a character: 1 or 2.
642 CHARS (integer) is the number of characters in a dimension: 94 or 96.
643 WIDTH (integer) is the number of columns a character in the charset
644 occupies on the screen: one of 0, 1, and 2.
646 DIRECTION (integer) is the rendering direction of characters in the
647 charset when rendering. If 0, render from left to right, else
648 render from right to left.
650 ISO-FINAL-CHAR (character) is the final character of the
651 corresponding ISO 2022 charset.
652 It may be -1 if the charset is internal use only.
654 ISO-GRAPHIC-PLANE (integer) is the graphic plane to be invoked
655 while encoding to variants of ISO 2022 coding system, one of the
656 following: 0/graphic-plane-left(GL), 1/graphic-plane-right(GR).
657 It may be -1 if the charset is internal use only.
659 SHORT-NAME (string) is the short name to refer to the charset.
661 LONG-NAME (string) is the long name to refer to the charset.
663 DESCRIPTION (string) is the description string of the charset. */)
664 (charset_id
, charset_symbol
, info_vector
)
665 Lisp_Object charset_id
, charset_symbol
, info_vector
;
669 if (!NILP (charset_id
))
670 CHECK_NUMBER (charset_id
);
671 CHECK_SYMBOL (charset_symbol
);
672 CHECK_VECTOR (info_vector
);
674 if (! NILP (charset_id
))
676 if (! CHARSET_VALID_P (XINT (charset_id
)))
677 error ("Invalid CHARSET: %d", XINT (charset_id
));
678 else if (CHARSET_DEFINED_P (XINT (charset_id
)))
679 error ("Already defined charset: %d", XINT (charset_id
));
682 vec
= XVECTOR (info_vector
)->contents
;
683 if (XVECTOR (info_vector
)->size
!= 9
684 || !INTEGERP (vec
[0]) || !(XINT (vec
[0]) == 1 || XINT (vec
[0]) == 2)
685 || !INTEGERP (vec
[1]) || !(XINT (vec
[1]) == 94 || XINT (vec
[1]) == 96)
686 || !INTEGERP (vec
[2]) || !(XINT (vec
[2]) == 1 || XINT (vec
[2]) == 2)
687 || !INTEGERP (vec
[3]) || !(XINT (vec
[3]) == 0 || XINT (vec
[3]) == 1)
688 || !INTEGERP (vec
[4])
689 || !(XINT (vec
[4]) == -1 || (XINT (vec
[4]) >= '0' && XINT (vec
[4]) <= '~'))
690 || !INTEGERP (vec
[5])
691 || !(XINT (vec
[5]) == -1 || XINT (vec
[5]) == 0 || XINT (vec
[5]) == 1)
694 || !STRINGP (vec
[8]))
695 error ("Invalid info-vector argument for defining charset %s",
696 XSYMBOL (charset_symbol
)->name
->data
);
698 if (NILP (charset_id
))
700 charset_id
= get_new_private_charset_id (XINT (vec
[0]), XINT (vec
[2]));
701 if (XINT (charset_id
) == 0)
702 error ("There's no room for a new private charset %s",
703 XSYMBOL (charset_symbol
)->name
->data
);
706 update_charset_table (charset_id
, vec
[0], vec
[1], vec
[2], vec
[3],
707 vec
[4], vec
[5], vec
[6], vec
[7], vec
[8]);
708 Fput (charset_symbol
, Qcharset
, CHARSET_TABLE_ENTRY (XINT (charset_id
)));
709 CHARSET_SYMBOL (XINT (charset_id
)) = charset_symbol
;
710 Vcharset_list
= Fcons (charset_symbol
, Vcharset_list
);
711 Fupdate_coding_systems_internal ();
715 DEFUN ("generic-character-list", Fgeneric_character_list
,
716 Sgeneric_character_list
, 0, 0, 0,
717 doc
: /* Return a list of all possible generic characters.
718 It includes a generic character for a charset not yet defined. */)
721 return Vgeneric_character_list
;
724 DEFUN ("get-unused-iso-final-char", Fget_unused_iso_final_char
,
725 Sget_unused_iso_final_char
, 2, 2, 0,
726 doc
: /* Return an unsed ISO's final char for a charset of DIMENISION and CHARS.
727 DIMENSION is the number of bytes to represent a character: 1 or 2.
728 CHARS is the number of characters in a dimension: 94 or 96.
730 This final char is for private use, thus the range is `0' (48) .. `?' (63).
731 If there's no unused final char for the specified kind of charset,
734 Lisp_Object dimension
, chars
;
738 CHECK_NUMBER (dimension
);
739 CHECK_NUMBER (chars
);
740 if (XINT (dimension
) != 1 && XINT (dimension
) != 2)
741 error ("Invalid charset dimension %d, it should be 1 or 2",
743 if (XINT (chars
) != 94 && XINT (chars
) != 96)
744 error ("Invalid charset chars %d, it should be 94 or 96",
746 for (final_char
= '0'; final_char
<= '?'; final_char
++)
748 if (ISO_CHARSET_TABLE (dimension
, chars
, make_number (final_char
)) < 0)
751 return (final_char
<= '?' ? make_number (final_char
) : Qnil
);
754 DEFUN ("declare-equiv-charset", Fdeclare_equiv_charset
, Sdeclare_equiv_charset
,
756 doc
: /* Declare a charset of DIMENSION, CHARS, FINAL-CHAR is the same as CHARSET.
757 CHARSET should be defined by `defined-charset' in advance. */)
758 (dimension
, chars
, final_char
, charset_symbol
)
759 Lisp_Object dimension
, chars
, final_char
, charset_symbol
;
763 CHECK_NUMBER (dimension
);
764 CHECK_NUMBER (chars
);
765 CHECK_NUMBER (final_char
);
766 CHECK_SYMBOL (charset_symbol
);
768 if (XINT (dimension
) != 1 && XINT (dimension
) != 2)
769 error ("Invalid DIMENSION %d, it should be 1 or 2", XINT (dimension
));
770 if (XINT (chars
) != 94 && XINT (chars
) != 96)
771 error ("Invalid CHARS %d, it should be 94 or 96", XINT (chars
));
772 if (XINT (final_char
) < '0' || XFASTINT (final_char
) > '~')
773 error ("Invalid FINAL-CHAR %c, it should be `0'..`~'", XINT (chars
));
774 if ((charset
= get_charset_id (charset_symbol
)) < 0)
775 error ("Invalid charset %s", XSYMBOL (charset_symbol
)->name
->data
);
777 ISO_CHARSET_TABLE (dimension
, chars
, final_char
) = charset
;
781 /* Return information about charsets in the text at PTR of NBYTES
782 bytes, which are NCHARS characters. The value is:
784 0: Each character is represented by one byte. This is always
785 true for unibyte text.
786 1: No charsets other than ascii eight-bit-control,
787 eight-bit-graphic, and latin-1 are found.
790 In addition, if CHARSETS is nonzero, for each found charset N, set
791 CHARSETS[N] to 1. For that, callers should allocate CHARSETS
792 (MAX_CHARSET + 1 elements) in advance. It may lookup a translation
793 table TABLE if supplied. For invalid charsets, set CHARSETS[1] to
794 1 (note that there's no charset whose ID is 1). */
797 find_charset_in_text (ptr
, nchars
, nbytes
, charsets
, table
)
799 int nchars
, nbytes
, *charsets
;
802 if (nchars
== nbytes
)
804 if (charsets
&& nbytes
> 0)
806 unsigned char *endp
= ptr
+ nbytes
;
809 while (ptr
< endp
&& maskbits
!= 7)
811 maskbits
|= (*ptr
< 0x80 ? 1 : *ptr
< 0xA0 ? 2 : 4);
816 charsets
[CHARSET_ASCII
] = 1;
818 charsets
[CHARSET_8_BIT_CONTROL
] = 1;
820 charsets
[CHARSET_8_BIT_GRAPHIC
] = 1;
827 int bytes
, charset
, c1
, c2
;
829 if (! CHAR_TABLE_P (table
))
834 SPLIT_MULTIBYTE_SEQ (ptr
, len
, bytes
, charset
, c1
, c2
);
837 if (!CHARSET_DEFINED_P (charset
))
839 else if (! NILP (table
))
841 int c
= translate_char (table
, -1, charset
, c1
, c2
);
843 charset
= CHAR_CHARSET (c
);
847 && charset
!= CHARSET_ASCII
848 && charset
!= CHARSET_8_BIT_CONTROL
849 && charset
!= CHARSET_8_BIT_GRAPHIC
850 && charset
!= charset_latin_iso8859_1
)
854 charsets
[charset
] = 1;
855 else if (return_val
== 2)
862 DEFUN ("find-charset-region", Ffind_charset_region
, Sfind_charset_region
,
864 doc
: /* Return a list of charsets in the region between BEG and END.
865 BEG and END are buffer positions.
866 Optional arg TABLE if non-nil is a translation table to look up.
868 If the region contains invalid multibyte characters,
869 `unknown' is included in the returned list.
871 If the current buffer is unibyte, the returned list may contain
872 only `ascii', `eight-bit-control', and `eight-bit-graphic'. */)
874 Lisp_Object beg
, end
, table
;
876 int charsets
[MAX_CHARSET
+ 1];
877 int from
, from_byte
, to
, stop
, stop_byte
, i
;
880 validate_region (&beg
, &end
);
881 from
= XFASTINT (beg
);
882 stop
= to
= XFASTINT (end
);
884 if (from
< GPT
&& GPT
< to
)
887 stop_byte
= GPT_BYTE
;
890 stop_byte
= CHAR_TO_BYTE (stop
);
892 from_byte
= CHAR_TO_BYTE (from
);
894 bzero (charsets
, (MAX_CHARSET
+ 1) * sizeof (int));
897 find_charset_in_text (BYTE_POS_ADDR (from_byte
), stop
- from
,
898 stop_byte
- from_byte
, charsets
, table
);
901 from
= stop
, from_byte
= stop_byte
;
902 stop
= to
, stop_byte
= CHAR_TO_BYTE (stop
);
910 val
= Fcons (Qunknown
, val
);
911 for (i
= MAX_CHARSET
; i
>= MIN_CHARSET_OFFICIAL_DIMENSION1
; i
--)
913 val
= Fcons (CHARSET_SYMBOL (i
), val
);
915 val
= Fcons (Qascii
, val
);
919 DEFUN ("find-charset-string", Ffind_charset_string
, Sfind_charset_string
,
921 doc
: /* Return a list of charsets in STR.
922 Optional arg TABLE if non-nil is a translation table to look up.
924 If the string contains invalid multibyte characters,
925 `unknown' is included in the returned list.
927 If STR is unibyte, the returned list may contain
928 only `ascii', `eight-bit-control', and `eight-bit-graphic'. */)
930 Lisp_Object str
, table
;
932 int charsets
[MAX_CHARSET
+ 1];
938 bzero (charsets
, (MAX_CHARSET
+ 1) * sizeof (int));
939 find_charset_in_text (XSTRING (str
)->data
, XSTRING (str
)->size
,
940 STRING_BYTES (XSTRING (str
)), charsets
, table
);
944 val
= Fcons (Qunknown
, val
);
945 for (i
= MAX_CHARSET
; i
>= MIN_CHARSET_OFFICIAL_DIMENSION1
; i
--)
947 val
= Fcons (CHARSET_SYMBOL (i
), val
);
949 val
= Fcons (Qascii
, val
);
954 DEFUN ("make-char-internal", Fmake_char_internal
, Smake_char_internal
, 1, 3, 0,
955 doc
: /* Return a character made from arguments.
956 Internal use only. */)
957 (charset
, code1
, code2
)
958 Lisp_Object charset
, code1
, code2
;
960 int charset_id
, c1
, c2
;
962 CHECK_NUMBER (charset
);
963 charset_id
= XINT (charset
);
964 if (!CHARSET_DEFINED_P (charset_id
))
965 error ("Invalid charset ID: %d", XINT (charset
));
971 CHECK_NUMBER (code1
);
978 CHECK_NUMBER (code2
);
982 if (charset_id
== CHARSET_ASCII
)
984 if (c1
< 0 || c1
> 0x7F)
985 goto invalid_code_posints
;
986 return make_number (c1
);
988 else if (charset_id
== CHARSET_8_BIT_CONTROL
)
992 else if (c1
< 0x80 || c1
> 0x9F)
993 goto invalid_code_posints
;
994 return make_number (c1
);
996 else if (charset_id
== CHARSET_8_BIT_GRAPHIC
)
1000 else if (c1
< 0xA0 || c1
> 0xFF)
1001 goto invalid_code_posints
;
1002 return make_number (c1
);
1004 else if (c1
< 0 || c1
> 0xFF || c2
< 0 || c2
> 0xFF)
1005 goto invalid_code_posints
;
1011 ? !CHAR_COMPONENTS_VALID_P (charset_id
, c1
, 0x20)
1012 : !CHAR_COMPONENTS_VALID_P (charset_id
, c1
, c2
)))
1013 goto invalid_code_posints
;
1014 return make_number (MAKE_CHAR (charset_id
, c1
, c2
));
1016 invalid_code_posints
:
1017 error ("Invalid code points for charset ID %d: %d %d", charset_id
, c1
, c2
);
1020 DEFUN ("split-char", Fsplit_char
, Ssplit_char
, 1, 1, 0,
1021 doc
: /* Return list of charset and one or two position-codes of CHAR.
1022 If CHAR is invalid as a character code,
1023 return a list of symbol `unknown' and CHAR. */)
1027 int c
, charset
, c1
, c2
;
1031 if (!CHAR_VALID_P (c
, 1))
1032 return Fcons (Qunknown
, Fcons (ch
, Qnil
));
1033 SPLIT_CHAR (XFASTINT (ch
), charset
, c1
, c2
);
1035 ? Fcons (CHARSET_SYMBOL (charset
),
1036 Fcons (make_number (c1
), Fcons (make_number (c2
), Qnil
)))
1037 : Fcons (CHARSET_SYMBOL (charset
), Fcons (make_number (c1
), Qnil
)));
1040 DEFUN ("char-charset", Fchar_charset
, Schar_charset
, 1, 1, 0,
1041 doc
: /* Return charset of CHAR. */)
1047 return CHARSET_SYMBOL (CHAR_CHARSET (XINT (ch
)));
1050 DEFUN ("charset-after", Fcharset_after
, Scharset_after
, 0, 1, 0,
1051 doc
: /* Return charset of a character in the current buffer at position POS.
1052 If POS is nil, it defauls to the current point.
1053 If POS is out of range, the value is nil. */)
1060 ch
= Fchar_after (pos
);
1061 if (! INTEGERP (ch
))
1063 charset
= CHAR_CHARSET (XINT (ch
));
1064 return CHARSET_SYMBOL (charset
);
1067 DEFUN ("iso-charset", Fiso_charset
, Siso_charset
, 3, 3, 0,
1068 doc
: /* Return charset of ISO's specification DIMENSION, CHARS, and FINAL-CHAR.
1070 ISO 2022's designation sequence (escape sequence) distinguishes charsets
1071 by their DIMENSION, CHARS, and FINAL-CHAR,
1072 where as Emacs distinguishes them by charset symbol.
1073 See the documentation of the function `charset-info' for the meanings of
1074 DIMENSION, CHARS, and FINAL-CHAR. */)
1075 (dimension
, chars
, final_char
)
1076 Lisp_Object dimension
, chars
, final_char
;
1080 CHECK_NUMBER (dimension
);
1081 CHECK_NUMBER (chars
);
1082 CHECK_NUMBER (final_char
);
1084 if ((charset
= ISO_CHARSET_TABLE (dimension
, chars
, final_char
)) < 0)
1086 return CHARSET_SYMBOL (charset
);
1089 /* If GENERICP is nonzero, return nonzero iff C is a valid normal or
1090 generic character. If GENERICP is zero, return nonzero iff C is a
1091 valid normal character. Do not call this function directly,
1092 instead use macro CHAR_VALID_P. */
1094 char_valid_p (c
, genericp
)
1097 int charset
, c1
, c2
;
1099 if (c
< 0 || c
>= MAX_CHAR
)
1101 if (SINGLE_BYTE_CHAR_P (c
))
1103 SPLIT_CHAR (c
, charset
, c1
, c2
);
1108 if (c2
<= 0) c2
= 0x20;
1112 if (c2
<= 0) c1
= c2
= 0x20;
1115 return (CHARSET_DEFINED_P (charset
)
1116 && CHAR_COMPONENTS_VALID_P (charset
, c1
, c2
));
1119 DEFUN ("char-valid-p", Fchar_valid_p
, Schar_valid_p
, 1, 2, 0,
1120 doc
: /* Return t if OBJECT is a valid normal character.
1121 If optional arg GENERICP is non-nil, also return t if OBJECT is
1122 a valid generic character. */)
1124 Lisp_Object object
, genericp
;
1126 if (! NATNUMP (object
))
1128 return (CHAR_VALID_P (XFASTINT (object
), !NILP (genericp
)) ? Qt
: Qnil
);
1131 DEFUN ("unibyte-char-to-multibyte", Funibyte_char_to_multibyte
,
1132 Sunibyte_char_to_multibyte
, 1, 1, 0,
1133 doc
: /* Convert the unibyte character CH to multibyte character.
1134 The conversion is done based on `nonascii-translation-table' (which see)
1135 or `nonascii-insert-offset' (which see). */)
1143 if (c
< 0 || c
>= 0400)
1144 error ("Invalid unibyte character: %d", c
);
1145 c
= unibyte_char_to_multibyte (c
);
1147 error ("Can't convert to multibyte character: %d", XINT (ch
));
1148 return make_number (c
);
1151 DEFUN ("multibyte-char-to-unibyte", Fmultibyte_char_to_unibyte
,
1152 Smultibyte_char_to_unibyte
, 1, 1, 0,
1153 doc
: /* Convert the multibyte character CH to unibyte character.
1154 The conversion is done based on `nonascii-translation-table' (which see)
1155 or `nonascii-insert-offset' (which see). */)
1163 if (! CHAR_VALID_P (c
, 0))
1164 error ("Invalid multibyte character: %d", c
);
1165 c
= multibyte_char_to_unibyte (c
, Qnil
);
1167 error ("Can't convert to unibyte character: %d", XINT (ch
));
1168 return make_number (c
);
1171 DEFUN ("char-bytes", Fchar_bytes
, Schar_bytes
, 1, 1, 0,
1172 doc
: /* Return 1 regardless of the argument CHAR.
1173 This is now an obsolete function. We keep it just for backward compatibility. */)
1178 return make_number (1);
1181 /* Return how many bytes C will occupy in a multibyte buffer.
1182 Don't call this function directly, instead use macro CHAR_BYTES. */
1189 if (ASCII_BYTE_P (c
) || (c
& ~((1 << CHARACTERBITS
) -1)))
1191 if (SINGLE_BYTE_CHAR_P (c
) && c
>= 0xA0)
1194 charset
= CHAR_CHARSET (c
);
1195 return (CHARSET_DEFINED_P (charset
) ? CHARSET_BYTES (charset
) : 1);
1198 /* Return the width of character of which multi-byte form starts with
1199 C. The width is measured by how many columns occupied on the
1200 screen when displayed in the current buffer. */
1202 #define ONE_BYTE_CHAR_WIDTH(c) \
1205 ? XFASTINT (current_buffer->tab_width) \
1206 : (c == '\n' ? 0 : (NILP (current_buffer->ctl_arrow) ? 4 : 2))) \
1210 ? (NILP (current_buffer->ctl_arrow) ? 4 : 2) \
1211 : ((! NILP (current_buffer->enable_multibyte_characters) \
1212 && BASE_LEADING_CODE_P (c)) \
1213 ? WIDTH_BY_CHAR_HEAD (c) \
1216 DEFUN ("char-width", Fchar_width
, Schar_width
, 1, 1, 0,
1217 doc
: /* Return width of CHAR when displayed in the current buffer.
1218 The width is measured by how many columns it occupies on the screen.
1219 Tab is taken to occupy `tab-width' columns. */)
1223 Lisp_Object val
, disp
;
1225 struct Lisp_Char_Table
*dp
= buffer_display_table ();
1231 /* Get the way the display table would display it. */
1232 disp
= dp
? DISP_CHAR_VECTOR (dp
, c
) : Qnil
;
1235 XSETINT (val
, XVECTOR (disp
)->size
);
1236 else if (SINGLE_BYTE_CHAR_P (c
))
1237 XSETINT (val
, ONE_BYTE_CHAR_WIDTH (c
));
1240 int charset
= CHAR_CHARSET (c
);
1242 XSETFASTINT (val
, CHARSET_WIDTH (charset
));
1247 /* Return width of string STR of length LEN when displayed in the
1248 current buffer. The width is measured by how many columns it
1249 occupies on the screen. */
1256 return c_string_width (str
, len
, -1, NULL
, NULL
);
1259 /* Return width of string STR of length LEN when displayed in the
1260 current buffer. The width is measured by how many columns it
1261 occupies on the screen. If PRECISION > 0, return the width of
1262 longest substring that doesn't exceed PRECISION, and set number of
1263 characters and bytes of the substring in *NCHARS and *NBYTES
1267 c_string_width (str
, len
, precision
, nchars
, nbytes
)
1269 int precision
, *nchars
, *nbytes
;
1271 int i
= 0, i_byte
= 0;
1274 struct Lisp_Char_Table
*dp
= buffer_display_table ();
1276 while (i_byte
< len
)
1278 int bytes
, thiswidth
;
1283 int c
= STRING_CHAR_AND_LENGTH (str
+ i_byte
, len
- i_byte
, bytes
);
1286 val
= DISP_CHAR_VECTOR (dp
, c
);
1288 thiswidth
= XVECTOR (val
)->size
;
1290 thiswidth
= ONE_BYTE_CHAR_WIDTH (str
[i_byte
]);
1295 PARSE_MULTIBYTE_SEQ (str
+ i_byte
, len
- i_byte
, bytes
);
1296 thiswidth
= ONE_BYTE_CHAR_WIDTH (str
[i_byte
]);
1300 && (width
+ thiswidth
> precision
))
1320 /* Return width of Lisp string STRING when displayed in the current
1321 buffer. The width is measured by how many columns it occupies on
1322 the screen while paying attention to compositions. If PRECISION >
1323 0, return the width of longest substring that doesn't exceed
1324 PRECISION, and set number of characters and bytes of the substring
1325 in *NCHARS and *NBYTES respectively. */
1328 lisp_string_width (string
, precision
, nchars
, nbytes
)
1330 int precision
, *nchars
, *nbytes
;
1332 int len
= XSTRING (string
)->size
;
1333 int len_byte
= STRING_BYTES (XSTRING (string
));
1334 unsigned char *str
= XSTRING (string
)->data
;
1335 int i
= 0, i_byte
= 0;
1337 struct Lisp_Char_Table
*dp
= buffer_display_table ();
1341 int chars
, bytes
, thiswidth
;
1346 if (find_composition (i
, -1, &ignore
, &end
, &val
, string
)
1347 && ((cmp_id
= get_composition_id (i
, i_byte
, end
- i
, val
, string
))
1350 thiswidth
= composition_table
[cmp_id
]->width
;
1352 bytes
= string_char_to_byte (string
, end
) - i_byte
;
1356 int c
= STRING_CHAR_AND_LENGTH (str
+ i_byte
, len
- i_byte
, bytes
);
1359 val
= DISP_CHAR_VECTOR (dp
, c
);
1361 thiswidth
= XVECTOR (val
)->size
;
1363 thiswidth
= ONE_BYTE_CHAR_WIDTH (str
[i_byte
]);
1368 PARSE_MULTIBYTE_SEQ (str
+ i_byte
, len_byte
- i_byte
, bytes
);
1369 thiswidth
= ONE_BYTE_CHAR_WIDTH (str
[i_byte
]);
1373 && (width
+ thiswidth
> precision
))
1393 DEFUN ("string-width", Fstring_width
, Sstring_width
, 1, 1, 0,
1394 doc
: /* Return width of STRING when displayed in the current buffer.
1395 Width is measured by how many columns it occupies on the screen.
1396 When calculating width of a multibyte character in STRING,
1397 only the base leading-code is considered; the validity of
1398 the following bytes is not checked. Tabs in STRING are always
1399 taken to occupy `tab-width' columns. */)
1406 XSETFASTINT (val
, lisp_string_width (str
, -1, NULL
, NULL
));
1410 DEFUN ("char-direction", Fchar_direction
, Schar_direction
, 1, 1, 0,
1411 doc
: /* Return the direction of CHAR.
1412 The returned value is 0 for left-to-right and 1 for right-to-left. */)
1419 charset
= CHAR_CHARSET (XFASTINT (ch
));
1420 if (!CHARSET_DEFINED_P (charset
))
1421 invalid_character (XINT (ch
));
1422 return CHARSET_TABLE_INFO (charset
, CHARSET_DIRECTION_IDX
);
1425 DEFUN ("chars-in-region", Fchars_in_region
, Schars_in_region
, 2, 2, 0,
1426 doc
: /* Return number of characters between BEG and END. */)
1428 Lisp_Object beg
, end
;
1432 CHECK_NUMBER_COERCE_MARKER (beg
);
1433 CHECK_NUMBER_COERCE_MARKER (end
);
1435 from
= min (XFASTINT (beg
), XFASTINT (end
));
1436 to
= max (XFASTINT (beg
), XFASTINT (end
));
1438 return make_number (to
- from
);
1441 /* Return the number of characters in the NBYTES bytes at PTR.
1442 This works by looking at the contents and checking for multibyte sequences.
1443 However, if the current buffer has enable-multibyte-characters = nil,
1444 we treat each byte as a character. */
1447 chars_in_text (ptr
, nbytes
)
1451 /* current_buffer is null at early stages of Emacs initialization. */
1452 if (current_buffer
== 0
1453 || NILP (current_buffer
->enable_multibyte_characters
))
1456 return multibyte_chars_in_text (ptr
, nbytes
);
1459 /* Return the number of characters in the NBYTES bytes at PTR.
1460 This works by looking at the contents and checking for multibyte sequences.
1461 It ignores enable-multibyte-characters. */
1464 multibyte_chars_in_text (ptr
, nbytes
)
1468 unsigned char *endp
;
1471 endp
= ptr
+ nbytes
;
1476 PARSE_MULTIBYTE_SEQ (ptr
, endp
- ptr
, bytes
);
1484 /* Parse unibyte text at STR of LEN bytes as multibyte text, and
1485 count the numbers of characters and bytes in it. On counting
1486 bytes, pay attention to the fact that 8-bit characters in the range
1487 0x80..0x9F are represented by 2 bytes in multibyte text. */
1489 parse_str_as_multibyte (str
, len
, nchars
, nbytes
)
1491 int len
, *nchars
, *nbytes
;
1493 unsigned char *endp
= str
+ len
;
1494 int n
, chars
= 0, bytes
= 0;
1498 if (UNIBYTE_STR_AS_MULTIBYTE_P (str
, endp
- str
, n
))
1499 str
+= n
, bytes
+= n
;
1509 /* Arrange unibyte text at STR of NBYTES bytes as multibyte text.
1510 It actually converts only 8-bit characters in the range 0x80..0x9F
1511 that don't contruct multibyte characters to multibyte forms. If
1512 NCHARS is nonzero, set *NCHARS to the number of characters in the
1513 text. It is assured that we can use LEN bytes at STR as a work
1514 area and that is enough. Return the number of bytes of the
1518 str_as_multibyte (str
, len
, nbytes
, nchars
)
1520 int len
, nbytes
, *nchars
;
1522 unsigned char *p
= str
, *endp
= str
+ nbytes
;
1527 while (p
< endp
&& UNIBYTE_STR_AS_MULTIBYTE_P (p
, endp
- p
, n
))
1537 safe_bcopy (p
, endp
- nbytes
, nbytes
);
1541 if (UNIBYTE_STR_AS_MULTIBYTE_P (p
, endp
- p
, n
))
1548 *to
++ = LEADING_CODE_8_BIT_CONTROL
;
1549 *to
++ = *p
++ + 0x20;
1558 /* Parse unibyte string at STR of LEN bytes, and return the number of
1559 bytes it may ocupy when converted to multibyte string by
1560 `str_to_multibyte'. */
1563 parse_str_to_multibyte (str
, len
)
1567 unsigned char *endp
= str
+ len
;
1570 for (bytes
= 0; str
< endp
; str
++)
1571 bytes
+= (*str
< 0x80 || *str
>= 0xA0) ? 1 : 2;
1575 /* Convert unibyte text at STR of NBYTES bytes to multibyte text
1576 that contains the same single-byte characters. It actually
1577 converts all 8-bit characters to multibyte forms. It is assured
1578 that we can use LEN bytes at STR as a work area and that is
1582 str_to_multibyte (str
, len
, bytes
)
1586 unsigned char *p
= str
, *endp
= str
+ bytes
;
1589 while (p
< endp
&& (*p
< 0x80 || *p
>= 0xA0)) p
++;
1595 safe_bcopy (p
, endp
- bytes
, bytes
);
1599 if (*p
< 0x80 || *p
>= 0xA0)
1602 *to
++ = LEADING_CODE_8_BIT_CONTROL
, *to
++ = *p
++ + 0x20;
1607 /* Arrange multibyte text at STR of LEN bytes as a unibyte text. It
1608 actually converts only 8-bit characters in the range 0x80..0x9F to
1612 str_as_unibyte (str
, bytes
)
1616 unsigned char *p
= str
, *endp
= str
+ bytes
;
1617 unsigned char *to
= str
;
1619 while (p
< endp
&& *p
!= LEADING_CODE_8_BIT_CONTROL
) p
++;
1623 if (*p
== LEADING_CODE_8_BIT_CONTROL
)
1624 *to
++ = *(p
+ 1) - 0x20, p
+= 2;
1632 DEFUN ("string", Fstring
, Sstring
, 1, MANY
, 0,
1633 doc
: /* Concatenate all the argument characters and make the result a string.
1634 usage: (string &rest CHARACTERS) */)
1640 unsigned char *buf
= (unsigned char *) alloca (MAX_MULTIBYTE_LENGTH
* n
);
1641 unsigned char *p
= buf
;
1645 for (i
= 0; i
< n
; i
++)
1647 CHECK_NUMBER (args
[i
]);
1648 if (!multibyte
&& !SINGLE_BYTE_CHAR_P (XFASTINT (args
[i
])))
1652 for (i
= 0; i
< n
; i
++)
1656 p
+= CHAR_STRING (c
, p
);
1661 return make_string_from_bytes (buf
, n
, p
- buf
);
1667 charset_id_internal (charset_name
)
1672 val
= Fget (intern (charset_name
), Qcharset
);
1674 error ("Charset %s is not defined", charset_name
);
1676 return (XINT (XVECTOR (val
)->contents
[0]));
1679 DEFUN ("setup-special-charsets", Fsetup_special_charsets
,
1680 Ssetup_special_charsets
, 0, 0, 0, doc
: /* Internal use only. */)
1683 charset_latin_iso8859_1
= charset_id_internal ("latin-iso8859-1");
1684 charset_jisx0208_1978
= charset_id_internal ("japanese-jisx0208-1978");
1685 charset_jisx0208
= charset_id_internal ("japanese-jisx0208");
1686 charset_katakana_jisx0201
= charset_id_internal ("katakana-jisx0201");
1687 charset_latin_jisx0201
= charset_id_internal ("latin-jisx0201");
1688 charset_big5_1
= charset_id_internal ("chinese-big5-1");
1689 charset_big5_2
= charset_id_internal ("chinese-big5-2");
1694 init_charset_once ()
1698 staticpro (&Vcharset_table
);
1699 staticpro (&Vcharset_symbol_table
);
1700 staticpro (&Vgeneric_character_list
);
1702 /* This has to be done here, before we call Fmake_char_table. */
1703 Qcharset_table
= intern ("charset-table");
1704 staticpro (&Qcharset_table
);
1706 /* Intern this now in case it isn't already done.
1707 Setting this variable twice is harmless.
1708 But don't staticpro it here--that is done in alloc.c. */
1709 Qchar_table_extra_slots
= intern ("char-table-extra-slots");
1711 /* Now we are ready to set up this property, so we can
1712 create the charset table. */
1713 Fput (Qcharset_table
, Qchar_table_extra_slots
, make_number (0));
1714 Vcharset_table
= Fmake_char_table (Qcharset_table
, Qnil
);
1716 Qunknown
= intern ("unknown");
1717 staticpro (&Qunknown
);
1718 Vcharset_symbol_table
= Fmake_vector (make_number (MAX_CHARSET
+ 1),
1722 for (i
= 0; i
< 2; i
++)
1723 for (j
= 0; j
< 2; j
++)
1724 for (k
= 0; k
< 128; k
++)
1725 iso_charset_table
[i
][j
][k
] = -1;
1727 for (i
= 0; i
< 256; i
++)
1728 bytes_by_char_head
[i
] = 1;
1729 bytes_by_char_head
[LEADING_CODE_PRIVATE_11
] = 3;
1730 bytes_by_char_head
[LEADING_CODE_PRIVATE_12
] = 3;
1731 bytes_by_char_head
[LEADING_CODE_PRIVATE_21
] = 4;
1732 bytes_by_char_head
[LEADING_CODE_PRIVATE_22
] = 4;
1734 for (i
= 0; i
< 128; i
++)
1735 width_by_char_head
[i
] = 1;
1736 for (; i
< 256; i
++)
1737 width_by_char_head
[i
] = 4;
1738 width_by_char_head
[LEADING_CODE_PRIVATE_11
] = 1;
1739 width_by_char_head
[LEADING_CODE_PRIVATE_12
] = 2;
1740 width_by_char_head
[LEADING_CODE_PRIVATE_21
] = 1;
1741 width_by_char_head
[LEADING_CODE_PRIVATE_22
] = 2;
1747 for (i
= 0x81; i
< 0x90; i
++)
1748 val
= Fcons (make_number ((i
- 0x70) << 7), val
);
1749 for (; i
< 0x9A; i
++)
1750 val
= Fcons (make_number ((i
- 0x8F) << 14), val
);
1751 for (i
= 0xA0; i
< 0xF0; i
++)
1752 val
= Fcons (make_number ((i
- 0x70) << 7), val
);
1753 for (; i
< 0xFF; i
++)
1754 val
= Fcons (make_number ((i
- 0xE0) << 14), val
);
1755 Vgeneric_character_list
= Fnreverse (val
);
1758 nonascii_insert_offset
= 0;
1759 Vnonascii_translation_table
= Qnil
;
1767 Qcharset
= intern ("charset");
1768 staticpro (&Qcharset
);
1770 Qascii
= intern ("ascii");
1771 staticpro (&Qascii
);
1773 Qeight_bit_control
= intern ("eight-bit-control");
1774 staticpro (&Qeight_bit_control
);
1776 Qeight_bit_graphic
= intern ("eight-bit-graphic");
1777 staticpro (&Qeight_bit_graphic
);
1779 /* Define special charsets ascii, eight-bit-control, and
1780 eight-bit-graphic. */
1781 update_charset_table (make_number (CHARSET_ASCII
),
1782 make_number (1), make_number (94),
1787 build_string ("ASCII"),
1788 Qnil
, /* same as above */
1789 build_string ("ASCII (ISO646 IRV)"));
1790 CHARSET_SYMBOL (CHARSET_ASCII
) = Qascii
;
1791 Fput (Qascii
, Qcharset
, CHARSET_TABLE_ENTRY (CHARSET_ASCII
));
1793 update_charset_table (make_number (CHARSET_8_BIT_CONTROL
),
1794 make_number (1), make_number (96),
1799 build_string ("8-bit control code (0x80..0x9F)"),
1800 Qnil
, /* same as above */
1801 Qnil
); /* same as above */
1802 CHARSET_SYMBOL (CHARSET_8_BIT_CONTROL
) = Qeight_bit_control
;
1803 Fput (Qeight_bit_control
, Qcharset
,
1804 CHARSET_TABLE_ENTRY (CHARSET_8_BIT_CONTROL
));
1806 update_charset_table (make_number (CHARSET_8_BIT_GRAPHIC
),
1807 make_number (1), make_number (96),
1812 build_string ("8-bit graphic char (0xA0..0xFF)"),
1813 Qnil
, /* same as above */
1814 Qnil
); /* same as above */
1815 CHARSET_SYMBOL (CHARSET_8_BIT_GRAPHIC
) = Qeight_bit_graphic
;
1816 Fput (Qeight_bit_graphic
, Qcharset
,
1817 CHARSET_TABLE_ENTRY (CHARSET_8_BIT_GRAPHIC
));
1819 Qauto_fill_chars
= intern ("auto-fill-chars");
1820 staticpro (&Qauto_fill_chars
);
1821 Fput (Qauto_fill_chars
, Qchar_table_extra_slots
, make_number (0));
1823 defsubr (&Sdefine_charset
);
1824 defsubr (&Sgeneric_character_list
);
1825 defsubr (&Sget_unused_iso_final_char
);
1826 defsubr (&Sdeclare_equiv_charset
);
1827 defsubr (&Sfind_charset_region
);
1828 defsubr (&Sfind_charset_string
);
1829 defsubr (&Smake_char_internal
);
1830 defsubr (&Ssplit_char
);
1831 defsubr (&Schar_charset
);
1832 defsubr (&Scharset_after
);
1833 defsubr (&Siso_charset
);
1834 defsubr (&Schar_valid_p
);
1835 defsubr (&Sunibyte_char_to_multibyte
);
1836 defsubr (&Smultibyte_char_to_unibyte
);
1837 defsubr (&Schar_bytes
);
1838 defsubr (&Schar_width
);
1839 defsubr (&Sstring_width
);
1840 defsubr (&Schar_direction
);
1841 defsubr (&Schars_in_region
);
1843 defsubr (&Ssetup_special_charsets
);
1845 DEFVAR_LISP ("charset-list", &Vcharset_list
,
1846 doc
: /* List of charsets ever defined. */);
1847 Vcharset_list
= Fcons (Qascii
, Fcons (Qeight_bit_control
,
1848 Fcons (Qeight_bit_graphic
, Qnil
)));
1850 DEFVAR_LISP ("translation-table-vector", &Vtranslation_table_vector
,
1851 doc
: /* Vector of cons cell of a symbol and translation table ever defined.
1852 An ID of a translation table is an index of this vector. */);
1853 Vtranslation_table_vector
= Fmake_vector (make_number (16), Qnil
);
1855 DEFVAR_INT ("leading-code-private-11", &leading_code_private_11
,
1856 doc
: /* Leading-code of private TYPE9N charset of column-width 1. */);
1857 leading_code_private_11
= LEADING_CODE_PRIVATE_11
;
1859 DEFVAR_INT ("leading-code-private-12", &leading_code_private_12
,
1860 doc
: /* Leading-code of private TYPE9N charset of column-width 2. */);
1861 leading_code_private_12
= LEADING_CODE_PRIVATE_12
;
1863 DEFVAR_INT ("leading-code-private-21", &leading_code_private_21
,
1864 doc
: /* Leading-code of private TYPE9Nx9N charset of column-width 1. */);
1865 leading_code_private_21
= LEADING_CODE_PRIVATE_21
;
1867 DEFVAR_INT ("leading-code-private-22", &leading_code_private_22
,
1868 doc
: /* Leading-code of private TYPE9Nx9N charset of column-width 2. */);
1869 leading_code_private_22
= LEADING_CODE_PRIVATE_22
;
1871 DEFVAR_INT ("nonascii-insert-offset", &nonascii_insert_offset
,
1872 doc
: /* Offset for converting non-ASCII unibyte codes 0240...0377 to multibyte.
1873 This is used for converting unibyte text to multibyte,
1874 and for inserting character codes specified by number.
1876 This serves to convert a Latin-1 or similar 8-bit character code
1877 to the corresponding Emacs multibyte character code.
1878 Typically the value should be (- (make-char CHARSET 0) 128),
1879 for your choice of character set.
1880 If `nonascii-translation-table' is non-nil, it overrides this variable. */);
1881 nonascii_insert_offset
= 0;
1883 DEFVAR_LISP ("nonascii-translation-table", &Vnonascii_translation_table
,
1884 doc
: /* Translation table to convert non-ASCII unibyte codes to multibyte.
1885 This is used for converting unibyte text to multibyte,
1886 and for inserting character codes specified by number.
1888 Conversion is performed only when multibyte characters are enabled,
1889 and it serves to convert a Latin-1 or similar 8-bit character code
1890 to the corresponding Emacs character code.
1892 If this is nil, `nonascii-insert-offset' is used instead.
1893 See also the docstring of `make-translation-table'. */);
1894 Vnonascii_translation_table
= Qnil
;
1896 DEFVAR_LISP ("auto-fill-chars", &Vauto_fill_chars
,
1897 doc
: /* A char-table for characters which invoke auto-filling.
1898 Such characters have value t in this table. */);
1899 Vauto_fill_chars
= Fmake_char_table (Qauto_fill_chars
, Qnil
);
1900 CHAR_TABLE_SET (Vauto_fill_chars
, make_number (' '), Qt
);
1901 CHAR_TABLE_SET (Vauto_fill_chars
, make_number ('\n'), Qt
);