1 /* Basic character support.
3 Copyright (C) 2001-2011 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>
39 #include "character.h"
42 #include "composite.h"
51 Lisp_Object Qcharacterp
;
53 Lisp_Object Qauto_fill_chars
;
55 /* Char-table of information about which character to unify to which
56 Unicode character. Mainly used by the macro MAYBE_UNIFY_CHAR. */
57 Lisp_Object Vchar_unify_table
;
59 /* Variable used locally in the macro FETCH_MULTIBYTE_CHAR. */
60 unsigned char *_fetch_multibyte_char_p
;
62 static Lisp_Object Qchar_script_table
;
66 /* If character code C has modifier masks, reflect them to the
67 character code if possible. Return the resulting code. */
70 char_resolve_modifier_mask (int c
)
72 /* A non-ASCII character can't reflect modifier bits to the code. */
73 if (! ASCII_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
76 /* For Meta, Shift, and Control modifiers, we need special care. */
79 /* Shift modifier is valid only with [A-Za-z]. */
80 if ((c
& 0377) >= 'A' && (c
& 0377) <= 'Z')
82 else if ((c
& 0377) >= 'a' && (c
& 0377) <= 'z')
83 c
= (c
& ~CHAR_SHIFT
) - ('a' - 'A');
84 /* Shift modifier for control characters and SPC is ignored. */
85 else if ((c
& ~CHAR_MODIFIER_MASK
) <= 0x20)
90 /* Simulate the code in lread.c. */
91 /* Allow `\C- ' and `\C-?'. */
92 if ((c
& 0377) == ' ')
93 c
&= ~0177 & ~ CHAR_CTL
;
94 else if ((c
& 0377) == '?')
95 c
= 0177 | (c
& ~0177 & ~CHAR_CTL
);
96 /* ASCII control chars are made from letters (both cases),
97 as well as the non-letters within 0100...0137. */
98 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
99 c
&= (037 | (~0177 & ~CHAR_CTL
));
100 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
101 c
&= (037 | (~0177 & ~CHAR_CTL
));
103 #if 0 /* This is outside the scope of this function. (bug#4751) */
106 /* Move the meta bit to the right place for a string. */
107 c
= (c
& ~CHAR_META
) | 0x80;
115 /* Store multibyte form of character C at P. If C has modifier bits,
116 handle them appropriately. */
119 char_string (unsigned int c
, unsigned char *p
)
123 if (c
& CHAR_MODIFIER_MASK
)
125 c
= (unsigned) char_resolve_modifier_mask ((int) c
);
126 /* If C still has any modifier bits, just ignore it. */
127 c
&= ~CHAR_MODIFIER_MASK
;
130 MAYBE_UNIFY_CHAR (c
);
132 if (c
<= MAX_3_BYTE_CHAR
)
134 bytes
= CHAR_STRING (c
, p
);
136 else if (c
<= MAX_4_BYTE_CHAR
)
138 p
[0] = (0xF0 | (c
>> 18));
139 p
[1] = (0x80 | ((c
>> 12) & 0x3F));
140 p
[2] = (0x80 | ((c
>> 6) & 0x3F));
141 p
[3] = (0x80 | (c
& 0x3F));
144 else if (c
<= MAX_5_BYTE_CHAR
)
147 p
[1] = (0x80 | ((c
>> 18) & 0x0F));
148 p
[2] = (0x80 | ((c
>> 12) & 0x3F));
149 p
[3] = (0x80 | ((c
>> 6) & 0x3F));
150 p
[4] = (0x80 | (c
& 0x3F));
153 else if (c
<= MAX_CHAR
)
155 c
= CHAR_TO_BYTE8 (c
);
156 bytes
= BYTE8_STRING (c
, p
);
159 error ("Invalid character: %d", c
);
165 /* Return a character whose multibyte form is at P. Set LEN is not
166 NULL, it must be a pointer to integer. In that case, set *LEN to
167 the byte length of the multibyte form. If ADVANCED is not NULL, is
168 must be a pointer to unsigned char. In that case, set *ADVANCED to
169 the ending address (i.e. the starting address of the next
170 character) of the multibyte form. */
173 string_char (const unsigned char *p
, const unsigned char **advanced
, int *len
)
176 const unsigned char *saved_p
= p
;
178 if (*p
< 0x80 || ! (*p
& 0x20) || ! (*p
& 0x10))
180 c
= STRING_CHAR_ADVANCE (p
);
182 else if (! (*p
& 0x08))
184 c
= ((((p
)[0] & 0xF) << 18)
185 | (((p
)[1] & 0x3F) << 12)
186 | (((p
)[2] & 0x3F) << 6)
192 c
= ((((p
)[1] & 0x3F) << 18)
193 | (((p
)[2] & 0x3F) << 12)
194 | (((p
)[3] & 0x3F) << 6)
199 MAYBE_UNIFY_CHAR (c
);
209 /* Translate character C by translation table TABLE. If C is
210 negative, translate a character specified by CHARSET and CODE. If
211 no translation is found in TABLE, return the untranslated
212 character. If TABLE is a list, elements are char tables. In this
213 case, translace C by all tables. */
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).
237 The argument REV_TBL is now ignored. It will be removed in the
241 multibyte_char_to_unibyte (int c
, Lisp_Object rev_tbl
)
245 if (CHAR_BYTE8_P (c
))
246 return CHAR_TO_BYTE8 (c
);
250 /* Like multibyte_char_to_unibyte, but return -1 if C is not supported
251 by charset_unibyte. */
254 multibyte_char_to_unibyte_safe (int c
)
258 if (CHAR_BYTE8_P (c
))
259 return CHAR_TO_BYTE8 (c
);
263 DEFUN ("characterp", Fcharacterp
, Scharacterp
, 1, 2, 0,
264 doc
: /* Return non-nil if OBJECT is a character. */)
265 (Lisp_Object object
, Lisp_Object ignore
)
267 return (CHARACTERP (object
) ? Qt
: Qnil
);
270 DEFUN ("max-char", Fmax_char
, Smax_char
, 0, 0, 0,
271 doc
: /* Return the character of the maximum code. */)
274 return make_number (MAX_CHAR
);
277 DEFUN ("unibyte-char-to-multibyte", Funibyte_char_to_multibyte
,
278 Sunibyte_char_to_multibyte
, 1, 1, 0,
279 doc
: /* Convert the byte CH to multibyte character. */)
284 CHECK_CHARACTER (ch
);
287 error ("Not a unibyte character: %d", c
);
288 MAKE_CHAR_MULTIBYTE (c
);
289 return make_number (c
);
292 DEFUN ("multibyte-char-to-unibyte", Fmultibyte_char_to_unibyte
,
293 Smultibyte_char_to_unibyte
, 1, 1, 0,
294 doc
: /* Convert the multibyte character CH to a byte.
295 If the multibyte character does not represent a byte, return -1. */)
300 CHECK_CHARACTER (ch
);
303 /* Can't distinguish a byte read from a unibyte buffer from
304 a latin1 char, so let's let it slide. */
308 int cu
= CHAR_TO_BYTE_SAFE (cm
);
309 return make_number (cu
);
313 DEFUN ("char-width", Fchar_width
, Schar_width
, 1, 1, 0,
314 doc
: /* Return width of CHAR when displayed in the current buffer.
315 The width is measured by how many columns it occupies on the screen.
316 Tab is taken to occupy `tab-width' columns.
317 usage: (char-width CHAR) */)
322 struct Lisp_Char_Table
*dp
= buffer_display_table ();
324 CHECK_CHARACTER (ch
);
327 /* Get the way the display table would display it. */
328 disp
= dp
? DISP_CHAR_VECTOR (dp
, c
) : Qnil
;
331 width
= ASIZE (disp
);
333 width
= CHAR_WIDTH (c
);
335 return make_number (width
);
338 /* Return width of string STR of length LEN when displayed in the
339 current buffer. The width is measured by how many columns it
340 occupies on the screen. If PRECISION > 0, return the width of
341 longest substring that doesn't exceed PRECISION, and set number of
342 characters and bytes of the substring in *NCHARS and *NBYTES
346 c_string_width (const unsigned char *str
, EMACS_INT len
, int precision
,
347 EMACS_INT
*nchars
, EMACS_INT
*nbytes
)
349 EMACS_INT i
= 0, i_byte
= 0;
351 struct Lisp_Char_Table
*dp
= buffer_display_table ();
355 int bytes
, thiswidth
;
357 int c
= STRING_CHAR_AND_LENGTH (str
+ i_byte
, bytes
);
361 val
= DISP_CHAR_VECTOR (dp
, c
);
363 thiswidth
= XVECTOR (val
)->size
;
365 thiswidth
= CHAR_WIDTH (c
);
369 thiswidth
= CHAR_WIDTH (c
);
373 && (width
+ thiswidth
> precision
))
393 /* Return width of string STR of length LEN when displayed in the
394 current buffer. The width is measured by how many columns it
395 occupies on the screen. */
398 strwidth (const char *str
, EMACS_INT len
)
400 return c_string_width ((const unsigned char *) str
, len
, -1, NULL
, NULL
);
403 /* Return width of Lisp string STRING when displayed in the current
404 buffer. The width is measured by how many columns it occupies on
405 the screen while paying attention to compositions. If PRECISION >
406 0, return the width of longest substring that doesn't exceed
407 PRECISION, and set number of characters and bytes of the substring
408 in *NCHARS and *NBYTES respectively. */
411 lisp_string_width (Lisp_Object string
, int precision
,
412 EMACS_INT
*nchars
, EMACS_INT
*nbytes
)
414 EMACS_INT len
= SCHARS (string
);
415 /* This set multibyte to 0 even if STRING is multibyte when it
416 contains only ascii and eight-bit-graphic, but that's
418 int multibyte
= len
< SBYTES (string
);
419 unsigned char *str
= SDATA (string
);
420 EMACS_INT i
= 0, i_byte
= 0;
422 struct Lisp_Char_Table
*dp
= buffer_display_table ();
426 int chars
, bytes
, thiswidth
;
429 EMACS_INT ignore
, end
;
431 if (find_composition (i
, -1, &ignore
, &end
, &val
, string
)
432 && ((cmp_id
= get_composition_id (i
, i_byte
, end
- i
, val
, string
))
435 thiswidth
= composition_table
[cmp_id
]->width
;
437 bytes
= string_char_to_byte (string
, end
) - i_byte
;
444 c
= STRING_CHAR_AND_LENGTH (str
+ i_byte
, bytes
);
446 c
= str
[i_byte
], bytes
= 1;
450 val
= DISP_CHAR_VECTOR (dp
, c
);
452 thiswidth
= XVECTOR (val
)->size
;
454 thiswidth
= CHAR_WIDTH (c
);
458 thiswidth
= CHAR_WIDTH (c
);
463 && (width
+ thiswidth
> precision
))
483 DEFUN ("string-width", Fstring_width
, Sstring_width
, 1, 1, 0,
484 doc
: /* Return width of STRING when displayed in the current buffer.
485 Width is measured by how many columns it occupies on the screen.
486 When calculating width of a multibyte character in STRING,
487 only the base leading-code is considered; the validity of
488 the following bytes is not checked. Tabs in STRING are always
489 taken to occupy `tab-width' columns.
490 usage: (string-width STRING) */)
496 XSETFASTINT (val
, lisp_string_width (str
, -1, NULL
, NULL
));
500 DEFUN ("char-direction", Fchar_direction
, Schar_direction
, 1, 1, 0,
501 doc
: /* Return the direction of CHAR.
502 The returned value is 0 for left-to-right and 1 for right-to-left.
503 usage: (char-direction CHAR) */)
508 CHECK_CHARACTER (ch
);
510 return CHAR_TABLE_REF (Vchar_direction_table
, c
);
513 /* Return the number of characters in the NBYTES bytes at PTR.
514 This works by looking at the contents and checking for multibyte
515 sequences while assuming that there's no invalid sequence.
516 However, if the current buffer has enable-multibyte-characters =
517 nil, we treat each byte as a character. */
520 chars_in_text (const unsigned char *ptr
, EMACS_INT nbytes
)
522 /* current_buffer is null at early stages of Emacs initialization. */
523 if (current_buffer
== 0
524 || NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
527 return multibyte_chars_in_text (ptr
, nbytes
);
530 /* Return the number of characters in the NBYTES bytes at PTR.
531 This works by looking at the contents and checking for multibyte
532 sequences while assuming that there's no invalid sequence. It
533 ignores enable-multibyte-characters. */
536 multibyte_chars_in_text (const unsigned char *ptr
, EMACS_INT nbytes
)
538 const unsigned char *endp
= ptr
+ nbytes
;
543 EMACS_INT len
= MULTIBYTE_LENGTH (ptr
, endp
);
554 /* Parse unibyte text at STR of LEN bytes as a multibyte text, count
555 characters and bytes in it, and store them in *NCHARS and *NBYTES
556 respectively. On counting bytes, pay attention to that 8-bit
557 characters not constructing a valid multibyte sequence are
558 represented by 2-byte in a multibyte text. */
561 parse_str_as_multibyte (const unsigned char *str
, EMACS_INT len
,
562 EMACS_INT
*nchars
, EMACS_INT
*nbytes
)
564 const unsigned char *endp
= str
+ len
;
565 EMACS_INT n
, chars
= 0, bytes
= 0;
567 if (len
>= MAX_MULTIBYTE_LENGTH
)
569 const unsigned char *adjusted_endp
= endp
- MAX_MULTIBYTE_LENGTH
;
570 while (str
< adjusted_endp
)
572 if (! CHAR_BYTE8_HEAD_P (*str
)
573 && (n
= MULTIBYTE_LENGTH_NO_CHECK (str
)) > 0)
574 str
+= n
, bytes
+= n
;
582 if (! CHAR_BYTE8_HEAD_P (*str
)
583 && (n
= MULTIBYTE_LENGTH (str
, endp
)) > 0)
584 str
+= n
, bytes
+= n
;
595 /* Arrange unibyte text at STR of NBYTES bytes as a multibyte text.
596 It actually converts only such 8-bit characters that don't contruct
597 a multibyte sequence to multibyte forms of Latin-1 characters. If
598 NCHARS is nonzero, set *NCHARS to the number of characters in the
599 text. It is assured that we can use LEN bytes at STR as a work
600 area and that is enough. Return the number of bytes of the
604 str_as_multibyte (unsigned char *str
, EMACS_INT len
, EMACS_INT nbytes
,
607 unsigned char *p
= str
, *endp
= str
+ nbytes
;
612 if (nbytes
>= MAX_MULTIBYTE_LENGTH
)
614 unsigned char *adjusted_endp
= endp
- MAX_MULTIBYTE_LENGTH
;
615 while (p
< adjusted_endp
616 && ! CHAR_BYTE8_HEAD_P (*p
)
617 && (n
= MULTIBYTE_LENGTH_NO_CHECK (p
)) > 0)
621 && ! CHAR_BYTE8_HEAD_P (*p
)
622 && (n
= MULTIBYTE_LENGTH (p
, endp
)) > 0)
632 memmove (endp
- nbytes
, p
, nbytes
);
635 if (nbytes
>= MAX_MULTIBYTE_LENGTH
)
637 unsigned char *adjusted_endp
= endp
- MAX_MULTIBYTE_LENGTH
;
638 while (p
< adjusted_endp
)
640 if (! CHAR_BYTE8_HEAD_P (*p
)
641 && (n
= MULTIBYTE_LENGTH_NO_CHECK (p
)) > 0)
649 c
= BYTE8_TO_CHAR (c
);
650 to
+= CHAR_STRING (c
, to
);
657 if (! CHAR_BYTE8_HEAD_P (*p
)
658 && (n
= MULTIBYTE_LENGTH (p
, endp
)) > 0)
666 c
= BYTE8_TO_CHAR (c
);
667 to
+= CHAR_STRING (c
, to
);
676 /* Parse unibyte string at STR of LEN bytes, and return the number of
677 bytes it may ocupy when converted to multibyte string by
678 `str_to_multibyte'. */
681 parse_str_to_multibyte (const unsigned char *str
, EMACS_INT len
)
683 const unsigned char *endp
= str
+ len
;
686 for (bytes
= 0; str
< endp
; str
++)
687 bytes
+= (*str
< 0x80) ? 1 : 2;
692 /* Convert unibyte text at STR of NBYTES bytes to a multibyte text
693 that contains the same single-byte characters. It actually
694 converts all 8-bit characters to multibyte forms. It is assured
695 that we can use LEN bytes at STR as a work area and that is
699 str_to_multibyte (unsigned char *str
, EMACS_INT len
, EMACS_INT bytes
)
701 unsigned char *p
= str
, *endp
= str
+ bytes
;
704 while (p
< endp
&& *p
< 0x80) p
++;
710 memmove (endp
- bytes
, p
, bytes
);
717 c
= BYTE8_TO_CHAR (c
);
718 to
+= CHAR_STRING (c
, to
);
723 /* Arrange multibyte text at STR of LEN bytes as a unibyte text. It
724 actually converts characters in the range 0x80..0xFF to
728 str_as_unibyte (unsigned char *str
, EMACS_INT bytes
)
730 const unsigned char *p
= str
, *endp
= str
+ bytes
;
737 len
= BYTES_BY_CHAR_HEAD (c
);
738 if (CHAR_BYTE8_HEAD_P (c
))
742 to
= str
+ (p
- str
);
746 len
= BYTES_BY_CHAR_HEAD (c
);
747 if (CHAR_BYTE8_HEAD_P (c
))
749 c
= STRING_CHAR_ADVANCE (p
);
750 *to
++ = CHAR_TO_BYTE8 (c
);
754 while (len
--) *to
++ = *p
++;
760 /* Convert eight-bit chars in SRC (in multibyte form) to the
761 corresponding byte and store in DST. CHARS is the number of
762 characters in SRC. The value is the number of bytes stored in DST.
763 Usually, the value is the same as CHARS, but is less than it if SRC
764 contains a non-ASCII, non-eight-bit character. If ACCEPT_LATIN_1
765 is nonzero, a Latin-1 character is accepted and converted to a byte
766 of that character code.
767 Note: Currently the arg ACCEPT_LATIN_1 is not used. */
770 str_to_unibyte (const unsigned char *src
, unsigned char *dst
, EMACS_INT chars
, int accept_latin_1
)
774 for (i
= 0; i
< chars
; i
++)
776 int c
= STRING_CHAR_ADVANCE (src
);
778 if (CHAR_BYTE8_P (c
))
779 c
= CHAR_TO_BYTE8 (c
);
780 else if (! ASCII_CHAR_P (c
)
781 && (! accept_latin_1
|| c
>= 0x100))
790 string_count_byte8 (Lisp_Object string
)
792 int multibyte
= STRING_MULTIBYTE (string
);
793 EMACS_INT nbytes
= SBYTES (string
);
794 unsigned char *p
= SDATA (string
);
795 unsigned char *pend
= p
+ nbytes
;
803 len
= BYTES_BY_CHAR_HEAD (c
);
805 if (CHAR_BYTE8_HEAD_P (c
))
820 string_escape_byte8 (Lisp_Object string
)
822 EMACS_INT nchars
= SCHARS (string
);
823 EMACS_INT nbytes
= SBYTES (string
);
824 int multibyte
= STRING_MULTIBYTE (string
);
825 EMACS_INT byte8_count
;
826 const unsigned char *src
, *src_end
;
831 if (multibyte
&& nchars
== nbytes
)
834 byte8_count
= string_count_byte8 (string
);
836 if (byte8_count
== 0)
841 if ((MOST_POSITIVE_FIXNUM
- nchars
) / 3 < byte8_count
842 || (MOST_POSITIVE_FIXNUM
- nbytes
) / 2 < byte8_count
)
843 error ("Maximum string size exceeded");
845 /* Convert 2-byte sequence of byte8 chars to 4-byte octal. */
846 val
= make_uninit_multibyte_string (nchars
+ byte8_count
* 3,
847 nbytes
+ byte8_count
* 2);
851 if ((MOST_POSITIVE_FIXNUM
- nchars
) / 3 < byte8_count
)
852 error ("Maximum string size exceeded");
853 /* Convert 1-byte sequence of byte8 chars to 4-byte octal. */
854 val
= make_uninit_string (nbytes
+ byte8_count
* 3);
857 src
= SDATA (string
);
858 src_end
= src
+ nbytes
;
861 while (src
< src_end
)
864 len
= BYTES_BY_CHAR_HEAD (c
);
866 if (CHAR_BYTE8_HEAD_P (c
))
868 c
= STRING_CHAR_ADVANCE (src
);
869 c
= CHAR_TO_BYTE8 (c
);
870 sprintf ((char *) dst
, "\\%03o", c
);
874 while (len
--) *dst
++ = *src
++;
877 while (src
< src_end
)
882 sprintf ((char *) dst
, "\\%03o", c
);
892 DEFUN ("string", Fstring
, Sstring
, 0, MANY
, 0,
894 Concatenate all the argument characters and make the result a string.
895 usage: (string &rest CHARACTERS) */)
896 (size_t n
, Lisp_Object
*args
)
900 unsigned char *buf
, *p
;
904 SAFE_ALLOCA (buf
, unsigned char *, MAX_MULTIBYTE_LENGTH
* n
);
907 for (i
= 0; i
< n
; i
++)
909 CHECK_CHARACTER (args
[i
]);
911 p
+= CHAR_STRING (c
, p
);
914 str
= make_string_from_bytes ((char *) buf
, n
, p
- buf
);
919 DEFUN ("unibyte-string", Funibyte_string
, Sunibyte_string
, 0, MANY
, 0,
920 doc
: /* Concatenate all the argument bytes and make the result a unibyte string.
921 usage: (unibyte-string &rest BYTES) */)
922 (size_t n
, Lisp_Object
*args
)
926 unsigned char *buf
, *p
;
930 SAFE_ALLOCA (buf
, unsigned char *, n
);
933 for (i
= 0; i
< n
; i
++)
935 CHECK_NATNUM (args
[i
]);
936 c
= XFASTINT (args
[i
]);
938 args_out_of_range_3 (args
[i
], make_number (0), make_number (255));
942 str
= make_string_from_bytes ((char *) buf
, n
, p
- buf
);
947 DEFUN ("char-resolve-modifiers", Fchar_resolve_modifiers
,
948 Schar_resolve_modifiers
, 1, 1, 0,
949 doc
: /* Resolve modifiers in the character CHAR.
950 The value is a character with modifiers resolved into the character
951 code. Unresolved modifiers are kept in the value.
952 usage: (char-resolve-modifiers CHAR) */)
953 (Lisp_Object character
)
957 CHECK_NUMBER (character
);
958 c
= XINT (character
);
959 return make_number (char_resolve_modifier_mask (c
));
962 DEFUN ("get-byte", Fget_byte
, Sget_byte
, 0, 2, 0,
963 doc
: /* Return a byte value of a character at point.
964 Optional 1st arg POSITION, if non-nil, is a position of a character to get
966 Optional 2nd arg STRING, if non-nil, is a string of which first
967 character is a target to get a byte value. In this case, POSITION, if
968 non-nil, is an index of a target character in the string.
970 If the current buffer (or STRING) is multibyte, and the target
971 character is not ASCII nor 8-bit character, an error is signalled. */)
972 (Lisp_Object position
, Lisp_Object string
)
986 CHECK_NUMBER_COERCE_MARKER (position
);
987 if (XINT (position
) < BEGV
|| XINT (position
) >= ZV
)
988 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
989 pos
= XFASTINT (position
);
990 p
= CHAR_POS_ADDR (pos
);
992 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
993 return make_number (*p
);
997 CHECK_STRING (string
);
1004 CHECK_NATNUM (position
);
1005 if (XINT (position
) >= SCHARS (string
))
1006 args_out_of_range (string
, position
);
1007 pos
= XFASTINT (position
);
1008 p
= SDATA (string
) + string_char_to_byte (string
, pos
);
1010 if (! STRING_MULTIBYTE (string
))
1011 return make_number (*p
);
1013 c
= STRING_CHAR (p
);
1014 if (CHAR_BYTE8_P (c
))
1015 c
= CHAR_TO_BYTE8 (c
);
1016 else if (! ASCII_CHAR_P (c
))
1017 error ("Not an ASCII nor an 8-bit character: %d", c
);
1018 return make_number (c
);
1023 init_character_once (void)
1030 syms_of_character (void)
1032 DEFSYM (Qcharacterp
, "characterp");
1033 DEFSYM (Qauto_fill_chars
, "auto-fill-chars");
1035 staticpro (&Vchar_unify_table
);
1036 Vchar_unify_table
= Qnil
;
1038 defsubr (&Smax_char
);
1039 defsubr (&Scharacterp
);
1040 defsubr (&Sunibyte_char_to_multibyte
);
1041 defsubr (&Smultibyte_char_to_unibyte
);
1042 defsubr (&Schar_width
);
1043 defsubr (&Sstring_width
);
1044 defsubr (&Schar_direction
);
1046 defsubr (&Sunibyte_string
);
1047 defsubr (&Schar_resolve_modifiers
);
1048 defsubr (&Sget_byte
);
1050 DEFVAR_LISP ("translation-table-vector", Vtranslation_table_vector
,
1052 Vector recording all translation tables ever defined.
1053 Each element is a pair (SYMBOL . TABLE) relating the table to the
1054 symbol naming it. The ID of a translation table is an index into this vector. */);
1055 Vtranslation_table_vector
= Fmake_vector (make_number (16), Qnil
);
1057 DEFVAR_LISP ("auto-fill-chars", Vauto_fill_chars
,
1059 A char-table for characters which invoke auto-filling.
1060 Such characters have value t in this table. */);
1061 Vauto_fill_chars
= Fmake_char_table (Qauto_fill_chars
, Qnil
);
1062 CHAR_TABLE_SET (Vauto_fill_chars
, ' ', Qt
);
1063 CHAR_TABLE_SET (Vauto_fill_chars
, '\n', Qt
);
1065 DEFVAR_LISP ("char-width-table", Vchar_width_table
,
1067 A char-table for width (columns) of each character. */);
1068 Vchar_width_table
= Fmake_char_table (Qnil
, make_number (1));
1069 char_table_set_range (Vchar_width_table
, 0x80, 0x9F, make_number (4));
1070 char_table_set_range (Vchar_width_table
, MAX_5_BYTE_CHAR
+ 1, MAX_CHAR
,
1073 DEFVAR_LISP ("char-direction-table", Vchar_direction_table
,
1074 doc
: /* A char-table for direction of each character. */);
1075 Vchar_direction_table
= Fmake_char_table (Qnil
, make_number (1));
1077 DEFVAR_LISP ("printable-chars", Vprintable_chars
,
1078 doc
: /* A char-table for each printable character. */);
1079 Vprintable_chars
= Fmake_char_table (Qnil
, Qnil
);
1080 Fset_char_table_range (Vprintable_chars
,
1081 Fcons (make_number (32), make_number (126)), Qt
);
1082 Fset_char_table_range (Vprintable_chars
,
1083 Fcons (make_number (160),
1084 make_number (MAX_5_BYTE_CHAR
)), Qt
);
1086 DEFVAR_LISP ("char-script-table", Vchar_script_table
,
1087 doc
: /* Char table of script symbols.
1088 It has one extra slot whose value is a list of script symbols. */);
1090 /* Intern this now in case it isn't already done.
1091 Setting this variable twice is harmless.
1092 But don't staticpro it here--that is done in alloc.c. */
1093 Qchar_table_extra_slots
= intern_c_string ("char-table-extra-slots");
1094 DEFSYM (Qchar_script_table
, "char-script-table");
1095 Fput (Qchar_script_table
, Qchar_table_extra_slots
, make_number (1));
1096 Vchar_script_table
= Fmake_char_table (Qchar_script_table
, Qnil
);
1098 DEFVAR_LISP ("script-representative-chars", Vscript_representative_chars
,
1099 doc
: /* Alist of scripts vs the representative characters.
1100 Each element is a cons (SCRIPT . CHARS).
1101 SCRIPT is a symbol representing a script or a subgroup of a script.
1102 CHARS is a list or a vector of characters.
1103 If it is a list, all characters in the list are necessary for supporting SCRIPT.
1104 If it is a vector, one of the characters in the vector is necessary.
1105 This variable is used to find a font for a specific script. */);
1106 Vscript_representative_chars
= Qnil
;
1108 DEFVAR_LISP ("unicode-category-table", Vunicode_category_table
,
1109 doc
: /* Char table of Unicode's "General Category".
1110 All Unicode characters have one of the following values (symbol):
1111 Lu, Ll, Lt, Lm, Lo, Mn, Mc, Me, Nd, Nl, No, Pc, Pd, Ps, Pe, Pi, Pf, Po,
1112 Sm, Sc, Sk, So, Zs, Zl, Zp, Cc, Cf, Cs, Co, Cn
1113 See The Unicode Standard for the meaning of those values. */);
1114 /* The correct char-table is setup in characters.el. */
1115 Vunicode_category_table
= Qnil
;