1 /* Basic character support.
3 Copyright (C) 2001-2012 Free Software Foundation, Inc.
4 Copyright (C) 1995, 1997, 1998, 2001 Electrotechnical Laboratory, JAPAN.
5 Licensed to the Free Software Foundation.
6 Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
7 National Institute of Advanced Industrial Science and Technology (AIST)
8 Registration Number H13PRO009
10 This file is part of GNU Emacs.
12 GNU Emacs is free software: you can redistribute it and/or modify
13 it under the terms of the GNU General Public License as published by
14 the Free Software Foundation, either version 3 of the License, or
15 (at your option) any later version.
17 GNU Emacs is distributed in the hope that it will be useful,
18 but WITHOUT ANY WARRANTY; without even the implied warranty of
19 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 GNU General Public License for more details.
22 You should have received a copy of the GNU General Public License
23 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
25 /* At first, see the document in `character.h' to understand the code
36 #include <sys/types.h>
40 #include "character.h"
43 #include "composite.h"
52 Lisp_Object Qcharacterp
;
54 static Lisp_Object Qauto_fill_chars
;
56 /* Char-table of information about which character to unify to which
57 Unicode character. Mainly used by the macro MAYBE_UNIFY_CHAR. */
58 Lisp_Object Vchar_unify_table
;
60 /* Variable used locally in the macro FETCH_MULTIBYTE_CHAR. */
61 unsigned char *_fetch_multibyte_char_p
;
63 static Lisp_Object Qchar_script_table
;
67 /* If character code C has modifier masks, reflect them to the
68 character code if possible. Return the resulting code. */
71 char_resolve_modifier_mask (EMACS_INT c
)
73 /* A non-ASCII character can't reflect modifier bits to the code. */
74 if (! ASCII_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
77 /* For Meta, Shift, and Control modifiers, we need special care. */
80 /* Shift modifier is valid only with [A-Za-z]. */
81 if ((c
& 0377) >= 'A' && (c
& 0377) <= 'Z')
83 else if ((c
& 0377) >= 'a' && (c
& 0377) <= 'z')
84 c
= (c
& ~CHAR_SHIFT
) - ('a' - 'A');
85 /* Shift modifier for control characters and SPC is ignored. */
86 else if ((c
& ~CHAR_MODIFIER_MASK
) <= 0x20)
91 /* Simulate the code in lread.c. */
92 /* Allow `\C- ' and `\C-?'. */
93 if ((c
& 0377) == ' ')
94 c
&= ~0177 & ~ CHAR_CTL
;
95 else if ((c
& 0377) == '?')
96 c
= 0177 | (c
& ~0177 & ~CHAR_CTL
);
97 /* ASCII control chars are made from letters (both cases),
98 as well as the non-letters within 0100...0137. */
99 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
100 c
&= (037 | (~0177 & ~CHAR_CTL
));
101 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
102 c
&= (037 | (~0177 & ~CHAR_CTL
));
104 #if 0 /* This is outside the scope of this function. (bug#4751) */
107 /* Move the meta bit to the right place for a string. */
108 c
= (c
& ~CHAR_META
) | 0x80;
116 /* Store multibyte form of character C at P. If C has modifier bits,
117 handle them appropriately. */
120 char_string (unsigned int c
, unsigned char *p
)
124 if (c
& CHAR_MODIFIER_MASK
)
126 c
= char_resolve_modifier_mask (c
);
127 /* If C still has any modifier bits, just ignore it. */
128 c
&= ~CHAR_MODIFIER_MASK
;
131 MAYBE_UNIFY_CHAR (c
);
133 if (c
<= MAX_3_BYTE_CHAR
)
135 bytes
= CHAR_STRING (c
, p
);
137 else if (c
<= MAX_4_BYTE_CHAR
)
139 p
[0] = (0xF0 | (c
>> 18));
140 p
[1] = (0x80 | ((c
>> 12) & 0x3F));
141 p
[2] = (0x80 | ((c
>> 6) & 0x3F));
142 p
[3] = (0x80 | (c
& 0x3F));
145 else if (c
<= MAX_5_BYTE_CHAR
)
148 p
[1] = (0x80 | ((c
>> 18) & 0x0F));
149 p
[2] = (0x80 | ((c
>> 12) & 0x3F));
150 p
[3] = (0x80 | ((c
>> 6) & 0x3F));
151 p
[4] = (0x80 | (c
& 0x3F));
154 else if (c
<= MAX_CHAR
)
156 c
= CHAR_TO_BYTE8 (c
);
157 bytes
= BYTE8_STRING (c
, p
);
160 error ("Invalid character: %x", c
);
166 /* Return a character whose multibyte form is at P. If LEN is not
167 NULL, it must be a pointer to integer. In that case, set *LEN to
168 the byte length of the multibyte form. If ADVANCED is not NULL, it
169 must be a pointer to unsigned char. In that case, set *ADVANCED to
170 the ending address (i.e., the starting address of the next
171 character) of the multibyte form. */
174 string_char (const unsigned char *p
, const unsigned char **advanced
, int *len
)
177 const unsigned char *saved_p
= p
;
179 if (*p
< 0x80 || ! (*p
& 0x20) || ! (*p
& 0x10))
181 c
= STRING_CHAR_ADVANCE (p
);
183 else if (! (*p
& 0x08))
185 c
= ((((p
)[0] & 0xF) << 18)
186 | (((p
)[1] & 0x3F) << 12)
187 | (((p
)[2] & 0x3F) << 6)
193 c
= ((((p
)[1] & 0x3F) << 18)
194 | (((p
)[2] & 0x3F) << 12)
195 | (((p
)[3] & 0x3F) << 6)
200 MAYBE_UNIFY_CHAR (c
);
210 /* Translate character C by translation table TABLE. If no translation is
211 found in TABLE, return the untranslated character. If TABLE is a list,
212 elements are char tables. In that case, recursively translate C by all the
213 tables in the list. */
216 translate_char (Lisp_Object table
, int c
)
218 if (CHAR_TABLE_P (table
))
222 ch
= CHAR_TABLE_REF (table
, c
);
228 for (; CONSP (table
); table
= XCDR (table
))
229 c
= translate_char (XCAR (table
), c
);
234 /* Convert ASCII or 8-bit character C to unibyte. If C is none of
235 them, return (C & 0xFF). */
238 multibyte_char_to_unibyte (int c
)
242 if (CHAR_BYTE8_P (c
))
243 return CHAR_TO_BYTE8 (c
);
247 /* Like multibyte_char_to_unibyte, but return -1 if C is not supported
248 by charset_unibyte. */
251 multibyte_char_to_unibyte_safe (int c
)
255 if (CHAR_BYTE8_P (c
))
256 return CHAR_TO_BYTE8 (c
);
260 DEFUN ("characterp", Fcharacterp
, Scharacterp
, 1, 2, 0,
261 doc
: /* Return non-nil if OBJECT is a character.
262 usage: (characterp OBJECT) */)
263 (Lisp_Object object
, Lisp_Object ignore
)
265 return (CHARACTERP (object
) ? Qt
: Qnil
);
268 DEFUN ("max-char", Fmax_char
, Smax_char
, 0, 0, 0,
269 doc
: /* Return the character of the maximum code. */)
272 return make_number (MAX_CHAR
);
275 DEFUN ("unibyte-char-to-multibyte", Funibyte_char_to_multibyte
,
276 Sunibyte_char_to_multibyte
, 1, 1, 0,
277 doc
: /* Convert the byte CH to multibyte character. */)
282 CHECK_CHARACTER (ch
);
285 error ("Not a unibyte character: %d", c
);
286 MAKE_CHAR_MULTIBYTE (c
);
287 return make_number (c
);
290 DEFUN ("multibyte-char-to-unibyte", Fmultibyte_char_to_unibyte
,
291 Smultibyte_char_to_unibyte
, 1, 1, 0,
292 doc
: /* Convert the multibyte character CH to a byte.
293 If the multibyte character does not represent a byte, return -1. */)
298 CHECK_CHARACTER (ch
);
301 /* Can't distinguish a byte read from a unibyte buffer from
302 a latin1 char, so let's let it slide. */
306 int cu
= CHAR_TO_BYTE_SAFE (cm
);
307 return make_number (cu
);
312 /* Return width (columns) of C considering the buffer display table DP. */
315 char_width (int c
, struct Lisp_Char_Table
*dp
)
317 ptrdiff_t width
= CHAR_WIDTH (c
);
321 Lisp_Object disp
= DISP_CHAR_VECTOR (dp
, c
), ch
;
325 for (i
= 0, width
= 0; i
< ASIZE (disp
); i
++)
330 int w
= CHAR_WIDTH (XFASTINT (ch
));
331 if (INT_ADD_OVERFLOW (width
, w
))
341 DEFUN ("char-width", Fchar_width
, Schar_width
, 1, 1, 0,
342 doc
: /* Return width of CHAR when displayed in the current buffer.
343 The width is measured by how many columns it occupies on the screen.
344 Tab is taken to occupy `tab-width' columns.
345 usage: (char-width CHAR) */)
351 CHECK_CHARACTER (ch
);
353 width
= char_width (c
, buffer_display_table ());
354 return make_number (width
);
357 /* Return width of string STR of length LEN when displayed in the
358 current buffer. The width is measured by how many columns it
359 occupies on the screen. If PRECISION > 0, return the width of
360 longest substring that doesn't exceed PRECISION, and set number of
361 characters and bytes of the substring in *NCHARS and *NBYTES
365 c_string_width (const unsigned char *str
, ptrdiff_t len
, int precision
,
366 ptrdiff_t *nchars
, ptrdiff_t *nbytes
)
368 ptrdiff_t i
= 0, i_byte
= 0;
370 struct Lisp_Char_Table
*dp
= buffer_display_table ();
375 int c
= STRING_CHAR_AND_LENGTH (str
+ i_byte
, bytes
);
376 ptrdiff_t thiswidth
= char_width (c
, dp
);
380 if (INT_ADD_OVERFLOW (width
, thiswidth
))
383 else if (precision
- width
< thiswidth
)
403 /* Return width of string STR of length LEN when displayed in the
404 current buffer. The width is measured by how many columns it
405 occupies on the screen. */
408 strwidth (const char *str
, ptrdiff_t len
)
410 return c_string_width ((const unsigned char *) str
, len
, -1, NULL
, NULL
);
413 /* Return width of Lisp string STRING when displayed in the current
414 buffer. The width is measured by how many columns it occupies on
415 the screen while paying attention to compositions. If PRECISION >
416 0, return the width of longest substring that doesn't exceed
417 PRECISION, and set number of characters and bytes of the substring
418 in *NCHARS and *NBYTES respectively. */
421 lisp_string_width (Lisp_Object string
, ptrdiff_t precision
,
422 ptrdiff_t *nchars
, ptrdiff_t *nbytes
)
424 ptrdiff_t len
= SCHARS (string
);
425 /* This set multibyte to 0 even if STRING is multibyte when it
426 contains only ascii and eight-bit-graphic, but that's
428 int multibyte
= len
< SBYTES (string
);
429 unsigned char *str
= SDATA (string
);
430 ptrdiff_t i
= 0, i_byte
= 0;
432 struct Lisp_Char_Table
*dp
= buffer_display_table ();
436 ptrdiff_t chars
, bytes
, thiswidth
;
439 ptrdiff_t ignore
, end
;
441 if (find_composition (i
, -1, &ignore
, &end
, &val
, string
)
442 && ((cmp_id
= get_composition_id (i
, i_byte
, end
- i
, val
, string
))
445 thiswidth
= composition_table
[cmp_id
]->width
;
447 bytes
= string_char_to_byte (string
, end
) - i_byte
;
456 c
= STRING_CHAR_AND_LENGTH (str
+ i_byte
, cbytes
);
460 c
= str
[i_byte
], bytes
= 1;
462 thiswidth
= char_width (c
, dp
);
468 if (INT_ADD_OVERFLOW (width
, thiswidth
))
472 else if (precision
- width
< thiswidth
)
492 DEFUN ("string-width", Fstring_width
, Sstring_width
, 1, 1, 0,
493 doc
: /* Return width of STRING when displayed in the current buffer.
494 Width is measured by how many columns it occupies on the screen.
495 When calculating width of a multibyte character in STRING,
496 only the base leading-code is considered; the validity of
497 the following bytes is not checked. Tabs in STRING are always
498 taken to occupy `tab-width' columns.
499 usage: (string-width STRING) */)
505 XSETFASTINT (val
, lisp_string_width (str
, -1, NULL
, NULL
));
509 /* Return the number of characters in the NBYTES bytes at PTR.
510 This works by looking at the contents and checking for multibyte
511 sequences while assuming that there's no invalid sequence.
512 However, if the current buffer has enable-multibyte-characters =
513 nil, we treat each byte as a character. */
516 chars_in_text (const unsigned char *ptr
, ptrdiff_t nbytes
)
518 /* current_buffer is null at early stages of Emacs initialization. */
519 if (current_buffer
== 0
520 || NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
523 return multibyte_chars_in_text (ptr
, nbytes
);
526 /* Return the number of characters in the NBYTES bytes at PTR.
527 This works by looking at the contents and checking for multibyte
528 sequences while assuming that there's no invalid sequence. It
529 ignores enable-multibyte-characters. */
532 multibyte_chars_in_text (const unsigned char *ptr
, ptrdiff_t nbytes
)
534 const unsigned char *endp
= ptr
+ nbytes
;
539 int len
= MULTIBYTE_LENGTH (ptr
, endp
);
550 /* Parse unibyte text at STR of LEN bytes as a multibyte text, count
551 characters and bytes in it, and store them in *NCHARS and *NBYTES
552 respectively. On counting bytes, pay attention to that 8-bit
553 characters not constructing a valid multibyte sequence are
554 represented by 2-byte in a multibyte text. */
557 parse_str_as_multibyte (const unsigned char *str
, ptrdiff_t len
,
558 ptrdiff_t *nchars
, ptrdiff_t *nbytes
)
560 const unsigned char *endp
= str
+ len
;
562 ptrdiff_t chars
= 0, bytes
= 0;
564 if (len
>= MAX_MULTIBYTE_LENGTH
)
566 const unsigned char *adjusted_endp
= endp
- MAX_MULTIBYTE_LENGTH
;
567 while (str
< adjusted_endp
)
569 if (! CHAR_BYTE8_HEAD_P (*str
)
570 && (n
= MULTIBYTE_LENGTH_NO_CHECK (str
)) > 0)
571 str
+= n
, bytes
+= n
;
579 if (! CHAR_BYTE8_HEAD_P (*str
)
580 && (n
= MULTIBYTE_LENGTH (str
, endp
)) > 0)
581 str
+= n
, bytes
+= n
;
592 /* Arrange unibyte text at STR of NBYTES bytes as a multibyte text.
593 It actually converts only such 8-bit characters that don't construct
594 a multibyte sequence to multibyte forms of Latin-1 characters. If
595 NCHARS is nonzero, set *NCHARS to the number of characters in the
596 text. It is assured that we can use LEN bytes at STR as a work
597 area and that is enough. Return the number of bytes of the
601 str_as_multibyte (unsigned char *str
, ptrdiff_t len
, ptrdiff_t nbytes
,
604 unsigned char *p
= str
, *endp
= str
+ nbytes
;
609 if (nbytes
>= MAX_MULTIBYTE_LENGTH
)
611 unsigned char *adjusted_endp
= endp
- MAX_MULTIBYTE_LENGTH
;
612 while (p
< adjusted_endp
613 && ! CHAR_BYTE8_HEAD_P (*p
)
614 && (n
= MULTIBYTE_LENGTH_NO_CHECK (p
)) > 0)
618 && ! CHAR_BYTE8_HEAD_P (*p
)
619 && (n
= MULTIBYTE_LENGTH (p
, endp
)) > 0)
629 memmove (endp
- nbytes
, p
, nbytes
);
632 if (nbytes
>= MAX_MULTIBYTE_LENGTH
)
634 unsigned char *adjusted_endp
= endp
- MAX_MULTIBYTE_LENGTH
;
635 while (p
< adjusted_endp
)
637 if (! CHAR_BYTE8_HEAD_P (*p
)
638 && (n
= MULTIBYTE_LENGTH_NO_CHECK (p
)) > 0)
646 c
= BYTE8_TO_CHAR (c
);
647 to
+= CHAR_STRING (c
, to
);
654 if (! CHAR_BYTE8_HEAD_P (*p
)
655 && (n
= MULTIBYTE_LENGTH (p
, endp
)) > 0)
663 c
= BYTE8_TO_CHAR (c
);
664 to
+= CHAR_STRING (c
, to
);
673 /* Parse unibyte string at STR of LEN bytes, and return the number of
674 bytes it may occupy when converted to multibyte string by
675 `str_to_multibyte'. */
678 count_size_as_multibyte (const unsigned char *str
, ptrdiff_t len
)
680 const unsigned char *endp
= str
+ len
;
683 for (bytes
= 0; str
< endp
; str
++)
685 int n
= *str
< 0x80 ? 1 : 2;
686 if (INT_ADD_OVERFLOW (bytes
, n
))
694 /* Convert unibyte text at STR of BYTES bytes to a multibyte text
695 that contains the same single-byte characters. It actually
696 converts all 8-bit characters to multibyte forms. It is assured
697 that we can use LEN bytes at STR as a work area and that is
701 str_to_multibyte (unsigned char *str
, ptrdiff_t len
, ptrdiff_t bytes
)
703 unsigned char *p
= str
, *endp
= str
+ bytes
;
706 while (p
< endp
&& *p
< 0x80) p
++;
712 memmove (endp
- bytes
, p
, bytes
);
719 c
= BYTE8_TO_CHAR (c
);
720 to
+= CHAR_STRING (c
, to
);
725 /* Arrange multibyte text at STR of LEN bytes as a unibyte text. It
726 actually converts characters in the range 0x80..0xFF to
730 str_as_unibyte (unsigned char *str
, ptrdiff_t bytes
)
732 const unsigned char *p
= str
, *endp
= str
+ bytes
;
739 len
= BYTES_BY_CHAR_HEAD (c
);
740 if (CHAR_BYTE8_HEAD_P (c
))
744 to
= str
+ (p
- str
);
748 len
= BYTES_BY_CHAR_HEAD (c
);
749 if (CHAR_BYTE8_HEAD_P (c
))
751 c
= STRING_CHAR_ADVANCE (p
);
752 *to
++ = CHAR_TO_BYTE8 (c
);
756 while (len
--) *to
++ = *p
++;
762 /* Convert eight-bit chars in SRC (in multibyte form) to the
763 corresponding byte and store in DST. CHARS is the number of
764 characters in SRC. The value is the number of bytes stored in DST.
765 Usually, the value is the same as CHARS, but is less than it if SRC
766 contains a non-ASCII, non-eight-bit character. If ACCEPT_LATIN_1
767 is nonzero, a Latin-1 character is accepted and converted to a byte
768 of that character code.
769 Note: Currently the arg ACCEPT_LATIN_1 is not used. */
772 str_to_unibyte (const unsigned char *src
, unsigned char *dst
, ptrdiff_t chars
, int accept_latin_1
)
776 for (i
= 0; i
< chars
; i
++)
778 int c
= STRING_CHAR_ADVANCE (src
);
780 if (CHAR_BYTE8_P (c
))
781 c
= CHAR_TO_BYTE8 (c
);
782 else if (! ASCII_CHAR_P (c
)
783 && (! accept_latin_1
|| c
>= 0x100))
792 string_count_byte8 (Lisp_Object string
)
794 int multibyte
= STRING_MULTIBYTE (string
);
795 ptrdiff_t nbytes
= SBYTES (string
);
796 unsigned char *p
= SDATA (string
);
797 unsigned char *pend
= p
+ nbytes
;
805 len
= BYTES_BY_CHAR_HEAD (c
);
807 if (CHAR_BYTE8_HEAD_P (c
))
822 string_escape_byte8 (Lisp_Object string
)
824 ptrdiff_t nchars
= SCHARS (string
);
825 ptrdiff_t nbytes
= SBYTES (string
);
826 int multibyte
= STRING_MULTIBYTE (string
);
827 ptrdiff_t byte8_count
;
828 const unsigned char *src
, *src_end
;
833 if (multibyte
&& nchars
== nbytes
)
836 byte8_count
= string_count_byte8 (string
);
838 if (byte8_count
== 0)
843 if ((MOST_POSITIVE_FIXNUM
- nchars
) / 3 < byte8_count
844 || (STRING_BYTES_BOUND
- nbytes
) / 2 < byte8_count
)
847 /* Convert 2-byte sequence of byte8 chars to 4-byte octal. */
848 val
= make_uninit_multibyte_string (nchars
+ byte8_count
* 3,
849 nbytes
+ byte8_count
* 2);
853 if ((STRING_BYTES_BOUND
- nbytes
) / 3 < byte8_count
)
856 /* Convert 1-byte sequence of byte8 chars to 4-byte octal. */
857 val
= make_uninit_string (nbytes
+ byte8_count
* 3);
860 src
= SDATA (string
);
861 src_end
= src
+ nbytes
;
864 while (src
< src_end
)
867 len
= BYTES_BY_CHAR_HEAD (c
);
869 if (CHAR_BYTE8_HEAD_P (c
))
871 c
= STRING_CHAR_ADVANCE (src
);
872 c
= CHAR_TO_BYTE8 (c
);
873 sprintf ((char *) dst
, "\\%03o", c
);
877 while (len
--) *dst
++ = *src
++;
880 while (src
< src_end
)
885 sprintf ((char *) dst
, "\\%03o", c
);
895 DEFUN ("string", Fstring
, Sstring
, 0, MANY
, 0,
897 Concatenate all the argument characters and make the result a string.
898 usage: (string &rest CHARACTERS) */)
899 (ptrdiff_t n
, Lisp_Object
*args
)
903 unsigned char *buf
, *p
;
907 SAFE_NALLOCA (buf
, MAX_MULTIBYTE_LENGTH
, n
);
910 for (i
= 0; i
< n
; i
++)
912 CHECK_CHARACTER (args
[i
]);
914 p
+= CHAR_STRING (c
, p
);
917 str
= make_string_from_bytes ((char *) buf
, n
, p
- buf
);
922 DEFUN ("unibyte-string", Funibyte_string
, Sunibyte_string
, 0, MANY
, 0,
923 doc
: /* Concatenate all the argument bytes and make the result a unibyte string.
924 usage: (unibyte-string &rest BYTES) */)
925 (ptrdiff_t n
, Lisp_Object
*args
)
928 unsigned char *buf
, *p
;
932 SAFE_ALLOCA (buf
, unsigned char *, n
);
935 for (i
= 0; i
< n
; i
++)
937 CHECK_RANGED_INTEGER (0, args
[i
], 255);
938 *p
++ = XINT (args
[i
]);
941 str
= make_string_from_bytes ((char *) buf
, n
, p
- buf
);
946 DEFUN ("char-resolve-modifiers", Fchar_resolve_modifiers
,
947 Schar_resolve_modifiers
, 1, 1, 0,
948 doc
: /* Resolve modifiers in the character CHAR.
949 The value is a character with modifiers resolved into the character
950 code. Unresolved modifiers are kept in the value.
951 usage: (char-resolve-modifiers CHAR) */)
952 (Lisp_Object character
)
956 CHECK_NUMBER (character
);
957 c
= XINT (character
);
958 return make_number (char_resolve_modifier_mask (c
));
961 DEFUN ("get-byte", Fget_byte
, Sget_byte
, 0, 2, 0,
962 doc
: /* Return a byte value of a character at point.
963 Optional 1st arg POSITION, if non-nil, is a position of a character to get
965 Optional 2nd arg STRING, if non-nil, is a string of which first
966 character is a target to get a byte value. In this case, POSITION, if
967 non-nil, is an index of a target character in the string.
969 If the current buffer (or STRING) is multibyte, and the target
970 character is not ASCII nor 8-bit character, an error is signaled. */)
971 (Lisp_Object position
, Lisp_Object string
)
985 CHECK_NUMBER_COERCE_MARKER (position
);
986 if (XINT (position
) < BEGV
|| XINT (position
) >= ZV
)
987 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
988 pos
= XFASTINT (position
);
989 p
= CHAR_POS_ADDR (pos
);
991 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
992 return make_number (*p
);
996 CHECK_STRING (string
);
1003 CHECK_NATNUM (position
);
1004 if (XINT (position
) >= SCHARS (string
))
1005 args_out_of_range (string
, position
);
1006 pos
= XFASTINT (position
);
1007 p
= SDATA (string
) + string_char_to_byte (string
, pos
);
1009 if (! STRING_MULTIBYTE (string
))
1010 return make_number (*p
);
1012 c
= STRING_CHAR (p
);
1013 if (CHAR_BYTE8_P (c
))
1014 c
= CHAR_TO_BYTE8 (c
);
1015 else if (! ASCII_CHAR_P (c
))
1016 error ("Not an ASCII nor an 8-bit character: %d", c
);
1017 return make_number (c
);
1022 init_character_once (void)
1029 syms_of_character (void)
1031 DEFSYM (Qcharacterp
, "characterp");
1032 DEFSYM (Qauto_fill_chars
, "auto-fill-chars");
1034 staticpro (&Vchar_unify_table
);
1035 Vchar_unify_table
= Qnil
;
1037 defsubr (&Smax_char
);
1038 defsubr (&Scharacterp
);
1039 defsubr (&Sunibyte_char_to_multibyte
);
1040 defsubr (&Smultibyte_char_to_unibyte
);
1041 defsubr (&Schar_width
);
1042 defsubr (&Sstring_width
);
1044 defsubr (&Sunibyte_string
);
1045 defsubr (&Schar_resolve_modifiers
);
1046 defsubr (&Sget_byte
);
1048 DEFVAR_LISP ("translation-table-vector", Vtranslation_table_vector
,
1050 Vector recording all translation tables ever defined.
1051 Each element is a pair (SYMBOL . TABLE) relating the table to the
1052 symbol naming it. The ID of a translation table is an index into this vector. */);
1053 Vtranslation_table_vector
= Fmake_vector (make_number (16), Qnil
);
1055 DEFVAR_LISP ("auto-fill-chars", Vauto_fill_chars
,
1057 A char-table for characters which invoke auto-filling.
1058 Such characters have value t in this table. */);
1059 Vauto_fill_chars
= Fmake_char_table (Qauto_fill_chars
, Qnil
);
1060 CHAR_TABLE_SET (Vauto_fill_chars
, ' ', Qt
);
1061 CHAR_TABLE_SET (Vauto_fill_chars
, '\n', Qt
);
1063 DEFVAR_LISP ("char-width-table", Vchar_width_table
,
1065 A char-table for width (columns) of each character. */);
1066 Vchar_width_table
= Fmake_char_table (Qnil
, make_number (1));
1067 char_table_set_range (Vchar_width_table
, 0x80, 0x9F, make_number (4));
1068 char_table_set_range (Vchar_width_table
, MAX_5_BYTE_CHAR
+ 1, MAX_CHAR
,
1071 DEFVAR_LISP ("printable-chars", Vprintable_chars
,
1072 doc
: /* A char-table for each printable character. */);
1073 Vprintable_chars
= Fmake_char_table (Qnil
, Qnil
);
1074 Fset_char_table_range (Vprintable_chars
,
1075 Fcons (make_number (32), make_number (126)), Qt
);
1076 Fset_char_table_range (Vprintable_chars
,
1077 Fcons (make_number (160),
1078 make_number (MAX_5_BYTE_CHAR
)), Qt
);
1080 DEFVAR_LISP ("char-script-table", Vchar_script_table
,
1081 doc
: /* Char table of script symbols.
1082 It has one extra slot whose value is a list of script symbols. */);
1084 /* Intern this now in case it isn't already done.
1085 Setting this variable twice is harmless.
1086 But don't staticpro it here--that is done in alloc.c. */
1087 Qchar_table_extra_slots
= intern_c_string ("char-table-extra-slots");
1088 DEFSYM (Qchar_script_table
, "char-script-table");
1089 Fput (Qchar_script_table
, Qchar_table_extra_slots
, make_number (1));
1090 Vchar_script_table
= Fmake_char_table (Qchar_script_table
, Qnil
);
1092 DEFVAR_LISP ("script-representative-chars", Vscript_representative_chars
,
1093 doc
: /* Alist of scripts vs the representative characters.
1094 Each element is a cons (SCRIPT . CHARS).
1095 SCRIPT is a symbol representing a script or a subgroup of a script.
1096 CHARS is a list or a vector of characters.
1097 If it is a list, all characters in the list are necessary for supporting SCRIPT.
1098 If it is a vector, one of the characters in the vector is necessary.
1099 This variable is used to find a font for a specific script. */);
1100 Vscript_representative_chars
= Qnil
;
1102 DEFVAR_LISP ("unicode-category-table", Vunicode_category_table
,
1103 doc
: /* Char table of Unicode's "General Category".
1104 All Unicode characters have one of the following values (symbol):
1105 Lu, Ll, Lt, Lm, Lo, Mn, Mc, Me, Nd, Nl, No, Pc, Pd, Ps, Pe, Pi, Pf, Po,
1106 Sm, Sc, Sk, So, Zs, Zl, Zp, Cc, Cf, Cs, Co, Cn
1107 See The Unicode Standard for the meaning of those values. */);
1108 /* The correct char-table is setup in characters.el. */
1109 Vunicode_category_table
= Qnil
;