1 /* Basic multilingual character support.
2 Copyright (C) 1995, 1997, 1998 Electrotechnical Laboratory, JAPAN.
3 Licensed to the Free Software Foundation.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
22 /* At first, see the document in `charset.h' to understand the code in
29 #include <sys/types.h>
43 Lisp_Object Qcharset
, Qascii
, Qcomposition
;
46 /* Declaration of special leading-codes. */
47 int leading_code_composition
; /* for composite characters */
48 int leading_code_private_11
; /* for private DIMENSION1 of 1-column */
49 int leading_code_private_12
; /* for private DIMENSION1 of 2-column */
50 int leading_code_private_21
; /* for private DIMENSION2 of 1-column */
51 int leading_code_private_22
; /* for private DIMENSION2 of 2-column */
53 /* Declaration of special charsets. */
54 int charset_ascii
; /* ASCII */
55 int charset_composition
; /* for a composite character */
56 int charset_latin_iso8859_1
; /* ISO8859-1 (Latin-1) */
57 int charset_jisx0208_1978
; /* JISX0208.1978 (Japanese Kanji old set) */
58 int charset_jisx0208
; /* JISX0208.1983 (Japanese Kanji) */
59 int charset_katakana_jisx0201
; /* JISX0201.Kana (Japanese Katakana) */
60 int charset_latin_jisx0201
; /* JISX0201.Roman (Japanese Roman) */
61 int charset_big5_1
; /* Big5 Level 1 (Chinese Traditional) */
62 int charset_big5_2
; /* Big5 Level 2 (Chinese Traditional) */
64 int min_composite_char
;
66 Lisp_Object Qcharset_table
;
68 /* A char-table containing information of each character set. */
69 Lisp_Object Vcharset_table
;
71 /* A vector of charset symbol indexed by charset-id. This is used
72 only for returning charset symbol from C functions. */
73 Lisp_Object Vcharset_symbol_table
;
75 /* A list of charset symbols ever defined. */
76 Lisp_Object Vcharset_list
;
78 /* Vector of translation table ever defined.
79 ID of a translation table is used to index this vector. */
80 Lisp_Object Vtranslation_table_vector
;
82 /* A char-table for characters which may invoke auto-filling. */
83 Lisp_Object Vauto_fill_chars
;
85 Lisp_Object Qauto_fill_chars
;
87 /* Tables used by macros BYTES_BY_CHAR_HEAD and WIDTH_BY_CHAR_HEAD. */
88 int bytes_by_char_head
[256];
89 int width_by_char_head
[256];
91 /* Mapping table from ISO2022's charset (specified by DIMENSION,
92 CHARS, and FINAL-CHAR) to Emacs' charset. */
93 int iso_charset_table
[2][2][128];
95 /* Table of pointers to the structure `cmpchar_info' indexed by
97 struct cmpchar_info
**cmpchar_table
;
98 /* The current size of `cmpchar_table'. */
99 static int cmpchar_table_size
;
100 /* Number of the current composite characters. */
103 /* Variables used locally in the macro FETCH_MULTIBYTE_CHAR. */
104 unsigned char *_fetch_multibyte_char_p
;
105 int _fetch_multibyte_char_len
;
107 /* Offset to add to a non-ASCII value when inserting it. */
108 int nonascii_insert_offset
;
110 /* Translation table for converting non-ASCII unibyte characters
111 to multibyte codes, or nil. */
112 Lisp_Object Vnonascii_translation_table
;
114 /* List of all possible generic characters. */
115 Lisp_Object Vgeneric_character_list
;
117 #define min(X, Y) ((X) < (Y) ? (X) : (Y))
118 #define max(X, Y) ((X) > (Y) ? (X) : (Y))
121 invalid_character (c
)
124 error ("Invalid character: 0%o, %d, 0x%x", c
, c
, c
);
128 /* Set STR a pointer to the multi-byte form of the character C. If C
129 is not a composite character, the multi-byte form is set in WORKBUF
130 and STR points WORKBUF. The caller should allocate at least 4-byte
131 area at WORKBUF in advance. Returns the length of the multi-byte
132 form. If C is an invalid character to have a multi-byte form,
135 Use macro `CHAR_STRING (C, WORKBUF, STR)' instead of calling this
136 function directly if C can be an ASCII character. */
139 non_ascii_char_to_string (c
, workbuf
, str
)
141 unsigned char *workbuf
, **str
;
145 if (c
& CHAR_MODIFIER_MASK
) /* This includes the case C is negative. */
147 /* Multibyte character can't have a modifier bit. */
148 if (! SINGLE_BYTE_CHAR_P ((c
& ~CHAR_MODIFIER_MASK
)))
149 invalid_character (c
);
151 /* For Meta, Shift, and Control modifiers, we need special care. */
154 /* Move the meta bit to the right place for a string. */
155 c
= (c
& ~CHAR_META
) | 0x80;
159 /* Shift modifier is valid only with [A-Za-z]. */
160 if ((c
& 0377) >= 'A' && (c
& 0377) <= 'Z')
162 else if ((c
& 0377) >= 'a' && (c
& 0377) <= 'z')
163 c
= (c
& ~CHAR_SHIFT
) - ('a' - 'A');
167 /* Simulate the code in lread.c. */
168 /* Allow `\C- ' and `\C-?'. */
169 if (c
== (CHAR_CTL
| ' '))
171 else if (c
== (CHAR_CTL
| '?'))
173 /* ASCII control chars are made from letters (both cases),
174 as well as the non-letters within 0100...0137. */
175 else if ((c
& 0137) >= 0101 && (c
& 0137) <= 0132)
176 c
&= (037 | (~0177 & ~CHAR_CTL
));
177 else if ((c
& 0177) >= 0100 && (c
& 0177) <= 0137)
178 c
&= (037 | (~0177 & ~CHAR_CTL
));
181 /* If C still has any modifier bits, it is an invalid character. */
182 if (c
& CHAR_MODIFIER_MASK
)
183 invalid_character (c
);
191 invalid_character (c
);
193 if (COMPOSITE_CHAR_P (c
))
195 int cmpchar_id
= COMPOSITE_CHAR_ID (c
);
197 if (cmpchar_id
< n_cmpchars
)
199 *str
= cmpchar_table
[cmpchar_id
]->data
;
200 return cmpchar_table
[cmpchar_id
]->len
;
204 invalid_character (c
);
208 SPLIT_NON_ASCII_CHAR (c
, charset
, c1
, c2
);
210 || ! CHARSET_DEFINED_P (charset
)
211 || c1
>= 0 && c1
< 32
212 || c2
>= 0 && c2
< 32)
213 invalid_character (c
);
216 *workbuf
++ = CHARSET_LEADING_CODE_BASE (charset
);
217 if (*workbuf
= CHARSET_LEADING_CODE_EXT (charset
))
219 *workbuf
++ = c1
| 0x80;
221 *workbuf
++ = c2
| 0x80;
223 return (workbuf
- *str
);
226 /* Return a non-ASCII character of which multi-byte form is at STR of
227 length LEN. If ACTUAL_LEN is not NULL, the actual length of the
228 multibyte form is set to the address ACTUAL_LEN.
230 If exclude_tail_garbage is nonzero, ACTUAL_LEN excludes gabage
231 bytes following the non-ASCII character.
233 Use macro `STRING_CHAR (STR, LEN)' instead of calling this function
234 directly if STR can hold an ASCII character. */
237 string_to_non_ascii_char (str
, len
, actual_len
, exclude_tail_garbage
)
238 const unsigned char *str
;
239 int len
, *actual_len
, exclude_tail_garbage
;
242 unsigned char c1
, c2
;
244 const unsigned char *begp
= str
;
249 if (BASE_LEADING_CODE_P (c
))
251 while (bytes
< len
&& ! CHAR_HEAD_P (begp
[bytes
])) bytes
++;
253 if (c
== LEADING_CODE_COMPOSITION
)
255 int cmpchar_id
= str_cmpchar_id (begp
, bytes
);
259 c
= MAKE_COMPOSITE_CHAR (cmpchar_id
);
260 str
+= cmpchar_table
[cmpchar_id
]->len
- 1;
267 const unsigned char *endp
= begp
+ bytes
;
268 int charset
= c
, c1
, c2
= 0;
270 if (str
>= endp
) break;
271 if (c
>= LEADING_CODE_PRIVATE_11
&& c
<= LEADING_CODE_PRIVATE_22
)
277 c1
= charset
, charset
= c
;
281 if (CHARSET_DEFINED_P (charset
)
282 && CHARSET_DIMENSION (charset
) == 2
285 c
= MAKE_NON_ASCII_CHAR (charset
, c1
, c2
);
290 *actual_len
= exclude_tail_garbage
? str
- begp
: bytes
;
294 /* Return the length of the multi-byte form at string STR of length LEN. */
296 multibyte_form_length (str
, len
)
297 const unsigned char *str
;
302 if (BASE_LEADING_CODE_P (*str
))
303 while (bytes
< len
&& ! CHAR_HEAD_P (str
[bytes
])) bytes
++;
308 /* Check if string STR of length LEN contains valid multi-byte form of
309 a character. If valid, charset and position codes of the character
310 is set at *CHARSET, *C1, and *C2, and return 0. If not valid,
311 return -1. This should be used only in the macro SPLIT_STRING
312 which checks range of STR in advance. */
315 split_non_ascii_string (str
, len
, charset
, c1
, c2
)
316 register const unsigned char *str
;
317 register unsigned char *c1
, *c2
;
318 register int len
, *charset
;
320 register unsigned int cs
= *str
++;
322 if (cs
== LEADING_CODE_COMPOSITION
)
324 int cmpchar_id
= str_cmpchar_id (str
- 1, len
);
328 *charset
= cs
, *c1
= cmpchar_id
>> 7, *c2
= cmpchar_id
& 0x7F;
330 else if ((cs
< LEADING_CODE_PRIVATE_11
|| (cs
= *str
++) >= 0xA0)
331 && CHARSET_DEFINED_P (cs
))
336 *c1
= (*str
++) & 0x7F;
337 if (CHARSET_DIMENSION (cs
) == 2)
341 *c2
= (*str
++) & 0x7F;
349 /* Translate character C by translation table TABLE. If C
350 is negative, translate a character specified by CHARSET, C1, and C2
351 (C1 and C2 are code points of the character). If no translation is
352 found in TABLE, return C. */
354 translate_char (table
, c
, charset
, c1
, c2
)
356 int c
, charset
, c1
, c2
;
359 int alt_charset
, alt_c1
, alt_c2
, dimension
;
361 if (c
< 0) c
= MAKE_CHAR (charset
, c1
, c2
);
362 if (!CHAR_TABLE_P (table
)
363 || (ch
= Faref (table
, make_number (c
)), !INTEGERP (ch
))
367 SPLIT_CHAR (XFASTINT (ch
), alt_charset
, alt_c1
, alt_c2
);
368 dimension
= CHARSET_DIMENSION (alt_charset
);
369 if (dimension
== 1 && alt_c1
> 0 || dimension
== 2 && alt_c2
> 0)
370 /* CH is not a generic character, just return it. */
371 return XFASTINT (ch
);
373 /* Since CH is a generic character, we must return a specific
374 charater which has the same position codes as C from CH. */
376 SPLIT_CHAR (c
, charset
, c1
, c2
);
377 if (dimension
!= CHARSET_DIMENSION (charset
))
378 /* We can't make such a character because of dimension mismatch. */
380 return MAKE_CHAR (alt_charset
, c1
, c2
);
383 /* Convert the unibyte character C to multibyte based on
384 Vnonascii_translation_table or nonascii_insert_offset. If they can't
385 convert C to a valid multibyte character, convert it based on
386 DEFAULT_NONASCII_INSERT_OFFSET which makes C a Latin-1 character. */
389 unibyte_char_to_multibyte (c
)
392 if (c
< 0400 && c
>= 0200)
396 if (! NILP (Vnonascii_translation_table
))
398 c
= XINT (Faref (Vnonascii_translation_table
, make_number (c
)));
399 if (c
>= 0400 && ! VALID_MULTIBYTE_CHAR_P (c
))
400 c
= c_save
+ DEFAULT_NONASCII_INSERT_OFFSET
;
402 else if (c
>= 0240 && nonascii_insert_offset
> 0)
404 c
+= nonascii_insert_offset
;
405 if (c
< 0400 || ! VALID_MULTIBYTE_CHAR_P (c
))
406 c
= c_save
+ DEFAULT_NONASCII_INSERT_OFFSET
;
409 c
= c_save
+ DEFAULT_NONASCII_INSERT_OFFSET
;
415 /* Convert the multibyte character C to unibyte 8-bit character based
416 on Vnonascii_translation_table or nonascii_insert_offset. If
417 REV_TBL is non-nil, it should be a reverse table of
418 Vnonascii_translation_table, i.e. what given by:
419 Fchar_table_extra_slot (Vnonascii_translation_table, make_number (0)) */
422 multibyte_char_to_unibyte (c
, rev_tbl
)
426 if (!SINGLE_BYTE_CHAR_P (c
))
430 if (! CHAR_TABLE_P (rev_tbl
)
431 && CHAR_TABLE_P (Vnonascii_translation_table
))
432 rev_tbl
= Fchar_table_extra_slot (Vnonascii_translation_table
,
434 if (CHAR_TABLE_P (rev_tbl
))
437 temp
= Faref (rev_tbl
, make_number (c
));
441 c
= (c_save
& 0177) + 0200;
445 if (nonascii_insert_offset
> 0)
446 c
-= nonascii_insert_offset
;
447 if (c
< 128 || c
>= 256)
448 c
= (c_save
& 0177) + 0200;
456 /* Update the table Vcharset_table with the given arguments (see the
457 document of `define-charset' for the meaning of each argument).
458 Several other table contents are also updated. The caller should
459 check the validity of CHARSET-ID and the remaining arguments in
463 update_charset_table (charset_id
, dimension
, chars
, width
, direction
,
464 iso_final_char
, iso_graphic_plane
,
465 short_name
, long_name
, description
)
466 Lisp_Object charset_id
, dimension
, chars
, width
, direction
;
467 Lisp_Object iso_final_char
, iso_graphic_plane
;
468 Lisp_Object short_name
, long_name
, description
;
470 int charset
= XINT (charset_id
);
472 unsigned char leading_code_base
, leading_code_ext
;
474 if (NILP (CHARSET_TABLE_ENTRY (charset
)))
475 CHARSET_TABLE_ENTRY (charset
)
476 = Fmake_vector (make_number (CHARSET_MAX_IDX
), Qnil
);
478 /* Get byte length of multibyte form, base leading-code, and
479 extended leading-code of the charset. See the comment under the
480 title "GENERAL NOTE on CHARACTER SET (CHARSET)" in charset.h. */
481 bytes
= XINT (dimension
);
482 if (charset
< MIN_CHARSET_PRIVATE_DIMENSION1
)
484 /* Official charset, it doesn't have an extended leading-code. */
485 if (charset
!= CHARSET_ASCII
)
486 bytes
+= 1; /* For a base leading-code. */
487 leading_code_base
= charset
;
488 leading_code_ext
= 0;
492 /* Private charset. */
493 bytes
+= 2; /* For base and extended leading-codes. */
495 = (charset
< LEADING_CODE_EXT_12
496 ? LEADING_CODE_PRIVATE_11
497 : (charset
< LEADING_CODE_EXT_21
498 ? LEADING_CODE_PRIVATE_12
499 : (charset
< LEADING_CODE_EXT_22
500 ? LEADING_CODE_PRIVATE_21
501 : LEADING_CODE_PRIVATE_22
)));
502 leading_code_ext
= charset
;
505 if (BYTES_BY_CHAR_HEAD (leading_code_base
) != bytes
)
506 error ("Invalid dimension for the charset-ID %d", charset
);
508 CHARSET_TABLE_INFO (charset
, CHARSET_ID_IDX
) = charset_id
;
509 CHARSET_TABLE_INFO (charset
, CHARSET_BYTES_IDX
) = make_number (bytes
);
510 CHARSET_TABLE_INFO (charset
, CHARSET_DIMENSION_IDX
) = dimension
;
511 CHARSET_TABLE_INFO (charset
, CHARSET_CHARS_IDX
) = chars
;
512 CHARSET_TABLE_INFO (charset
, CHARSET_WIDTH_IDX
) = width
;
513 CHARSET_TABLE_INFO (charset
, CHARSET_DIRECTION_IDX
) = direction
;
514 CHARSET_TABLE_INFO (charset
, CHARSET_LEADING_CODE_BASE_IDX
)
515 = make_number (leading_code_base
);
516 CHARSET_TABLE_INFO (charset
, CHARSET_LEADING_CODE_EXT_IDX
)
517 = make_number (leading_code_ext
);
518 CHARSET_TABLE_INFO (charset
, CHARSET_ISO_FINAL_CHAR_IDX
) = iso_final_char
;
519 CHARSET_TABLE_INFO (charset
, CHARSET_ISO_GRAPHIC_PLANE_IDX
)
521 CHARSET_TABLE_INFO (charset
, CHARSET_SHORT_NAME_IDX
) = short_name
;
522 CHARSET_TABLE_INFO (charset
, CHARSET_LONG_NAME_IDX
) = long_name
;
523 CHARSET_TABLE_INFO (charset
, CHARSET_DESCRIPTION_IDX
) = description
;
524 CHARSET_TABLE_INFO (charset
, CHARSET_PLIST_IDX
) = Qnil
;
527 /* If we have already defined a charset which has the same
528 DIMENSION, CHARS and ISO-FINAL-CHAR but the different
529 DIRECTION, we must update the entry REVERSE-CHARSET of both
530 charsets. If there's no such charset, the value of the entry
534 for (i
= 0; i
<= MAX_CHARSET
; i
++)
535 if (!NILP (CHARSET_TABLE_ENTRY (i
)))
537 if (CHARSET_DIMENSION (i
) == XINT (dimension
)
538 && CHARSET_CHARS (i
) == XINT (chars
)
539 && CHARSET_ISO_FINAL_CHAR (i
) == XINT (iso_final_char
)
540 && CHARSET_DIRECTION (i
) != XINT (direction
))
542 CHARSET_TABLE_INFO (charset
, CHARSET_REVERSE_CHARSET_IDX
)
544 CHARSET_TABLE_INFO (i
, CHARSET_REVERSE_CHARSET_IDX
) = charset_id
;
549 /* No such a charset. */
550 CHARSET_TABLE_INFO (charset
, CHARSET_REVERSE_CHARSET_IDX
)
554 if (charset
!= CHARSET_ASCII
555 && charset
< MIN_CHARSET_PRIVATE_DIMENSION1
)
557 width_by_char_head
[leading_code_base
] = XINT (width
);
559 /* Update table emacs_code_class. */
560 emacs_code_class
[charset
] = (bytes
== 2
561 ? EMACS_leading_code_2
563 ? EMACS_leading_code_3
564 : EMACS_leading_code_4
));
567 /* Update table iso_charset_table. */
568 if (ISO_CHARSET_TABLE (dimension
, chars
, iso_final_char
) < 0)
569 ISO_CHARSET_TABLE (dimension
, chars
, iso_final_char
) = charset
;
574 /* Return charset id of CHARSET_SYMBOL, or return -1 if CHARSET_SYMBOL
577 get_charset_id (charset_symbol
)
578 Lisp_Object charset_symbol
;
583 return ((SYMBOLP (charset_symbol
)
584 && (val
= Fget (charset_symbol
, Qcharset
), VECTORP (val
))
585 && (charset
= XINT (XVECTOR (val
)->contents
[CHARSET_ID_IDX
]),
586 CHARSET_VALID_P (charset
)))
590 /* Return an identification number for a new private charset of
591 DIMENSION and WIDTH. If there's no more room for the new charset,
594 get_new_private_charset_id (dimension
, width
)
595 int dimension
, width
;
597 int charset
, from
, to
;
602 from
= LEADING_CODE_EXT_11
, to
= LEADING_CODE_EXT_12
;
604 from
= LEADING_CODE_EXT_12
, to
= LEADING_CODE_EXT_21
;
609 from
= LEADING_CODE_EXT_21
, to
= LEADING_CODE_EXT_22
;
611 from
= LEADING_CODE_EXT_22
, to
= LEADING_CODE_EXT_MAX
+ 1;
614 for (charset
= from
; charset
< to
; charset
++)
615 if (!CHARSET_DEFINED_P (charset
)) break;
617 return make_number (charset
< to
? charset
: 0);
620 DEFUN ("define-charset", Fdefine_charset
, Sdefine_charset
, 3, 3, 0,
621 "Define CHARSET-ID as the identification number of CHARSET with INFO-VECTOR.\n\
622 If CHARSET-ID is nil, it is decided automatically, which means CHARSET is\n\
623 treated as a private charset.\n\
624 INFO-VECTOR is a vector of the format:\n\
625 [DIMENSION CHARS WIDTH DIRECTION ISO-FINAL-CHAR ISO-GRAPHIC-PLANE\n\
626 SHORT-NAME LONG-NAME DESCRIPTION]\n\
627 The meanings of each elements is as follows:\n\
628 DIMENSION (integer) is the number of bytes to represent a character: 1 or 2.\n\
629 CHARS (integer) is the number of characters in a dimension: 94 or 96.\n\
630 WIDTH (integer) is the number of columns a character in the charset\n\
631 occupies on the screen: one of 0, 1, and 2.\n\
633 DIRECTION (integer) is the rendering direction of characters in the\n\
634 charset when rendering. If 0, render from left to right, else\n\
635 render from right to left.\n\
637 ISO-FINAL-CHAR (character) is the final character of the\n\
638 corresponding ISO 2022 charset.\n\
640 ISO-GRAPHIC-PLANE (integer) is the graphic plane to be invoked\n\
641 while encoding to variants of ISO 2022 coding system, one of the\n\
642 following: 0/graphic-plane-left(GL), 1/graphic-plane-right(GR).\n\
644 SHORT-NAME (string) is the short name to refer to the charset.\n\
646 LONG-NAME (string) is the long name to refer to the charset.\n\
648 DESCRIPTION (string) is the description string of the charset.")
649 (charset_id
, charset_symbol
, info_vector
)
650 Lisp_Object charset_id
, charset_symbol
, info_vector
;
654 if (!NILP (charset_id
))
655 CHECK_NUMBER (charset_id
, 0);
656 CHECK_SYMBOL (charset_symbol
, 1);
657 CHECK_VECTOR (info_vector
, 2);
659 if (! NILP (charset_id
))
661 if (! CHARSET_VALID_P (XINT (charset_id
)))
662 error ("Invalid CHARSET: %d", XINT (charset_id
));
663 else if (CHARSET_DEFINED_P (XINT (charset_id
)))
664 error ("Already defined charset: %d", XINT (charset_id
));
667 vec
= XVECTOR (info_vector
)->contents
;
668 if (XVECTOR (info_vector
)->size
!= 9
669 || !INTEGERP (vec
[0]) || !(XINT (vec
[0]) == 1 || XINT (vec
[0]) == 2)
670 || !INTEGERP (vec
[1]) || !(XINT (vec
[1]) == 94 || XINT (vec
[1]) == 96)
671 || !INTEGERP (vec
[2]) || !(XINT (vec
[2]) == 1 || XINT (vec
[2]) == 2)
672 || !INTEGERP (vec
[3]) || !(XINT (vec
[3]) == 0 || XINT (vec
[3]) == 1)
673 || !INTEGERP (vec
[4]) || !(XINT (vec
[4]) >= '0' && XINT (vec
[4]) <= '~')
674 || !INTEGERP (vec
[5]) || !(XINT (vec
[5]) == 0 || XINT (vec
[5]) == 1)
677 || !STRINGP (vec
[8]))
678 error ("Invalid info-vector argument for defining charset %s",
679 XSYMBOL (charset_symbol
)->name
->data
);
681 if (NILP (charset_id
))
683 charset_id
= get_new_private_charset_id (XINT (vec
[0]), XINT (vec
[2]));
684 if (XINT (charset_id
) == 0)
685 error ("There's no room for a new private charset %s",
686 XSYMBOL (charset_symbol
)->name
->data
);
689 update_charset_table (charset_id
, vec
[0], vec
[1], vec
[2], vec
[3],
690 vec
[4], vec
[5], vec
[6], vec
[7], vec
[8]);
691 Fput (charset_symbol
, Qcharset
, CHARSET_TABLE_ENTRY (XINT (charset_id
)));
692 CHARSET_SYMBOL (XINT (charset_id
)) = charset_symbol
;
693 Vcharset_list
= Fcons (charset_symbol
, Vcharset_list
);
697 DEFUN ("generic-character-list", Fgeneric_character_list
,
698 Sgeneric_character_list
, 0, 0, 0,
699 "Return a list of all possible generic characters.\n\
700 It includes a generic character for a charset not yet defined.")
703 return Vgeneric_character_list
;
706 DEFUN ("get-unused-iso-final-char", Fget_unused_iso_final_char
,
707 Sget_unused_iso_final_char
, 2, 2, 0,
708 "Return an unsed ISO's final char for a charset of DIMENISION and CHARS.\n\
709 DIMENSION is the number of bytes to represent a character: 1 or 2.\n\
710 CHARS is the number of characters in a dimension: 94 or 96.\n\
712 This final char is for private use, thus the range is `0' (48) .. `?' (63).\n\
713 If there's no unused final char for the specified kind of charset,\n\
716 Lisp_Object dimension
, chars
;
720 CHECK_NUMBER (dimension
, 0);
721 CHECK_NUMBER (chars
, 1);
722 if (XINT (dimension
) != 1 && XINT (dimension
) != 2)
723 error ("Invalid charset dimension %d, it should be 1 or 2",
725 if (XINT (chars
) != 94 && XINT (chars
) != 96)
726 error ("Invalid charset chars %d, it should be 94 or 96",
728 for (final_char
= '0'; final_char
<= '?'; final_char
++)
730 if (ISO_CHARSET_TABLE (dimension
, chars
, make_number (final_char
)) < 0)
733 return (final_char
<= '?' ? make_number (final_char
) : Qnil
);
736 DEFUN ("declare-equiv-charset", Fdeclare_equiv_charset
, Sdeclare_equiv_charset
,
738 "Declare a charset of DIMENSION, CHARS, FINAL-CHAR is the same as CHARSET.\n\
739 CHARSET should be defined by `defined-charset' in advance.")
740 (dimension
, chars
, final_char
, charset_symbol
)
741 Lisp_Object dimension
, chars
, final_char
, charset_symbol
;
745 CHECK_NUMBER (dimension
, 0);
746 CHECK_NUMBER (chars
, 1);
747 CHECK_NUMBER (final_char
, 2);
748 CHECK_SYMBOL (charset_symbol
, 3);
750 if (XINT (dimension
) != 1 && XINT (dimension
) != 2)
751 error ("Invalid DIMENSION %d, it should be 1 or 2", XINT (dimension
));
752 if (XINT (chars
) != 94 && XINT (chars
) != 96)
753 error ("Invalid CHARS %d, it should be 94 or 96", XINT (chars
));
754 if (XINT (final_char
) < '0' || XFASTINT (final_char
) > '~')
755 error ("Invalid FINAL-CHAR %c, it should be `0'..`~'", XINT (chars
));
756 if ((charset
= get_charset_id (charset_symbol
)) < 0)
757 error ("Invalid charset %s", XSYMBOL (charset_symbol
)->name
->data
);
759 ISO_CHARSET_TABLE (dimension
, chars
, final_char
) = charset
;
763 /* Return number of different charsets in STR of length LEN. In
764 addition, for each found charset N, CHARSETS[N] is set 1. The
765 caller should allocate CHARSETS (MAX_CHARSET + 1 elements) in advance.
766 It may lookup a translation table TABLE if supplied.
768 If CMPCHARP is nonzero and some composite character is found,
769 CHARSETS[128] is also set 1 and the returned number is incremented
772 If MULTIBYTE is zero, do not check multibyte characters, i.e. if
773 any ASCII codes (7-bit) are found, CHARSET[0] is set to 1, if any
774 8-bit codes are found CHARSET[1] is set to 1. */
777 find_charset_in_str (str
, len
, charsets
, table
, cmpcharp
, multibyte
)
784 register int num
= 0, c
;
788 unsigned char *endp
= str
+ len
;
791 while (str
< endp
&& maskbits
!= 3)
792 maskbits
|= (*str
++ < 0x80 ? 1 : 2);
806 if (! CHAR_TABLE_P (table
))
814 if (c
== LEADING_CODE_COMPOSITION
)
816 int cmpchar_id
= str_cmpchar_id (str
, len
);
821 struct cmpchar_info
*cmp_p
= cmpchar_table
[cmpchar_id
];
824 for (i
= 0; i
< cmp_p
->glyph_len
; i
++)
829 if ((c
= translate_char (table
, c
, 0, 0, 0)) < 0)
832 if ((charset
= CHAR_CHARSET (c
)) < 0)
833 charset
= CHARSET_ASCII
;
834 if (!charsets
[charset
])
836 charsets
[charset
] = 1;
842 if (cmpcharp
&& !charsets
[CHARSET_COMPOSITION
])
844 charsets
[CHARSET_COMPOSITION
] = 1;
850 charset
= 1; /* This leads to `unknown' charset. */
855 c
= STRING_CHAR_AND_LENGTH (str
, len
, bytes
);
858 int c1
= translate_char (table
, c
, 0, 0, 0);
862 charset
= CHAR_CHARSET (c
);
865 if (!charsets
[charset
])
867 charsets
[charset
] = 1;
876 DEFUN ("find-charset-region", Ffind_charset_region
, Sfind_charset_region
,
878 "Return a list of charsets in the region between BEG and END.\n\
879 BEG and END are buffer positions.\n\
880 If the region contains any composite character,\n\
881 `composition' is included in the returned list.\n\
882 Optional arg TABLE if non-nil is a translation table to look up.\n\
884 If the region contains invalid multiybte characters,\n\
885 `unknown' is included in the returned list.\n\
887 If the current buffer is unibyte, the returned list contains\n\
888 `ascii' if any 7-bit characters are found,\n\
889 and `unknown' if any 8-bit characters are found.")
891 Lisp_Object beg
, end
, table
;
893 int charsets
[MAX_CHARSET
+ 1];
894 int from
, from_byte
, to
, stop
, stop_byte
, i
;
897 int multibyte
= !NILP (current_buffer
->enable_multibyte_characters
);
899 validate_region (&beg
, &end
);
900 from
= XFASTINT (beg
);
901 stop
= to
= XFASTINT (end
);
903 if (from
< GPT
&& GPT
< to
)
906 stop_byte
= GPT_BYTE
;
909 stop_byte
= CHAR_TO_BYTE (stop
);
911 from_byte
= CHAR_TO_BYTE (from
);
913 bzero (charsets
, (MAX_CHARSET
+ 1) * sizeof (int));
916 find_charset_in_str (BYTE_POS_ADDR (from_byte
), stop_byte
- from_byte
,
917 charsets
, table
, 1, multibyte
);
920 from
= stop
, from_byte
= stop_byte
;
921 stop
= to
, stop_byte
= CHAR_TO_BYTE (stop
);
929 for (i
= (multibyte
? MAX_CHARSET
: 1); i
>= 0; i
--)
932 if (CHARSET_DEFINED_P (i
) || i
== CHARSET_COMPOSITION
)
933 val
= Fcons (CHARSET_SYMBOL (i
), val
);
938 val
= Fcons (Qunknown
, val
);
942 DEFUN ("find-charset-string", Ffind_charset_string
, Sfind_charset_string
,
944 "Return a list of charsets in STR.\n\
945 If the string contains any composite characters,\n\
946 `composition' is included in the returned list.\n\
947 Optional arg TABLE if non-nil is a translation table to look up.\n\
949 If the region contains invalid multiybte characters,\n\
950 `unknown' is included in the returned list.\n\
952 If STR is unibyte, the returned list contains\n\
953 `ascii' if any 7-bit characters are found,\n\
954 and `unknown' if any 8-bit characters are found.")
956 Lisp_Object str
, table
;
958 int charsets
[MAX_CHARSET
+ 1];
964 CHECK_STRING (str
, 0);
965 multibyte
= STRING_MULTIBYTE (str
);
967 bzero (charsets
, (MAX_CHARSET
+ 1) * sizeof (int));
968 find_charset_in_str (XSTRING (str
)->data
, STRING_BYTES (XSTRING (str
)),
969 charsets
, table
, 1, multibyte
);
972 for (i
= (multibyte
? MAX_CHARSET
: 1); i
>= 0; i
--)
975 if (CHARSET_DEFINED_P (i
) || i
== CHARSET_COMPOSITION
)
976 val
= Fcons (CHARSET_SYMBOL (i
), val
);
981 val
= Fcons (Qunknown
, val
);
985 DEFUN ("make-char-internal", Fmake_char_internal
, Smake_char_internal
, 1, 3, 0,
987 (charset
, code1
, code2
)
988 Lisp_Object charset
, code1
, code2
;
990 CHECK_NUMBER (charset
, 0);
993 XSETFASTINT (code1
, 0);
995 CHECK_NUMBER (code1
, 1);
997 XSETFASTINT (code2
, 0);
999 CHECK_NUMBER (code2
, 2);
1001 if (!CHARSET_DEFINED_P (XINT (charset
)))
1002 error ("Invalid charset: %d", XINT (charset
));
1004 return make_number (MAKE_CHAR (XINT (charset
), XINT (code1
), XINT (code2
)));
1007 DEFUN ("split-char", Fsplit_char
, Ssplit_char
, 1, 1, 0,
1008 "Return list of charset and one or two position-codes of CHAR.\n\
1009 If CHAR is invalid as a character code,\n\
1010 return a list of symbol `unknown' and CHAR.")
1015 int c
, charset
, c1
, c2
;
1017 CHECK_NUMBER (ch
, 0);
1019 if (!CHAR_VALID_P (c
, 1))
1020 return Fcons (Qunknown
, Fcons (ch
, Qnil
));
1021 SPLIT_CHAR (XFASTINT (ch
), charset
, c1
, c2
);
1023 ? Fcons (CHARSET_SYMBOL (charset
),
1024 Fcons (make_number (c1
), Fcons (make_number (c2
), Qnil
)))
1025 : Fcons (CHARSET_SYMBOL (charset
), Fcons (make_number (c1
), Qnil
)));
1028 DEFUN ("char-charset", Fchar_charset
, Schar_charset
, 1, 1, 0,
1029 "Return charset of CHAR.")
1033 CHECK_NUMBER (ch
, 0);
1035 return CHARSET_SYMBOL (CHAR_CHARSET (XINT (ch
)));
1038 DEFUN ("charset-after", Fcharset_after
, Scharset_after
, 0, 1, 0,
1039 "Return charset of a character in current buffer at position POS.\n\
1040 If POS is nil, it defauls to the current point.\n\
1041 If POS is out of range, the value is nil.")
1045 register int pos_byte
, c
, charset
;
1046 register unsigned char *p
;
1050 else if (MARKERP (pos
))
1052 pos_byte
= marker_byte_position (pos
);
1053 if (pos_byte
< BEGV_BYTE
|| pos_byte
>= ZV_BYTE
)
1058 CHECK_NUMBER (pos
, 0);
1059 if (XINT (pos
) < BEGV
|| XINT (pos
) >= ZV
)
1061 pos_byte
= CHAR_TO_BYTE (XINT (pos
));
1063 p
= BYTE_POS_ADDR (pos_byte
);
1064 c
= STRING_CHAR (p
, Z_BYTE
- pos_byte
);
1065 charset
= CHAR_CHARSET (c
);
1066 return CHARSET_SYMBOL (charset
);
1069 DEFUN ("iso-charset", Fiso_charset
, Siso_charset
, 3, 3, 0,
1070 "Return charset of ISO's specification DIMENSION, CHARS, and FINAL-CHAR.\n\
1072 ISO 2022's designation sequence (escape sequence) distinguishes charsets\n\
1073 by their DIMENSION, CHARS, and FINAL-CHAR,\n\
1074 where as Emacs distinguishes them by charset symbol.\n\
1075 See the documentation of the function `charset-info' for the meanings of\n\
1076 DIMENSION, CHARS, and FINAL-CHAR.")
1077 (dimension
, chars
, final_char
)
1078 Lisp_Object dimension
, chars
, final_char
;
1082 CHECK_NUMBER (dimension
, 0);
1083 CHECK_NUMBER (chars
, 1);
1084 CHECK_NUMBER (final_char
, 2);
1086 if ((charset
= ISO_CHARSET_TABLE (dimension
, chars
, final_char
)) < 0)
1088 return CHARSET_SYMBOL (charset
);
1091 /* If GENERICP is nonzero, return nonzero iff C is a valid normal or
1092 generic character. If GENERICP is zero, return nonzero iff C is a
1093 valid normal character. Do not call this function directly,
1094 instead use macro CHAR_VALID_P. */
1096 char_valid_p (c
, genericp
)
1099 int charset
, c1
, c2
;
1103 if (SINGLE_BYTE_CHAR_P (c
))
1105 SPLIT_NON_ASCII_CHAR (c
, charset
, c1
, c2
);
1106 if (charset
!= CHARSET_COMPOSITION
&& !CHARSET_DEFINED_P (charset
))
1108 return (c
< MIN_CHAR_COMPOSITION
1109 ? ((c
& CHAR_FIELD1_MASK
) /* i.e. dimension of C is two. */
1110 ? (genericp
&& c1
== 0 && c2
== 0
1111 || c1
>= 32 && c2
>= 32)
1112 : (genericp
&& c1
== 0
1114 : c
< MIN_CHAR_COMPOSITION
+ n_cmpchars
);
1117 DEFUN ("char-valid-p", Fchar_valid_p
, Schar_valid_p
, 1, 2, 0,
1118 "Return t if OBJECT is a valid normal character.\n\
1119 If optional arg GENERICP is non-nil, also return t if OBJECT is\n\
1120 a valid generic character.")
1122 Lisp_Object object
, genericp
;
1124 if (! NATNUMP (object
))
1126 return (CHAR_VALID_P (XFASTINT (object
), !NILP (genericp
)) ? Qt
: Qnil
);
1129 DEFUN ("unibyte-char-to-multibyte", Funibyte_char_to_multibyte
,
1130 Sunibyte_char_to_multibyte
, 1, 1, 0,
1131 "Convert the unibyte character CH to multibyte character.\n\
1132 The conversion is done based on `nonascii-translation-table' (which see)\n\
1133 or `nonascii-insert-offset' (which see).")
1139 CHECK_NUMBER (ch
, 0);
1141 if (c
< 0 || c
>= 0400)
1142 error ("Invalid unibyte character: %d", c
);
1143 c
= unibyte_char_to_multibyte (c
);
1145 error ("Can't convert to multibyte character: %d", XINT (ch
));
1146 return make_number (c
);
1149 DEFUN ("multibyte-char-to-unibyte", Fmultibyte_char_to_unibyte
,
1150 Smultibyte_char_to_unibyte
, 1, 1, 0,
1151 "Convert the multibyte character CH to unibyte character.\n\
1152 The conversion is done based on `nonascii-translation-table' (which see)\n\
1153 or `nonascii-insert-offset' (which see).")
1159 CHECK_NUMBER (ch
, 0);
1162 error ("Invalid multibyte character: %d", c
);
1163 c
= multibyte_char_to_unibyte (c
, Qnil
);
1165 error ("Can't convert to unibyte character: %d", XINT (ch
));
1166 return make_number (c
);
1169 DEFUN ("char-bytes", Fchar_bytes
, Schar_bytes
, 1, 1, 0,
1170 "Return 1 regardless of the argument CHAR.\n\
1171 This is now an obsolete function. We keep it just for backward compatibility.")
1177 CHECK_NUMBER (ch
, 0);
1178 return make_number (1);
1181 /* Return how many bytes C will occupy in a multibyte buffer.
1182 Don't call this function directly, instead use macro CHAR_BYTES. */
1189 if (SINGLE_BYTE_CHAR_P (c
) || (c
& ~GLYPH_MASK_CHAR
))
1192 if (COMPOSITE_CHAR_P (c
))
1194 unsigned int id
= COMPOSITE_CHAR_ID (c
);
1196 bytes
= (id
< n_cmpchars
? cmpchar_table
[id
]->len
: 1);
1200 int charset
= CHAR_CHARSET (c
);
1202 bytes
= CHARSET_DEFINED_P (charset
) ? CHARSET_BYTES (charset
) : 1;
1208 /* Return the width of character of which multi-byte form starts with
1209 C. The width is measured by how many columns occupied on the
1210 screen when displayed in the current buffer. */
1212 #define ONE_BYTE_CHAR_WIDTH(c) \
1215 ? XFASTINT (current_buffer->tab_width) \
1216 : (c == '\n' ? 0 : (NILP (current_buffer->ctl_arrow) ? 4 : 2))) \
1220 ? (NILP (current_buffer->ctl_arrow) ? 4 : 2) \
1221 : ((! NILP (current_buffer->enable_multibyte_characters) \
1222 && BASE_LEADING_CODE_P (c)) \
1223 ? WIDTH_BY_CHAR_HEAD (c) \
1226 DEFUN ("char-width", Fchar_width
, Schar_width
, 1, 1, 0,
1227 "Return width of CHAR when displayed in the current buffer.\n\
1228 The width is measured by how many columns it occupies on the screen.")
1232 Lisp_Object val
, disp
;
1234 struct Lisp_Char_Table
*dp
= buffer_display_table ();
1236 CHECK_NUMBER (ch
, 0);
1240 /* Get the way the display table would display it. */
1241 disp
= dp
? DISP_CHAR_VECTOR (dp
, c
) : Qnil
;
1244 XSETINT (val
, XVECTOR (disp
)->size
);
1245 else if (SINGLE_BYTE_CHAR_P (c
))
1246 XSETINT (val
, ONE_BYTE_CHAR_WIDTH (c
));
1247 else if (COMPOSITE_CHAR_P (c
))
1249 int id
= COMPOSITE_CHAR_ID (XFASTINT (ch
));
1250 XSETFASTINT (val
, (id
< n_cmpchars
? cmpchar_table
[id
]->width
: 1));
1254 int charset
= CHAR_CHARSET (c
);
1256 XSETFASTINT (val
, CHARSET_WIDTH (charset
));
1261 /* Return width of string STR of length LEN when displayed in the
1262 current buffer. The width is measured by how many columns it
1263 occupies on the screen. */
1270 unsigned char *endp
= str
+ len
;
1272 struct Lisp_Char_Table
*dp
= buffer_display_table ();
1276 if (*str
== LEADING_CODE_COMPOSITION
)
1278 int id
= str_cmpchar_id (str
, endp
- str
);
1287 width
+= cmpchar_table
[id
]->width
;
1288 str
+= cmpchar_table
[id
]->len
;
1295 int c
= STRING_CHAR_AND_LENGTH (str
, endp
- str
, thislen
);
1297 /* Get the way the display table would display it. */
1299 disp
= DISP_CHAR_VECTOR (dp
, c
);
1304 width
+= XVECTOR (disp
)->size
;
1306 width
+= ONE_BYTE_CHAR_WIDTH (*str
);
1314 DEFUN ("string-width", Fstring_width
, Sstring_width
, 1, 1, 0,
1315 "Return width of STRING when displayed in the current buffer.\n\
1316 Width is measured by how many columns it occupies on the screen.\n\
1317 When calculating width of a multibyte character in STRING,\n\
1318 only the base leading-code is considered; the validity of\n\
1319 the following bytes is not checked.")
1325 CHECK_STRING (str
, 0);
1326 XSETFASTINT (val
, strwidth (XSTRING (str
)->data
,
1327 STRING_BYTES (XSTRING (str
))));
1331 DEFUN ("char-direction", Fchar_direction
, Schar_direction
, 1, 1, 0,
1332 "Return the direction of CHAR.\n\
1333 The returned value is 0 for left-to-right and 1 for right-to-left.")
1339 CHECK_NUMBER (ch
, 0);
1340 charset
= CHAR_CHARSET (XFASTINT (ch
));
1341 if (!CHARSET_DEFINED_P (charset
))
1342 invalid_character (XINT (ch
));
1343 return CHARSET_TABLE_INFO (charset
, CHARSET_DIRECTION_IDX
);
1346 DEFUN ("chars-in-region", Fchars_in_region
, Schars_in_region
, 2, 2, 0,
1347 "Return number of characters between BEG and END.")
1349 Lisp_Object beg
, end
;
1353 CHECK_NUMBER_COERCE_MARKER (beg
, 0);
1354 CHECK_NUMBER_COERCE_MARKER (end
, 1);
1356 from
= min (XFASTINT (beg
), XFASTINT (end
));
1357 to
= max (XFASTINT (beg
), XFASTINT (end
));
1359 return make_number (to
- from
);
1362 /* Return the number of characters in the NBYTES bytes at PTR.
1363 This works by looking at the contents and checking for multibyte sequences.
1364 However, if the current buffer has enable-multibyte-characters = nil,
1365 we treat each byte as a character. */
1368 chars_in_text (ptr
, nbytes
)
1372 unsigned char *endp
, c
;
1375 /* current_buffer is null at early stages of Emacs initialization. */
1376 if (current_buffer
== 0
1377 || NILP (current_buffer
->enable_multibyte_characters
))
1380 endp
= ptr
+ nbytes
;
1387 if (BASE_LEADING_CODE_P (c
))
1388 while (ptr
< endp
&& ! CHAR_HEAD_P (*ptr
)) ptr
++;
1395 /* Return the number of characters in the NBYTES bytes at PTR.
1396 This works by looking at the contents and checking for multibyte sequences.
1397 It ignores enable-multibyte-characters. */
1400 multibyte_chars_in_text (ptr
, nbytes
)
1404 unsigned char *endp
, c
;
1407 endp
= ptr
+ nbytes
;
1414 if (BASE_LEADING_CODE_P (c
))
1415 while (ptr
< endp
&& ! CHAR_HEAD_P (*ptr
)) ptr
++;
1422 DEFUN ("string", Fstring
, Sstring
, 1, MANY
, 0,
1423 "Concatenate all the argument characters and make the result a string.")
1430 = (unsigned char *) alloca (MAX_LENGTH_OF_MULTI_BYTE_FORM
* n
);
1431 unsigned char *p
= buf
;
1434 for (i
= 0; i
< n
; i
++)
1439 if (!INTEGERP (args
[i
]))
1440 CHECK_NUMBER (args
[i
], 0);
1442 len
= CHAR_STRING (c
, p
, str
);
1444 /* C is a composite character. */
1445 bcopy (str
, p
, len
);
1449 /* Here, we can't use make_string_from_bytes because of byte
1450 combining problem. */
1451 val
= make_string (buf
, p
- buf
);
1457 /*** Composite characters staffs ***/
1459 /* Each composite character is identified by CMPCHAR-ID which is
1460 assigned when Emacs needs the character code of the composite
1461 character (e.g. when displaying it on the screen). See the
1462 document "GENERAL NOTE on COMPOSITE CHARACTER" in `charset.h' how a
1463 composite character is represented in Emacs. */
1465 /* If `static' is defined, it means that it is defined to null string. */
1467 /* The following function is copied from lread.c. */
1469 hash_string (ptr
, len
)
1473 register unsigned char *p
= ptr
;
1474 register unsigned char *end
= p
+ len
;
1475 register unsigned char c
;
1476 register int hash
= 0;
1481 if (c
>= 0140) c
-= 40;
1482 hash
= ((hash
<<3) + (hash
>>28) + c
);
1484 return hash
& 07777777777;
1488 #define CMPCHAR_HASH_TABLE_SIZE 0xFFF
1490 static int *cmpchar_hash_table
[CMPCHAR_HASH_TABLE_SIZE
];
1492 /* Each element of `cmpchar_hash_table' is a pointer to an array of
1493 integer, where the 1st element is the size of the array, the 2nd
1494 element is how many elements are actually used in the array, and
1495 the remaining elements are CMPCHAR-IDs of composite characters of
1496 the same hash value. */
1497 #define CMPCHAR_HASH_SIZE(table) table[0]
1498 #define CMPCHAR_HASH_USED(table) table[1]
1499 #define CMPCHAR_HASH_CMPCHAR_ID(table, i) table[i]
1501 /* Return CMPCHAR-ID of the composite character in STR of the length
1502 LEN. If the composite character has not yet been registered,
1503 register it in `cmpchar_table' and assign new CMPCHAR-ID. This
1504 is the sole function for assigning CMPCHAR-ID. */
1506 str_cmpchar_id (str
, len
)
1507 const unsigned char *str
;
1510 int hash_idx
, *hashp
;
1512 int embedded_rule
; /* 1 if composition rule is embedded. */
1513 int chars
; /* number of components. */
1515 struct cmpchar_info
*cmpcharp
;
1517 /* The second byte 0xFF means compostion rule is embedded. */
1518 embedded_rule
= (str
[1] == 0xFF);
1520 /* At first, get the actual length of the composite character. */
1522 const unsigned char *p
, *endp
= str
+ 1, *lastp
= str
+ len
;
1525 while (endp
< lastp
&& ! CHAR_HEAD_P (*endp
)) endp
++;
1527 /* Any composite char have at least 5-byte length. */
1540 /* No need of checking if *P is 0xA0 because
1541 BYTES_BY_CHAR_HEAD (0x80) surely returns 2. */
1542 p
+= BYTES_BY_CHAR_HEAD (*p
- 0x20);
1545 if (p
> endp
|| chars
< 2 || chars
> MAX_COMPONENT_COUNT
)
1546 /* Invalid components. */
1550 hash_idx
= hash_string (str
, len
) % CMPCHAR_HASH_TABLE_SIZE
;
1551 hashp
= cmpchar_hash_table
[hash_idx
];
1553 /* Then, look into the hash table. */
1555 /* Find the correct one among composite characters of the same
1557 for (i
= 2; i
< CMPCHAR_HASH_USED (hashp
); i
++)
1559 cmpcharp
= cmpchar_table
[CMPCHAR_HASH_CMPCHAR_ID (hashp
, i
)];
1560 if (len
== cmpcharp
->len
1561 && ! bcmp (str
, cmpcharp
->data
, len
))
1562 return CMPCHAR_HASH_CMPCHAR_ID (hashp
, i
);
1565 /* We have to register the composite character in cmpchar_table. */
1566 if (n_cmpchars
>= (CHAR_FIELD2_MASK
| CHAR_FIELD3_MASK
))
1567 /* No, we have no more room for a new composite character. */
1570 /* Make the entry in hash table. */
1573 /* Make a table for 8 composite characters initially. */
1574 hashp
= (cmpchar_hash_table
[hash_idx
]
1575 = (int *) xmalloc (sizeof (int) * (2 + 8)));
1576 CMPCHAR_HASH_SIZE (hashp
) = 10;
1577 CMPCHAR_HASH_USED (hashp
) = 2;
1579 else if (CMPCHAR_HASH_USED (hashp
) >= CMPCHAR_HASH_SIZE (hashp
))
1581 CMPCHAR_HASH_SIZE (hashp
) += 8;
1582 hashp
= (cmpchar_hash_table
[hash_idx
]
1583 = (int *) xrealloc (hashp
,
1584 sizeof (int) * CMPCHAR_HASH_SIZE (hashp
)));
1586 CMPCHAR_HASH_CMPCHAR_ID (hashp
, CMPCHAR_HASH_USED (hashp
)) = n_cmpchars
;
1587 CMPCHAR_HASH_USED (hashp
)++;
1589 /* Set information of the composite character in cmpchar_table. */
1590 if (cmpchar_table_size
== 0)
1592 /* This is the first composite character to be registered. */
1593 cmpchar_table_size
= 256;
1595 = (struct cmpchar_info
**) xmalloc (sizeof (cmpchar_table
[0])
1596 * cmpchar_table_size
);
1598 else if (cmpchar_table_size
<= n_cmpchars
)
1600 cmpchar_table_size
+= 256;
1602 = (struct cmpchar_info
**) xrealloc (cmpchar_table
,
1603 sizeof (cmpchar_table
[0])
1604 * cmpchar_table_size
);
1607 cmpcharp
= (struct cmpchar_info
*) xmalloc (sizeof (struct cmpchar_info
));
1609 cmpcharp
->len
= len
;
1610 cmpcharp
->data
= (unsigned char *) xmalloc (len
+ 1);
1611 bcopy (str
, cmpcharp
->data
, len
);
1612 cmpcharp
->data
[len
] = 0;
1613 cmpcharp
->glyph_len
= chars
;
1614 cmpcharp
->glyph
= (GLYPH
*) xmalloc (sizeof (GLYPH
) * chars
);
1617 cmpcharp
->cmp_rule
= (unsigned char *) xmalloc (chars
);
1618 cmpcharp
->col_offset
= (float *) xmalloc (sizeof (float) * chars
);
1622 cmpcharp
->cmp_rule
= NULL
;
1623 cmpcharp
->col_offset
= NULL
;
1626 /* Setup GLYPH data and composition rules (if any) so as not to make
1627 them every time on displaying. */
1629 unsigned char *bufp
;
1631 float leftmost
= 0.0, rightmost
= 1.0;
1634 /* At first, col_offset[N] is set to relative to col_offset[0]. */
1635 cmpcharp
->col_offset
[0] = 0;
1637 for (i
= 0, bufp
= cmpcharp
->data
+ 1; i
< chars
; i
++)
1640 cmpcharp
->cmp_rule
[i
] = *bufp
++;
1642 if (*bufp
== 0xA0) /* This is an ASCII character. */
1644 cmpcharp
->glyph
[i
] = FAST_MAKE_GLYPH ((*++bufp
& 0x7F), 0);
1648 else /* Multibyte character. */
1650 /* Make `bufp' point normal multi-byte form temporally. */
1653 = FAST_MAKE_GLYPH (string_to_non_ascii_char (bufp
, 4, 0, 0), 0);
1654 width
= WIDTH_BY_CHAR_HEAD (*bufp
);
1656 bufp
+= BYTES_BY_CHAR_HEAD (*bufp
- 0x20);
1659 if (embedded_rule
&& i
> 0)
1661 /* Reference points (global_ref and new_ref) are
1672 Now, we calculate the column offset of the new glyph
1673 from the left edge of the first glyph. This can avoid
1674 the same calculation everytime displaying this
1675 composite character. */
1677 /* Reference points of global glyph and new glyph. */
1678 int global_ref
= (cmpcharp
->cmp_rule
[i
] - 0xA0) / 9;
1679 int new_ref
= (cmpcharp
->cmp_rule
[i
] - 0xA0) % 9;
1680 /* Column offset relative to the first glyph. */
1681 float left
= (leftmost
1682 + (global_ref
% 3) * (rightmost
- leftmost
) / 2.0
1683 - (new_ref
% 3) * width
/ 2.0);
1685 cmpcharp
->col_offset
[i
] = left
;
1686 if (left
< leftmost
)
1688 if (left
+ width
> rightmost
)
1689 rightmost
= left
+ width
;
1693 if (width
> rightmost
)
1699 /* Now col_offset[N] are relative to the left edge of the
1700 first component. Make them relative to the left edge of
1702 for (i
= 0; i
< chars
; i
++)
1703 cmpcharp
->col_offset
[i
] -= leftmost
;
1704 /* Make rightmost holds width of overall glyph. */
1705 rightmost
-= leftmost
;
1708 cmpcharp
->width
= rightmost
;
1709 if (cmpcharp
->width
< rightmost
)
1710 /* To get a ceiling integer value. */
1714 cmpchar_table
[n_cmpchars
] = cmpcharp
;
1716 return n_cmpchars
++;
1719 /* Return the Nth element of the composite character C. If NOERROR is
1720 nonzero, return 0 on error condition (C is an invalid composite
1721 charcter, or N is out of range). */
1723 cmpchar_component (c
, n
, noerror
)
1726 int id
= COMPOSITE_CHAR_ID (c
);
1728 if (id
< 0 || id
>= n_cmpchars
)
1730 /* C is not a valid composite character. */
1731 if (noerror
) return 0;
1732 error ("Invalid composite character: %d", c
) ;
1734 if (n
>= cmpchar_table
[id
]->glyph_len
)
1736 /* No such component. */
1737 if (noerror
) return 0;
1738 args_out_of_range (make_number (c
), make_number (n
));
1740 /* No face data is stored in glyph code. */
1741 return ((int) (cmpchar_table
[id
]->glyph
[n
]));
1744 DEFUN ("cmpcharp", Fcmpcharp
, Scmpcharp
, 1, 1, 0,
1745 "T if CHAR is a composite character.")
1749 CHECK_NUMBER (ch
, 0);
1750 return (COMPOSITE_CHAR_P (XINT (ch
)) ? Qt
: Qnil
);
1753 DEFUN ("composite-char-component", Fcmpchar_component
, Scmpchar_component
,
1755 "Return the Nth component character of composite character CHARACTER.")
1757 Lisp_Object character
, n
;
1761 CHECK_NUMBER (character
, 0);
1762 CHECK_NUMBER (n
, 1);
1764 return (make_number (cmpchar_component (XINT (character
), XINT (n
), 0)));
1767 DEFUN ("composite-char-composition-rule", Fcmpchar_cmp_rule
, Scmpchar_cmp_rule
,
1769 "Return the Nth composition rule of composite character CHARACTER.\n\
1770 The returned rule is for composing the Nth component\n\
1771 on the (N-1)th component.\n\
1772 If CHARACTER should be composed relatively or N is 0, return 255.")
1774 Lisp_Object character
, n
;
1778 CHECK_NUMBER (character
, 0);
1779 CHECK_NUMBER (n
, 1);
1781 id
= COMPOSITE_CHAR_ID (XINT (character
));
1782 if (id
< 0 || id
>= n_cmpchars
)
1783 error ("Invalid composite character: %d", XINT (character
));
1784 if (XINT (n
) < 0 || XINT (n
) >= cmpchar_table
[id
]->glyph_len
)
1785 args_out_of_range (character
, n
);
1787 return make_number (cmpchar_table
[id
]->cmp_rule
1788 ? cmpchar_table
[id
]->cmp_rule
[XINT (n
)]
1792 DEFUN ("composite-char-composition-rule-p", Fcmpchar_cmp_rule_p
,
1793 Scmpchar_cmp_rule_p
, 1, 1, 0,
1794 "Return non-nil if composite character CHARACTER contains a embedded rule.")
1796 Lisp_Object character
;
1800 CHECK_NUMBER (character
, 0);
1801 id
= COMPOSITE_CHAR_ID (XINT (character
));
1802 if (id
< 0 || id
>= n_cmpchars
)
1803 error ("Invalid composite character: %d", XINT (character
));
1805 return (cmpchar_table
[id
]->cmp_rule
? Qt
: Qnil
);
1808 DEFUN ("composite-char-component-count", Fcmpchar_cmp_count
,
1809 Scmpchar_cmp_count
, 1, 1, 0,
1810 "Return number of compoents of composite character CHARACTER.")
1812 Lisp_Object character
;
1816 CHECK_NUMBER (character
, 0);
1817 id
= COMPOSITE_CHAR_ID (XINT (character
));
1818 if (id
< 0 || id
>= n_cmpchars
)
1819 error ("Invalid composite character: %d", XINT (character
));
1821 return (make_number (cmpchar_table
[id
]->glyph_len
));
1824 DEFUN ("compose-string", Fcompose_string
, Scompose_string
,
1826 "Return one char string composed from all characters in STRING.")
1830 unsigned char buf
[MAX_LENGTH_OF_MULTI_BYTE_FORM
], *p
, *pend
, *ptemp
;
1833 CHECK_STRING (str
, 0);
1835 buf
[0] = LEADING_CODE_COMPOSITION
;
1836 p
= XSTRING (str
)->data
;
1837 pend
= p
+ STRING_BYTES (XSTRING (str
));
1841 if (*p
< 0x20) /* control code */
1842 error ("Invalid component character: %d", *p
);
1843 else if (*p
< 0x80) /* ASCII */
1845 if (i
+ 2 >= MAX_LENGTH_OF_MULTI_BYTE_FORM
)
1846 error ("Too long string to be composed: %s", XSTRING (str
)->data
);
1847 /* Prepend an ASCII charset indicator 0xA0, set MSB of the
1850 buf
[i
++] = *p
++ + 0x80;
1852 else if (*p
== LEADING_CODE_COMPOSITION
) /* composite char */
1854 /* Already composed. Eliminate the heading
1855 LEADING_CODE_COMPOSITION, keep the remaining bytes
1859 error ("Can't compose a rule-based composition character");
1861 while (! CHAR_HEAD_P (*p
)) p
++;
1862 if (str_cmpchar_id (ptemp
- 1, p
- ptemp
+ 1) < 0)
1863 error ("Can't compose an invalid composition character");
1864 if (i
+ (p
- ptemp
) >= MAX_LENGTH_OF_MULTI_BYTE_FORM
)
1865 error ("Too long string to be composed: %s", XSTRING (str
)->data
);
1866 bcopy (ptemp
, buf
+ i
, p
- ptemp
);
1869 else /* multibyte char */
1871 /* Add 0x20 to the base leading-code, keep the remaining
1873 int c
= STRING_CHAR_AND_CHAR_LENGTH (p
, pend
- p
, len
);
1875 if (len
<= 1 || ! CHAR_VALID_P (c
, 0))
1876 error ("Can't compose an invalid character");
1877 if (i
+ len
>= MAX_LENGTH_OF_MULTI_BYTE_FORM
)
1878 error ("Too long string to be composed: %s", XSTRING (str
)->data
);
1879 bcopy (p
, buf
+ i
, len
);
1886 /* STR contains only one character, which can't be composed. */
1887 error ("Too short string to be composed: %s", XSTRING (str
)->data
);
1889 return make_string_from_bytes (buf
, 1, i
);
1894 charset_id_internal (charset_name
)
1899 val
= Fget (intern (charset_name
), Qcharset
);
1901 error ("Charset %s is not defined", charset_name
);
1903 return (XINT (XVECTOR (val
)->contents
[0]));
1906 DEFUN ("setup-special-charsets", Fsetup_special_charsets
,
1907 Ssetup_special_charsets
, 0, 0, 0, "Internal use only.")
1910 charset_latin_iso8859_1
= charset_id_internal ("latin-iso8859-1");
1911 charset_jisx0208_1978
= charset_id_internal ("japanese-jisx0208-1978");
1912 charset_jisx0208
= charset_id_internal ("japanese-jisx0208");
1913 charset_katakana_jisx0201
= charset_id_internal ("katakana-jisx0201");
1914 charset_latin_jisx0201
= charset_id_internal ("latin-jisx0201");
1915 charset_big5_1
= charset_id_internal ("chinese-big5-1");
1916 charset_big5_2
= charset_id_internal ("chinese-big5-2");
1921 init_charset_once ()
1925 staticpro (&Vcharset_table
);
1926 staticpro (&Vcharset_symbol_table
);
1927 staticpro (&Vgeneric_character_list
);
1929 /* This has to be done here, before we call Fmake_char_table. */
1930 Qcharset_table
= intern ("charset-table");
1931 staticpro (&Qcharset_table
);
1933 /* Intern this now in case it isn't already done.
1934 Setting this variable twice is harmless.
1935 But don't staticpro it here--that is done in alloc.c. */
1936 Qchar_table_extra_slots
= intern ("char-table-extra-slots");
1938 /* Now we are ready to set up this property, so we can
1939 create the charset table. */
1940 Fput (Qcharset_table
, Qchar_table_extra_slots
, make_number (0));
1941 Vcharset_table
= Fmake_char_table (Qcharset_table
, Qnil
);
1943 Qunknown
= intern ("unknown");
1944 staticpro (&Qunknown
);
1945 Vcharset_symbol_table
= Fmake_vector (make_number (MAX_CHARSET
+ 1),
1949 for (i
= 0; i
< 2; i
++)
1950 for (j
= 0; j
< 2; j
++)
1951 for (k
= 0; k
< 128; k
++)
1952 iso_charset_table
[i
][j
][k
] = -1;
1954 bzero (cmpchar_hash_table
, sizeof cmpchar_hash_table
);
1955 cmpchar_table_size
= n_cmpchars
= 0;
1957 for (i
= 0; i
< 256; i
++)
1958 BYTES_BY_CHAR_HEAD (i
) = 1;
1959 for (i
= MIN_CHARSET_OFFICIAL_DIMENSION1
;
1960 i
<= MAX_CHARSET_OFFICIAL_DIMENSION1
; i
++)
1961 BYTES_BY_CHAR_HEAD (i
) = 2;
1962 for (i
= MIN_CHARSET_OFFICIAL_DIMENSION2
;
1963 i
<= MAX_CHARSET_OFFICIAL_DIMENSION2
; i
++)
1964 BYTES_BY_CHAR_HEAD (i
) = 3;
1965 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_11
) = 3;
1966 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_12
) = 3;
1967 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_21
) = 4;
1968 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_22
) = 4;
1969 /* The followings don't reflect the actual bytes, but just to tell
1970 that it is a start of a multibyte character. */
1971 BYTES_BY_CHAR_HEAD (LEADING_CODE_COMPOSITION
) = 2;
1972 BYTES_BY_CHAR_HEAD (0x9E) = 2;
1973 BYTES_BY_CHAR_HEAD (0x9F) = 2;
1975 for (i
= 0; i
< 128; i
++)
1976 WIDTH_BY_CHAR_HEAD (i
) = 1;
1977 for (; i
< 256; i
++)
1978 WIDTH_BY_CHAR_HEAD (i
) = 4;
1979 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_11
) = 1;
1980 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_12
) = 2;
1981 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_21
) = 1;
1982 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_22
) = 2;
1988 for (i
= 0x81; i
< 0x90; i
++)
1989 val
= Fcons (make_number ((i
- 0x70) << 7), val
);
1990 for (; i
< 0x9A; i
++)
1991 val
= Fcons (make_number ((i
- 0x8F) << 14), val
);
1992 for (i
= 0xA0; i
< 0xF0; i
++)
1993 val
= Fcons (make_number ((i
- 0x70) << 7), val
);
1994 for (; i
< 0xFF; i
++)
1995 val
= Fcons (make_number ((i
- 0xE0) << 14), val
);
1996 val
= Fcons (make_number (GENERIC_COMPOSITION_CHAR
), val
);
1997 Vgeneric_character_list
= Fnreverse (val
);
2000 nonascii_insert_offset
= 0;
2001 Vnonascii_translation_table
= Qnil
;
2009 Qascii
= intern ("ascii");
2010 staticpro (&Qascii
);
2012 Qcharset
= intern ("charset");
2013 staticpro (&Qcharset
);
2015 /* Define ASCII charset now. */
2016 update_charset_table (make_number (CHARSET_ASCII
),
2017 make_number (1), make_number (94),
2022 build_string ("ASCII"),
2023 build_string ("ASCII"),
2024 build_string ("ASCII (ISO646 IRV)"));
2025 CHARSET_SYMBOL (CHARSET_ASCII
) = Qascii
;
2026 Fput (Qascii
, Qcharset
, CHARSET_TABLE_ENTRY (CHARSET_ASCII
));
2028 Qcomposition
= intern ("composition");
2029 staticpro (&Qcomposition
);
2030 CHARSET_SYMBOL (CHARSET_COMPOSITION
) = Qcomposition
;
2032 Qauto_fill_chars
= intern ("auto-fill-chars");
2033 staticpro (&Qauto_fill_chars
);
2034 Fput (Qauto_fill_chars
, Qchar_table_extra_slots
, make_number (0));
2036 defsubr (&Sdefine_charset
);
2037 defsubr (&Sgeneric_character_list
);
2038 defsubr (&Sget_unused_iso_final_char
);
2039 defsubr (&Sdeclare_equiv_charset
);
2040 defsubr (&Sfind_charset_region
);
2041 defsubr (&Sfind_charset_string
);
2042 defsubr (&Smake_char_internal
);
2043 defsubr (&Ssplit_char
);
2044 defsubr (&Schar_charset
);
2045 defsubr (&Scharset_after
);
2046 defsubr (&Siso_charset
);
2047 defsubr (&Schar_valid_p
);
2048 defsubr (&Sunibyte_char_to_multibyte
);
2049 defsubr (&Smultibyte_char_to_unibyte
);
2050 defsubr (&Schar_bytes
);
2051 defsubr (&Schar_width
);
2052 defsubr (&Sstring_width
);
2053 defsubr (&Schar_direction
);
2054 defsubr (&Schars_in_region
);
2056 defsubr (&Scmpcharp
);
2057 defsubr (&Scmpchar_component
);
2058 defsubr (&Scmpchar_cmp_rule
);
2059 defsubr (&Scmpchar_cmp_rule_p
);
2060 defsubr (&Scmpchar_cmp_count
);
2061 defsubr (&Scompose_string
);
2062 defsubr (&Ssetup_special_charsets
);
2064 DEFVAR_LISP ("charset-list", &Vcharset_list
,
2065 "List of charsets ever defined.");
2066 Vcharset_list
= Fcons (Qascii
, Qnil
);
2068 DEFVAR_LISP ("translation-table-vector", &Vtranslation_table_vector
,
2069 "Vector of cons cell of a symbol and translation table ever defined.\n\
2070 An ID of a translation table is an index of this vector.");
2071 Vtranslation_table_vector
= Fmake_vector (make_number (16), Qnil
);
2073 DEFVAR_INT ("leading-code-composition", &leading_code_composition
,
2074 "Leading-code of composite characters.");
2075 leading_code_composition
= LEADING_CODE_COMPOSITION
;
2077 DEFVAR_INT ("leading-code-private-11", &leading_code_private_11
,
2078 "Leading-code of private TYPE9N charset of column-width 1.");
2079 leading_code_private_11
= LEADING_CODE_PRIVATE_11
;
2081 DEFVAR_INT ("leading-code-private-12", &leading_code_private_12
,
2082 "Leading-code of private TYPE9N charset of column-width 2.");
2083 leading_code_private_12
= LEADING_CODE_PRIVATE_12
;
2085 DEFVAR_INT ("leading-code-private-21", &leading_code_private_21
,
2086 "Leading-code of private TYPE9Nx9N charset of column-width 1.");
2087 leading_code_private_21
= LEADING_CODE_PRIVATE_21
;
2089 DEFVAR_INT ("leading-code-private-22", &leading_code_private_22
,
2090 "Leading-code of private TYPE9Nx9N charset of column-width 2.");
2091 leading_code_private_22
= LEADING_CODE_PRIVATE_22
;
2093 DEFVAR_INT ("nonascii-insert-offset", &nonascii_insert_offset
,
2094 "Offset for converting non-ASCII unibyte codes 0240...0377 to multibyte.\n\
2095 This is used for converting unibyte text to multibyte,\n\
2096 and for inserting character codes specified by number.\n\n\
2097 This serves to convert a Latin-1 or similar 8-bit character code\n\
2098 to the corresponding Emacs multibyte character code.\n\
2099 Typically the value should be (- (make-char CHARSET 0) 128),\n\
2100 for your choice of character set.\n\
2101 If `nonascii-translation-table' is non-nil, it overrides this variable.");
2102 nonascii_insert_offset
= 0;
2104 DEFVAR_LISP ("nonascii-translation-table", &Vnonascii_translation_table
,
2105 "Translation table to convert non-ASCII unibyte codes to multibyte.\n\
2106 This is used for converting unibyte text to multibyte,\n\
2107 and for inserting character codes specified by number.\n\n\
2108 Conversion is performed only when multibyte characters are enabled,\n\
2109 and it serves to convert a Latin-1 or similar 8-bit character code\n\
2110 to the corresponding Emacs character code.\n\n\
2111 If this is nil, `nonascii-insert-offset' is used instead.\n\
2112 See also the docstring of `make-translation-table'.");
2113 Vnonascii_translation_table
= Qnil
;
2115 DEFVAR_INT ("min-composite-char", &min_composite_char
,
2116 "Minimum character code of a composite character.");
2117 min_composite_char
= MIN_CHAR_COMPOSITION
;
2119 DEFVAR_LISP ("auto-fill-chars", &Vauto_fill_chars
,
2120 "A char-table for characters which invoke auto-filling.\n\
2121 Such characters has value t in this table.");
2122 Vauto_fill_chars
= Fmake_char_table (Qauto_fill_chars
, Qnil
);
2123 CHAR_TABLE_SET (Vauto_fill_chars
, make_number (' '), Qt
);
2124 CHAR_TABLE_SET (Vauto_fill_chars
, make_number ('\n'), Qt
);