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 EMACS_INT leading_code_private_11
; /* for private DIMENSION1 of 1-column */
53 EMACS_INT leading_code_private_12
; /* for private DIMENSION1 of 2-column */
54 EMACS_INT leading_code_private_21
; /* for private DIMENSION2 of 1-column */
55 EMACS_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 EMACS_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 /* This originally used a ?: operator, but reportedly the HP-UX
601 compiler version HP92453-01 A.10.32.22 miscompiles that. */
602 if (SYMBOLP (charset_symbol
)
603 && VECTORP (val
= Fget (charset_symbol
, Qcharset
))
604 && CHARSET_VALID_P (charset
=
605 XINT (XVECTOR (val
)->contents
[CHARSET_ID_IDX
])))
611 /* Return an identification number for a new private charset of
612 DIMENSION and WIDTH. If there's no more room for the new charset,
615 get_new_private_charset_id (dimension
, width
)
616 int dimension
, width
;
618 int charset
, from
, to
;
622 from
= LEADING_CODE_EXT_11
;
623 to
= LEADING_CODE_EXT_21
;
627 from
= LEADING_CODE_EXT_21
;
628 to
= LEADING_CODE_EXT_MAX
+ 1;
631 for (charset
= from
; charset
< to
; charset
++)
632 if (!CHARSET_DEFINED_P (charset
)) break;
634 return make_number (charset
< to
? charset
: 0);
637 DEFUN ("define-charset", Fdefine_charset
, Sdefine_charset
, 3, 3, 0,
638 doc
: /* Define CHARSET-ID as the identification number of CHARSET with INFO-VECTOR.
639 If CHARSET-ID is nil, it is decided automatically, which means CHARSET is
640 treated as a private charset.
641 INFO-VECTOR is a vector of the format:
642 [DIMENSION CHARS WIDTH DIRECTION ISO-FINAL-CHAR ISO-GRAPHIC-PLANE
643 SHORT-NAME LONG-NAME DESCRIPTION]
644 The meanings of each elements is as follows:
645 DIMENSION (integer) is the number of bytes to represent a character: 1 or 2.
646 CHARS (integer) is the number of characters in a dimension: 94 or 96.
647 WIDTH (integer) is the number of columns a character in the charset
648 occupies on the screen: one of 0, 1, and 2.
650 DIRECTION (integer) is the rendering direction of characters in the
651 charset when rendering. If 0, render from left to right, else
652 render from right to left.
654 ISO-FINAL-CHAR (character) is the final character of the
655 corresponding ISO 2022 charset.
656 It may be -1 if the charset is internal use only.
658 ISO-GRAPHIC-PLANE (integer) is the graphic plane to be invoked
659 while encoding to variants of ISO 2022 coding system, one of the
660 following: 0/graphic-plane-left(GL), 1/graphic-plane-right(GR).
661 It may be -1 if the charset is internal use only.
663 SHORT-NAME (string) is the short name to refer to the charset.
665 LONG-NAME (string) is the long name to refer to the charset.
667 DESCRIPTION (string) is the description string of the charset. */)
668 (charset_id
, charset_symbol
, info_vector
)
669 Lisp_Object charset_id
, charset_symbol
, info_vector
;
673 if (!NILP (charset_id
))
674 CHECK_NUMBER (charset_id
);
675 CHECK_SYMBOL (charset_symbol
);
676 CHECK_VECTOR (info_vector
);
678 if (! NILP (charset_id
))
680 if (! CHARSET_VALID_P (XINT (charset_id
)))
681 error ("Invalid CHARSET: %d", XINT (charset_id
));
682 else if (CHARSET_DEFINED_P (XINT (charset_id
)))
683 error ("Already defined charset: %d", XINT (charset_id
));
686 vec
= XVECTOR (info_vector
)->contents
;
687 if (XVECTOR (info_vector
)->size
!= 9
688 || !INTEGERP (vec
[0]) || !(XINT (vec
[0]) == 1 || XINT (vec
[0]) == 2)
689 || !INTEGERP (vec
[1]) || !(XINT (vec
[1]) == 94 || XINT (vec
[1]) == 96)
690 || !INTEGERP (vec
[2]) || !(XINT (vec
[2]) == 1 || XINT (vec
[2]) == 2)
691 || !INTEGERP (vec
[3]) || !(XINT (vec
[3]) == 0 || XINT (vec
[3]) == 1)
692 || !INTEGERP (vec
[4])
693 || !(XINT (vec
[4]) == -1 || (XINT (vec
[4]) >= '0' && XINT (vec
[4]) <= '~'))
694 || !INTEGERP (vec
[5])
695 || !(XINT (vec
[5]) == -1 || XINT (vec
[5]) == 0 || XINT (vec
[5]) == 1)
698 || !STRINGP (vec
[8]))
699 error ("Invalid info-vector argument for defining charset %s",
700 XSYMBOL (charset_symbol
)->name
->data
);
702 if (NILP (charset_id
))
704 charset_id
= get_new_private_charset_id (XINT (vec
[0]), XINT (vec
[2]));
705 if (XINT (charset_id
) == 0)
706 error ("There's no room for a new private charset %s",
707 XSYMBOL (charset_symbol
)->name
->data
);
710 update_charset_table (charset_id
, vec
[0], vec
[1], vec
[2], vec
[3],
711 vec
[4], vec
[5], vec
[6], vec
[7], vec
[8]);
712 Fput (charset_symbol
, Qcharset
, CHARSET_TABLE_ENTRY (XINT (charset_id
)));
713 CHARSET_SYMBOL (XINT (charset_id
)) = charset_symbol
;
714 Vcharset_list
= Fcons (charset_symbol
, Vcharset_list
);
715 Fupdate_coding_systems_internal ();
719 DEFUN ("generic-character-list", Fgeneric_character_list
,
720 Sgeneric_character_list
, 0, 0, 0,
721 doc
: /* Return a list of all possible generic characters.
722 It includes a generic character for a charset not yet defined. */)
725 return Vgeneric_character_list
;
728 DEFUN ("get-unused-iso-final-char", Fget_unused_iso_final_char
,
729 Sget_unused_iso_final_char
, 2, 2, 0,
730 doc
: /* Return an unsed ISO's final char for a charset of DIMENISION and CHARS.
731 DIMENSION is the number of bytes to represent a character: 1 or 2.
732 CHARS is the number of characters in a dimension: 94 or 96.
734 This final char is for private use, thus the range is `0' (48) .. `?' (63).
735 If there's no unused final char for the specified kind of charset,
738 Lisp_Object dimension
, chars
;
742 CHECK_NUMBER (dimension
);
743 CHECK_NUMBER (chars
);
744 if (XINT (dimension
) != 1 && XINT (dimension
) != 2)
745 error ("Invalid charset dimension %d, it should be 1 or 2",
747 if (XINT (chars
) != 94 && XINT (chars
) != 96)
748 error ("Invalid charset chars %d, it should be 94 or 96",
750 for (final_char
= '0'; final_char
<= '?'; final_char
++)
752 if (ISO_CHARSET_TABLE (dimension
, chars
, make_number (final_char
)) < 0)
755 return (final_char
<= '?' ? make_number (final_char
) : Qnil
);
758 DEFUN ("declare-equiv-charset", Fdeclare_equiv_charset
, Sdeclare_equiv_charset
,
760 doc
: /* Declare a charset of DIMENSION, CHARS, FINAL-CHAR is the same as CHARSET.
761 CHARSET should be defined by `defined-charset' in advance. */)
762 (dimension
, chars
, final_char
, charset_symbol
)
763 Lisp_Object dimension
, chars
, final_char
, charset_symbol
;
767 CHECK_NUMBER (dimension
);
768 CHECK_NUMBER (chars
);
769 CHECK_NUMBER (final_char
);
770 CHECK_SYMBOL (charset_symbol
);
772 if (XINT (dimension
) != 1 && XINT (dimension
) != 2)
773 error ("Invalid DIMENSION %d, it should be 1 or 2", XINT (dimension
));
774 if (XINT (chars
) != 94 && XINT (chars
) != 96)
775 error ("Invalid CHARS %d, it should be 94 or 96", XINT (chars
));
776 if (XINT (final_char
) < '0' || XFASTINT (final_char
) > '~')
777 error ("Invalid FINAL-CHAR %c, it should be `0'..`~'", XINT (chars
));
778 if ((charset
= get_charset_id (charset_symbol
)) < 0)
779 error ("Invalid charset %s", XSYMBOL (charset_symbol
)->name
->data
);
781 ISO_CHARSET_TABLE (dimension
, chars
, final_char
) = charset
;
785 /* Return information about charsets in the text at PTR of NBYTES
786 bytes, which are NCHARS characters. The value is:
788 0: Each character is represented by one byte. This is always
789 true for unibyte text.
790 1: No charsets other than ascii eight-bit-control,
791 eight-bit-graphic, and latin-1 are found.
794 In addition, if CHARSETS is nonzero, for each found charset N, set
795 CHARSETS[N] to 1. For that, callers should allocate CHARSETS
796 (MAX_CHARSET + 1 elements) in advance. It may lookup a translation
797 table TABLE if supplied. For invalid charsets, set CHARSETS[1] to
798 1 (note that there's no charset whose ID is 1). */
801 find_charset_in_text (ptr
, nchars
, nbytes
, charsets
, table
)
803 int nchars
, nbytes
, *charsets
;
806 if (nchars
== nbytes
)
808 if (charsets
&& nbytes
> 0)
810 unsigned char *endp
= ptr
+ nbytes
;
813 while (ptr
< endp
&& maskbits
!= 7)
815 maskbits
|= (*ptr
< 0x80 ? 1 : *ptr
< 0xA0 ? 2 : 4);
820 charsets
[CHARSET_ASCII
] = 1;
822 charsets
[CHARSET_8_BIT_CONTROL
] = 1;
824 charsets
[CHARSET_8_BIT_GRAPHIC
] = 1;
831 int bytes
, charset
, c1
, c2
;
833 if (! CHAR_TABLE_P (table
))
838 SPLIT_MULTIBYTE_SEQ (ptr
, len
, bytes
, charset
, c1
, c2
);
841 if (!CHARSET_DEFINED_P (charset
))
843 else if (! NILP (table
))
845 int c
= translate_char (table
, -1, charset
, c1
, c2
);
847 charset
= CHAR_CHARSET (c
);
851 && charset
!= CHARSET_ASCII
852 && charset
!= CHARSET_8_BIT_CONTROL
853 && charset
!= CHARSET_8_BIT_GRAPHIC
854 && charset
!= charset_latin_iso8859_1
)
858 charsets
[charset
] = 1;
859 else if (return_val
== 2)
866 DEFUN ("find-charset-region", Ffind_charset_region
, Sfind_charset_region
,
868 doc
: /* Return a list of charsets in the region between BEG and END.
869 BEG and END are buffer positions.
870 Optional arg TABLE if non-nil is a translation table to look up.
872 If the region contains invalid multibyte characters,
873 `unknown' is included in the returned list.
875 If the current buffer is unibyte, the returned list may contain
876 only `ascii', `eight-bit-control', and `eight-bit-graphic'. */)
878 Lisp_Object beg
, end
, table
;
880 int charsets
[MAX_CHARSET
+ 1];
881 int from
, from_byte
, to
, stop
, stop_byte
, i
;
884 validate_region (&beg
, &end
);
885 from
= XFASTINT (beg
);
886 stop
= to
= XFASTINT (end
);
888 if (from
< GPT
&& GPT
< to
)
891 stop_byte
= GPT_BYTE
;
894 stop_byte
= CHAR_TO_BYTE (stop
);
896 from_byte
= CHAR_TO_BYTE (from
);
898 bzero (charsets
, (MAX_CHARSET
+ 1) * sizeof (int));
901 find_charset_in_text (BYTE_POS_ADDR (from_byte
), stop
- from
,
902 stop_byte
- from_byte
, charsets
, table
);
905 from
= stop
, from_byte
= stop_byte
;
906 stop
= to
, stop_byte
= CHAR_TO_BYTE (stop
);
914 val
= Fcons (Qunknown
, val
);
915 for (i
= MAX_CHARSET
; i
>= MIN_CHARSET_OFFICIAL_DIMENSION1
; i
--)
917 val
= Fcons (CHARSET_SYMBOL (i
), val
);
919 val
= Fcons (Qascii
, val
);
923 DEFUN ("find-charset-string", Ffind_charset_string
, Sfind_charset_string
,
925 doc
: /* Return a list of charsets in STR.
926 Optional arg TABLE if non-nil is a translation table to look up.
928 If the string contains invalid multibyte characters,
929 `unknown' is included in the returned list.
931 If STR is unibyte, the returned list may contain
932 only `ascii', `eight-bit-control', and `eight-bit-graphic'. */)
934 Lisp_Object str
, table
;
936 int charsets
[MAX_CHARSET
+ 1];
942 bzero (charsets
, (MAX_CHARSET
+ 1) * sizeof (int));
943 find_charset_in_text (XSTRING (str
)->data
, XSTRING (str
)->size
,
944 STRING_BYTES (XSTRING (str
)), charsets
, table
);
948 val
= Fcons (Qunknown
, val
);
949 for (i
= MAX_CHARSET
; i
>= MIN_CHARSET_OFFICIAL_DIMENSION1
; i
--)
951 val
= Fcons (CHARSET_SYMBOL (i
), val
);
953 val
= Fcons (Qascii
, val
);
958 DEFUN ("make-char-internal", Fmake_char_internal
, Smake_char_internal
, 1, 3, 0,
959 doc
: /* Return a character made from arguments.
960 Internal use only. */)
961 (charset
, code1
, code2
)
962 Lisp_Object charset
, code1
, code2
;
964 int charset_id
, c1
, c2
;
966 CHECK_NUMBER (charset
);
967 charset_id
= XINT (charset
);
968 if (!CHARSET_DEFINED_P (charset_id
))
969 error ("Invalid charset ID: %d", XINT (charset
));
975 CHECK_NUMBER (code1
);
982 CHECK_NUMBER (code2
);
986 if (charset_id
== CHARSET_ASCII
)
988 if (c1
< 0 || c1
> 0x7F)
989 goto invalid_code_posints
;
990 return make_number (c1
);
992 else if (charset_id
== CHARSET_8_BIT_CONTROL
)
996 else if (c1
< 0x80 || c1
> 0x9F)
997 goto invalid_code_posints
;
998 return make_number (c1
);
1000 else if (charset_id
== CHARSET_8_BIT_GRAPHIC
)
1004 else if (c1
< 0xA0 || c1
> 0xFF)
1005 goto invalid_code_posints
;
1006 return make_number (c1
);
1008 else if (c1
< 0 || c1
> 0xFF || c2
< 0 || c2
> 0xFF)
1009 goto invalid_code_posints
;
1015 ? !CHAR_COMPONENTS_VALID_P (charset_id
, c1
, 0x20)
1016 : !CHAR_COMPONENTS_VALID_P (charset_id
, c1
, c2
)))
1017 goto invalid_code_posints
;
1018 return make_number (MAKE_CHAR (charset_id
, c1
, c2
));
1020 invalid_code_posints
:
1021 error ("Invalid code points for charset ID %d: %d %d", charset_id
, c1
, c2
);
1024 DEFUN ("split-char", Fsplit_char
, Ssplit_char
, 1, 1, 0,
1025 doc
: /* Return list of charset and one or two position-codes of CHAR.
1026 If CHAR is invalid as a character code,
1027 return a list of symbol `unknown' and CHAR. */)
1031 int c
, charset
, c1
, c2
;
1035 if (!CHAR_VALID_P (c
, 1))
1036 return Fcons (Qunknown
, Fcons (ch
, Qnil
));
1037 SPLIT_CHAR (XFASTINT (ch
), charset
, c1
, c2
);
1039 ? Fcons (CHARSET_SYMBOL (charset
),
1040 Fcons (make_number (c1
), Fcons (make_number (c2
), Qnil
)))
1041 : Fcons (CHARSET_SYMBOL (charset
), Fcons (make_number (c1
), Qnil
)));
1044 DEFUN ("char-charset", Fchar_charset
, Schar_charset
, 1, 1, 0,
1045 doc
: /* Return charset of CHAR. */)
1051 return CHARSET_SYMBOL (CHAR_CHARSET (XINT (ch
)));
1054 DEFUN ("charset-after", Fcharset_after
, Scharset_after
, 0, 1, 0,
1055 doc
: /* Return charset of a character in the current buffer at position POS.
1056 If POS is nil, it defauls to the current point.
1057 If POS is out of range, the value is nil. */)
1064 ch
= Fchar_after (pos
);
1065 if (! INTEGERP (ch
))
1067 charset
= CHAR_CHARSET (XINT (ch
));
1068 return CHARSET_SYMBOL (charset
);
1071 DEFUN ("iso-charset", Fiso_charset
, Siso_charset
, 3, 3, 0,
1072 doc
: /* Return charset of ISO's specification DIMENSION, CHARS, and FINAL-CHAR.
1074 ISO 2022's designation sequence (escape sequence) distinguishes charsets
1075 by their DIMENSION, CHARS, and FINAL-CHAR,
1076 where as Emacs distinguishes them by charset symbol.
1077 See the documentation of the function `charset-info' for the meanings of
1078 DIMENSION, CHARS, and FINAL-CHAR. */)
1079 (dimension
, chars
, final_char
)
1080 Lisp_Object dimension
, chars
, final_char
;
1084 CHECK_NUMBER (dimension
);
1085 CHECK_NUMBER (chars
);
1086 CHECK_NUMBER (final_char
);
1088 if ((charset
= ISO_CHARSET_TABLE (dimension
, chars
, final_char
)) < 0)
1090 return CHARSET_SYMBOL (charset
);
1093 /* If GENERICP is nonzero, return nonzero iff C is a valid normal or
1094 generic character. If GENERICP is zero, return nonzero iff C is a
1095 valid normal character. Do not call this function directly,
1096 instead use macro CHAR_VALID_P. */
1098 char_valid_p (c
, genericp
)
1101 int charset
, c1
, c2
;
1103 if (c
< 0 || c
>= MAX_CHAR
)
1105 if (SINGLE_BYTE_CHAR_P (c
))
1107 SPLIT_CHAR (c
, charset
, c1
, c2
);
1112 if (c2
<= 0) c2
= 0x20;
1116 if (c2
<= 0) c1
= c2
= 0x20;
1119 return (CHARSET_DEFINED_P (charset
)
1120 && CHAR_COMPONENTS_VALID_P (charset
, c1
, c2
));
1123 DEFUN ("char-valid-p", Fchar_valid_p
, Schar_valid_p
, 1, 2, 0,
1124 doc
: /* Return t if OBJECT is a valid normal character.
1125 If optional arg GENERICP is non-nil, also return t if OBJECT is
1126 a valid generic character. */)
1128 Lisp_Object object
, genericp
;
1130 if (! NATNUMP (object
))
1132 return (CHAR_VALID_P (XFASTINT (object
), !NILP (genericp
)) ? Qt
: Qnil
);
1135 DEFUN ("unibyte-char-to-multibyte", Funibyte_char_to_multibyte
,
1136 Sunibyte_char_to_multibyte
, 1, 1, 0,
1137 doc
: /* Convert the unibyte character CH to multibyte character.
1138 The conversion is done based on `nonascii-translation-table' (which see)
1139 or `nonascii-insert-offset' (which see). */)
1147 if (c
< 0 || c
>= 0400)
1148 error ("Invalid unibyte character: %d", c
);
1149 c
= unibyte_char_to_multibyte (c
);
1151 error ("Can't convert to multibyte character: %d", XINT (ch
));
1152 return make_number (c
);
1155 DEFUN ("multibyte-char-to-unibyte", Fmultibyte_char_to_unibyte
,
1156 Smultibyte_char_to_unibyte
, 1, 1, 0,
1157 doc
: /* Convert the multibyte character CH to unibyte character.
1158 The conversion is done based on `nonascii-translation-table' (which see)
1159 or `nonascii-insert-offset' (which see). */)
1167 if (! CHAR_VALID_P (c
, 0))
1168 error ("Invalid multibyte character: %d", c
);
1169 c
= multibyte_char_to_unibyte (c
, Qnil
);
1171 error ("Can't convert to unibyte character: %d", XINT (ch
));
1172 return make_number (c
);
1175 DEFUN ("char-bytes", Fchar_bytes
, Schar_bytes
, 1, 1, 0,
1176 doc
: /* Return 1 regardless of the argument CHAR.
1177 This is now an obsolete function. We keep it just for backward compatibility. */)
1182 return make_number (1);
1185 /* Return how many bytes C will occupy in a multibyte buffer.
1186 Don't call this function directly, instead use macro CHAR_BYTES. */
1193 if (ASCII_BYTE_P (c
) || (c
& ~((1 << CHARACTERBITS
) -1)))
1195 if (SINGLE_BYTE_CHAR_P (c
) && c
>= 0xA0)
1198 charset
= CHAR_CHARSET (c
);
1199 return (CHARSET_DEFINED_P (charset
) ? CHARSET_BYTES (charset
) : 1);
1202 /* Return the width of character of which multi-byte form starts with
1203 C. The width is measured by how many columns occupied on the
1204 screen when displayed in the current buffer. */
1206 #define ONE_BYTE_CHAR_WIDTH(c) \
1209 ? XFASTINT (current_buffer->tab_width) \
1210 : (c == '\n' ? 0 : (NILP (current_buffer->ctl_arrow) ? 4 : 2))) \
1214 ? (NILP (current_buffer->ctl_arrow) ? 4 : 2) \
1215 : ((! NILP (current_buffer->enable_multibyte_characters) \
1216 && BASE_LEADING_CODE_P (c)) \
1217 ? WIDTH_BY_CHAR_HEAD (c) \
1220 DEFUN ("char-width", Fchar_width
, Schar_width
, 1, 1, 0,
1221 doc
: /* Return width of CHAR when displayed in the current buffer.
1222 The width is measured by how many columns it occupies on the screen.
1223 Tab is taken to occupy `tab-width' columns. */)
1227 Lisp_Object val
, disp
;
1229 struct Lisp_Char_Table
*dp
= buffer_display_table ();
1235 /* Get the way the display table would display it. */
1236 disp
= dp
? DISP_CHAR_VECTOR (dp
, c
) : Qnil
;
1239 XSETINT (val
, XVECTOR (disp
)->size
);
1240 else if (SINGLE_BYTE_CHAR_P (c
))
1241 XSETINT (val
, ONE_BYTE_CHAR_WIDTH (c
));
1244 int charset
= CHAR_CHARSET (c
);
1246 XSETFASTINT (val
, CHARSET_WIDTH (charset
));
1251 /* Return width of string STR of length LEN when displayed in the
1252 current buffer. The width is measured by how many columns it
1253 occupies on the screen. */
1260 return c_string_width (str
, len
, -1, NULL
, NULL
);
1263 /* Return width of string STR of length LEN when displayed in the
1264 current buffer. The width is measured by how many columns it
1265 occupies on the screen. If PRECISION > 0, return the width of
1266 longest substring that doesn't exceed PRECISION, and set number of
1267 characters and bytes of the substring in *NCHARS and *NBYTES
1271 c_string_width (str
, len
, precision
, nchars
, nbytes
)
1273 int precision
, *nchars
, *nbytes
;
1275 int i
= 0, i_byte
= 0;
1278 struct Lisp_Char_Table
*dp
= buffer_display_table ();
1280 while (i_byte
< len
)
1282 int bytes
, thiswidth
;
1287 int c
= STRING_CHAR_AND_LENGTH (str
+ i_byte
, len
- i_byte
, bytes
);
1290 val
= DISP_CHAR_VECTOR (dp
, c
);
1292 thiswidth
= XVECTOR (val
)->size
;
1294 thiswidth
= ONE_BYTE_CHAR_WIDTH (str
[i_byte
]);
1299 PARSE_MULTIBYTE_SEQ (str
+ i_byte
, len
- i_byte
, bytes
);
1300 thiswidth
= ONE_BYTE_CHAR_WIDTH (str
[i_byte
]);
1304 && (width
+ thiswidth
> precision
))
1324 /* Return width of Lisp string STRING when displayed in the current
1325 buffer. The width is measured by how many columns it occupies on
1326 the screen while paying attention to compositions. If PRECISION >
1327 0, return the width of longest substring that doesn't exceed
1328 PRECISION, and set number of characters and bytes of the substring
1329 in *NCHARS and *NBYTES respectively. */
1332 lisp_string_width (string
, precision
, nchars
, nbytes
)
1334 int precision
, *nchars
, *nbytes
;
1336 int len
= XSTRING (string
)->size
;
1337 int len_byte
= STRING_BYTES (XSTRING (string
));
1338 unsigned char *str
= XSTRING (string
)->data
;
1339 int i
= 0, i_byte
= 0;
1341 struct Lisp_Char_Table
*dp
= buffer_display_table ();
1345 int chars
, bytes
, thiswidth
;
1350 if (find_composition (i
, -1, &ignore
, &end
, &val
, string
)
1351 && ((cmp_id
= get_composition_id (i
, i_byte
, end
- i
, val
, string
))
1354 thiswidth
= composition_table
[cmp_id
]->width
;
1356 bytes
= string_char_to_byte (string
, end
) - i_byte
;
1360 int c
= STRING_CHAR_AND_LENGTH (str
+ i_byte
, len
- i_byte
, bytes
);
1363 val
= DISP_CHAR_VECTOR (dp
, c
);
1365 thiswidth
= XVECTOR (val
)->size
;
1367 thiswidth
= ONE_BYTE_CHAR_WIDTH (str
[i_byte
]);
1372 PARSE_MULTIBYTE_SEQ (str
+ i_byte
, len_byte
- i_byte
, bytes
);
1373 thiswidth
= ONE_BYTE_CHAR_WIDTH (str
[i_byte
]);
1377 && (width
+ thiswidth
> precision
))
1397 DEFUN ("string-width", Fstring_width
, Sstring_width
, 1, 1, 0,
1398 doc
: /* Return width of STRING when displayed in the current buffer.
1399 Width is measured by how many columns it occupies on the screen.
1400 When calculating width of a multibyte character in STRING,
1401 only the base leading-code is considered; the validity of
1402 the following bytes is not checked. Tabs in STRING are always
1403 taken to occupy `tab-width' columns. */)
1410 XSETFASTINT (val
, lisp_string_width (str
, -1, NULL
, NULL
));
1414 DEFUN ("char-direction", Fchar_direction
, Schar_direction
, 1, 1, 0,
1415 doc
: /* Return the direction of CHAR.
1416 The returned value is 0 for left-to-right and 1 for right-to-left. */)
1423 charset
= CHAR_CHARSET (XFASTINT (ch
));
1424 if (!CHARSET_DEFINED_P (charset
))
1425 invalid_character (XINT (ch
));
1426 return CHARSET_TABLE_INFO (charset
, CHARSET_DIRECTION_IDX
);
1429 DEFUN ("chars-in-region", Fchars_in_region
, Schars_in_region
, 2, 2, 0,
1430 doc
: /* Return number of characters between BEG and END. */)
1432 Lisp_Object beg
, end
;
1436 CHECK_NUMBER_COERCE_MARKER (beg
);
1437 CHECK_NUMBER_COERCE_MARKER (end
);
1439 from
= min (XFASTINT (beg
), XFASTINT (end
));
1440 to
= max (XFASTINT (beg
), XFASTINT (end
));
1442 return make_number (to
- from
);
1445 /* Return the number of characters in the NBYTES bytes at PTR.
1446 This works by looking at the contents and checking for multibyte sequences.
1447 However, if the current buffer has enable-multibyte-characters = nil,
1448 we treat each byte as a character. */
1451 chars_in_text (ptr
, nbytes
)
1455 /* current_buffer is null at early stages of Emacs initialization. */
1456 if (current_buffer
== 0
1457 || NILP (current_buffer
->enable_multibyte_characters
))
1460 return multibyte_chars_in_text (ptr
, nbytes
);
1463 /* Return the number of characters in the NBYTES bytes at PTR.
1464 This works by looking at the contents and checking for multibyte sequences.
1465 It ignores enable-multibyte-characters. */
1468 multibyte_chars_in_text (ptr
, nbytes
)
1472 unsigned char *endp
;
1475 endp
= ptr
+ nbytes
;
1480 PARSE_MULTIBYTE_SEQ (ptr
, endp
- ptr
, bytes
);
1488 /* Parse unibyte text at STR of LEN bytes as multibyte text, and
1489 count the numbers of characters and bytes in it. On counting
1490 bytes, pay attention to the fact that 8-bit characters in the range
1491 0x80..0x9F are represented by 2 bytes in multibyte text. */
1493 parse_str_as_multibyte (str
, len
, nchars
, nbytes
)
1495 int len
, *nchars
, *nbytes
;
1497 unsigned char *endp
= str
+ len
;
1498 int n
, chars
= 0, bytes
= 0;
1502 if (UNIBYTE_STR_AS_MULTIBYTE_P (str
, endp
- str
, n
))
1503 str
+= n
, bytes
+= n
;
1513 /* Arrange unibyte text at STR of NBYTES bytes as multibyte text.
1514 It actually converts only 8-bit characters in the range 0x80..0x9F
1515 that don't contruct multibyte characters to multibyte forms. If
1516 NCHARS is nonzero, set *NCHARS to the number of characters in the
1517 text. It is assured that we can use LEN bytes at STR as a work
1518 area and that is enough. Return the number of bytes of the
1522 str_as_multibyte (str
, len
, nbytes
, nchars
)
1524 int len
, nbytes
, *nchars
;
1526 unsigned char *p
= str
, *endp
= str
+ nbytes
;
1531 while (p
< endp
&& UNIBYTE_STR_AS_MULTIBYTE_P (p
, endp
- p
, n
))
1541 safe_bcopy (p
, endp
- nbytes
, nbytes
);
1545 if (UNIBYTE_STR_AS_MULTIBYTE_P (p
, endp
- p
, n
))
1552 *to
++ = LEADING_CODE_8_BIT_CONTROL
;
1553 *to
++ = *p
++ + 0x20;
1562 /* Parse unibyte string at STR of LEN bytes, and return the number of
1563 bytes it may ocupy when converted to multibyte string by
1564 `str_to_multibyte'. */
1567 parse_str_to_multibyte (str
, len
)
1571 unsigned char *endp
= str
+ len
;
1574 for (bytes
= 0; str
< endp
; str
++)
1575 bytes
+= (*str
< 0x80 || *str
>= 0xA0) ? 1 : 2;
1579 /* Convert unibyte text at STR of NBYTES bytes to multibyte text
1580 that contains the same single-byte characters. It actually
1581 converts all 8-bit characters to multibyte forms. It is assured
1582 that we can use LEN bytes at STR as a work area and that is
1586 str_to_multibyte (str
, len
, bytes
)
1590 unsigned char *p
= str
, *endp
= str
+ bytes
;
1593 while (p
< endp
&& (*p
< 0x80 || *p
>= 0xA0)) p
++;
1599 safe_bcopy (p
, endp
- bytes
, bytes
);
1603 if (*p
< 0x80 || *p
>= 0xA0)
1606 *to
++ = LEADING_CODE_8_BIT_CONTROL
, *to
++ = *p
++ + 0x20;
1611 /* Arrange multibyte text at STR of LEN bytes as a unibyte text. It
1612 actually converts only 8-bit characters in the range 0x80..0x9F to
1616 str_as_unibyte (str
, bytes
)
1620 unsigned char *p
= str
, *endp
= str
+ bytes
;
1621 unsigned char *to
= str
;
1623 while (p
< endp
&& *p
!= LEADING_CODE_8_BIT_CONTROL
) p
++;
1627 if (*p
== LEADING_CODE_8_BIT_CONTROL
)
1628 *to
++ = *(p
+ 1) - 0x20, p
+= 2;
1636 DEFUN ("string", Fstring
, Sstring
, 0, MANY
, 0,
1637 doc
: /* Concatenate all the argument characters and make the result a string.
1638 usage: (string &rest CHARACTERS) */)
1644 unsigned char *buf
= (unsigned char *) alloca (MAX_MULTIBYTE_LENGTH
* n
);
1645 unsigned char *p
= buf
;
1649 for (i
= 0; i
< n
; i
++)
1651 CHECK_NUMBER (args
[i
]);
1652 if (!multibyte
&& !SINGLE_BYTE_CHAR_P (XFASTINT (args
[i
])))
1656 for (i
= 0; i
< n
; i
++)
1660 p
+= CHAR_STRING (c
, p
);
1665 return make_string_from_bytes (buf
, n
, p
- buf
);
1671 charset_id_internal (charset_name
)
1676 val
= Fget (intern (charset_name
), Qcharset
);
1678 error ("Charset %s is not defined", charset_name
);
1680 return (XINT (XVECTOR (val
)->contents
[0]));
1683 DEFUN ("setup-special-charsets", Fsetup_special_charsets
,
1684 Ssetup_special_charsets
, 0, 0, 0, doc
: /* Internal use only. */)
1687 charset_latin_iso8859_1
= charset_id_internal ("latin-iso8859-1");
1688 charset_jisx0208_1978
= charset_id_internal ("japanese-jisx0208-1978");
1689 charset_jisx0208
= charset_id_internal ("japanese-jisx0208");
1690 charset_katakana_jisx0201
= charset_id_internal ("katakana-jisx0201");
1691 charset_latin_jisx0201
= charset_id_internal ("latin-jisx0201");
1692 charset_big5_1
= charset_id_internal ("chinese-big5-1");
1693 charset_big5_2
= charset_id_internal ("chinese-big5-2");
1698 init_charset_once ()
1702 staticpro (&Vcharset_table
);
1703 staticpro (&Vcharset_symbol_table
);
1704 staticpro (&Vgeneric_character_list
);
1706 /* This has to be done here, before we call Fmake_char_table. */
1707 Qcharset_table
= intern ("charset-table");
1708 staticpro (&Qcharset_table
);
1710 /* Intern this now in case it isn't already done.
1711 Setting this variable twice is harmless.
1712 But don't staticpro it here--that is done in alloc.c. */
1713 Qchar_table_extra_slots
= intern ("char-table-extra-slots");
1715 /* Now we are ready to set up this property, so we can
1716 create the charset table. */
1717 Fput (Qcharset_table
, Qchar_table_extra_slots
, make_number (0));
1718 Vcharset_table
= Fmake_char_table (Qcharset_table
, Qnil
);
1720 Qunknown
= intern ("unknown");
1721 staticpro (&Qunknown
);
1722 Vcharset_symbol_table
= Fmake_vector (make_number (MAX_CHARSET
+ 1),
1726 for (i
= 0; i
< 2; i
++)
1727 for (j
= 0; j
< 2; j
++)
1728 for (k
= 0; k
< 128; k
++)
1729 iso_charset_table
[i
][j
][k
] = -1;
1731 for (i
= 0; i
< 256; i
++)
1732 bytes_by_char_head
[i
] = 1;
1733 bytes_by_char_head
[LEADING_CODE_PRIVATE_11
] = 3;
1734 bytes_by_char_head
[LEADING_CODE_PRIVATE_12
] = 3;
1735 bytes_by_char_head
[LEADING_CODE_PRIVATE_21
] = 4;
1736 bytes_by_char_head
[LEADING_CODE_PRIVATE_22
] = 4;
1738 for (i
= 0; i
< 128; i
++)
1739 width_by_char_head
[i
] = 1;
1740 for (; i
< 256; i
++)
1741 width_by_char_head
[i
] = 4;
1742 width_by_char_head
[LEADING_CODE_PRIVATE_11
] = 1;
1743 width_by_char_head
[LEADING_CODE_PRIVATE_12
] = 2;
1744 width_by_char_head
[LEADING_CODE_PRIVATE_21
] = 1;
1745 width_by_char_head
[LEADING_CODE_PRIVATE_22
] = 2;
1751 for (i
= 0x81; i
< 0x90; i
++)
1752 val
= Fcons (make_number ((i
- 0x70) << 7), val
);
1753 for (; i
< 0x9A; i
++)
1754 val
= Fcons (make_number ((i
- 0x8F) << 14), val
);
1755 for (i
= 0xA0; i
< 0xF0; i
++)
1756 val
= Fcons (make_number ((i
- 0x70) << 7), val
);
1757 for (; i
< 0xFF; i
++)
1758 val
= Fcons (make_number ((i
- 0xE0) << 14), val
);
1759 Vgeneric_character_list
= Fnreverse (val
);
1762 nonascii_insert_offset
= 0;
1763 Vnonascii_translation_table
= Qnil
;
1771 Qcharset
= intern ("charset");
1772 staticpro (&Qcharset
);
1774 Qascii
= intern ("ascii");
1775 staticpro (&Qascii
);
1777 Qeight_bit_control
= intern ("eight-bit-control");
1778 staticpro (&Qeight_bit_control
);
1780 Qeight_bit_graphic
= intern ("eight-bit-graphic");
1781 staticpro (&Qeight_bit_graphic
);
1783 /* Define special charsets ascii, eight-bit-control, and
1784 eight-bit-graphic. */
1785 update_charset_table (make_number (CHARSET_ASCII
),
1786 make_number (1), make_number (94),
1791 build_string ("ASCII"),
1792 Qnil
, /* same as above */
1793 build_string ("ASCII (ISO646 IRV)"));
1794 CHARSET_SYMBOL (CHARSET_ASCII
) = Qascii
;
1795 Fput (Qascii
, Qcharset
, CHARSET_TABLE_ENTRY (CHARSET_ASCII
));
1797 update_charset_table (make_number (CHARSET_8_BIT_CONTROL
),
1798 make_number (1), make_number (96),
1803 build_string ("8-bit control code (0x80..0x9F)"),
1804 Qnil
, /* same as above */
1805 Qnil
); /* same as above */
1806 CHARSET_SYMBOL (CHARSET_8_BIT_CONTROL
) = Qeight_bit_control
;
1807 Fput (Qeight_bit_control
, Qcharset
,
1808 CHARSET_TABLE_ENTRY (CHARSET_8_BIT_CONTROL
));
1810 update_charset_table (make_number (CHARSET_8_BIT_GRAPHIC
),
1811 make_number (1), make_number (96),
1816 build_string ("8-bit graphic char (0xA0..0xFF)"),
1817 Qnil
, /* same as above */
1818 Qnil
); /* same as above */
1819 CHARSET_SYMBOL (CHARSET_8_BIT_GRAPHIC
) = Qeight_bit_graphic
;
1820 Fput (Qeight_bit_graphic
, Qcharset
,
1821 CHARSET_TABLE_ENTRY (CHARSET_8_BIT_GRAPHIC
));
1823 Qauto_fill_chars
= intern ("auto-fill-chars");
1824 staticpro (&Qauto_fill_chars
);
1825 Fput (Qauto_fill_chars
, Qchar_table_extra_slots
, make_number (0));
1827 defsubr (&Sdefine_charset
);
1828 defsubr (&Sgeneric_character_list
);
1829 defsubr (&Sget_unused_iso_final_char
);
1830 defsubr (&Sdeclare_equiv_charset
);
1831 defsubr (&Sfind_charset_region
);
1832 defsubr (&Sfind_charset_string
);
1833 defsubr (&Smake_char_internal
);
1834 defsubr (&Ssplit_char
);
1835 defsubr (&Schar_charset
);
1836 defsubr (&Scharset_after
);
1837 defsubr (&Siso_charset
);
1838 defsubr (&Schar_valid_p
);
1839 defsubr (&Sunibyte_char_to_multibyte
);
1840 defsubr (&Smultibyte_char_to_unibyte
);
1841 defsubr (&Schar_bytes
);
1842 defsubr (&Schar_width
);
1843 defsubr (&Sstring_width
);
1844 defsubr (&Schar_direction
);
1845 defsubr (&Schars_in_region
);
1847 defsubr (&Ssetup_special_charsets
);
1849 DEFVAR_LISP ("charset-list", &Vcharset_list
,
1850 doc
: /* List of charsets ever defined. */);
1851 Vcharset_list
= Fcons (Qascii
, Fcons (Qeight_bit_control
,
1852 Fcons (Qeight_bit_graphic
, Qnil
)));
1854 DEFVAR_LISP ("translation-table-vector", &Vtranslation_table_vector
,
1855 doc
: /* Vector of cons cell of a symbol and translation table ever defined.
1856 An ID of a translation table is an index of this vector. */);
1857 Vtranslation_table_vector
= Fmake_vector (make_number (16), Qnil
);
1859 DEFVAR_INT ("leading-code-private-11", &leading_code_private_11
,
1860 doc
: /* Leading-code of private TYPE9N charset of column-width 1. */);
1861 leading_code_private_11
= LEADING_CODE_PRIVATE_11
;
1863 DEFVAR_INT ("leading-code-private-12", &leading_code_private_12
,
1864 doc
: /* Leading-code of private TYPE9N charset of column-width 2. */);
1865 leading_code_private_12
= LEADING_CODE_PRIVATE_12
;
1867 DEFVAR_INT ("leading-code-private-21", &leading_code_private_21
,
1868 doc
: /* Leading-code of private TYPE9Nx9N charset of column-width 1. */);
1869 leading_code_private_21
= LEADING_CODE_PRIVATE_21
;
1871 DEFVAR_INT ("leading-code-private-22", &leading_code_private_22
,
1872 doc
: /* Leading-code of private TYPE9Nx9N charset of column-width 2. */);
1873 leading_code_private_22
= LEADING_CODE_PRIVATE_22
;
1875 DEFVAR_INT ("nonascii-insert-offset", &nonascii_insert_offset
,
1876 doc
: /* Offset for converting non-ASCII unibyte codes 0240...0377 to multibyte.
1877 This is used for converting unibyte text to multibyte,
1878 and for inserting character codes specified by number.
1880 This serves to convert a Latin-1 or similar 8-bit character code
1881 to the corresponding Emacs multibyte character code.
1882 Typically the value should be (- (make-char CHARSET 0) 128),
1883 for your choice of character set.
1884 If `nonascii-translation-table' is non-nil, it overrides this variable. */);
1885 nonascii_insert_offset
= 0;
1887 DEFVAR_LISP ("nonascii-translation-table", &Vnonascii_translation_table
,
1888 doc
: /* Translation table to convert non-ASCII unibyte codes to multibyte.
1889 This is used for converting unibyte text to multibyte,
1890 and for inserting character codes specified by number.
1892 Conversion is performed only when multibyte characters are enabled,
1893 and it serves to convert a Latin-1 or similar 8-bit character code
1894 to the corresponding Emacs character code.
1896 If this is nil, `nonascii-insert-offset' is used instead.
1897 See also the docstring of `make-translation-table'. */);
1898 Vnonascii_translation_table
= Qnil
;
1900 DEFVAR_LISP ("auto-fill-chars", &Vauto_fill_chars
,
1901 doc
: /* A char-table for characters which invoke auto-filling.
1902 Such characters have value t in this table. */);
1903 Vauto_fill_chars
= Fmake_char_table (Qauto_fill_chars
, Qnil
);
1904 CHAR_TABLE_SET (Vauto_fill_chars
, make_number (' '), Qt
);
1905 CHAR_TABLE_SET (Vauto_fill_chars
, make_number ('\n'), Qt
);