Fix earlier NEWS change
[emacs.git] / src / character.c
blob5808d48a23524d41f48254a9d89290f095fef109
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
26 in this file. */
28 #ifdef emacs
29 #include <config.h>
30 #endif
32 #define CHARACTER_INLINE EXTERN_INLINE
34 #include <stdio.h>
36 #ifdef emacs
38 #include <sys/types.h>
39 #include <intprops.h>
40 #include "lisp.h"
41 #include "character.h"
42 #include "buffer.h"
43 #include "charset.h"
44 #include "composite.h"
45 #include "disptab.h"
47 #else /* not emacs */
49 #include "mulelib.h"
51 #endif /* emacs */
53 Lisp_Object Qcharacterp;
55 static Lisp_Object Qauto_fill_chars;
57 /* Char-table of information about which character to unify to which
58 Unicode character. Mainly used by the macro MAYBE_UNIFY_CHAR. */
59 Lisp_Object Vchar_unify_table;
61 static Lisp_Object Qchar_script_table;
65 /* If character code C has modifier masks, reflect them to the
66 character code if possible. Return the resulting code. */
68 EMACS_INT
69 char_resolve_modifier_mask (EMACS_INT c)
71 /* A non-ASCII character can't reflect modifier bits to the code. */
72 if (! ASCII_CHAR_P ((c & ~CHAR_MODIFIER_MASK)))
73 return c;
75 /* For Meta, Shift, and Control modifiers, we need special care. */
76 if (c & CHAR_SHIFT)
78 /* Shift modifier is valid only with [A-Za-z]. */
79 if ((c & 0377) >= 'A' && (c & 0377) <= 'Z')
80 c &= ~CHAR_SHIFT;
81 else if ((c & 0377) >= 'a' && (c & 0377) <= 'z')
82 c = (c & ~CHAR_SHIFT) - ('a' - 'A');
83 /* Shift modifier for control characters and SPC is ignored. */
84 else if ((c & ~CHAR_MODIFIER_MASK) <= 0x20)
85 c &= ~CHAR_SHIFT;
87 if (c & CHAR_CTL)
89 /* Simulate the code in lread.c. */
90 /* Allow `\C- ' and `\C-?'. */
91 if ((c & 0377) == ' ')
92 c &= ~0177 & ~ CHAR_CTL;
93 else if ((c & 0377) == '?')
94 c = 0177 | (c & ~0177 & ~CHAR_CTL);
95 /* ASCII control chars are made from letters (both cases),
96 as well as the non-letters within 0100...0137. */
97 else if ((c & 0137) >= 0101 && (c & 0137) <= 0132)
98 c &= (037 | (~0177 & ~CHAR_CTL));
99 else if ((c & 0177) >= 0100 && (c & 0177) <= 0137)
100 c &= (037 | (~0177 & ~CHAR_CTL));
102 #if 0 /* This is outside the scope of this function. (bug#4751) */
103 if (c & CHAR_META)
105 /* Move the meta bit to the right place for a string. */
106 c = (c & ~CHAR_META) | 0x80;
108 #endif
110 return c;
114 /* Store multibyte form of character C at P. If C has modifier bits,
115 handle them appropriately. */
118 char_string (unsigned int c, unsigned char *p)
120 int bytes;
122 if (c & CHAR_MODIFIER_MASK)
124 c = char_resolve_modifier_mask (c);
125 /* If C still has any modifier bits, just ignore it. */
126 c &= ~CHAR_MODIFIER_MASK;
129 if (c <= MAX_3_BYTE_CHAR)
131 bytes = CHAR_STRING (c, p);
133 else if (c <= MAX_4_BYTE_CHAR)
135 p[0] = (0xF0 | (c >> 18));
136 p[1] = (0x80 | ((c >> 12) & 0x3F));
137 p[2] = (0x80 | ((c >> 6) & 0x3F));
138 p[3] = (0x80 | (c & 0x3F));
139 bytes = 4;
141 else if (c <= MAX_5_BYTE_CHAR)
143 p[0] = 0xF8;
144 p[1] = (0x80 | ((c >> 18) & 0x0F));
145 p[2] = (0x80 | ((c >> 12) & 0x3F));
146 p[3] = (0x80 | ((c >> 6) & 0x3F));
147 p[4] = (0x80 | (c & 0x3F));
148 bytes = 5;
150 else if (c <= MAX_CHAR)
152 c = CHAR_TO_BYTE8 (c);
153 bytes = BYTE8_STRING (c, p);
155 else
156 error ("Invalid character: %x", c);
158 return bytes;
162 /* Return a character whose multibyte form is at P. If LEN is not
163 NULL, it must be a pointer to integer. In that case, set *LEN to
164 the byte length of the multibyte form. If ADVANCED is not NULL, it
165 must be a pointer to unsigned char. In that case, set *ADVANCED to
166 the ending address (i.e., the starting address of the next
167 character) of the multibyte form. */
170 string_char (const unsigned char *p, const unsigned char **advanced, int *len)
172 int c;
173 const unsigned char *saved_p = p;
175 if (*p < 0x80 || ! (*p & 0x20) || ! (*p & 0x10))
177 c = STRING_CHAR_ADVANCE (p);
179 else if (! (*p & 0x08))
181 c = ((((p)[0] & 0xF) << 18)
182 | (((p)[1] & 0x3F) << 12)
183 | (((p)[2] & 0x3F) << 6)
184 | ((p)[3] & 0x3F));
185 p += 4;
187 else
189 c = ((((p)[1] & 0x3F) << 18)
190 | (((p)[2] & 0x3F) << 12)
191 | (((p)[3] & 0x3F) << 6)
192 | ((p)[4] & 0x3F));
193 p += 5;
196 if (len)
197 *len = p - saved_p;
198 if (advanced)
199 *advanced = p;
200 return c;
204 /* Translate character C by translation table TABLE. If no translation is
205 found in TABLE, return the untranslated character. If TABLE is a list,
206 elements are char tables. In that case, recursively translate C by all the
207 tables in the list. */
210 translate_char (Lisp_Object table, int c)
212 if (CHAR_TABLE_P (table))
214 Lisp_Object ch;
216 ch = CHAR_TABLE_REF (table, c);
217 if (CHARACTERP (ch))
218 c = XINT (ch);
220 else
222 for (; CONSP (table); table = XCDR (table))
223 c = translate_char (XCAR (table), c);
225 return c;
228 /* Convert ASCII or 8-bit character C to unibyte. If C is none of
229 them, return (C & 0xFF). */
232 multibyte_char_to_unibyte (int c)
234 if (c < 0x80)
235 return c;
236 if (CHAR_BYTE8_P (c))
237 return CHAR_TO_BYTE8 (c);
238 return (c & 0xFF);
241 /* Like multibyte_char_to_unibyte, but return -1 if C is not supported
242 by charset_unibyte. */
245 multibyte_char_to_unibyte_safe (int c)
247 if (c < 0x80)
248 return c;
249 if (CHAR_BYTE8_P (c))
250 return CHAR_TO_BYTE8 (c);
251 return -1;
254 DEFUN ("characterp", Fcharacterp, Scharacterp, 1, 2, 0,
255 doc: /* Return non-nil if OBJECT is a character.
256 In Emacs Lisp, characters are represented by character codes, which
257 are non-negative integers. The function `max-char' returns the
258 maximum character code.
259 usage: (characterp OBJECT) */)
260 (Lisp_Object object, Lisp_Object ignore)
262 return (CHARACTERP (object) ? Qt : Qnil);
265 DEFUN ("max-char", Fmax_char, Smax_char, 0, 0, 0,
266 doc: /* Return the character of the maximum code. */)
267 (void)
269 return make_number (MAX_CHAR);
272 DEFUN ("unibyte-char-to-multibyte", Funibyte_char_to_multibyte,
273 Sunibyte_char_to_multibyte, 1, 1, 0,
274 doc: /* Convert the byte CH to multibyte character. */)
275 (Lisp_Object ch)
277 int c;
279 CHECK_CHARACTER (ch);
280 c = XFASTINT (ch);
281 if (c >= 0x100)
282 error ("Not a unibyte character: %d", c);
283 MAKE_CHAR_MULTIBYTE (c);
284 return make_number (c);
287 DEFUN ("multibyte-char-to-unibyte", Fmultibyte_char_to_unibyte,
288 Smultibyte_char_to_unibyte, 1, 1, 0,
289 doc: /* Convert the multibyte character CH to a byte.
290 If the multibyte character does not represent a byte, return -1. */)
291 (Lisp_Object ch)
293 int cm;
295 CHECK_CHARACTER (ch);
296 cm = XFASTINT (ch);
297 if (cm < 256)
298 /* Can't distinguish a byte read from a unibyte buffer from
299 a latin1 char, so let's let it slide. */
300 return ch;
301 else
303 int cu = CHAR_TO_BYTE_SAFE (cm);
304 return make_number (cu);
309 /* Return width (columns) of C considering the buffer display table DP. */
311 static ptrdiff_t
312 char_width (int c, struct Lisp_Char_Table *dp)
314 ptrdiff_t width = CHAR_WIDTH (c);
316 if (dp)
318 Lisp_Object disp = DISP_CHAR_VECTOR (dp, c), ch;
319 int i;
321 if (VECTORP (disp))
322 for (i = 0, width = 0; i < ASIZE (disp); i++)
324 ch = AREF (disp, i);
325 if (CHARACTERP (ch))
327 int w = CHAR_WIDTH (XFASTINT (ch));
328 if (INT_ADD_OVERFLOW (width, w))
329 string_overflow ();
330 width += w;
334 return width;
338 DEFUN ("char-width", Fchar_width, Schar_width, 1, 1, 0,
339 doc: /* Return width of CHAR when displayed in the current buffer.
340 The width is measured by how many columns it occupies on the screen.
341 Tab is taken to occupy `tab-width' columns.
342 usage: (char-width CHAR) */)
343 (Lisp_Object ch)
345 int c;
346 ptrdiff_t width;
348 CHECK_CHARACTER (ch);
349 c = XINT (ch);
350 width = char_width (c, buffer_display_table ());
351 return make_number (width);
354 /* Return width of string STR of length LEN when displayed in the
355 current buffer. The width is measured by how many columns it
356 occupies on the screen. If PRECISION > 0, return the width of
357 longest substring that doesn't exceed PRECISION, and set number of
358 characters and bytes of the substring in *NCHARS and *NBYTES
359 respectively. */
361 ptrdiff_t
362 c_string_width (const unsigned char *str, ptrdiff_t len, int precision,
363 ptrdiff_t *nchars, ptrdiff_t *nbytes)
365 ptrdiff_t i = 0, i_byte = 0;
366 ptrdiff_t width = 0;
367 struct Lisp_Char_Table *dp = buffer_display_table ();
369 while (i_byte < len)
371 int bytes;
372 int c = STRING_CHAR_AND_LENGTH (str + i_byte, bytes);
373 ptrdiff_t thiswidth = char_width (c, dp);
375 if (precision <= 0)
377 if (INT_ADD_OVERFLOW (width, thiswidth))
378 string_overflow ();
380 else if (precision - width < thiswidth)
382 *nchars = i;
383 *nbytes = i_byte;
384 return width;
386 i++;
387 i_byte += bytes;
388 width += thiswidth;
391 if (precision > 0)
393 *nchars = i;
394 *nbytes = i_byte;
397 return width;
400 /* Return width of string STR of length LEN when displayed in the
401 current buffer. The width is measured by how many columns it
402 occupies on the screen. */
404 ptrdiff_t
405 strwidth (const char *str, ptrdiff_t len)
407 return c_string_width ((const unsigned char *) str, len, -1, NULL, NULL);
410 /* Return width of Lisp string STRING when displayed in the current
411 buffer. The width is measured by how many columns it occupies on
412 the screen while paying attention to compositions. If PRECISION >
413 0, return the width of longest substring that doesn't exceed
414 PRECISION, and set number of characters and bytes of the substring
415 in *NCHARS and *NBYTES respectively. */
417 ptrdiff_t
418 lisp_string_width (Lisp_Object string, ptrdiff_t precision,
419 ptrdiff_t *nchars, ptrdiff_t *nbytes)
421 ptrdiff_t len = SCHARS (string);
422 /* This set multibyte to 0 even if STRING is multibyte when it
423 contains only ascii and eight-bit-graphic, but that's
424 intentional. */
425 bool multibyte = len < SBYTES (string);
426 unsigned char *str = SDATA (string);
427 ptrdiff_t i = 0, i_byte = 0;
428 ptrdiff_t width = 0;
429 struct Lisp_Char_Table *dp = buffer_display_table ();
431 while (i < len)
433 ptrdiff_t chars, bytes, thiswidth;
434 Lisp_Object val;
435 ptrdiff_t cmp_id;
436 ptrdiff_t ignore, end;
438 if (find_composition (i, -1, &ignore, &end, &val, string)
439 && ((cmp_id = get_composition_id (i, i_byte, end - i, val, string))
440 >= 0))
442 thiswidth = composition_table[cmp_id]->width;
443 chars = end - i;
444 bytes = string_char_to_byte (string, end) - i_byte;
446 else
448 int c;
450 if (multibyte)
452 int cbytes;
453 c = STRING_CHAR_AND_LENGTH (str + i_byte, cbytes);
454 bytes = cbytes;
456 else
457 c = str[i_byte], bytes = 1;
458 chars = 1;
459 thiswidth = char_width (c, dp);
462 if (precision <= 0)
464 #ifdef emacs
465 if (INT_ADD_OVERFLOW (width, thiswidth))
466 string_overflow ();
467 #endif
469 else if (precision - width < thiswidth)
471 *nchars = i;
472 *nbytes = i_byte;
473 return width;
475 i += chars;
476 i_byte += bytes;
477 width += thiswidth;
480 if (precision > 0)
482 *nchars = i;
483 *nbytes = i_byte;
486 return width;
489 DEFUN ("string-width", Fstring_width, Sstring_width, 1, 1, 0,
490 doc: /* Return width of STRING when displayed in the current buffer.
491 Width is measured by how many columns it occupies on the screen.
492 When calculating width of a multibyte character in STRING,
493 only the base leading-code is considered; the validity of
494 the following bytes is not checked. Tabs in STRING are always
495 taken to occupy `tab-width' columns.
496 usage: (string-width STRING) */)
497 (Lisp_Object str)
499 Lisp_Object val;
501 CHECK_STRING (str);
502 XSETFASTINT (val, lisp_string_width (str, -1, NULL, NULL));
503 return val;
506 /* Return the number of characters in the NBYTES bytes at PTR.
507 This works by looking at the contents and checking for multibyte
508 sequences while assuming that there's no invalid sequence.
509 However, if the current buffer has enable-multibyte-characters =
510 nil, we treat each byte as a character. */
512 ptrdiff_t
513 chars_in_text (const unsigned char *ptr, ptrdiff_t nbytes)
515 /* current_buffer is null at early stages of Emacs initialization. */
516 if (current_buffer == 0
517 || NILP (BVAR (current_buffer, enable_multibyte_characters)))
518 return nbytes;
520 return multibyte_chars_in_text (ptr, nbytes);
523 /* Return the number of characters in the NBYTES bytes at PTR.
524 This works by looking at the contents and checking for multibyte
525 sequences while assuming that there's no invalid sequence. It
526 ignores enable-multibyte-characters. */
528 ptrdiff_t
529 multibyte_chars_in_text (const unsigned char *ptr, ptrdiff_t nbytes)
531 const unsigned char *endp = ptr + nbytes;
532 ptrdiff_t chars = 0;
534 while (ptr < endp)
536 int len = MULTIBYTE_LENGTH (ptr, endp);
538 if (len == 0)
539 emacs_abort ();
540 ptr += len;
541 chars++;
544 return chars;
547 /* Parse unibyte text at STR of LEN bytes as a multibyte text, count
548 characters and bytes in it, and store them in *NCHARS and *NBYTES
549 respectively. On counting bytes, pay attention to that 8-bit
550 characters not constructing a valid multibyte sequence are
551 represented by 2-byte in a multibyte text. */
553 void
554 parse_str_as_multibyte (const unsigned char *str, ptrdiff_t len,
555 ptrdiff_t *nchars, ptrdiff_t *nbytes)
557 const unsigned char *endp = str + len;
558 int n;
559 ptrdiff_t chars = 0, bytes = 0;
561 if (len >= MAX_MULTIBYTE_LENGTH)
563 const unsigned char *adjusted_endp = endp - MAX_MULTIBYTE_LENGTH;
564 while (str < adjusted_endp)
566 if (! CHAR_BYTE8_HEAD_P (*str)
567 && (n = MULTIBYTE_LENGTH_NO_CHECK (str)) > 0)
568 str += n, bytes += n;
569 else
570 str++, bytes += 2;
571 chars++;
574 while (str < endp)
576 if (! CHAR_BYTE8_HEAD_P (*str)
577 && (n = MULTIBYTE_LENGTH (str, endp)) > 0)
578 str += n, bytes += n;
579 else
580 str++, bytes += 2;
581 chars++;
584 *nchars = chars;
585 *nbytes = bytes;
586 return;
589 /* Arrange unibyte text at STR of NBYTES bytes as a multibyte text.
590 It actually converts only such 8-bit characters that don't construct
591 a multibyte sequence to multibyte forms of Latin-1 characters. If
592 NCHARS is nonzero, set *NCHARS to the number of characters in the
593 text. It is assured that we can use LEN bytes at STR as a work
594 area and that is enough. Return the number of bytes of the
595 resulting text. */
597 ptrdiff_t
598 str_as_multibyte (unsigned char *str, ptrdiff_t len, ptrdiff_t nbytes,
599 ptrdiff_t *nchars)
601 unsigned char *p = str, *endp = str + nbytes;
602 unsigned char *to;
603 ptrdiff_t chars = 0;
604 int n;
606 if (nbytes >= MAX_MULTIBYTE_LENGTH)
608 unsigned char *adjusted_endp = endp - MAX_MULTIBYTE_LENGTH;
609 while (p < adjusted_endp
610 && ! CHAR_BYTE8_HEAD_P (*p)
611 && (n = MULTIBYTE_LENGTH_NO_CHECK (p)) > 0)
612 p += n, chars++;
614 while (p < endp
615 && ! CHAR_BYTE8_HEAD_P (*p)
616 && (n = MULTIBYTE_LENGTH (p, endp)) > 0)
617 p += n, chars++;
618 if (nchars)
619 *nchars = chars;
620 if (p == endp)
621 return nbytes;
623 to = p;
624 nbytes = endp - p;
625 endp = str + len;
626 memmove (endp - nbytes, p, nbytes);
627 p = endp - nbytes;
629 if (nbytes >= MAX_MULTIBYTE_LENGTH)
631 unsigned char *adjusted_endp = endp - MAX_MULTIBYTE_LENGTH;
632 while (p < adjusted_endp)
634 if (! CHAR_BYTE8_HEAD_P (*p)
635 && (n = MULTIBYTE_LENGTH_NO_CHECK (p)) > 0)
637 while (n--)
638 *to++ = *p++;
640 else
642 int c = *p++;
643 c = BYTE8_TO_CHAR (c);
644 to += CHAR_STRING (c, to);
647 chars++;
649 while (p < endp)
651 if (! CHAR_BYTE8_HEAD_P (*p)
652 && (n = MULTIBYTE_LENGTH (p, endp)) > 0)
654 while (n--)
655 *to++ = *p++;
657 else
659 int c = *p++;
660 c = BYTE8_TO_CHAR (c);
661 to += CHAR_STRING (c, to);
663 chars++;
665 if (nchars)
666 *nchars = chars;
667 return (to - str);
670 /* Parse unibyte string at STR of LEN bytes, and return the number of
671 bytes it may occupy when converted to multibyte string by
672 `str_to_multibyte'. */
674 ptrdiff_t
675 count_size_as_multibyte (const unsigned char *str, ptrdiff_t len)
677 const unsigned char *endp = str + len;
678 ptrdiff_t bytes;
680 for (bytes = 0; str < endp; str++)
682 int n = *str < 0x80 ? 1 : 2;
683 if (INT_ADD_OVERFLOW (bytes, n))
684 string_overflow ();
685 bytes += n;
687 return bytes;
691 /* Convert unibyte text at STR of BYTES bytes to a multibyte text
692 that contains the same single-byte characters. It actually
693 converts all 8-bit characters to multibyte forms. It is assured
694 that we can use LEN bytes at STR as a work area and that is
695 enough. */
697 ptrdiff_t
698 str_to_multibyte (unsigned char *str, ptrdiff_t len, ptrdiff_t bytes)
700 unsigned char *p = str, *endp = str + bytes;
701 unsigned char *to;
703 while (p < endp && *p < 0x80) p++;
704 if (p == endp)
705 return bytes;
706 to = p;
707 bytes = endp - p;
708 endp = str + len;
709 memmove (endp - bytes, p, bytes);
710 p = endp - bytes;
711 while (p < endp)
713 int c = *p++;
715 if (c >= 0x80)
716 c = BYTE8_TO_CHAR (c);
717 to += CHAR_STRING (c, to);
719 return (to - str);
722 /* Arrange multibyte text at STR of LEN bytes as a unibyte text. It
723 actually converts characters in the range 0x80..0xFF to
724 unibyte. */
726 ptrdiff_t
727 str_as_unibyte (unsigned char *str, ptrdiff_t bytes)
729 const unsigned char *p = str, *endp = str + bytes;
730 unsigned char *to;
731 int c, len;
733 while (p < endp)
735 c = *p;
736 len = BYTES_BY_CHAR_HEAD (c);
737 if (CHAR_BYTE8_HEAD_P (c))
738 break;
739 p += len;
741 to = str + (p - str);
742 while (p < endp)
744 c = *p;
745 len = BYTES_BY_CHAR_HEAD (c);
746 if (CHAR_BYTE8_HEAD_P (c))
748 c = STRING_CHAR_ADVANCE (p);
749 *to++ = CHAR_TO_BYTE8 (c);
751 else
753 while (len--) *to++ = *p++;
756 return (to - str);
759 /* Convert eight-bit chars in SRC (in multibyte form) to the
760 corresponding byte and store in DST. CHARS is the number of
761 characters in SRC. The value is the number of bytes stored in DST.
762 Usually, the value is the same as CHARS, but is less than it if SRC
763 contains a non-ASCII, non-eight-bit character. */
765 ptrdiff_t
766 str_to_unibyte (const unsigned char *src, unsigned char *dst, ptrdiff_t chars)
768 ptrdiff_t i;
770 for (i = 0; i < chars; i++)
772 int c = STRING_CHAR_ADVANCE (src);
774 if (CHAR_BYTE8_P (c))
775 c = CHAR_TO_BYTE8 (c);
776 else if (! ASCII_CHAR_P (c))
777 return i;
778 *dst++ = c;
780 return i;
784 static ptrdiff_t
785 string_count_byte8 (Lisp_Object string)
787 bool multibyte = STRING_MULTIBYTE (string);
788 ptrdiff_t nbytes = SBYTES (string);
789 unsigned char *p = SDATA (string);
790 unsigned char *pend = p + nbytes;
791 ptrdiff_t count = 0;
792 int c, len;
794 if (multibyte)
795 while (p < pend)
797 c = *p;
798 len = BYTES_BY_CHAR_HEAD (c);
800 if (CHAR_BYTE8_HEAD_P (c))
801 count++;
802 p += len;
804 else
805 while (p < pend)
807 if (*p++ >= 0x80)
808 count++;
810 return count;
814 Lisp_Object
815 string_escape_byte8 (Lisp_Object string)
817 ptrdiff_t nchars = SCHARS (string);
818 ptrdiff_t nbytes = SBYTES (string);
819 bool multibyte = STRING_MULTIBYTE (string);
820 ptrdiff_t byte8_count;
821 const unsigned char *src, *src_end;
822 unsigned char *dst;
823 Lisp_Object val;
824 int c, len;
826 if (multibyte && nchars == nbytes)
827 return string;
829 byte8_count = string_count_byte8 (string);
831 if (byte8_count == 0)
832 return string;
834 if (multibyte)
836 if ((MOST_POSITIVE_FIXNUM - nchars) / 3 < byte8_count
837 || (STRING_BYTES_BOUND - nbytes) / 2 < byte8_count)
838 string_overflow ();
840 /* Convert 2-byte sequence of byte8 chars to 4-byte octal. */
841 val = make_uninit_multibyte_string (nchars + byte8_count * 3,
842 nbytes + byte8_count * 2);
844 else
846 if ((STRING_BYTES_BOUND - nbytes) / 3 < byte8_count)
847 string_overflow ();
849 /* Convert 1-byte sequence of byte8 chars to 4-byte octal. */
850 val = make_uninit_string (nbytes + byte8_count * 3);
853 src = SDATA (string);
854 src_end = src + nbytes;
855 dst = SDATA (val);
856 if (multibyte)
857 while (src < src_end)
859 c = *src;
860 len = BYTES_BY_CHAR_HEAD (c);
862 if (CHAR_BYTE8_HEAD_P (c))
864 c = STRING_CHAR_ADVANCE (src);
865 c = CHAR_TO_BYTE8 (c);
866 dst += sprintf ((char *) dst, "\\%03o", c);
868 else
869 while (len--) *dst++ = *src++;
871 else
872 while (src < src_end)
874 c = *src++;
875 if (c >= 0x80)
876 dst += sprintf ((char *) dst, "\\%03o", c);
877 else
878 *dst++ = c;
880 return val;
884 DEFUN ("string", Fstring, Sstring, 0, MANY, 0,
885 doc: /*
886 Concatenate all the argument characters and make the result a string.
887 usage: (string &rest CHARACTERS) */)
888 (ptrdiff_t n, Lisp_Object *args)
890 ptrdiff_t i;
891 int c;
892 unsigned char *buf, *p;
893 Lisp_Object str;
894 USE_SAFE_ALLOCA;
896 SAFE_NALLOCA (buf, MAX_MULTIBYTE_LENGTH, n);
897 p = buf;
899 for (i = 0; i < n; i++)
901 CHECK_CHARACTER (args[i]);
902 c = XINT (args[i]);
903 p += CHAR_STRING (c, p);
906 str = make_string_from_bytes ((char *) buf, n, p - buf);
907 SAFE_FREE ();
908 return str;
911 DEFUN ("unibyte-string", Funibyte_string, Sunibyte_string, 0, MANY, 0,
912 doc: /* Concatenate all the argument bytes and make the result a unibyte string.
913 usage: (unibyte-string &rest BYTES) */)
914 (ptrdiff_t n, Lisp_Object *args)
916 ptrdiff_t i;
917 Lisp_Object str;
918 USE_SAFE_ALLOCA;
919 unsigned char *buf = SAFE_ALLOCA (n);
920 unsigned char *p = buf;
922 for (i = 0; i < n; i++)
924 CHECK_RANGED_INTEGER (args[i], 0, 255);
925 *p++ = XINT (args[i]);
928 str = make_string_from_bytes ((char *) buf, n, p - buf);
929 SAFE_FREE ();
930 return str;
933 DEFUN ("char-resolve-modifiers", Fchar_resolve_modifiers,
934 Schar_resolve_modifiers, 1, 1, 0,
935 doc: /* Resolve modifiers in the character CHAR.
936 The value is a character with modifiers resolved into the character
937 code. Unresolved modifiers are kept in the value.
938 usage: (char-resolve-modifiers CHAR) */)
939 (Lisp_Object character)
941 EMACS_INT c;
943 CHECK_NUMBER (character);
944 c = XINT (character);
945 return make_number (char_resolve_modifier_mask (c));
948 DEFUN ("get-byte", Fget_byte, Sget_byte, 0, 2, 0,
949 doc: /* Return a byte value of a character at point.
950 Optional 1st arg POSITION, if non-nil, is a position of a character to get
951 a byte value.
952 Optional 2nd arg STRING, if non-nil, is a string of which first
953 character is a target to get a byte value. In this case, POSITION, if
954 non-nil, is an index of a target character in the string.
956 If the current buffer (or STRING) is multibyte, and the target
957 character is not ASCII nor 8-bit character, an error is signaled. */)
958 (Lisp_Object position, Lisp_Object string)
960 int c;
961 ptrdiff_t pos;
962 unsigned char *p;
964 if (NILP (string))
966 if (NILP (position))
968 p = PT_ADDR;
970 else
972 CHECK_NUMBER_COERCE_MARKER (position);
973 if (XINT (position) < BEGV || XINT (position) >= ZV)
974 args_out_of_range_3 (position, make_number (BEGV), make_number (ZV));
975 pos = XFASTINT (position);
976 p = CHAR_POS_ADDR (pos);
978 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
979 return make_number (*p);
981 else
983 CHECK_STRING (string);
984 if (NILP (position))
986 p = SDATA (string);
988 else
990 CHECK_NATNUM (position);
991 if (XINT (position) >= SCHARS (string))
992 args_out_of_range (string, position);
993 pos = XFASTINT (position);
994 p = SDATA (string) + string_char_to_byte (string, pos);
996 if (! STRING_MULTIBYTE (string))
997 return make_number (*p);
999 c = STRING_CHAR (p);
1000 if (CHAR_BYTE8_P (c))
1001 c = CHAR_TO_BYTE8 (c);
1002 else if (! ASCII_CHAR_P (c))
1003 error ("Not an ASCII nor an 8-bit character: %d", c);
1004 return make_number (c);
1007 #ifdef emacs
1009 void
1010 syms_of_character (void)
1012 DEFSYM (Qcharacterp, "characterp");
1013 DEFSYM (Qauto_fill_chars, "auto-fill-chars");
1015 staticpro (&Vchar_unify_table);
1016 Vchar_unify_table = Qnil;
1018 defsubr (&Smax_char);
1019 defsubr (&Scharacterp);
1020 defsubr (&Sunibyte_char_to_multibyte);
1021 defsubr (&Smultibyte_char_to_unibyte);
1022 defsubr (&Schar_width);
1023 defsubr (&Sstring_width);
1024 defsubr (&Sstring);
1025 defsubr (&Sunibyte_string);
1026 defsubr (&Schar_resolve_modifiers);
1027 defsubr (&Sget_byte);
1029 DEFVAR_LISP ("translation-table-vector", Vtranslation_table_vector,
1030 doc: /*
1031 Vector recording all translation tables ever defined.
1032 Each element is a pair (SYMBOL . TABLE) relating the table to the
1033 symbol naming it. The ID of a translation table is an index into this vector. */);
1034 Vtranslation_table_vector = Fmake_vector (make_number (16), Qnil);
1036 DEFVAR_LISP ("auto-fill-chars", Vauto_fill_chars,
1037 doc: /*
1038 A char-table for characters which invoke auto-filling.
1039 Such characters have value t in this table. */);
1040 Vauto_fill_chars = Fmake_char_table (Qauto_fill_chars, Qnil);
1041 CHAR_TABLE_SET (Vauto_fill_chars, ' ', Qt);
1042 CHAR_TABLE_SET (Vauto_fill_chars, '\n', Qt);
1044 DEFVAR_LISP ("char-width-table", Vchar_width_table,
1045 doc: /*
1046 A char-table for width (columns) of each character. */);
1047 Vchar_width_table = Fmake_char_table (Qnil, make_number (1));
1048 char_table_set_range (Vchar_width_table, 0x80, 0x9F, make_number (4));
1049 char_table_set_range (Vchar_width_table, MAX_5_BYTE_CHAR + 1, MAX_CHAR,
1050 make_number (4));
1052 DEFVAR_LISP ("printable-chars", Vprintable_chars,
1053 doc: /* A char-table for each printable character. */);
1054 Vprintable_chars = Fmake_char_table (Qnil, Qnil);
1055 Fset_char_table_range (Vprintable_chars,
1056 Fcons (make_number (32), make_number (126)), Qt);
1057 Fset_char_table_range (Vprintable_chars,
1058 Fcons (make_number (160),
1059 make_number (MAX_5_BYTE_CHAR)), Qt);
1061 DEFVAR_LISP ("char-script-table", Vchar_script_table,
1062 doc: /* Char table of script symbols.
1063 It has one extra slot whose value is a list of script symbols. */);
1065 /* Intern this now in case it isn't already done.
1066 Setting this variable twice is harmless.
1067 But don't staticpro it here--that is done in alloc.c. */
1068 Qchar_table_extra_slots = intern_c_string ("char-table-extra-slots");
1069 DEFSYM (Qchar_script_table, "char-script-table");
1070 Fput (Qchar_script_table, Qchar_table_extra_slots, make_number (1));
1071 Vchar_script_table = Fmake_char_table (Qchar_script_table, Qnil);
1073 DEFVAR_LISP ("script-representative-chars", Vscript_representative_chars,
1074 doc: /* Alist of scripts vs the representative characters.
1075 Each element is a cons (SCRIPT . CHARS).
1076 SCRIPT is a symbol representing a script or a subgroup of a script.
1077 CHARS is a list or a vector of characters.
1078 If it is a list, all characters in the list are necessary for supporting SCRIPT.
1079 If it is a vector, one of the characters in the vector is necessary.
1080 This variable is used to find a font for a specific script. */);
1081 Vscript_representative_chars = Qnil;
1083 DEFVAR_LISP ("unicode-category-table", Vunicode_category_table,
1084 doc: /* Char table of Unicode's "General Category".
1085 All Unicode characters have one of the following values (symbol):
1086 Lu, Ll, Lt, Lm, Lo, Mn, Mc, Me, Nd, Nl, No, Pc, Pd, Ps, Pe, Pi, Pf, Po,
1087 Sm, Sc, Sk, So, Zs, Zl, Zp, Cc, Cf, Cs, Co, Cn
1088 See The Unicode Standard for the meaning of those values. */);
1089 /* The correct char-table is setup in characters.el. */
1090 Vunicode_category_table = Qnil;
1093 #endif /* emacs */