1 /* Basic character support.
3 Copyright (C) 2001-2019 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 (at
15 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 <https://www.gnu.org/licenses/>. */
25 /* At first, see the document in `character.h' to understand the code
32 #include <sys/types.h>
35 #include "character.h"
37 #include "dispextern.h"
38 #include "composite.h"
41 /* Char-table of information about which character to unify to which
42 Unicode character. Mainly used by the macro MAYBE_UNIFY_CHAR. */
43 Lisp_Object Vchar_unify_table
;
47 /* If character code C has modifier masks, reflect them to the
48 character code if possible. Return the resulting code. */
51 char_resolve_modifier_mask (EMACS_INT c
)
53 /* A non-ASCII character can't reflect modifier bits to the code. */
54 if (! ASCII_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
57 /* For Meta, Shift, and Control modifiers, we need special care. */
60 /* Shift modifier is valid only with [A-Za-z]. */
61 if ((c
& 0377) >= 'A' && (c
& 0377) <= 'Z')
63 else if ((c
& 0377) >= 'a' && (c
& 0377) <= 'z')
64 c
= (c
& ~CHAR_SHIFT
) - ('a' - 'A');
65 /* Shift modifier for control characters and SPC is ignored. */
66 else if ((c
& ~CHAR_MODIFIER_MASK
) <= 0x20)
71 /* Simulate the code in lread.c. */
72 /* Allow `\C- ' and `\C-?'. */
73 if ((c
& 0377) == ' ')
74 c
&= ~0177 & ~ CHAR_CTL
;
75 else if ((c
& 0377) == '?')
76 c
= 0177 | (c
& ~0177 & ~CHAR_CTL
);
77 /* ASCII control chars are made from letters (both cases),
78 as well as the non-letters within 0100...0137. */
79 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
80 c
&= (037 | (~0177 & ~CHAR_CTL
));
81 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
82 c
&= (037 | (~0177 & ~CHAR_CTL
));
84 #if 0 /* This is outside the scope of this function. (bug#4751) */
87 /* Move the meta bit to the right place for a string. */
88 c
= (c
& ~CHAR_META
) | 0x80;
96 /* Store multibyte form of character C at P. If C has modifier bits,
97 handle them appropriately. */
100 char_string (unsigned int c
, unsigned char *p
)
104 if (c
& CHAR_MODIFIER_MASK
)
106 c
= char_resolve_modifier_mask (c
);
107 /* If C still has any modifier bits, just ignore it. */
108 c
&= ~CHAR_MODIFIER_MASK
;
111 if (c
<= MAX_3_BYTE_CHAR
)
113 bytes
= CHAR_STRING (c
, p
);
115 else if (c
<= MAX_4_BYTE_CHAR
)
117 p
[0] = (0xF0 | (c
>> 18));
118 p
[1] = (0x80 | ((c
>> 12) & 0x3F));
119 p
[2] = (0x80 | ((c
>> 6) & 0x3F));
120 p
[3] = (0x80 | (c
& 0x3F));
123 else if (c
<= MAX_5_BYTE_CHAR
)
126 p
[1] = (0x80 | ((c
>> 18) & 0x0F));
127 p
[2] = (0x80 | ((c
>> 12) & 0x3F));
128 p
[3] = (0x80 | ((c
>> 6) & 0x3F));
129 p
[4] = (0x80 | (c
& 0x3F));
132 else if (c
<= MAX_CHAR
)
134 c
= CHAR_TO_BYTE8 (c
);
135 bytes
= BYTE8_STRING (c
, p
);
138 error ("Invalid character: %x", c
);
144 /* Return a character whose multibyte form is at P. If LEN is not
145 NULL, it must be a pointer to integer. In that case, set *LEN to
146 the byte length of the multibyte form. If ADVANCED is not NULL, it
147 must be a pointer to unsigned char. In that case, set *ADVANCED to
148 the ending address (i.e., the starting address of the next
149 character) of the multibyte form. */
152 string_char (const unsigned char *p
, const unsigned char **advanced
, int *len
)
155 const unsigned char *saved_p
= p
;
157 if (*p
< 0x80 || ! (*p
& 0x20) || ! (*p
& 0x10))
159 /* 1-, 2-, and 3-byte sequences can be handled by the macro. */
160 c
= STRING_CHAR_ADVANCE (p
);
162 else if (! (*p
& 0x08))
164 /* A 4-byte sequence of this form:
165 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx */
166 c
= ((((p
)[0] & 0x7) << 18)
167 | (((p
)[1] & 0x3F) << 12)
168 | (((p
)[2] & 0x3F) << 6)
174 /* A 5-byte sequence of this form:
176 111110xx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx
178 Note that the top 4 `x's are always 0, so shifting p[1] can
179 never exceed the maximum valid character codepoint. */
180 c
= (/* (((p)[0] & 0x3) << 24) ... always 0, so no need to shift. */
181 (((p
)[1] & 0x3F) << 18)
182 | (((p
)[2] & 0x3F) << 12)
183 | (((p
)[3] & 0x3F) << 6)
196 /* Translate character C by translation table TABLE. If no translation is
197 found in TABLE, return the untranslated character. If TABLE is a list,
198 elements are char tables. In that case, recursively translate C by all the
199 tables in the list. */
202 translate_char (Lisp_Object table
, int c
)
204 if (CHAR_TABLE_P (table
))
208 ch
= CHAR_TABLE_REF (table
, c
);
214 for (; CONSP (table
); table
= XCDR (table
))
215 c
= translate_char (XCAR (table
), c
);
220 DEFUN ("characterp", Fcharacterp
, Scharacterp
, 1, 2, 0,
221 doc
: /* Return non-nil if OBJECT is a character.
222 In Emacs Lisp, characters are represented by character codes, which
223 are non-negative integers. The function `max-char' returns the
224 maximum character code.
225 usage: (characterp OBJECT) */
227 (Lisp_Object object
, Lisp_Object ignore
)
229 return (CHARACTERP (object
) ? Qt
: Qnil
);
232 DEFUN ("max-char", Fmax_char
, Smax_char
, 0, 0, 0,
233 doc
: /* Return the character of the maximum code. */
237 return make_number (MAX_CHAR
);
240 DEFUN ("unibyte-char-to-multibyte", Funibyte_char_to_multibyte
,
241 Sunibyte_char_to_multibyte
, 1, 1, 0,
242 doc
: /* Convert the byte CH to multibyte character. */)
247 CHECK_CHARACTER (ch
);
250 error ("Not a unibyte character: %d", c
);
251 MAKE_CHAR_MULTIBYTE (c
);
252 return make_number (c
);
255 DEFUN ("multibyte-char-to-unibyte", Fmultibyte_char_to_unibyte
,
256 Smultibyte_char_to_unibyte
, 1, 1, 0,
257 doc
: /* Convert the multibyte character CH to a byte.
258 If the multibyte character does not represent a byte, return -1. */)
263 CHECK_CHARACTER (ch
);
266 /* Can't distinguish a byte read from a unibyte buffer from
267 a latin1 char, so let's let it slide. */
271 int cu
= CHAR_TO_BYTE_SAFE (cm
);
272 return make_number (cu
);
277 /* Return width (columns) of C considering the buffer display table DP. */
280 char_width (int c
, struct Lisp_Char_Table
*dp
)
282 ptrdiff_t width
= CHARACTER_WIDTH (c
);
286 Lisp_Object disp
= DISP_CHAR_VECTOR (dp
, c
), ch
;
290 for (i
= 0, width
= 0; i
< ASIZE (disp
); i
++)
294 if (GLYPH_CODE_P (ch
))
295 c
= GLYPH_CODE_CHAR (ch
);
296 else if (CHARACTERP (ch
))
300 int w
= CHARACTER_WIDTH (c
);
301 if (INT_ADD_WRAPV (width
, w
, &width
))
310 DEFUN ("char-width", Fchar_width
, Schar_width
, 1, 1, 0,
311 doc
: /* Return width of CHAR when displayed in the current buffer.
312 The width is measured by how many columns it occupies on the screen.
313 Tab is taken to occupy `tab-width' columns.
314 usage: (char-width CHAR) */)
320 CHECK_CHARACTER (ch
);
322 width
= char_width (c
, buffer_display_table ());
323 return make_number (width
);
326 /* Return width of string STR of length LEN when displayed in the
327 current buffer. The width is measured by how many columns it
328 occupies on the screen. If PRECISION > 0, return the width of
329 longest substring that doesn't exceed PRECISION, and set number of
330 characters and bytes of the substring in *NCHARS and *NBYTES
334 c_string_width (const unsigned char *str
, ptrdiff_t len
, int precision
,
335 ptrdiff_t *nchars
, ptrdiff_t *nbytes
)
337 ptrdiff_t i
= 0, i_byte
= 0;
339 struct Lisp_Char_Table
*dp
= buffer_display_table ();
344 int c
= STRING_CHAR_AND_LENGTH (str
+ i_byte
, bytes
);
345 ptrdiff_t thiswidth
= char_width (c
, dp
);
347 if (0 < precision
&& precision
- width
< thiswidth
)
353 if (INT_ADD_WRAPV (thiswidth
, width
, &width
))
368 /* Return width of string STR of length LEN when displayed in the
369 current buffer. The width is measured by how many columns it
370 occupies on the screen. */
373 strwidth (const char *str
, ptrdiff_t len
)
375 return c_string_width ((const unsigned char *) str
, len
, -1, NULL
, NULL
);
378 /* Return width of Lisp string STRING when displayed in the current
379 buffer. The width is measured by how many columns it occupies on
380 the screen while paying attention to compositions. If PRECISION >
381 0, return the width of longest substring that doesn't exceed
382 PRECISION, and set number of characters and bytes of the substring
383 in *NCHARS and *NBYTES respectively. */
386 lisp_string_width (Lisp_Object string
, ptrdiff_t precision
,
387 ptrdiff_t *nchars
, ptrdiff_t *nbytes
)
389 ptrdiff_t len
= SCHARS (string
);
390 /* This set multibyte to 0 even if STRING is multibyte when it
391 contains only ascii and eight-bit-graphic, but that's
393 bool multibyte
= len
< SBYTES (string
);
394 unsigned char *str
= SDATA (string
);
395 ptrdiff_t i
= 0, i_byte
= 0;
397 struct Lisp_Char_Table
*dp
= buffer_display_table ();
401 ptrdiff_t chars
, bytes
, thiswidth
;
404 ptrdiff_t ignore
, end
;
406 if (find_composition (i
, -1, &ignore
, &end
, &val
, string
)
407 && ((cmp_id
= get_composition_id (i
, i_byte
, end
- i
, val
, string
))
410 thiswidth
= composition_table
[cmp_id
]->width
;
412 bytes
= string_char_to_byte (string
, end
) - i_byte
;
421 c
= STRING_CHAR_AND_LENGTH (str
+ i_byte
, cbytes
);
425 c
= str
[i_byte
], bytes
= 1;
427 thiswidth
= char_width (c
, dp
);
430 if (0 < precision
&& precision
- width
< thiswidth
)
436 if (INT_ADD_WRAPV (thiswidth
, width
, &width
))
451 DEFUN ("string-width", Fstring_width
, Sstring_width
, 1, 1, 0,
452 doc
: /* Return width of STRING when displayed in the current buffer.
453 Width is measured by how many columns it occupies on the screen.
454 When calculating width of a multibyte character in STRING,
455 only the base leading-code is considered; the validity of
456 the following bytes is not checked. Tabs in STRING are always
457 taken to occupy `tab-width' columns.
458 usage: (string-width STRING) */)
464 XSETFASTINT (val
, lisp_string_width (str
, -1, NULL
, NULL
));
468 /* Return the number of characters in the NBYTES bytes at PTR.
469 This works by looking at the contents and checking for multibyte
470 sequences while assuming that there's no invalid sequence.
471 However, if the current buffer has enable-multibyte-characters =
472 nil, we treat each byte as a character. */
475 chars_in_text (const unsigned char *ptr
, ptrdiff_t nbytes
)
477 /* current_buffer is null at early stages of Emacs initialization. */
478 if (current_buffer
== 0
479 || NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
482 return multibyte_chars_in_text (ptr
, nbytes
);
485 /* Return the number of characters in the NBYTES bytes at PTR.
486 This works by looking at the contents and checking for multibyte
487 sequences while assuming that there's no invalid sequence. It
488 ignores enable-multibyte-characters. */
491 multibyte_chars_in_text (const unsigned char *ptr
, ptrdiff_t nbytes
)
493 const unsigned char *endp
= ptr
+ nbytes
;
498 int len
= MULTIBYTE_LENGTH (ptr
, endp
);
509 /* Parse unibyte text at STR of LEN bytes as a multibyte text, count
510 characters and bytes in it, and store them in *NCHARS and *NBYTES
511 respectively. On counting bytes, pay attention to that 8-bit
512 characters not constructing a valid multibyte sequence are
513 represented by 2-byte in a multibyte text. */
516 parse_str_as_multibyte (const unsigned char *str
, ptrdiff_t len
,
517 ptrdiff_t *nchars
, ptrdiff_t *nbytes
)
519 const unsigned char *endp
= str
+ len
;
521 ptrdiff_t chars
= 0, bytes
= 0;
523 if (len
>= MAX_MULTIBYTE_LENGTH
)
525 const unsigned char *adjusted_endp
= endp
- MAX_MULTIBYTE_LENGTH
;
526 while (str
< adjusted_endp
)
528 if (! CHAR_BYTE8_HEAD_P (*str
)
529 && (n
= MULTIBYTE_LENGTH_NO_CHECK (str
)) > 0)
530 str
+= n
, bytes
+= n
;
538 if (! CHAR_BYTE8_HEAD_P (*str
)
539 && (n
= MULTIBYTE_LENGTH (str
, endp
)) > 0)
540 str
+= n
, bytes
+= n
;
551 /* Arrange unibyte text at STR of NBYTES bytes as a multibyte text.
552 It actually converts only such 8-bit characters that don't construct
553 a multibyte sequence to multibyte forms of Latin-1 characters. If
554 NCHARS is nonzero, set *NCHARS to the number of characters in the
555 text. It is assured that we can use LEN bytes at STR as a work
556 area and that is enough. Return the number of bytes of the
560 str_as_multibyte (unsigned char *str
, ptrdiff_t len
, ptrdiff_t nbytes
,
563 unsigned char *p
= str
, *endp
= str
+ nbytes
;
568 if (nbytes
>= MAX_MULTIBYTE_LENGTH
)
570 unsigned char *adjusted_endp
= endp
- MAX_MULTIBYTE_LENGTH
;
571 while (p
< adjusted_endp
572 && ! CHAR_BYTE8_HEAD_P (*p
)
573 && (n
= MULTIBYTE_LENGTH_NO_CHECK (p
)) > 0)
577 && ! CHAR_BYTE8_HEAD_P (*p
)
578 && (n
= MULTIBYTE_LENGTH (p
, endp
)) > 0)
588 memmove (endp
- nbytes
, p
, nbytes
);
591 if (nbytes
>= MAX_MULTIBYTE_LENGTH
)
593 unsigned char *adjusted_endp
= endp
- MAX_MULTIBYTE_LENGTH
;
594 while (p
< adjusted_endp
)
596 if (! CHAR_BYTE8_HEAD_P (*p
)
597 && (n
= MULTIBYTE_LENGTH_NO_CHECK (p
)) > 0)
605 c
= BYTE8_TO_CHAR (c
);
606 to
+= CHAR_STRING (c
, to
);
613 if (! CHAR_BYTE8_HEAD_P (*p
)
614 && (n
= MULTIBYTE_LENGTH (p
, endp
)) > 0)
622 c
= BYTE8_TO_CHAR (c
);
623 to
+= CHAR_STRING (c
, to
);
632 /* Parse unibyte string at STR of LEN bytes, and return the number of
633 bytes it may occupy when converted to multibyte string by
634 `str_to_multibyte'. */
637 count_size_as_multibyte (const unsigned char *str
, ptrdiff_t len
)
639 const unsigned char *endp
= str
+ len
;
642 for (bytes
= 0; str
< endp
; str
++)
644 int n
= *str
< 0x80 ? 1 : 2;
645 if (INT_ADD_WRAPV (bytes
, n
, &bytes
))
652 /* Convert unibyte text at STR of BYTES bytes to a multibyte text
653 that contains the same single-byte characters. It actually
654 converts all 8-bit characters to multibyte forms. It is assured
655 that we can use LEN bytes at STR as a work area and that is
659 str_to_multibyte (unsigned char *str
, ptrdiff_t len
, ptrdiff_t bytes
)
661 unsigned char *p
= str
, *endp
= str
+ bytes
;
664 while (p
< endp
&& *p
< 0x80) p
++;
670 memmove (endp
- bytes
, p
, bytes
);
677 c
= BYTE8_TO_CHAR (c
);
678 to
+= CHAR_STRING (c
, to
);
683 /* Arrange multibyte text at STR of LEN bytes as a unibyte text. It
684 actually converts characters in the range 0x80..0xFF to
688 str_as_unibyte (unsigned char *str
, ptrdiff_t bytes
)
690 const unsigned char *p
= str
, *endp
= str
+ bytes
;
697 len
= BYTES_BY_CHAR_HEAD (c
);
698 if (CHAR_BYTE8_HEAD_P (c
))
702 to
= str
+ (p
- str
);
706 len
= BYTES_BY_CHAR_HEAD (c
);
707 if (CHAR_BYTE8_HEAD_P (c
))
709 c
= STRING_CHAR_ADVANCE (p
);
710 *to
++ = CHAR_TO_BYTE8 (c
);
714 while (len
--) *to
++ = *p
++;
720 /* Convert eight-bit chars in SRC (in multibyte form) to the
721 corresponding byte and store in DST. CHARS is the number of
722 characters in SRC. The value is the number of bytes stored in DST.
723 Usually, the value is the same as CHARS, but is less than it if SRC
724 contains a non-ASCII, non-eight-bit character. */
727 str_to_unibyte (const unsigned char *src
, unsigned char *dst
, ptrdiff_t chars
)
731 for (i
= 0; i
< chars
; i
++)
733 int c
= STRING_CHAR_ADVANCE (src
);
735 if (CHAR_BYTE8_P (c
))
736 c
= CHAR_TO_BYTE8 (c
);
737 else if (! ASCII_CHAR_P (c
))
746 string_count_byte8 (Lisp_Object string
)
748 bool multibyte
= STRING_MULTIBYTE (string
);
749 ptrdiff_t nbytes
= SBYTES (string
);
750 unsigned char *p
= SDATA (string
);
751 unsigned char *pend
= p
+ nbytes
;
759 len
= BYTES_BY_CHAR_HEAD (c
);
761 if (CHAR_BYTE8_HEAD_P (c
))
776 string_escape_byte8 (Lisp_Object string
)
778 ptrdiff_t nchars
= SCHARS (string
);
779 ptrdiff_t nbytes
= SBYTES (string
);
780 bool multibyte
= STRING_MULTIBYTE (string
);
781 ptrdiff_t byte8_count
;
782 ptrdiff_t thrice_byte8_count
, uninit_nchars
, uninit_nbytes
;
783 const unsigned char *src
, *src_end
;
788 if (multibyte
&& nchars
== nbytes
)
791 byte8_count
= string_count_byte8 (string
);
793 if (byte8_count
== 0)
796 if (INT_MULTIPLY_WRAPV (byte8_count
, 3, &thrice_byte8_count
))
801 /* Convert 2-byte sequence of byte8 chars to 4-byte octal. */
802 if (INT_ADD_WRAPV (nchars
, thrice_byte8_count
, &uninit_nchars
)
803 || INT_ADD_WRAPV (nbytes
, 2 * byte8_count
, &uninit_nbytes
))
805 val
= make_uninit_multibyte_string (uninit_nchars
, uninit_nbytes
);
809 /* Convert 1-byte sequence of byte8 chars to 4-byte octal. */
810 if (INT_ADD_WRAPV (thrice_byte8_count
, nbytes
, &uninit_nbytes
))
812 val
= make_uninit_string (uninit_nbytes
);
815 src
= SDATA (string
);
816 src_end
= src
+ nbytes
;
819 while (src
< src_end
)
822 len
= BYTES_BY_CHAR_HEAD (c
);
824 if (CHAR_BYTE8_HEAD_P (c
))
826 c
= STRING_CHAR_ADVANCE (src
);
827 c
= CHAR_TO_BYTE8 (c
);
828 dst
+= sprintf ((char *) dst
, "\\%03o", c
+ 0u);
831 while (len
--) *dst
++ = *src
++;
834 while (src
< src_end
)
838 dst
+= sprintf ((char *) dst
, "\\%03o", c
+ 0u);
846 DEFUN ("string", Fstring
, Sstring
, 0, MANY
, 0,
848 Concatenate all the argument characters and make the result a string.
849 usage: (string &rest CHARACTERS) */)
850 (ptrdiff_t n
, Lisp_Object
*args
)
854 unsigned char *buf
, *p
;
858 SAFE_NALLOCA (buf
, MAX_MULTIBYTE_LENGTH
, n
);
861 for (i
= 0; i
< n
; i
++)
863 CHECK_CHARACTER (args
[i
]);
865 p
+= CHAR_STRING (c
, p
);
868 str
= make_string_from_bytes ((char *) buf
, n
, p
- buf
);
873 DEFUN ("unibyte-string", Funibyte_string
, Sunibyte_string
, 0, MANY
, 0,
874 doc
: /* Concatenate all the argument bytes and make the result a unibyte string.
875 usage: (unibyte-string &rest BYTES) */)
876 (ptrdiff_t n
, Lisp_Object
*args
)
881 unsigned char *buf
= SAFE_ALLOCA (n
);
882 unsigned char *p
= buf
;
884 for (i
= 0; i
< n
; i
++)
886 CHECK_RANGED_INTEGER (args
[i
], 0, 255);
887 *p
++ = XINT (args
[i
]);
890 str
= make_string_from_bytes ((char *) buf
, n
, p
- buf
);
895 DEFUN ("char-resolve-modifiers", Fchar_resolve_modifiers
,
896 Schar_resolve_modifiers
, 1, 1, 0,
897 doc
: /* Resolve modifiers in the character CHAR.
898 The value is a character with modifiers resolved into the character
899 code. Unresolved modifiers are kept in the value.
900 usage: (char-resolve-modifiers CHAR) */)
901 (Lisp_Object character
)
905 CHECK_NUMBER (character
);
906 c
= XINT (character
);
907 return make_number (char_resolve_modifier_mask (c
));
910 DEFUN ("get-byte", Fget_byte
, Sget_byte
, 0, 2, 0,
911 doc
: /* Return a byte value of a character at point.
912 Optional 1st arg POSITION, if non-nil, is a position of a character to get
914 Optional 2nd arg STRING, if non-nil, is a string of which first
915 character is a target to get a byte value. In this case, POSITION, if
916 non-nil, is an index of a target character in the string.
918 If the current buffer (or STRING) is multibyte, and the target
919 character is not ASCII nor 8-bit character, an error is signaled. */)
920 (Lisp_Object position
, Lisp_Object string
)
934 CHECK_NUMBER_COERCE_MARKER (position
);
935 if (XINT (position
) < BEGV
|| XINT (position
) >= ZV
)
936 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
937 pos
= XFASTINT (position
);
938 p
= CHAR_POS_ADDR (pos
);
940 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
941 return make_number (*p
);
945 CHECK_STRING (string
);
952 CHECK_NATNUM (position
);
953 if (XINT (position
) >= SCHARS (string
))
954 args_out_of_range (string
, position
);
955 pos
= XFASTINT (position
);
956 p
= SDATA (string
) + string_char_to_byte (string
, pos
);
958 if (! STRING_MULTIBYTE (string
))
959 return make_number (*p
);
962 if (CHAR_BYTE8_P (c
))
963 c
= CHAR_TO_BYTE8 (c
);
964 else if (! ASCII_CHAR_P (c
))
965 error ("Not an ASCII nor an 8-bit character: %d", c
);
966 return make_number (c
);
969 /* Return true if C is an alphabetic character. */
973 Lisp_Object category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
974 if (! INTEGERP (category
))
976 EMACS_INT gen_cat
= XINT (category
);
978 /* See UTS #18. There are additional characters that should be
979 here, those designated as Other_uppercase, Other_lowercase,
980 and Other_alphabetic; FIXME. */
981 return (gen_cat
== UNICODE_CATEGORY_Lu
982 || gen_cat
== UNICODE_CATEGORY_Ll
983 || gen_cat
== UNICODE_CATEGORY_Lt
984 || gen_cat
== UNICODE_CATEGORY_Lm
985 || gen_cat
== UNICODE_CATEGORY_Lo
986 || gen_cat
== UNICODE_CATEGORY_Mn
987 || gen_cat
== UNICODE_CATEGORY_Mc
988 || gen_cat
== UNICODE_CATEGORY_Me
989 || gen_cat
== UNICODE_CATEGORY_Nl
);
992 /* Return true if C is an alphabetic or decimal-number character. */
994 alphanumericp (int c
)
996 Lisp_Object category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
997 if (! INTEGERP (category
))
999 EMACS_INT gen_cat
= XINT (category
);
1001 /* See UTS #18. Same comment as for alphabeticp applies. FIXME. */
1002 return (gen_cat
== UNICODE_CATEGORY_Lu
1003 || gen_cat
== UNICODE_CATEGORY_Ll
1004 || gen_cat
== UNICODE_CATEGORY_Lt
1005 || gen_cat
== UNICODE_CATEGORY_Lm
1006 || gen_cat
== UNICODE_CATEGORY_Lo
1007 || gen_cat
== UNICODE_CATEGORY_Mn
1008 || gen_cat
== UNICODE_CATEGORY_Mc
1009 || gen_cat
== UNICODE_CATEGORY_Me
1010 || gen_cat
== UNICODE_CATEGORY_Nl
1011 || gen_cat
== UNICODE_CATEGORY_Nd
);
1014 /* Return true if C is a graphic character. */
1018 Lisp_Object category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
1019 if (! INTEGERP (category
))
1021 EMACS_INT gen_cat
= XINT (category
);
1024 return (!(gen_cat
== UNICODE_CATEGORY_Zs
/* space separator */
1025 || gen_cat
== UNICODE_CATEGORY_Zl
/* line separator */
1026 || gen_cat
== UNICODE_CATEGORY_Zp
/* paragraph separator */
1027 || gen_cat
== UNICODE_CATEGORY_Cc
/* control */
1028 || gen_cat
== UNICODE_CATEGORY_Cs
/* surrogate */
1029 || gen_cat
== UNICODE_CATEGORY_Cn
)); /* unassigned */
1032 /* Return true if C is a printable character. */
1036 Lisp_Object category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
1037 if (! INTEGERP (category
))
1039 EMACS_INT gen_cat
= XINT (category
);
1042 return (!(gen_cat
== UNICODE_CATEGORY_Cc
/* control */
1043 || gen_cat
== UNICODE_CATEGORY_Cs
/* surrogate */
1044 || gen_cat
== UNICODE_CATEGORY_Cn
)); /* unassigned */
1047 /* Return true if C is a horizontal whitespace character, as defined
1048 by http://www.unicode.org/reports/tr18/tr18-19.html#blank. */
1052 Lisp_Object category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
1053 if (! INTEGERP (category
))
1056 return XINT (category
) == UNICODE_CATEGORY_Zs
; /* separator, space */
1059 signed char HEXDIGIT_CONST hexdigit
[UCHAR_MAX
+ 1] =
1061 #if HEXDIGIT_IS_CONST
1062 [0 ... UCHAR_MAX
] = -1,
1064 ['0'] = 0, ['1'] = 1, ['2'] = 2, ['3'] = 3, ['4'] = 4,
1065 ['5'] = 5, ['6'] = 6, ['7'] = 7, ['8'] = 8, ['9'] = 9,
1066 ['A'] = 10, ['B'] = 11, ['C'] = 12, ['D'] = 13, ['E'] = 14, ['F'] = 15,
1067 ['a'] = 10, ['b'] = 11, ['c'] = 12, ['d'] = 13, ['e'] = 14, ['f'] = 15
1071 syms_of_character (void)
1073 #if !HEXDIGIT_IS_CONST
1074 /* Set the non-hex digit values to -1. */
1075 for (int i
= 0; i
<= UCHAR_MAX
; i
++)
1076 hexdigit
[i
] -= i
!= '0' && !hexdigit
[i
];
1079 DEFSYM (Qcharacterp
, "characterp");
1080 DEFSYM (Qauto_fill_chars
, "auto-fill-chars");
1082 staticpro (&Vchar_unify_table
);
1083 Vchar_unify_table
= Qnil
;
1085 defsubr (&Smax_char
);
1086 defsubr (&Scharacterp
);
1087 defsubr (&Sunibyte_char_to_multibyte
);
1088 defsubr (&Smultibyte_char_to_unibyte
);
1089 defsubr (&Schar_width
);
1090 defsubr (&Sstring_width
);
1092 defsubr (&Sunibyte_string
);
1093 defsubr (&Schar_resolve_modifiers
);
1094 defsubr (&Sget_byte
);
1096 DEFVAR_LISP ("translation-table-vector", Vtranslation_table_vector
,
1098 Vector recording all translation tables ever defined.
1099 Each element is a pair (SYMBOL . TABLE) relating the table to the
1100 symbol naming it. The ID of a translation table is an index into this vector. */);
1101 Vtranslation_table_vector
= Fmake_vector (make_number (16), Qnil
);
1103 DEFVAR_LISP ("auto-fill-chars", Vauto_fill_chars
,
1105 A char-table for characters which invoke auto-filling.
1106 Such characters have value t in this table. */);
1107 Vauto_fill_chars
= Fmake_char_table (Qauto_fill_chars
, Qnil
);
1108 CHAR_TABLE_SET (Vauto_fill_chars
, ' ', Qt
);
1109 CHAR_TABLE_SET (Vauto_fill_chars
, '\n', Qt
);
1111 DEFVAR_LISP ("char-width-table", Vchar_width_table
,
1113 A char-table for width (columns) of each character. */);
1114 Vchar_width_table
= Fmake_char_table (Qnil
, make_number (1));
1115 char_table_set_range (Vchar_width_table
, 0x80, 0x9F, make_number (4));
1116 char_table_set_range (Vchar_width_table
, MAX_5_BYTE_CHAR
+ 1, MAX_CHAR
,
1119 DEFVAR_LISP ("printable-chars", Vprintable_chars
,
1120 doc
: /* A char-table for each printable character. */);
1121 Vprintable_chars
= Fmake_char_table (Qnil
, Qnil
);
1122 Fset_char_table_range (Vprintable_chars
,
1123 Fcons (make_number (32), make_number (126)), Qt
);
1124 Fset_char_table_range (Vprintable_chars
,
1125 Fcons (make_number (160),
1126 make_number (MAX_5_BYTE_CHAR
)), Qt
);
1128 DEFVAR_LISP ("char-script-table", Vchar_script_table
,
1129 doc
: /* Char table of script symbols.
1130 It has one extra slot whose value is a list of script symbols. */);
1132 DEFSYM (Qchar_script_table
, "char-script-table");
1133 Fput (Qchar_script_table
, Qchar_table_extra_slots
, make_number (1));
1134 Vchar_script_table
= Fmake_char_table (Qchar_script_table
, Qnil
);
1136 DEFVAR_LISP ("script-representative-chars", Vscript_representative_chars
,
1137 doc
: /* Alist of scripts vs the representative characters.
1138 Each element is a cons (SCRIPT . CHARS).
1139 SCRIPT is a symbol representing a script or a subgroup of a script.
1140 CHARS is a list or a vector of characters.
1141 If it is a list, all characters in the list are necessary for supporting SCRIPT.
1142 If it is a vector, one of the characters in the vector is necessary.
1143 This variable is used to find a font for a specific script. */);
1144 Vscript_representative_chars
= Qnil
;
1146 DEFVAR_LISP ("unicode-category-table", Vunicode_category_table
,
1147 doc
: /* Char table of Unicode's "General Category".
1148 All Unicode characters have one of the following values (symbol):
1149 Lu, Ll, Lt, Lm, Lo, Mn, Mc, Me, Nd, Nl, No, Pc, Pd, Ps, Pe, Pi, Pf, Po,
1150 Sm, Sc, Sk, So, Zs, Zl, Zp, Cc, Cf, Cs, Co, Cn
1151 See The Unicode Standard for the meaning of those values. */);
1152 /* The correct char-table is setup in characters.el. */
1153 Vunicode_category_table
= Qnil
;