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
;
45 /* Declaration of special leading-codes. */
46 int leading_code_composition
; /* for composite characters */
47 int leading_code_private_11
; /* for private DIMENSION1 of 1-column */
48 int leading_code_private_12
; /* for private DIMENSION1 of 2-column */
49 int leading_code_private_21
; /* for private DIMENSION2 of 1-column */
50 int leading_code_private_22
; /* for private DIMENSION2 of 2-column */
52 /* Declaration of special charsets. */
53 int charset_ascii
; /* ASCII */
54 int charset_composition
; /* for a composite character */
55 int charset_latin_iso8859_1
; /* ISO8859-1 (Latin-1) */
56 int charset_jisx0208_1978
; /* JISX0208.1978 (Japanese Kanji old set) */
57 int charset_jisx0208
; /* JISX0208.1983 (Japanese Kanji) */
58 int charset_katakana_jisx0201
; /* JISX0201.Kana (Japanese Katakana) */
59 int charset_latin_jisx0201
; /* JISX0201.Roman (Japanese Roman) */
60 int charset_big5_1
; /* Big5 Level 1 (Chinese Traditional) */
61 int charset_big5_2
; /* Big5 Level 2 (Chinese Traditional) */
63 int min_composite_char
;
65 Lisp_Object Qcharset_table
;
67 /* A char-table containing information of each character set. */
68 Lisp_Object Vcharset_table
;
70 /* A vector of charset symbol indexed by charset-id. This is used
71 only for returning charset symbol from C functions. */
72 Lisp_Object Vcharset_symbol_table
;
74 /* A list of charset symbols ever defined. */
75 Lisp_Object Vcharset_list
;
77 /* Vector of translation table ever defined.
78 ID of a translation table is used to index this vector. */
79 Lisp_Object Vtranslation_table_vector
;
81 /* A char-table for characters which may invoke auto-filling. */
82 Lisp_Object Vauto_fill_chars
;
84 Lisp_Object Qauto_fill_chars
;
86 /* Tables used by macros BYTES_BY_CHAR_HEAD and WIDTH_BY_CHAR_HEAD. */
87 int bytes_by_char_head
[256];
88 int width_by_char_head
[256];
90 /* Mapping table from ISO2022's charset (specified by DIMENSION,
91 CHARS, and FINAL-CHAR) to Emacs' charset. */
92 int iso_charset_table
[2][2][128];
94 /* Table of pointers to the structure `cmpchar_info' indexed by
96 struct cmpchar_info
**cmpchar_table
;
97 /* The current size of `cmpchar_table'. */
98 static int cmpchar_table_size
;
99 /* Number of the current composite characters. */
102 /* Variables used locally in the macro FETCH_MULTIBYTE_CHAR. */
103 unsigned char *_fetch_multibyte_char_p
;
104 int _fetch_multibyte_char_len
;
106 /* Offset to add to a non-ASCII value when inserting it. */
107 int nonascii_insert_offset
;
109 /* Translation table for converting non-ASCII unibyte characters
110 to multibyte codes, or nil. */
111 Lisp_Object Vnonascii_translation_table
;
113 /* List of all possible generic characters. */
114 Lisp_Object Vgeneric_character_list
;
116 #define min(X, Y) ((X) < (Y) ? (X) : (Y))
117 #define max(X, Y) ((X) > (Y) ? (X) : (Y))
120 invalid_character (c
)
123 error ("Invalid character: 0%o, %d, 0x%x", c
, c
, c
);
127 /* Set STR a pointer to the multi-byte form of the character C. If C
128 is not a composite character, the multi-byte form is set in WORKBUF
129 and STR points WORKBUF. The caller should allocate at least 4-byte
130 area at WORKBUF in advance. Returns the length of the multi-byte
131 form. If C is an invalid character to have a multi-byte form,
134 Use macro `CHAR_STRING (C, WORKBUF, STR)' instead of calling this
135 function directly if C can be an ASCII character. */
138 non_ascii_char_to_string (c
, workbuf
, str
)
140 unsigned char *workbuf
, **str
;
144 if (COMPOSITE_CHAR_P (c
))
146 int cmpchar_id
= COMPOSITE_CHAR_ID (c
);
148 if (cmpchar_id
< n_cmpchars
)
150 *str
= cmpchar_table
[cmpchar_id
]->data
;
151 return cmpchar_table
[cmpchar_id
]->len
;
155 invalid_character (c
);
159 SPLIT_NON_ASCII_CHAR (c
, charset
, c1
, c2
);
161 || ! CHARSET_DEFINED_P (charset
)
162 || c1
>= 0 && c1
< 32
163 || c2
>= 0 && c2
< 32)
164 invalid_character (c
);
167 *workbuf
++ = CHARSET_LEADING_CODE_BASE (charset
);
168 if (*workbuf
= CHARSET_LEADING_CODE_EXT (charset
))
170 *workbuf
++ = c1
| 0x80;
172 *workbuf
++ = c2
| 0x80;
174 return (workbuf
- *str
);
177 /* Return a non-ASCII character of which multi-byte form is at STR of
178 length LEN. If ACTUAL_LEN is not NULL, the actual length of the
179 multibyte form is set to the address ACTUAL_LEN.
181 If exclude_tail_garbage is nonzero, ACTUAL_LEN excludes gabage
182 bytes following the non-ASCII character.
184 Use macro `STRING_CHAR (STR, LEN)' instead of calling this function
185 directly if STR can hold an ASCII character. */
188 string_to_non_ascii_char (str
, len
, actual_len
, exclude_tail_garbage
)
189 const unsigned char *str
;
190 int len
, *actual_len
, exclude_tail_garbage
;
193 unsigned char c1
, c2
;
194 register int c
, bytes
;
199 if (BASE_LEADING_CODE_P (c
))
201 while (bytes
< len
&& ! CHAR_HEAD_P (str
[bytes
])) bytes
++;
203 if (c
== LEADING_CODE_COMPOSITION
)
205 int cmpchar_id
= str_cmpchar_id (str
, bytes
);
209 c
= MAKE_COMPOSITE_CHAR (cmpchar_id
);
210 if (exclude_tail_garbage
)
211 bytes
= cmpchar_table
[cmpchar_id
]->len
;
216 int charset
= c
, c1
, c2
= 0;
217 int char_bytes
= BYTES_BY_CHAR_HEAD (c
);
220 if (c
>= LEADING_CODE_PRIVATE_11
)
222 if (char_bytes
<= bytes
&& CHARSET_DEFINED_P (charset
))
225 if (CHARSET_DIMENSION (charset
) == 2)
227 c
= MAKE_NON_ASCII_CHAR (charset
, c1
, c2
);
228 if (exclude_tail_garbage
)
239 /* Return the length of the multi-byte form at string STR of length LEN. */
241 multibyte_form_length (str
, len
)
242 const unsigned char *str
;
247 if (BASE_LEADING_CODE_P (*str
))
248 while (bytes
< len
&& ! CHAR_HEAD_P (str
[bytes
])) bytes
++;
253 /* Check if string STR of length LEN contains valid multi-byte form of
254 a character. If valid, charset and position codes of the character
255 is set at *CHARSET, *C1, and *C2, and return 0. If not valid,
256 return -1. This should be used only in the macro SPLIT_STRING
257 which checks range of STR in advance. */
260 split_non_ascii_string (str
, len
, charset
, c1
, c2
)
261 register const unsigned char *str
;
262 register unsigned char *c1
, *c2
;
263 register int len
, *charset
;
265 register unsigned int cs
= *str
++;
267 if (cs
== LEADING_CODE_COMPOSITION
)
269 int cmpchar_id
= str_cmpchar_id (str
- 1, len
);
273 *charset
= cs
, *c1
= cmpchar_id
>> 7, *c2
= cmpchar_id
& 0x7F;
275 else if ((cs
< LEADING_CODE_PRIVATE_11
|| (cs
= *str
++) >= 0xA0)
276 && CHARSET_DEFINED_P (cs
))
281 *c1
= (*str
++) & 0x7F;
282 if (CHARSET_DIMENSION (cs
) == 2)
286 *c2
= (*str
++) & 0x7F;
294 /* Translate character C by translation table TABLE. If C
295 is negative, translate a character specified by CHARSET, C1, and C2
296 (C1 and C2 are code points of the character). If no translation is
297 found in TABLE, return C. */
299 translate_char (table
, c
, charset
, c1
, c2
)
301 int c
, charset
, c1
, c2
;
304 int alt_charset
, alt_c1
, alt_c2
, dimension
;
306 if (c
< 0) c
= MAKE_CHAR (charset
, c1
, c2
);
307 if (!CHAR_TABLE_P (table
)
308 || (ch
= Faref (table
, make_number (c
)), !INTEGERP (ch
))
312 SPLIT_CHAR (XFASTINT (ch
), alt_charset
, alt_c1
, alt_c2
);
313 dimension
= CHARSET_DIMENSION (alt_charset
);
314 if (dimension
== 1 && alt_c1
> 0 || dimension
== 2 && alt_c2
> 0)
315 /* CH is not a generic character, just return it. */
316 return XFASTINT (ch
);
318 /* Since CH is a generic character, we must return a specific
319 charater which has the same position codes as C from CH. */
321 SPLIT_CHAR (c
, charset
, c1
, c2
);
322 if (dimension
!= CHARSET_DIMENSION (charset
))
323 /* We can't make such a character because of dimension mismatch. */
325 return MAKE_CHAR (alt_charset
, c1
, c2
);
328 /* Convert the unibyte character C to multibyte based on
329 Vnonascii_translation_table or nonascii_insert_offset. If they can't
330 convert C to a valid multibyte character, convert it based on
331 DEFAULT_NONASCII_INSERT_OFFSET which makes C a Latin-1 character. */
334 unibyte_char_to_multibyte (c
)
341 if (! NILP (Vnonascii_translation_table
))
343 c
= XINT (Faref (Vnonascii_translation_table
, make_number (c
)));
344 if (c
>= 0400 && ! VALID_MULTIBYTE_CHAR_P (c
))
345 c
= c_save
+ DEFAULT_NONASCII_INSERT_OFFSET
;
347 else if (c
>= 0240 && nonascii_insert_offset
> 0)
349 c
+= nonascii_insert_offset
;
350 if (c
< 0400 || ! VALID_MULTIBYTE_CHAR_P (c
))
351 c
= c_save
+ DEFAULT_NONASCII_INSERT_OFFSET
;
354 c
= c_save
+ DEFAULT_NONASCII_INSERT_OFFSET
;
360 /* Convert the multibyte character C to unibyte 8-bit character based
361 on Vnonascii_translation_table or nonascii_insert_offset. If
362 REV_TBL is non-nil, it should be a reverse table of
363 Vnonascii_translation_table, i.e. what given by:
364 Fchar_table_extra_slot (Vnonascii_translation_table, make_number (0)) */
367 multibyte_char_to_unibyte (c
, rev_tbl
)
371 if (!SINGLE_BYTE_CHAR_P (c
))
375 if (! CHAR_TABLE_P (rev_tbl
)
376 && CHAR_TABLE_P (Vnonascii_translation_table
))
377 rev_tbl
= Fchar_table_extra_slot (Vnonascii_translation_table
,
379 if (CHAR_TABLE_P (rev_tbl
))
382 temp
= Faref (rev_tbl
, make_number (c
));
386 c
= (c_save
& 0177) + 0200;
390 if (nonascii_insert_offset
> 0)
391 c
-= nonascii_insert_offset
;
392 if (c
< 128 || c
>= 256)
393 c
= (c_save
& 0177) + 0200;
401 /* Update the table Vcharset_table with the given arguments (see the
402 document of `define-charset' for the meaning of each argument).
403 Several other table contents are also updated. The caller should
404 check the validity of CHARSET-ID and the remaining arguments in
408 update_charset_table (charset_id
, dimension
, chars
, width
, direction
,
409 iso_final_char
, iso_graphic_plane
,
410 short_name
, long_name
, description
)
411 Lisp_Object charset_id
, dimension
, chars
, width
, direction
;
412 Lisp_Object iso_final_char
, iso_graphic_plane
;
413 Lisp_Object short_name
, long_name
, description
;
415 int charset
= XINT (charset_id
);
417 unsigned char leading_code_base
, leading_code_ext
;
419 if (NILP (CHARSET_TABLE_ENTRY (charset
)))
420 CHARSET_TABLE_ENTRY (charset
)
421 = Fmake_vector (make_number (CHARSET_MAX_IDX
), Qnil
);
423 /* Get byte length of multibyte form, base leading-code, and
424 extended leading-code of the charset. See the comment under the
425 title "GENERAL NOTE on CHARACTER SET (CHARSET)" in charset.h. */
426 bytes
= XINT (dimension
);
427 if (charset
< MIN_CHARSET_PRIVATE_DIMENSION1
)
429 /* Official charset, it doesn't have an extended leading-code. */
430 if (charset
!= CHARSET_ASCII
)
431 bytes
+= 1; /* For a base leading-code. */
432 leading_code_base
= charset
;
433 leading_code_ext
= 0;
437 /* Private charset. */
438 bytes
+= 2; /* For base and extended leading-codes. */
440 = (charset
< LEADING_CODE_EXT_12
441 ? LEADING_CODE_PRIVATE_11
442 : (charset
< LEADING_CODE_EXT_21
443 ? LEADING_CODE_PRIVATE_12
444 : (charset
< LEADING_CODE_EXT_22
445 ? LEADING_CODE_PRIVATE_21
446 : LEADING_CODE_PRIVATE_22
)));
447 leading_code_ext
= charset
;
450 CHARSET_TABLE_INFO (charset
, CHARSET_ID_IDX
) = charset_id
;
451 CHARSET_TABLE_INFO (charset
, CHARSET_BYTES_IDX
) = make_number (bytes
);
452 CHARSET_TABLE_INFO (charset
, CHARSET_DIMENSION_IDX
) = dimension
;
453 CHARSET_TABLE_INFO (charset
, CHARSET_CHARS_IDX
) = chars
;
454 CHARSET_TABLE_INFO (charset
, CHARSET_WIDTH_IDX
) = width
;
455 CHARSET_TABLE_INFO (charset
, CHARSET_DIRECTION_IDX
) = direction
;
456 CHARSET_TABLE_INFO (charset
, CHARSET_LEADING_CODE_BASE_IDX
)
457 = make_number (leading_code_base
);
458 CHARSET_TABLE_INFO (charset
, CHARSET_LEADING_CODE_EXT_IDX
)
459 = make_number (leading_code_ext
);
460 CHARSET_TABLE_INFO (charset
, CHARSET_ISO_FINAL_CHAR_IDX
) = iso_final_char
;
461 CHARSET_TABLE_INFO (charset
, CHARSET_ISO_GRAPHIC_PLANE_IDX
)
463 CHARSET_TABLE_INFO (charset
, CHARSET_SHORT_NAME_IDX
) = short_name
;
464 CHARSET_TABLE_INFO (charset
, CHARSET_LONG_NAME_IDX
) = long_name
;
465 CHARSET_TABLE_INFO (charset
, CHARSET_DESCRIPTION_IDX
) = description
;
466 CHARSET_TABLE_INFO (charset
, CHARSET_PLIST_IDX
) = Qnil
;
469 /* If we have already defined a charset which has the same
470 DIMENSION, CHARS and ISO-FINAL-CHAR but the different
471 DIRECTION, we must update the entry REVERSE-CHARSET of both
472 charsets. If there's no such charset, the value of the entry
476 for (i
= 0; i
<= MAX_CHARSET
; i
++)
477 if (!NILP (CHARSET_TABLE_ENTRY (i
)))
479 if (CHARSET_DIMENSION (i
) == XINT (dimension
)
480 && CHARSET_CHARS (i
) == XINT (chars
)
481 && CHARSET_ISO_FINAL_CHAR (i
) == XINT (iso_final_char
)
482 && CHARSET_DIRECTION (i
) != XINT (direction
))
484 CHARSET_TABLE_INFO (charset
, CHARSET_REVERSE_CHARSET_IDX
)
486 CHARSET_TABLE_INFO (i
, CHARSET_REVERSE_CHARSET_IDX
) = charset_id
;
491 /* No such a charset. */
492 CHARSET_TABLE_INFO (charset
, CHARSET_REVERSE_CHARSET_IDX
)
496 if (charset
!= CHARSET_ASCII
497 && charset
< MIN_CHARSET_PRIVATE_DIMENSION1
)
499 /* Update tables bytes_by_char_head and width_by_char_head. */
500 bytes_by_char_head
[leading_code_base
] = bytes
;
501 width_by_char_head
[leading_code_base
] = XINT (width
);
503 /* Update table emacs_code_class. */
504 emacs_code_class
[charset
] = (bytes
== 2
505 ? EMACS_leading_code_2
507 ? EMACS_leading_code_3
508 : EMACS_leading_code_4
));
511 /* Update table iso_charset_table. */
512 if (ISO_CHARSET_TABLE (dimension
, chars
, iso_final_char
) < 0)
513 ISO_CHARSET_TABLE (dimension
, chars
, iso_final_char
) = charset
;
518 /* Return charset id of CHARSET_SYMBOL, or return -1 if CHARSET_SYMBOL
521 get_charset_id (charset_symbol
)
522 Lisp_Object charset_symbol
;
527 return ((SYMBOLP (charset_symbol
)
528 && (val
= Fget (charset_symbol
, Qcharset
), VECTORP (val
))
529 && (charset
= XINT (XVECTOR (val
)->contents
[CHARSET_ID_IDX
]),
530 CHARSET_VALID_P (charset
)))
534 /* Return an identification number for a new private charset of
535 DIMENSION and WIDTH. If there's no more room for the new charset,
538 get_new_private_charset_id (dimension
, width
)
539 int dimension
, width
;
541 int charset
, from
, to
;
546 from
= LEADING_CODE_EXT_11
, to
= LEADING_CODE_EXT_12
;
548 from
= LEADING_CODE_EXT_12
, to
= LEADING_CODE_EXT_21
;
553 from
= LEADING_CODE_EXT_21
, to
= LEADING_CODE_EXT_22
;
555 from
= LEADING_CODE_EXT_22
, to
= LEADING_CODE_EXT_MAX
+ 1;
558 for (charset
= from
; charset
< to
; charset
++)
559 if (!CHARSET_DEFINED_P (charset
)) break;
561 return make_number (charset
< to
? charset
: 0);
564 DEFUN ("define-charset", Fdefine_charset
, Sdefine_charset
, 3, 3, 0,
565 "Define CHARSET-ID as the identification number of CHARSET with INFO-VECTOR.\n\
566 If CHARSET-ID is nil, it is decided automatically, which means CHARSET is\n\
567 treated as a private charset.\n\
568 INFO-VECTOR is a vector of the format:\n\
569 [DIMENSION CHARS WIDTH DIRECTION ISO-FINAL-CHAR ISO-GRAPHIC-PLANE\n\
570 SHORT-NAME LONG-NAME DESCRIPTION]\n\
571 The meanings of each elements is as follows:\n\
572 DIMENSION (integer) is the number of bytes to represent a character: 1 or 2.\n\
573 CHARS (integer) is the number of characters in a dimension: 94 or 96.\n\
574 WIDTH (integer) is the number of columns a character in the charset\n\
575 occupies on the screen: one of 0, 1, and 2.\n\
577 DIRECTION (integer) is the rendering direction of characters in the\n\
578 charset when rendering. If 0, render from left to right, else\n\
579 render from right to left.\n\
581 ISO-FINAL-CHAR (character) is the final character of the\n\
582 corresponding ISO 2022 charset.\n\
584 ISO-GRAPHIC-PLANE (integer) is the graphic plane to be invoked\n\
585 while encoding to variants of ISO 2022 coding system, one of the\n\
586 following: 0/graphic-plane-left(GL), 1/graphic-plane-right(GR).\n\
588 SHORT-NAME (string) is the short name to refer to the charset.\n\
590 LONG-NAME (string) is the long name to refer to the charset.\n\
592 DESCRIPTION (string) is the description string of the charset.")
593 (charset_id
, charset_symbol
, info_vector
)
594 Lisp_Object charset_id
, charset_symbol
, info_vector
;
598 if (!NILP (charset_id
))
599 CHECK_NUMBER (charset_id
, 0);
600 CHECK_SYMBOL (charset_symbol
, 1);
601 CHECK_VECTOR (info_vector
, 2);
603 if (! NILP (charset_id
))
605 if (! CHARSET_VALID_P (XINT (charset_id
)))
606 error ("Invalid CHARSET: %d", XINT (charset_id
));
607 else if (CHARSET_DEFINED_P (XINT (charset_id
)))
608 error ("Already defined charset: %d", XINT (charset_id
));
611 vec
= XVECTOR (info_vector
)->contents
;
612 if (XVECTOR (info_vector
)->size
!= 9
613 || !INTEGERP (vec
[0]) || !(XINT (vec
[0]) == 1 || XINT (vec
[0]) == 2)
614 || !INTEGERP (vec
[1]) || !(XINT (vec
[1]) == 94 || XINT (vec
[1]) == 96)
615 || !INTEGERP (vec
[2]) || !(XINT (vec
[2]) == 1 || XINT (vec
[2]) == 2)
616 || !INTEGERP (vec
[3]) || !(XINT (vec
[3]) == 0 || XINT (vec
[3]) == 1)
617 || !INTEGERP (vec
[4]) || !(XINT (vec
[4]) >= '0' && XINT (vec
[4]) <= '~')
618 || !INTEGERP (vec
[5]) || !(XINT (vec
[5]) == 0 || XINT (vec
[5]) == 1)
621 || !STRINGP (vec
[8]))
622 error ("Invalid info-vector argument for defining charset %s",
623 XSYMBOL (charset_symbol
)->name
->data
);
625 if (NILP (charset_id
))
627 charset_id
= get_new_private_charset_id (XINT (vec
[0]), XINT (vec
[2]));
628 if (XINT (charset_id
) == 0)
629 error ("There's no room for a new private charset %s",
630 XSYMBOL (charset_symbol
)->name
->data
);
633 update_charset_table (charset_id
, vec
[0], vec
[1], vec
[2], vec
[3],
634 vec
[4], vec
[5], vec
[6], vec
[7], vec
[8]);
635 Fput (charset_symbol
, Qcharset
, CHARSET_TABLE_ENTRY (XINT (charset_id
)));
636 CHARSET_SYMBOL (XINT (charset_id
)) = charset_symbol
;
637 Vcharset_list
= Fcons (charset_symbol
, Vcharset_list
);
641 DEFUN ("generic-character-list", Fgeneric_character_list
,
642 Sgeneric_character_list
, 0, 0, 0,
643 "Return a list of all possible generic characters.\n\
644 It includes a generic character for a charset not yet defined.")
647 return Vgeneric_character_list
;
650 DEFUN ("get-unused-iso-final-char", Fget_unused_iso_final_char
,
651 Sget_unused_iso_final_char
, 2, 2, 0,
652 "Return an unsed ISO's final char for a charset of DIMENISION and CHARS.\n\
653 DIMENSION is the number of bytes to represent a character: 1 or 2.\n\
654 CHARS is the number of characters in a dimension: 94 or 96.\n\
656 This final char is for private use, thus the range is `0' (48) .. `?' (63).\n\
657 If there's no unused final char for the specified kind of charset,\n\
660 Lisp_Object dimension
, chars
;
664 CHECK_NUMBER (dimension
, 0);
665 CHECK_NUMBER (chars
, 1);
666 if (XINT (dimension
) != 1 && XINT (dimension
) != 2)
667 error ("Invalid charset dimension %d, it should be 1 or 2",
669 if (XINT (chars
) != 94 && XINT (chars
) != 96)
670 error ("Invalid charset chars %d, it should be 94 or 96",
672 for (final_char
= '0'; final_char
<= '?'; final_char
++)
674 if (ISO_CHARSET_TABLE (dimension
, chars
, make_number (final_char
)) < 0)
677 return (final_char
<= '?' ? make_number (final_char
) : Qnil
);
680 DEFUN ("declare-equiv-charset", Fdeclare_equiv_charset
, Sdeclare_equiv_charset
,
682 "Declare a charset of DIMENSION, CHARS, FINAL-CHAR is the same as CHARSET.\n\
683 CHARSET should be defined by `defined-charset' in advance.")
684 (dimension
, chars
, final_char
, charset_symbol
)
685 Lisp_Object dimension
, chars
, final_char
, charset_symbol
;
689 CHECK_NUMBER (dimension
, 0);
690 CHECK_NUMBER (chars
, 1);
691 CHECK_NUMBER (final_char
, 2);
692 CHECK_SYMBOL (charset_symbol
, 3);
694 if (XINT (dimension
) != 1 && XINT (dimension
) != 2)
695 error ("Invalid DIMENSION %d, it should be 1 or 2", XINT (dimension
));
696 if (XINT (chars
) != 94 && XINT (chars
) != 96)
697 error ("Invalid CHARS %d, it should be 94 or 96", XINT (chars
));
698 if (XINT (final_char
) < '0' || XFASTINT (final_char
) > '~')
699 error ("Invalid FINAL-CHAR %c, it should be `0'..`~'", XINT (chars
));
700 if ((charset
= get_charset_id (charset_symbol
)) < 0)
701 error ("Invalid charset %s", XSYMBOL (charset_symbol
)->name
->data
);
703 ISO_CHARSET_TABLE (dimension
, chars
, final_char
) = charset
;
707 /* Return number of different charsets in STR of length LEN. In
708 addition, for each found charset N, CHARSETS[N] is set 1. The
709 caller should allocate CHARSETS (MAX_CHARSET + 1 elements) in advance.
710 It may lookup a translation table TABLE if supplied.
712 If CMPCHARP is nonzero and some composite character is found,
713 CHARSETS[128] is also set 1 and the returned number is incremented
717 find_charset_in_str (str
, len
, charsets
, table
, cmpcharp
)
723 register int num
= 0, c
;
725 if (! CHAR_TABLE_P (table
))
733 if (c
== LEADING_CODE_COMPOSITION
)
735 int cmpchar_id
= str_cmpchar_id (str
, len
);
740 struct cmpchar_info
*cmp_p
= cmpchar_table
[cmpchar_id
];
743 for (i
= 0; i
< cmp_p
->glyph_len
; i
++)
748 if ((c
= translate_char (table
, c
, 0, 0, 0)) < 0)
751 if ((charset
= CHAR_CHARSET (c
)) < 0)
752 charset
= CHARSET_ASCII
;
753 if (!charsets
[charset
])
755 charsets
[charset
] = 1;
761 if (cmpcharp
&& !charsets
[CHARSET_COMPOSITION
])
763 charsets
[CHARSET_COMPOSITION
] = 1;
769 charset
= CHARSET_ASCII
;
774 c
= STRING_CHAR_AND_LENGTH (str
, len
, bytes
);
777 int c1
= translate_char (table
, c
, 0, 0, 0);
781 charset
= CHAR_CHARSET (c
);
784 if (!charsets
[charset
])
786 charsets
[charset
] = 1;
795 DEFUN ("find-charset-region", Ffind_charset_region
, Sfind_charset_region
,
797 "Return a list of charsets in the region between BEG and END.\n\
798 BEG and END are buffer positions.\n\
799 If the region contains any composite character,\n\
800 `composition' is included in the returned list.\n\
801 Optional arg TABLE if non-nil is a translation table to look up.")
803 Lisp_Object beg
, end
, table
;
805 int charsets
[MAX_CHARSET
+ 1];
806 int from
, from_byte
, to
, stop
, stop_byte
, i
;
809 validate_region (&beg
, &end
);
810 from
= XFASTINT (beg
);
811 stop
= to
= XFASTINT (end
);
813 if (NILP (current_buffer
->enable_multibyte_characters
))
816 : Fcons (Qascii
, Qnil
));
818 if (from
< GPT
&& GPT
< to
)
821 stop_byte
= GPT_BYTE
;
824 stop_byte
= CHAR_TO_BYTE (stop
);
826 from_byte
= CHAR_TO_BYTE (from
);
828 bzero (charsets
, (MAX_CHARSET
+ 1) * sizeof (int));
831 find_charset_in_str (BYTE_POS_ADDR (from_byte
), stop_byte
- from_byte
,
835 from
= stop
, from_byte
= stop_byte
;
836 stop
= to
, stop_byte
= CHAR_TO_BYTE (stop
);
843 for (i
= MAX_CHARSET
; i
>= 0; i
--)
845 val
= Fcons (CHARSET_SYMBOL (i
), val
);
849 DEFUN ("find-charset-string", Ffind_charset_string
, Sfind_charset_string
,
851 "Return a list of charsets in STR.\n\
852 If the string contains any composite characters,\n\
853 `composition' is included in the returned list.\n\
854 Optional arg TABLE if non-nil is a translation table to look up.")
856 Lisp_Object str
, table
;
858 int charsets
[MAX_CHARSET
+ 1];
862 CHECK_STRING (str
, 0);
864 if (! STRING_MULTIBYTE (str
))
865 return (XSTRING (str
)->size
== 0
867 : Fcons (Qascii
, Qnil
));
869 bzero (charsets
, (MAX_CHARSET
+ 1) * sizeof (int));
870 find_charset_in_str (XSTRING (str
)->data
, STRING_BYTES (XSTRING (str
)),
873 for (i
= MAX_CHARSET
; i
>= 0; i
--)
875 val
= Fcons (CHARSET_SYMBOL (i
), val
);
879 DEFUN ("make-char-internal", Fmake_char_internal
, Smake_char_internal
, 1, 3, 0,
881 (charset
, code1
, code2
)
882 Lisp_Object charset
, code1
, code2
;
884 CHECK_NUMBER (charset
, 0);
887 XSETFASTINT (code1
, 0);
889 CHECK_NUMBER (code1
, 1);
891 XSETFASTINT (code2
, 0);
893 CHECK_NUMBER (code2
, 2);
895 if (!CHARSET_DEFINED_P (XINT (charset
)))
896 error ("Invalid charset: %d", XINT (charset
));
898 return make_number (MAKE_CHAR (XINT (charset
), XINT (code1
), XINT (code2
)));
901 DEFUN ("split-char", Fsplit_char
, Ssplit_char
, 1, 1, 0,
902 "Return list of charset and one or two position-codes of CHAR.")
909 CHECK_NUMBER (ch
, 0);
910 SPLIT_CHAR (XFASTINT (ch
), charset
, c1
, c2
);
912 ? Fcons (CHARSET_SYMBOL (charset
),
913 Fcons (make_number (c1
), Fcons (make_number (c2
), Qnil
)))
914 : Fcons (CHARSET_SYMBOL (charset
), Fcons (make_number (c1
), Qnil
)));
917 DEFUN ("char-charset", Fchar_charset
, Schar_charset
, 1, 1, 0,
918 "Return charset of CHAR.")
922 CHECK_NUMBER (ch
, 0);
924 return CHARSET_SYMBOL (CHAR_CHARSET (XINT (ch
)));
927 DEFUN ("charset-after", Fcharset_after
, Scharset_after
, 0, 1, 0,
928 "Return charset of a character in current buffer at position POS.\n\
929 If POS is nil, it defauls to the current point.")
933 register int pos_byte
, c
, charset
;
934 register unsigned char *p
;
938 else if (MARKERP (pos
))
939 pos_byte
= marker_byte_position (pos
);
942 CHECK_NUMBER (pos
, 0);
943 pos_byte
= CHAR_TO_BYTE (XINT (pos
));
945 p
= BYTE_POS_ADDR (pos_byte
);
946 c
= STRING_CHAR (p
, Z_BYTE
- pos_byte
);
947 charset
= CHAR_CHARSET (c
);
948 return CHARSET_SYMBOL (charset
);
951 DEFUN ("iso-charset", Fiso_charset
, Siso_charset
, 3, 3, 0,
952 "Return charset of ISO's specification DIMENSION, CHARS, and FINAL-CHAR.\n\
954 ISO 2022's designation sequence (escape sequence) distinguishes charsets\n\
955 by their DIMENSION, CHARS, and FINAL-CHAR,\n\
956 where as Emacs distinguishes them by charset symbol.\n\
957 See the documentation of the function `charset-info' for the meanings of\n\
958 DIMENSION, CHARS, and FINAL-CHAR.")
959 (dimension
, chars
, final_char
)
960 Lisp_Object dimension
, chars
, final_char
;
964 CHECK_NUMBER (dimension
, 0);
965 CHECK_NUMBER (chars
, 1);
966 CHECK_NUMBER (final_char
, 2);
968 if ((charset
= ISO_CHARSET_TABLE (dimension
, chars
, final_char
)) < 0)
970 return CHARSET_SYMBOL (charset
);
973 /* If GENERICP is nonzero, return nonzero iff C is a valid normal or
974 generic character. If GENERICP is zero, return nonzero iff C is a
975 valid normal character. Do not call this function directly,
976 instead use macro CHAR_VALID_P. */
978 char_valid_p (c
, genericp
)
985 if (SINGLE_BYTE_CHAR_P (c
))
987 SPLIT_NON_ASCII_CHAR (c
, charset
, c1
, c2
);
988 if (!CHARSET_VALID_P (charset
))
990 return (c
< MIN_CHAR_COMPOSITION
991 ? ((c
& CHAR_FIELD1_MASK
) /* i.e. dimension of C is two. */
992 ? (genericp
&& c1
== 0 && c2
== 0
993 || c1
>= 32 && c2
>= 32)
994 : (genericp
&& c1
== 0
996 : c
< MIN_CHAR_COMPOSITION
+ n_cmpchars
);
999 DEFUN ("char-valid-p", Fchar_valid_p
, Schar_valid_p
, 1, 2, 0,
1000 "Return t if OBJECT is a valid normal character.\n\
1001 If optional arg GENERICP is non-nil, also return t if OBJECT is\n\
1002 a valid generic character.")
1004 Lisp_Object object
, genericp
;
1006 if (! NATNUMP (object
))
1008 return (CHAR_VALID_P (XFASTINT (object
), !NILP (genericp
)) ? Qt
: Qnil
);
1011 DEFUN ("unibyte-char-to-multibyte", Funibyte_char_to_multibyte
,
1012 Sunibyte_char_to_multibyte
, 1, 1, 0,
1013 "Convert the unibyte character CH to multibyte character.\n\
1014 The conversion is done based on `nonascii-translation-table' (which see)\n\
1015 or `nonascii-insert-offset' (which see).")
1021 CHECK_NUMBER (ch
, 0);
1023 if (c
< 0 || c
>= 0400)
1024 error ("Invalid unibyte character: %d", c
);
1025 c
= unibyte_char_to_multibyte (c
);
1027 error ("Can't convert to multibyte character: %d", XINT (ch
));
1028 return make_number (c
);
1031 DEFUN ("multibyte-char-to-unibyte", Fmultibyte_char_to_unibyte
,
1032 Smultibyte_char_to_unibyte
, 1, 1, 0,
1033 "Convert the multibyte character CH to unibyte character.\n\
1034 The conversion is done based on `nonascii-translation-table' (which see)\n\
1035 or `nonascii-insert-offset' (which see).")
1041 CHECK_NUMBER (ch
, 0);
1044 error ("Invalid multibyte character: %d", c
);
1045 c
= multibyte_char_to_unibyte (c
, Qnil
);
1047 error ("Can't convert to unibyte character: %d", XINT (ch
));
1048 return make_number (c
);
1051 DEFUN ("char-bytes", Fchar_bytes
, Schar_bytes
, 1, 1, 0,
1052 "Return 1 regardless of the argument CHAR.\n\
1053 This is now an obsolete function. We keep it just for backward compatibility.")
1059 CHECK_NUMBER (ch
, 0);
1060 return make_number (1);
1063 /* Return how many bytes C will occupy in a multibyte buffer.
1064 Don't call this function directly, instead use macro CHAR_BYTES. */
1071 if (COMPOSITE_CHAR_P (c
))
1073 unsigned int id
= COMPOSITE_CHAR_ID (c
);
1075 bytes
= (id
< n_cmpchars
? cmpchar_table
[id
]->len
: 1);
1079 int charset
= CHAR_CHARSET (c
);
1081 bytes
= CHARSET_DEFINED_P (charset
) ? CHARSET_BYTES (charset
) : 1;
1087 /* Return the width of character of which multi-byte form starts with
1088 C. The width is measured by how many columns occupied on the
1089 screen when displayed in the current buffer. */
1091 #define ONE_BYTE_CHAR_WIDTH(c) \
1094 ? XFASTINT (current_buffer->tab_width) \
1095 : (c == '\n' ? 0 : (NILP (current_buffer->ctl_arrow) ? 4 : 2))) \
1099 ? (NILP (current_buffer->ctl_arrow) ? 4 : 2) \
1100 : ((! NILP (current_buffer->enable_multibyte_characters) \
1101 && BASE_LEADING_CODE_P (c)) \
1102 ? WIDTH_BY_CHAR_HEAD (c) \
1105 DEFUN ("char-width", Fchar_width
, Schar_width
, 1, 1, 0,
1106 "Return width of CHAR when displayed in the current buffer.\n\
1107 The width is measured by how many columns it occupies on the screen.")
1111 Lisp_Object val
, disp
;
1113 struct Lisp_Char_Table
*dp
= buffer_display_table ();
1115 CHECK_NUMBER (ch
, 0);
1119 /* Get the way the display table would display it. */
1120 disp
= dp
? DISP_CHAR_VECTOR (dp
, c
) : Qnil
;
1123 XSETINT (val
, XVECTOR (disp
)->size
);
1124 else if (SINGLE_BYTE_CHAR_P (c
))
1125 XSETINT (val
, ONE_BYTE_CHAR_WIDTH (c
));
1126 else if (COMPOSITE_CHAR_P (c
))
1128 int id
= COMPOSITE_CHAR_ID (XFASTINT (ch
));
1129 XSETFASTINT (val
, (id
< n_cmpchars
? cmpchar_table
[id
]->width
: 0));
1133 int charset
= CHAR_CHARSET (c
);
1135 XSETFASTINT (val
, CHARSET_WIDTH (charset
));
1140 /* Return width of string STR of length LEN when displayed in the
1141 current buffer. The width is measured by how many columns it
1142 occupies on the screen. */
1149 unsigned char *endp
= str
+ len
;
1151 struct Lisp_Char_Table
*dp
= buffer_display_table ();
1155 if (*str
== LEADING_CODE_COMPOSITION
)
1157 int id
= str_cmpchar_id (str
, endp
- str
);
1166 width
+= cmpchar_table
[id
]->width
;
1167 str
+= cmpchar_table
[id
]->len
;
1174 int c
= STRING_CHAR_AND_LENGTH (str
, endp
- str
, thislen
);
1176 /* Get the way the display table would display it. */
1178 disp
= DISP_CHAR_VECTOR (dp
, c
);
1183 width
+= XVECTOR (disp
)->size
;
1185 width
+= ONE_BYTE_CHAR_WIDTH (*str
);
1193 DEFUN ("string-width", Fstring_width
, Sstring_width
, 1, 1, 0,
1194 "Return width of STRING when displayed in the current buffer.\n\
1195 Width is measured by how many columns it occupies on the screen.\n\
1196 When calculating width of a multibyte character in STRING,\n\
1197 only the base leading-code is considered; the validity of\n\
1198 the following bytes is not checked.")
1204 CHECK_STRING (str
, 0);
1205 XSETFASTINT (val
, strwidth (XSTRING (str
)->data
,
1206 STRING_BYTES (XSTRING (str
))));
1210 DEFUN ("char-direction", Fchar_direction
, Schar_direction
, 1, 1, 0,
1211 "Return the direction of CHAR.\n\
1212 The returned value is 0 for left-to-right and 1 for right-to-left.")
1218 CHECK_NUMBER (ch
, 0);
1219 charset
= CHAR_CHARSET (XFASTINT (ch
));
1220 if (!CHARSET_DEFINED_P (charset
))
1221 invalid_character (XINT (ch
));
1222 return CHARSET_TABLE_INFO (charset
, CHARSET_DIRECTION_IDX
);
1225 DEFUN ("chars-in-region", Fchars_in_region
, Schars_in_region
, 2, 2, 0,
1226 "Return number of characters between BEG and END.")
1228 Lisp_Object beg
, end
;
1232 CHECK_NUMBER_COERCE_MARKER (beg
, 0);
1233 CHECK_NUMBER_COERCE_MARKER (end
, 1);
1235 from
= min (XFASTINT (beg
), XFASTINT (end
));
1236 to
= max (XFASTINT (beg
), XFASTINT (end
));
1238 return make_number (to
- from
);
1241 /* Return the number of characters in the NBYTES bytes at PTR.
1242 This works by looking at the contents and checking for multibyte sequences.
1243 However, if the current buffer has enable-multibyte-characters = nil,
1244 we treat each byte as a character. */
1247 chars_in_text (ptr
, nbytes
)
1251 unsigned char *endp
, c
;
1254 /* current_buffer is null at early stages of Emacs initialization. */
1255 if (current_buffer
== 0
1256 || NILP (current_buffer
->enable_multibyte_characters
))
1259 endp
= ptr
+ nbytes
;
1266 if (BASE_LEADING_CODE_P (c
))
1267 while (ptr
< endp
&& ! CHAR_HEAD_P (*ptr
)) ptr
++;
1274 /* Return the number of characters in the NBYTES bytes at PTR.
1275 This works by looking at the contents and checking for multibyte sequences.
1276 It ignores enable-multibyte-characters. */
1279 multibyte_chars_in_text (ptr
, nbytes
)
1283 unsigned char *endp
, c
;
1286 endp
= ptr
+ nbytes
;
1293 if (BASE_LEADING_CODE_P (c
))
1294 while (ptr
< endp
&& ! CHAR_HEAD_P (*ptr
)) ptr
++;
1301 DEFUN ("string", Fstring
, Sstring
, 1, MANY
, 0,
1302 "Concatenate all the argument characters and make the result a string.")
1309 = (unsigned char *) alloca (MAX_LENGTH_OF_MULTI_BYTE_FORM
* n
);
1310 unsigned char *p
= buf
;
1313 for (i
= 0; i
< n
; i
++)
1318 if (!INTEGERP (args
[i
]))
1319 CHECK_NUMBER (args
[i
], 0);
1321 len
= CHAR_STRING (c
, p
, str
);
1323 /* C is a composite character. */
1324 bcopy (str
, p
, len
);
1328 /* Here, we can't use make_string_from_bytes because of byte
1329 combining problem. */
1330 val
= make_string (buf
, p
- buf
);
1336 /*** Composite characters staffs ***/
1338 /* Each composite character is identified by CMPCHAR-ID which is
1339 assigned when Emacs needs the character code of the composite
1340 character (e.g. when displaying it on the screen). See the
1341 document "GENERAL NOTE on COMPOSITE CHARACTER" in `charset.h' how a
1342 composite character is represented in Emacs. */
1344 /* If `static' is defined, it means that it is defined to null string. */
1346 /* The following function is copied from lread.c. */
1348 hash_string (ptr
, len
)
1352 register unsigned char *p
= ptr
;
1353 register unsigned char *end
= p
+ len
;
1354 register unsigned char c
;
1355 register int hash
= 0;
1360 if (c
>= 0140) c
-= 40;
1361 hash
= ((hash
<<3) + (hash
>>28) + c
);
1363 return hash
& 07777777777;
1367 #define CMPCHAR_HASH_TABLE_SIZE 0xFFF
1369 static int *cmpchar_hash_table
[CMPCHAR_HASH_TABLE_SIZE
];
1371 /* Each element of `cmpchar_hash_table' is a pointer to an array of
1372 integer, where the 1st element is the size of the array, the 2nd
1373 element is how many elements are actually used in the array, and
1374 the remaining elements are CMPCHAR-IDs of composite characters of
1375 the same hash value. */
1376 #define CMPCHAR_HASH_SIZE(table) table[0]
1377 #define CMPCHAR_HASH_USED(table) table[1]
1378 #define CMPCHAR_HASH_CMPCHAR_ID(table, i) table[i]
1380 /* Return CMPCHAR-ID of the composite character in STR of the length
1381 LEN. If the composite character has not yet been registered,
1382 register it in `cmpchar_table' and assign new CMPCHAR-ID. This
1383 is the sole function for assigning CMPCHAR-ID. */
1385 str_cmpchar_id (str
, len
)
1386 const unsigned char *str
;
1389 int hash_idx
, *hashp
;
1391 int embedded_rule
; /* 1 if composition rule is embedded. */
1392 int chars
; /* number of components. */
1394 struct cmpchar_info
*cmpcharp
;
1396 /* The second byte 0xFF means compostion rule is embedded. */
1397 embedded_rule
= (str
[1] == 0xFF);
1399 /* At first, get the actual length of the composite character. */
1401 const unsigned char *p
, *endp
= str
+ 1, *lastp
= str
+ len
;
1404 while (endp
< lastp
&& ! CHAR_HEAD_P (*endp
)) endp
++;
1406 /* Any composite char have at least 5-byte length. */
1413 if (embedded_rule
) p
++;
1414 /* No need of checking if *P is 0xA0 because
1415 BYTES_BY_CHAR_HEAD (0x80) surely returns 2. */
1416 p
+= BYTES_BY_CHAR_HEAD (*p
- 0x20);
1419 if (p
> endp
|| chars
< 2 || chars
> MAX_COMPONENT_COUNT
)
1420 /* Invalid components. */
1424 hash_idx
= hash_string (str
, len
) % CMPCHAR_HASH_TABLE_SIZE
;
1425 hashp
= cmpchar_hash_table
[hash_idx
];
1427 /* Then, look into the hash table. */
1429 /* Find the correct one among composite characters of the same
1431 for (i
= 2; i
< CMPCHAR_HASH_USED (hashp
); i
++)
1433 cmpcharp
= cmpchar_table
[CMPCHAR_HASH_CMPCHAR_ID (hashp
, i
)];
1434 if (len
== cmpcharp
->len
1435 && ! bcmp (str
, cmpcharp
->data
, len
))
1436 return CMPCHAR_HASH_CMPCHAR_ID (hashp
, i
);
1439 /* We have to register the composite character in cmpchar_table. */
1440 if (n_cmpchars
> (CHAR_FIELD2_MASK
| CHAR_FIELD3_MASK
))
1441 /* No, we have no more room for a new composite character. */
1444 /* Make the entry in hash table. */
1447 /* Make a table for 8 composite characters initially. */
1448 hashp
= (cmpchar_hash_table
[hash_idx
]
1449 = (int *) xmalloc (sizeof (int) * (2 + 8)));
1450 CMPCHAR_HASH_SIZE (hashp
) = 10;
1451 CMPCHAR_HASH_USED (hashp
) = 2;
1453 else if (CMPCHAR_HASH_USED (hashp
) >= CMPCHAR_HASH_SIZE (hashp
))
1455 CMPCHAR_HASH_SIZE (hashp
) += 8;
1456 hashp
= (cmpchar_hash_table
[hash_idx
]
1457 = (int *) xrealloc (hashp
,
1458 sizeof (int) * CMPCHAR_HASH_SIZE (hashp
)));
1460 CMPCHAR_HASH_CMPCHAR_ID (hashp
, CMPCHAR_HASH_USED (hashp
)) = n_cmpchars
;
1461 CMPCHAR_HASH_USED (hashp
)++;
1463 /* Set information of the composite character in cmpchar_table. */
1464 if (cmpchar_table_size
== 0)
1466 /* This is the first composite character to be registered. */
1467 cmpchar_table_size
= 256;
1469 = (struct cmpchar_info
**) xmalloc (sizeof (cmpchar_table
[0])
1470 * cmpchar_table_size
);
1472 else if (cmpchar_table_size
<= n_cmpchars
)
1474 cmpchar_table_size
+= 256;
1476 = (struct cmpchar_info
**) xrealloc (cmpchar_table
,
1477 sizeof (cmpchar_table
[0])
1478 * cmpchar_table_size
);
1481 cmpcharp
= (struct cmpchar_info
*) xmalloc (sizeof (struct cmpchar_info
));
1483 cmpcharp
->len
= len
;
1484 cmpcharp
->data
= (unsigned char *) xmalloc (len
+ 1);
1485 bcopy (str
, cmpcharp
->data
, len
);
1486 cmpcharp
->data
[len
] = 0;
1487 cmpcharp
->glyph_len
= chars
;
1488 cmpcharp
->glyph
= (GLYPH
*) xmalloc (sizeof (GLYPH
) * chars
);
1491 cmpcharp
->cmp_rule
= (unsigned char *) xmalloc (chars
);
1492 cmpcharp
->col_offset
= (float *) xmalloc (sizeof (float) * chars
);
1496 cmpcharp
->cmp_rule
= NULL
;
1497 cmpcharp
->col_offset
= NULL
;
1500 /* Setup GLYPH data and composition rules (if any) so as not to make
1501 them every time on displaying. */
1503 unsigned char *bufp
;
1505 float leftmost
= 0.0, rightmost
= 1.0;
1508 /* At first, col_offset[N] is set to relative to col_offset[0]. */
1509 cmpcharp
->col_offset
[0] = 0;
1511 for (i
= 0, bufp
= cmpcharp
->data
+ 1; i
< chars
; i
++)
1514 cmpcharp
->cmp_rule
[i
] = *bufp
++;
1516 if (*bufp
== 0xA0) /* This is an ASCII character. */
1518 cmpcharp
->glyph
[i
] = FAST_MAKE_GLYPH ((*++bufp
& 0x7F), 0);
1522 else /* Multibyte character. */
1524 /* Make `bufp' point normal multi-byte form temporally. */
1527 = FAST_MAKE_GLYPH (string_to_non_ascii_char (bufp
, 4, 0, 0), 0);
1528 width
= WIDTH_BY_CHAR_HEAD (*bufp
);
1530 bufp
+= BYTES_BY_CHAR_HEAD (*bufp
- 0x20);
1533 if (embedded_rule
&& i
> 0)
1535 /* Reference points (global_ref and new_ref) are
1546 Now, we calculate the column offset of the new glyph
1547 from the left edge of the first glyph. This can avoid
1548 the same calculation everytime displaying this
1549 composite character. */
1551 /* Reference points of global glyph and new glyph. */
1552 int global_ref
= (cmpcharp
->cmp_rule
[i
] - 0xA0) / 9;
1553 int new_ref
= (cmpcharp
->cmp_rule
[i
] - 0xA0) % 9;
1554 /* Column offset relative to the first glyph. */
1555 float left
= (leftmost
1556 + (global_ref
% 3) * (rightmost
- leftmost
) / 2.0
1557 - (new_ref
% 3) * width
/ 2.0);
1559 cmpcharp
->col_offset
[i
] = left
;
1560 if (left
< leftmost
)
1562 if (left
+ width
> rightmost
)
1563 rightmost
= left
+ width
;
1567 if (width
> rightmost
)
1573 /* Now col_offset[N] are relative to the left edge of the
1574 first component. Make them relative to the left edge of
1576 for (i
= 0; i
< chars
; i
++)
1577 cmpcharp
->col_offset
[i
] -= leftmost
;
1578 /* Make rightmost holds width of overall glyph. */
1579 rightmost
-= leftmost
;
1582 cmpcharp
->width
= rightmost
;
1583 if (cmpcharp
->width
< rightmost
)
1584 /* To get a ceiling integer value. */
1588 cmpchar_table
[n_cmpchars
] = cmpcharp
;
1590 return n_cmpchars
++;
1593 /* Return the Nth element of the composite character C. */
1595 cmpchar_component (c
, n
)
1598 int id
= COMPOSITE_CHAR_ID (c
);
1600 if (id
>= n_cmpchars
/* C is not a valid composite character. */
1601 || n
>= cmpchar_table
[id
]->glyph_len
) /* No such component. */
1603 /* No face data is stored in glyph code. */
1604 return ((int) (cmpchar_table
[id
]->glyph
[n
]));
1607 DEFUN ("cmpcharp", Fcmpcharp
, Scmpcharp
, 1, 1, 0,
1608 "T if CHAR is a composite character.")
1612 CHECK_NUMBER (ch
, 0);
1613 return (COMPOSITE_CHAR_P (XINT (ch
)) ? Qt
: Qnil
);
1616 DEFUN ("composite-char-component", Fcmpchar_component
, Scmpchar_component
,
1618 "Return the IDXth component character of composite character CHARACTER.")
1620 Lisp_Object character
, idx
;
1624 CHECK_NUMBER (character
, 0);
1625 CHECK_NUMBER (idx
, 1);
1627 if ((c
= cmpchar_component (XINT (character
), XINT (idx
))) < 0)
1628 args_out_of_range (character
, idx
);
1630 return make_number (c
);
1633 DEFUN ("composite-char-composition-rule", Fcmpchar_cmp_rule
, Scmpchar_cmp_rule
,
1635 "Return the Nth composition rule embedded in composite character CHARACTER.\n\
1636 The returned rule is for composing the Nth component\n\
1637 on the (N-1)th component. If N is 0, the returned value is always 255.")
1639 Lisp_Object character
, n
;
1643 CHECK_NUMBER (character
, 0);
1644 CHECK_NUMBER (n
, 1);
1646 id
= COMPOSITE_CHAR_ID (XINT (character
));
1647 if (id
< 0 || id
>= n_cmpchars
)
1648 error ("Invalid composite character: %d", XINT (character
));
1650 if (i
> cmpchar_table
[id
]->glyph_len
)
1651 args_out_of_range (character
, n
);
1653 return make_number (cmpchar_table
[id
]->cmp_rule
[i
]);
1656 DEFUN ("composite-char-composition-rule-p", Fcmpchar_cmp_rule_p
,
1657 Scmpchar_cmp_rule_p
, 1, 1, 0,
1658 "Return non-nil if composite character CHARACTER contains a embedded rule.")
1660 Lisp_Object character
;
1664 CHECK_NUMBER (character
, 0);
1665 id
= COMPOSITE_CHAR_ID (XINT (character
));
1666 if (id
< 0 || id
>= n_cmpchars
)
1667 error ("Invalid composite character: %d", XINT (character
));
1669 return (cmpchar_table
[id
]->cmp_rule
? Qt
: Qnil
);
1672 DEFUN ("composite-char-component-count", Fcmpchar_cmp_count
,
1673 Scmpchar_cmp_count
, 1, 1, 0,
1674 "Return number of compoents of composite character CHARACTER.")
1676 Lisp_Object character
;
1680 CHECK_NUMBER (character
, 0);
1681 id
= COMPOSITE_CHAR_ID (XINT (character
));
1682 if (id
< 0 || id
>= n_cmpchars
)
1683 error ("Invalid composite character: %d", XINT (character
));
1685 return (make_number (cmpchar_table
[id
]->glyph_len
));
1688 DEFUN ("compose-string", Fcompose_string
, Scompose_string
,
1690 "Return one char string composed from all characters in STRING.")
1694 unsigned char buf
[MAX_LENGTH_OF_MULTI_BYTE_FORM
], *p
, *pend
, *ptemp
;
1697 CHECK_STRING (str
, 0);
1699 buf
[0] = LEADING_CODE_COMPOSITION
;
1700 p
= XSTRING (str
)->data
;
1701 pend
= p
+ STRING_BYTES (XSTRING (str
));
1705 if (*p
< 0x20 || *p
== 127) /* control code */
1706 error ("Invalid component character: %d", *p
);
1707 else if (*p
< 0x80) /* ASCII */
1709 if (i
+ 2 >= MAX_LENGTH_OF_MULTI_BYTE_FORM
)
1710 error ("Too long string to be composed: %s", XSTRING (str
)->data
);
1711 /* Prepend an ASCII charset indicator 0xA0, set MSB of the
1714 buf
[i
++] = *p
++ + 0x80;
1716 else if (*p
== LEADING_CODE_COMPOSITION
) /* composite char */
1718 /* Already composed. Eliminate the heading
1719 LEADING_CODE_COMPOSITION, keep the remaining bytes
1723 while (! CHAR_HEAD_P (*p
)) p
++;
1724 if (i
+ (p
- ptemp
) >= MAX_LENGTH_OF_MULTI_BYTE_FORM
)
1725 error ("Too long string to be composed: %s", XSTRING (str
)->data
);
1726 bcopy (ptemp
, buf
+ i
, p
- ptemp
);
1729 else /* multibyte char */
1731 /* Add 0x20 to the base leading-code, keep the remaining
1733 len
= BYTES_BY_CHAR_HEAD (*p
);
1734 if (i
+ len
>= MAX_LENGTH_OF_MULTI_BYTE_FORM
)
1735 error ("Too long string to be composed: %s", XSTRING (str
)->data
);
1736 bcopy (p
, buf
+ i
, len
);
1743 /* STR contains only one character, which can't be composed. */
1744 error ("Too short string to be composed: %s", XSTRING (str
)->data
);
1746 return make_string_from_bytes (buf
, 1, i
);
1751 charset_id_internal (charset_name
)
1756 val
= Fget (intern (charset_name
), Qcharset
);
1758 error ("Charset %s is not defined", charset_name
);
1760 return (XINT (XVECTOR (val
)->contents
[0]));
1763 DEFUN ("setup-special-charsets", Fsetup_special_charsets
,
1764 Ssetup_special_charsets
, 0, 0, 0, "Internal use only.")
1767 charset_latin_iso8859_1
= charset_id_internal ("latin-iso8859-1");
1768 charset_jisx0208_1978
= charset_id_internal ("japanese-jisx0208-1978");
1769 charset_jisx0208
= charset_id_internal ("japanese-jisx0208");
1770 charset_katakana_jisx0201
= charset_id_internal ("katakana-jisx0201");
1771 charset_latin_jisx0201
= charset_id_internal ("latin-jisx0201");
1772 charset_big5_1
= charset_id_internal ("chinese-big5-1");
1773 charset_big5_2
= charset_id_internal ("chinese-big5-2");
1778 init_charset_once ()
1782 staticpro (&Vcharset_table
);
1783 staticpro (&Vcharset_symbol_table
);
1784 staticpro (&Vgeneric_character_list
);
1786 /* This has to be done here, before we call Fmake_char_table. */
1787 Qcharset_table
= intern ("charset-table");
1788 staticpro (&Qcharset_table
);
1790 /* Intern this now in case it isn't already done.
1791 Setting this variable twice is harmless.
1792 But don't staticpro it here--that is done in alloc.c. */
1793 Qchar_table_extra_slots
= intern ("char-table-extra-slots");
1795 /* Now we are ready to set up this property, so we can
1796 create the charset table. */
1797 Fput (Qcharset_table
, Qchar_table_extra_slots
, make_number (0));
1798 Vcharset_table
= Fmake_char_table (Qcharset_table
, Qnil
);
1800 Vcharset_symbol_table
= Fmake_vector (make_number (MAX_CHARSET
+ 1), Qnil
);
1803 for (i
= 0; i
< 2; i
++)
1804 for (j
= 0; j
< 2; j
++)
1805 for (k
= 0; k
< 128; k
++)
1806 iso_charset_table
[i
][j
][k
] = -1;
1808 bzero (cmpchar_hash_table
, sizeof cmpchar_hash_table
);
1809 cmpchar_table_size
= n_cmpchars
= 0;
1811 for (i
= 0; i
< 256; i
++)
1812 BYTES_BY_CHAR_HEAD (i
) = 1;
1813 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_11
) = 3;
1814 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_12
) = 3;
1815 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_21
) = 4;
1816 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_22
) = 4;
1817 /* The following doesn't reflect the actual bytes, but just to tell
1818 that it is a start of a multibyte character. */
1819 BYTES_BY_CHAR_HEAD (LEADING_CODE_COMPOSITION
) = 2;
1821 for (i
= 0; i
< 128; i
++)
1822 WIDTH_BY_CHAR_HEAD (i
) = 1;
1823 for (; i
< 256; i
++)
1824 WIDTH_BY_CHAR_HEAD (i
) = 4;
1825 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_11
) = 1;
1826 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_12
) = 2;
1827 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_21
) = 1;
1828 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_22
) = 2;
1834 for (i
= 0x81; i
< 0x90; i
++)
1835 val
= Fcons (make_number ((i
- 0x70) << 7), val
);
1836 for (; i
< 0x9A; i
++)
1837 val
= Fcons (make_number ((i
- 0x8F) << 14), val
);
1838 for (i
= 0xA0; i
< 0xF0; i
++)
1839 val
= Fcons (make_number ((i
- 0x70) << 7), val
);
1840 for (; i
< 0xFF; i
++)
1841 val
= Fcons (make_number ((i
- 0xE0) << 14), val
);
1842 val
= Fcons (make_number (GENERIC_COMPOSITION_CHAR
), val
);
1843 Vgeneric_character_list
= Fnreverse (val
);
1846 nonascii_insert_offset
= 0;
1847 Vnonascii_translation_table
= Qnil
;
1855 Qascii
= intern ("ascii");
1856 staticpro (&Qascii
);
1858 Qcharset
= intern ("charset");
1859 staticpro (&Qcharset
);
1861 /* Define ASCII charset now. */
1862 update_charset_table (make_number (CHARSET_ASCII
),
1863 make_number (1), make_number (94),
1868 build_string ("ASCII"),
1869 build_string ("ASCII"),
1870 build_string ("ASCII (ISO646 IRV)"));
1871 CHARSET_SYMBOL (CHARSET_ASCII
) = Qascii
;
1872 Fput (Qascii
, Qcharset
, CHARSET_TABLE_ENTRY (CHARSET_ASCII
));
1874 Qcomposition
= intern ("composition");
1875 staticpro (&Qcomposition
);
1876 CHARSET_SYMBOL (CHARSET_COMPOSITION
) = Qcomposition
;
1878 Qauto_fill_chars
= intern ("auto-fill-chars");
1879 staticpro (&Qauto_fill_chars
);
1880 Fput (Qauto_fill_chars
, Qchar_table_extra_slots
, make_number (0));
1882 defsubr (&Sdefine_charset
);
1883 defsubr (&Sgeneric_character_list
);
1884 defsubr (&Sget_unused_iso_final_char
);
1885 defsubr (&Sdeclare_equiv_charset
);
1886 defsubr (&Sfind_charset_region
);
1887 defsubr (&Sfind_charset_string
);
1888 defsubr (&Smake_char_internal
);
1889 defsubr (&Ssplit_char
);
1890 defsubr (&Schar_charset
);
1891 defsubr (&Scharset_after
);
1892 defsubr (&Siso_charset
);
1893 defsubr (&Schar_valid_p
);
1894 defsubr (&Sunibyte_char_to_multibyte
);
1895 defsubr (&Smultibyte_char_to_unibyte
);
1896 defsubr (&Schar_bytes
);
1897 defsubr (&Schar_width
);
1898 defsubr (&Sstring_width
);
1899 defsubr (&Schar_direction
);
1900 defsubr (&Schars_in_region
);
1902 defsubr (&Scmpcharp
);
1903 defsubr (&Scmpchar_component
);
1904 defsubr (&Scmpchar_cmp_rule
);
1905 defsubr (&Scmpchar_cmp_rule_p
);
1906 defsubr (&Scmpchar_cmp_count
);
1907 defsubr (&Scompose_string
);
1908 defsubr (&Ssetup_special_charsets
);
1910 DEFVAR_LISP ("charset-list", &Vcharset_list
,
1911 "List of charsets ever defined.");
1912 Vcharset_list
= Fcons (Qascii
, Qnil
);
1914 DEFVAR_LISP ("translation-table-vector", &Vtranslation_table_vector
,
1915 "Vector of cons cell of a symbol and translation table ever defined.\n\
1916 An ID of a translation table is an index of this vector.");
1917 Vtranslation_table_vector
= Fmake_vector (make_number (16), Qnil
);
1919 DEFVAR_INT ("leading-code-composition", &leading_code_composition
,
1920 "Leading-code of composite characters.");
1921 leading_code_composition
= LEADING_CODE_COMPOSITION
;
1923 DEFVAR_INT ("leading-code-private-11", &leading_code_private_11
,
1924 "Leading-code of private TYPE9N charset of column-width 1.");
1925 leading_code_private_11
= LEADING_CODE_PRIVATE_11
;
1927 DEFVAR_INT ("leading-code-private-12", &leading_code_private_12
,
1928 "Leading-code of private TYPE9N charset of column-width 2.");
1929 leading_code_private_12
= LEADING_CODE_PRIVATE_12
;
1931 DEFVAR_INT ("leading-code-private-21", &leading_code_private_21
,
1932 "Leading-code of private TYPE9Nx9N charset of column-width 1.");
1933 leading_code_private_21
= LEADING_CODE_PRIVATE_21
;
1935 DEFVAR_INT ("leading-code-private-22", &leading_code_private_22
,
1936 "Leading-code of private TYPE9Nx9N charset of column-width 2.");
1937 leading_code_private_22
= LEADING_CODE_PRIVATE_22
;
1939 DEFVAR_INT ("nonascii-insert-offset", &nonascii_insert_offset
,
1940 "Offset for converting non-ASCII unibyte codes 0240...0377 to multibyte.\n\
1941 This is used for converting unibyte text to multibyte,\n\
1942 and for inserting character codes specified by number.\n\n\
1943 This serves to convert a Latin-1 or similar 8-bit character code\n\
1944 to the corresponding Emacs multibyte character code.\n\
1945 Typically the value should be (- (make-char CHARSET 0) 128),\n\
1946 for your choice of character set.\n\
1947 If `nonascii-translation-table' is non-nil, it overrides this variable.");
1948 nonascii_insert_offset
= 0;
1950 DEFVAR_LISP ("nonascii-translation-table", &Vnonascii_translation_table
,
1951 "Translation table to convert non-ASCII unibyte codes to multibyte.\n\
1952 This is used for converting unibyte text to multibyte,\n\
1953 and for inserting character codes specified by number.\n\n\
1954 Conversion is performed only when multibyte characters are enabled,\n\
1955 and it serves to convert a Latin-1 or similar 8-bit character code\n\
1956 to the corresponding Emacs character code.\n\n\
1957 If this is nil, `nonascii-insert-offset' is used instead.\n\
1958 See also the docstring of `make-translation-table'.");
1959 Vnonascii_translation_table
= Qnil
;
1961 DEFVAR_INT ("min-composite-char", &min_composite_char
,
1962 "Minimum character code of a composite character.");
1963 min_composite_char
= MIN_CHAR_COMPOSITION
;
1965 DEFVAR_LISP ("auto-fill-chars", &Vauto_fill_chars
,
1966 "A char-table for characters which invoke auto-filling.\n\
1967 Such characters has value t in this table.");
1968 Vauto_fill_chars
= Fmake_char_table (Qauto_fill_chars
, Qnil
);
1969 CHAR_TABLE_SET (Vauto_fill_chars
, make_number (' '), Qt
);
1970 CHAR_TABLE_SET (Vauto_fill_chars
, make_number ('\n'), Qt
);