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
;
195 const unsigned char *begp
= str
;
200 if (BASE_LEADING_CODE_P (c
))
202 while (bytes
< len
&& ! CHAR_HEAD_P (begp
[bytes
])) bytes
++;
204 if (c
== LEADING_CODE_COMPOSITION
)
206 int cmpchar_id
= str_cmpchar_id (begp
, bytes
);
210 c
= MAKE_COMPOSITE_CHAR (cmpchar_id
);
211 str
+= cmpchar_table
[cmpchar_id
]->len
- 1;
218 const unsigned char *endp
= begp
+ bytes
;
219 int charset
= c
, c1
, c2
= 0;
221 if (str
>= endp
) break;
222 if (c
>= LEADING_CODE_PRIVATE_11
&& c
<= LEADING_CODE_PRIVATE_22
)
228 c1
= charset
, charset
= c
;
232 if (CHARSET_DEFINED_P (charset
)
233 && CHARSET_DIMENSION (charset
) == 2
236 c
= MAKE_NON_ASCII_CHAR (charset
, c1
, c2
);
241 *actual_len
= exclude_tail_garbage
? str
- begp
: bytes
;
245 /* Return the length of the multi-byte form at string STR of length LEN. */
247 multibyte_form_length (str
, len
)
248 const unsigned char *str
;
253 if (BASE_LEADING_CODE_P (*str
))
254 while (bytes
< len
&& ! CHAR_HEAD_P (str
[bytes
])) bytes
++;
259 /* Check if string STR of length LEN contains valid multi-byte form of
260 a character. If valid, charset and position codes of the character
261 is set at *CHARSET, *C1, and *C2, and return 0. If not valid,
262 return -1. This should be used only in the macro SPLIT_STRING
263 which checks range of STR in advance. */
266 split_non_ascii_string (str
, len
, charset
, c1
, c2
)
267 register const unsigned char *str
;
268 register unsigned char *c1
, *c2
;
269 register int len
, *charset
;
271 register unsigned int cs
= *str
++;
273 if (cs
== LEADING_CODE_COMPOSITION
)
275 int cmpchar_id
= str_cmpchar_id (str
- 1, len
);
279 *charset
= cs
, *c1
= cmpchar_id
>> 7, *c2
= cmpchar_id
& 0x7F;
281 else if ((cs
< LEADING_CODE_PRIVATE_11
|| (cs
= *str
++) >= 0xA0)
282 && CHARSET_DEFINED_P (cs
))
287 *c1
= (*str
++) & 0x7F;
288 if (CHARSET_DIMENSION (cs
) == 2)
292 *c2
= (*str
++) & 0x7F;
300 /* Translate character C by translation table TABLE. If C
301 is negative, translate a character specified by CHARSET, C1, and C2
302 (C1 and C2 are code points of the character). If no translation is
303 found in TABLE, return C. */
305 translate_char (table
, c
, charset
, c1
, c2
)
307 int c
, charset
, c1
, c2
;
310 int alt_charset
, alt_c1
, alt_c2
, dimension
;
312 if (c
< 0) c
= MAKE_CHAR (charset
, c1
, c2
);
313 if (!CHAR_TABLE_P (table
)
314 || (ch
= Faref (table
, make_number (c
)), !INTEGERP (ch
))
318 SPLIT_CHAR (XFASTINT (ch
), alt_charset
, alt_c1
, alt_c2
);
319 dimension
= CHARSET_DIMENSION (alt_charset
);
320 if (dimension
== 1 && alt_c1
> 0 || dimension
== 2 && alt_c2
> 0)
321 /* CH is not a generic character, just return it. */
322 return XFASTINT (ch
);
324 /* Since CH is a generic character, we must return a specific
325 charater which has the same position codes as C from CH. */
327 SPLIT_CHAR (c
, charset
, c1
, c2
);
328 if (dimension
!= CHARSET_DIMENSION (charset
))
329 /* We can't make such a character because of dimension mismatch. */
331 return MAKE_CHAR (alt_charset
, c1
, c2
);
334 /* Convert the unibyte character C to multibyte based on
335 Vnonascii_translation_table or nonascii_insert_offset. If they can't
336 convert C to a valid multibyte character, convert it based on
337 DEFAULT_NONASCII_INSERT_OFFSET which makes C a Latin-1 character. */
340 unibyte_char_to_multibyte (c
)
347 if (! NILP (Vnonascii_translation_table
))
349 c
= XINT (Faref (Vnonascii_translation_table
, make_number (c
)));
350 if (c
>= 0400 && ! VALID_MULTIBYTE_CHAR_P (c
))
351 c
= c_save
+ DEFAULT_NONASCII_INSERT_OFFSET
;
353 else if (c
>= 0240 && nonascii_insert_offset
> 0)
355 c
+= nonascii_insert_offset
;
356 if (c
< 0400 || ! VALID_MULTIBYTE_CHAR_P (c
))
357 c
= c_save
+ DEFAULT_NONASCII_INSERT_OFFSET
;
360 c
= c_save
+ DEFAULT_NONASCII_INSERT_OFFSET
;
366 /* Convert the multibyte character C to unibyte 8-bit character based
367 on Vnonascii_translation_table or nonascii_insert_offset. If
368 REV_TBL is non-nil, it should be a reverse table of
369 Vnonascii_translation_table, i.e. what given by:
370 Fchar_table_extra_slot (Vnonascii_translation_table, make_number (0)) */
373 multibyte_char_to_unibyte (c
, rev_tbl
)
377 if (!SINGLE_BYTE_CHAR_P (c
))
381 if (! CHAR_TABLE_P (rev_tbl
)
382 && CHAR_TABLE_P (Vnonascii_translation_table
))
383 rev_tbl
= Fchar_table_extra_slot (Vnonascii_translation_table
,
385 if (CHAR_TABLE_P (rev_tbl
))
388 temp
= Faref (rev_tbl
, make_number (c
));
392 c
= (c_save
& 0177) + 0200;
396 if (nonascii_insert_offset
> 0)
397 c
-= nonascii_insert_offset
;
398 if (c
< 128 || c
>= 256)
399 c
= (c_save
& 0177) + 0200;
407 /* Update the table Vcharset_table with the given arguments (see the
408 document of `define-charset' for the meaning of each argument).
409 Several other table contents are also updated. The caller should
410 check the validity of CHARSET-ID and the remaining arguments in
414 update_charset_table (charset_id
, dimension
, chars
, width
, direction
,
415 iso_final_char
, iso_graphic_plane
,
416 short_name
, long_name
, description
)
417 Lisp_Object charset_id
, dimension
, chars
, width
, direction
;
418 Lisp_Object iso_final_char
, iso_graphic_plane
;
419 Lisp_Object short_name
, long_name
, description
;
421 int charset
= XINT (charset_id
);
423 unsigned char leading_code_base
, leading_code_ext
;
425 if (NILP (CHARSET_TABLE_ENTRY (charset
)))
426 CHARSET_TABLE_ENTRY (charset
)
427 = Fmake_vector (make_number (CHARSET_MAX_IDX
), Qnil
);
429 /* Get byte length of multibyte form, base leading-code, and
430 extended leading-code of the charset. See the comment under the
431 title "GENERAL NOTE on CHARACTER SET (CHARSET)" in charset.h. */
432 bytes
= XINT (dimension
);
433 if (charset
< MIN_CHARSET_PRIVATE_DIMENSION1
)
435 /* Official charset, it doesn't have an extended leading-code. */
436 if (charset
!= CHARSET_ASCII
)
437 bytes
+= 1; /* For a base leading-code. */
438 leading_code_base
= charset
;
439 leading_code_ext
= 0;
443 /* Private charset. */
444 bytes
+= 2; /* For base and extended leading-codes. */
446 = (charset
< LEADING_CODE_EXT_12
447 ? LEADING_CODE_PRIVATE_11
448 : (charset
< LEADING_CODE_EXT_21
449 ? LEADING_CODE_PRIVATE_12
450 : (charset
< LEADING_CODE_EXT_22
451 ? LEADING_CODE_PRIVATE_21
452 : LEADING_CODE_PRIVATE_22
)));
453 leading_code_ext
= charset
;
456 if (BYTES_BY_CHAR_HEAD (leading_code_base
) != bytes
)
457 error ("Invalid dimension for the charset-ID %d", charset
);
459 CHARSET_TABLE_INFO (charset
, CHARSET_ID_IDX
) = charset_id
;
460 CHARSET_TABLE_INFO (charset
, CHARSET_BYTES_IDX
) = make_number (bytes
);
461 CHARSET_TABLE_INFO (charset
, CHARSET_DIMENSION_IDX
) = dimension
;
462 CHARSET_TABLE_INFO (charset
, CHARSET_CHARS_IDX
) = chars
;
463 CHARSET_TABLE_INFO (charset
, CHARSET_WIDTH_IDX
) = width
;
464 CHARSET_TABLE_INFO (charset
, CHARSET_DIRECTION_IDX
) = direction
;
465 CHARSET_TABLE_INFO (charset
, CHARSET_LEADING_CODE_BASE_IDX
)
466 = make_number (leading_code_base
);
467 CHARSET_TABLE_INFO (charset
, CHARSET_LEADING_CODE_EXT_IDX
)
468 = make_number (leading_code_ext
);
469 CHARSET_TABLE_INFO (charset
, CHARSET_ISO_FINAL_CHAR_IDX
) = iso_final_char
;
470 CHARSET_TABLE_INFO (charset
, CHARSET_ISO_GRAPHIC_PLANE_IDX
)
472 CHARSET_TABLE_INFO (charset
, CHARSET_SHORT_NAME_IDX
) = short_name
;
473 CHARSET_TABLE_INFO (charset
, CHARSET_LONG_NAME_IDX
) = long_name
;
474 CHARSET_TABLE_INFO (charset
, CHARSET_DESCRIPTION_IDX
) = description
;
475 CHARSET_TABLE_INFO (charset
, CHARSET_PLIST_IDX
) = Qnil
;
478 /* If we have already defined a charset which has the same
479 DIMENSION, CHARS and ISO-FINAL-CHAR but the different
480 DIRECTION, we must update the entry REVERSE-CHARSET of both
481 charsets. If there's no such charset, the value of the entry
485 for (i
= 0; i
<= MAX_CHARSET
; i
++)
486 if (!NILP (CHARSET_TABLE_ENTRY (i
)))
488 if (CHARSET_DIMENSION (i
) == XINT (dimension
)
489 && CHARSET_CHARS (i
) == XINT (chars
)
490 && CHARSET_ISO_FINAL_CHAR (i
) == XINT (iso_final_char
)
491 && CHARSET_DIRECTION (i
) != XINT (direction
))
493 CHARSET_TABLE_INFO (charset
, CHARSET_REVERSE_CHARSET_IDX
)
495 CHARSET_TABLE_INFO (i
, CHARSET_REVERSE_CHARSET_IDX
) = charset_id
;
500 /* No such a charset. */
501 CHARSET_TABLE_INFO (charset
, CHARSET_REVERSE_CHARSET_IDX
)
505 if (charset
!= CHARSET_ASCII
506 && charset
< MIN_CHARSET_PRIVATE_DIMENSION1
)
508 width_by_char_head
[leading_code_base
] = XINT (width
);
510 /* Update table emacs_code_class. */
511 emacs_code_class
[charset
] = (bytes
== 2
512 ? EMACS_leading_code_2
514 ? EMACS_leading_code_3
515 : EMACS_leading_code_4
));
518 /* Update table iso_charset_table. */
519 if (ISO_CHARSET_TABLE (dimension
, chars
, iso_final_char
) < 0)
520 ISO_CHARSET_TABLE (dimension
, chars
, iso_final_char
) = charset
;
525 /* Return charset id of CHARSET_SYMBOL, or return -1 if CHARSET_SYMBOL
528 get_charset_id (charset_symbol
)
529 Lisp_Object charset_symbol
;
534 return ((SYMBOLP (charset_symbol
)
535 && (val
= Fget (charset_symbol
, Qcharset
), VECTORP (val
))
536 && (charset
= XINT (XVECTOR (val
)->contents
[CHARSET_ID_IDX
]),
537 CHARSET_VALID_P (charset
)))
541 /* Return an identification number for a new private charset of
542 DIMENSION and WIDTH. If there's no more room for the new charset,
545 get_new_private_charset_id (dimension
, width
)
546 int dimension
, width
;
548 int charset
, from
, to
;
553 from
= LEADING_CODE_EXT_11
, to
= LEADING_CODE_EXT_12
;
555 from
= LEADING_CODE_EXT_12
, to
= LEADING_CODE_EXT_21
;
560 from
= LEADING_CODE_EXT_21
, to
= LEADING_CODE_EXT_22
;
562 from
= LEADING_CODE_EXT_22
, to
= LEADING_CODE_EXT_MAX
+ 1;
565 for (charset
= from
; charset
< to
; charset
++)
566 if (!CHARSET_DEFINED_P (charset
)) break;
568 return make_number (charset
< to
? charset
: 0);
571 DEFUN ("define-charset", Fdefine_charset
, Sdefine_charset
, 3, 3, 0,
572 "Define CHARSET-ID as the identification number of CHARSET with INFO-VECTOR.\n\
573 If CHARSET-ID is nil, it is decided automatically, which means CHARSET is\n\
574 treated as a private charset.\n\
575 INFO-VECTOR is a vector of the format:\n\
576 [DIMENSION CHARS WIDTH DIRECTION ISO-FINAL-CHAR ISO-GRAPHIC-PLANE\n\
577 SHORT-NAME LONG-NAME DESCRIPTION]\n\
578 The meanings of each elements is as follows:\n\
579 DIMENSION (integer) is the number of bytes to represent a character: 1 or 2.\n\
580 CHARS (integer) is the number of characters in a dimension: 94 or 96.\n\
581 WIDTH (integer) is the number of columns a character in the charset\n\
582 occupies on the screen: one of 0, 1, and 2.\n\
584 DIRECTION (integer) is the rendering direction of characters in the\n\
585 charset when rendering. If 0, render from left to right, else\n\
586 render from right to left.\n\
588 ISO-FINAL-CHAR (character) is the final character of the\n\
589 corresponding ISO 2022 charset.\n\
591 ISO-GRAPHIC-PLANE (integer) is the graphic plane to be invoked\n\
592 while encoding to variants of ISO 2022 coding system, one of the\n\
593 following: 0/graphic-plane-left(GL), 1/graphic-plane-right(GR).\n\
595 SHORT-NAME (string) is the short name to refer to the charset.\n\
597 LONG-NAME (string) is the long name to refer to the charset.\n\
599 DESCRIPTION (string) is the description string of the charset.")
600 (charset_id
, charset_symbol
, info_vector
)
601 Lisp_Object charset_id
, charset_symbol
, info_vector
;
605 if (!NILP (charset_id
))
606 CHECK_NUMBER (charset_id
, 0);
607 CHECK_SYMBOL (charset_symbol
, 1);
608 CHECK_VECTOR (info_vector
, 2);
610 if (! NILP (charset_id
))
612 if (! CHARSET_VALID_P (XINT (charset_id
)))
613 error ("Invalid CHARSET: %d", XINT (charset_id
));
614 else if (CHARSET_DEFINED_P (XINT (charset_id
)))
615 error ("Already defined charset: %d", XINT (charset_id
));
618 vec
= XVECTOR (info_vector
)->contents
;
619 if (XVECTOR (info_vector
)->size
!= 9
620 || !INTEGERP (vec
[0]) || !(XINT (vec
[0]) == 1 || XINT (vec
[0]) == 2)
621 || !INTEGERP (vec
[1]) || !(XINT (vec
[1]) == 94 || XINT (vec
[1]) == 96)
622 || !INTEGERP (vec
[2]) || !(XINT (vec
[2]) == 1 || XINT (vec
[2]) == 2)
623 || !INTEGERP (vec
[3]) || !(XINT (vec
[3]) == 0 || XINT (vec
[3]) == 1)
624 || !INTEGERP (vec
[4]) || !(XINT (vec
[4]) >= '0' && XINT (vec
[4]) <= '~')
625 || !INTEGERP (vec
[5]) || !(XINT (vec
[5]) == 0 || XINT (vec
[5]) == 1)
628 || !STRINGP (vec
[8]))
629 error ("Invalid info-vector argument for defining charset %s",
630 XSYMBOL (charset_symbol
)->name
->data
);
632 if (NILP (charset_id
))
634 charset_id
= get_new_private_charset_id (XINT (vec
[0]), XINT (vec
[2]));
635 if (XINT (charset_id
) == 0)
636 error ("There's no room for a new private charset %s",
637 XSYMBOL (charset_symbol
)->name
->data
);
640 update_charset_table (charset_id
, vec
[0], vec
[1], vec
[2], vec
[3],
641 vec
[4], vec
[5], vec
[6], vec
[7], vec
[8]);
642 Fput (charset_symbol
, Qcharset
, CHARSET_TABLE_ENTRY (XINT (charset_id
)));
643 CHARSET_SYMBOL (XINT (charset_id
)) = charset_symbol
;
644 Vcharset_list
= Fcons (charset_symbol
, Vcharset_list
);
648 DEFUN ("generic-character-list", Fgeneric_character_list
,
649 Sgeneric_character_list
, 0, 0, 0,
650 "Return a list of all possible generic characters.\n\
651 It includes a generic character for a charset not yet defined.")
654 return Vgeneric_character_list
;
657 DEFUN ("get-unused-iso-final-char", Fget_unused_iso_final_char
,
658 Sget_unused_iso_final_char
, 2, 2, 0,
659 "Return an unsed ISO's final char for a charset of DIMENISION and CHARS.\n\
660 DIMENSION is the number of bytes to represent a character: 1 or 2.\n\
661 CHARS is the number of characters in a dimension: 94 or 96.\n\
663 This final char is for private use, thus the range is `0' (48) .. `?' (63).\n\
664 If there's no unused final char for the specified kind of charset,\n\
667 Lisp_Object dimension
, chars
;
671 CHECK_NUMBER (dimension
, 0);
672 CHECK_NUMBER (chars
, 1);
673 if (XINT (dimension
) != 1 && XINT (dimension
) != 2)
674 error ("Invalid charset dimension %d, it should be 1 or 2",
676 if (XINT (chars
) != 94 && XINT (chars
) != 96)
677 error ("Invalid charset chars %d, it should be 94 or 96",
679 for (final_char
= '0'; final_char
<= '?'; final_char
++)
681 if (ISO_CHARSET_TABLE (dimension
, chars
, make_number (final_char
)) < 0)
684 return (final_char
<= '?' ? make_number (final_char
) : Qnil
);
687 DEFUN ("declare-equiv-charset", Fdeclare_equiv_charset
, Sdeclare_equiv_charset
,
689 "Declare a charset of DIMENSION, CHARS, FINAL-CHAR is the same as CHARSET.\n\
690 CHARSET should be defined by `defined-charset' in advance.")
691 (dimension
, chars
, final_char
, charset_symbol
)
692 Lisp_Object dimension
, chars
, final_char
, charset_symbol
;
696 CHECK_NUMBER (dimension
, 0);
697 CHECK_NUMBER (chars
, 1);
698 CHECK_NUMBER (final_char
, 2);
699 CHECK_SYMBOL (charset_symbol
, 3);
701 if (XINT (dimension
) != 1 && XINT (dimension
) != 2)
702 error ("Invalid DIMENSION %d, it should be 1 or 2", XINT (dimension
));
703 if (XINT (chars
) != 94 && XINT (chars
) != 96)
704 error ("Invalid CHARS %d, it should be 94 or 96", XINT (chars
));
705 if (XINT (final_char
) < '0' || XFASTINT (final_char
) > '~')
706 error ("Invalid FINAL-CHAR %c, it should be `0'..`~'", XINT (chars
));
707 if ((charset
= get_charset_id (charset_symbol
)) < 0)
708 error ("Invalid charset %s", XSYMBOL (charset_symbol
)->name
->data
);
710 ISO_CHARSET_TABLE (dimension
, chars
, final_char
) = charset
;
714 /* Return number of different charsets in STR of length LEN. In
715 addition, for each found charset N, CHARSETS[N] is set 1. The
716 caller should allocate CHARSETS (MAX_CHARSET + 1 elements) in advance.
717 It may lookup a translation table TABLE if supplied.
719 If CMPCHARP is nonzero and some composite character is found,
720 CHARSETS[128] is also set 1 and the returned number is incremented
724 find_charset_in_str (str
, len
, charsets
, table
, cmpcharp
)
730 register int num
= 0, c
;
732 if (! CHAR_TABLE_P (table
))
740 if (c
== LEADING_CODE_COMPOSITION
)
742 int cmpchar_id
= str_cmpchar_id (str
, len
);
747 struct cmpchar_info
*cmp_p
= cmpchar_table
[cmpchar_id
];
750 for (i
= 0; i
< cmp_p
->glyph_len
; i
++)
755 if ((c
= translate_char (table
, c
, 0, 0, 0)) < 0)
758 if ((charset
= CHAR_CHARSET (c
)) < 0)
759 charset
= CHARSET_ASCII
;
760 if (!charsets
[charset
])
762 charsets
[charset
] = 1;
768 if (cmpcharp
&& !charsets
[CHARSET_COMPOSITION
])
770 charsets
[CHARSET_COMPOSITION
] = 1;
776 charset
= CHARSET_ASCII
;
781 c
= STRING_CHAR_AND_LENGTH (str
, len
, bytes
);
784 int c1
= translate_char (table
, c
, 0, 0, 0);
788 charset
= CHAR_CHARSET (c
);
791 if (!charsets
[charset
])
793 charsets
[charset
] = 1;
802 DEFUN ("find-charset-region", Ffind_charset_region
, Sfind_charset_region
,
804 "Return a list of charsets in the region between BEG and END.\n\
805 BEG and END are buffer positions.\n\
806 If the region contains any composite character,\n\
807 `composition' is included in the returned list.\n\
808 Optional arg TABLE if non-nil is a translation table to look up.")
810 Lisp_Object beg
, end
, table
;
812 int charsets
[MAX_CHARSET
+ 1];
813 int from
, from_byte
, to
, stop
, stop_byte
, i
;
816 validate_region (&beg
, &end
);
817 from
= XFASTINT (beg
);
818 stop
= to
= XFASTINT (end
);
820 if (NILP (current_buffer
->enable_multibyte_characters
))
823 : Fcons (Qascii
, Qnil
));
825 if (from
< GPT
&& GPT
< to
)
828 stop_byte
= GPT_BYTE
;
831 stop_byte
= CHAR_TO_BYTE (stop
);
833 from_byte
= CHAR_TO_BYTE (from
);
835 bzero (charsets
, (MAX_CHARSET
+ 1) * sizeof (int));
838 find_charset_in_str (BYTE_POS_ADDR (from_byte
), stop_byte
- from_byte
,
842 from
= stop
, from_byte
= stop_byte
;
843 stop
= to
, stop_byte
= CHAR_TO_BYTE (stop
);
850 for (i
= MAX_CHARSET
; i
>= 0; i
--)
852 val
= Fcons (CHARSET_SYMBOL (i
), val
);
856 DEFUN ("find-charset-string", Ffind_charset_string
, Sfind_charset_string
,
858 "Return a list of charsets in STR.\n\
859 If the string contains any composite characters,\n\
860 `composition' is included in the returned list.\n\
861 Optional arg TABLE if non-nil is a translation table to look up.")
863 Lisp_Object str
, table
;
865 int charsets
[MAX_CHARSET
+ 1];
869 CHECK_STRING (str
, 0);
871 if (! STRING_MULTIBYTE (str
))
872 return (XSTRING (str
)->size
== 0
874 : Fcons (Qascii
, Qnil
));
876 bzero (charsets
, (MAX_CHARSET
+ 1) * sizeof (int));
877 find_charset_in_str (XSTRING (str
)->data
, STRING_BYTES (XSTRING (str
)),
880 for (i
= MAX_CHARSET
; i
>= 0; i
--)
882 val
= Fcons (CHARSET_SYMBOL (i
), val
);
886 DEFUN ("make-char-internal", Fmake_char_internal
, Smake_char_internal
, 1, 3, 0,
888 (charset
, code1
, code2
)
889 Lisp_Object charset
, code1
, code2
;
891 CHECK_NUMBER (charset
, 0);
894 XSETFASTINT (code1
, 0);
896 CHECK_NUMBER (code1
, 1);
898 XSETFASTINT (code2
, 0);
900 CHECK_NUMBER (code2
, 2);
902 if (!CHARSET_DEFINED_P (XINT (charset
)))
903 error ("Invalid charset: %d", XINT (charset
));
905 return make_number (MAKE_CHAR (XINT (charset
), XINT (code1
), XINT (code2
)));
908 DEFUN ("split-char", Fsplit_char
, Ssplit_char
, 1, 1, 0,
909 "Return list of charset and one or two position-codes of CHAR.")
916 CHECK_NUMBER (ch
, 0);
917 SPLIT_CHAR (XFASTINT (ch
), charset
, c1
, c2
);
919 ? Fcons (CHARSET_SYMBOL (charset
),
920 Fcons (make_number (c1
), Fcons (make_number (c2
), Qnil
)))
921 : Fcons (CHARSET_SYMBOL (charset
), Fcons (make_number (c1
), Qnil
)));
924 DEFUN ("char-charset", Fchar_charset
, Schar_charset
, 1, 1, 0,
925 "Return charset of CHAR.")
929 CHECK_NUMBER (ch
, 0);
931 return CHARSET_SYMBOL (CHAR_CHARSET (XINT (ch
)));
934 DEFUN ("charset-after", Fcharset_after
, Scharset_after
, 0, 1, 0,
935 "Return charset of a character in current buffer at position POS.\n\
936 If POS is nil, it defauls to the current point.")
940 register int pos_byte
, c
, charset
;
941 register unsigned char *p
;
945 else if (MARKERP (pos
))
946 pos_byte
= marker_byte_position (pos
);
949 CHECK_NUMBER (pos
, 0);
950 pos_byte
= CHAR_TO_BYTE (XINT (pos
));
952 p
= BYTE_POS_ADDR (pos_byte
);
953 c
= STRING_CHAR (p
, Z_BYTE
- pos_byte
);
954 charset
= CHAR_CHARSET (c
);
955 return CHARSET_SYMBOL (charset
);
958 DEFUN ("iso-charset", Fiso_charset
, Siso_charset
, 3, 3, 0,
959 "Return charset of ISO's specification DIMENSION, CHARS, and FINAL-CHAR.\n\
961 ISO 2022's designation sequence (escape sequence) distinguishes charsets\n\
962 by their DIMENSION, CHARS, and FINAL-CHAR,\n\
963 where as Emacs distinguishes them by charset symbol.\n\
964 See the documentation of the function `charset-info' for the meanings of\n\
965 DIMENSION, CHARS, and FINAL-CHAR.")
966 (dimension
, chars
, final_char
)
967 Lisp_Object dimension
, chars
, final_char
;
971 CHECK_NUMBER (dimension
, 0);
972 CHECK_NUMBER (chars
, 1);
973 CHECK_NUMBER (final_char
, 2);
975 if ((charset
= ISO_CHARSET_TABLE (dimension
, chars
, final_char
)) < 0)
977 return CHARSET_SYMBOL (charset
);
980 /* If GENERICP is nonzero, return nonzero iff C is a valid normal or
981 generic character. If GENERICP is zero, return nonzero iff C is a
982 valid normal character. Do not call this function directly,
983 instead use macro CHAR_VALID_P. */
985 char_valid_p (c
, genericp
)
992 if (SINGLE_BYTE_CHAR_P (c
))
994 SPLIT_NON_ASCII_CHAR (c
, charset
, c1
, c2
);
995 if (!CHARSET_DEFINED_P (charset
))
997 return (c
< MIN_CHAR_COMPOSITION
998 ? ((c
& CHAR_FIELD1_MASK
) /* i.e. dimension of C is two. */
999 ? (genericp
&& c1
== 0 && c2
== 0
1000 || c1
>= 32 && c2
>= 32)
1001 : (genericp
&& c1
== 0
1003 : c
< MIN_CHAR_COMPOSITION
+ n_cmpchars
);
1006 DEFUN ("char-valid-p", Fchar_valid_p
, Schar_valid_p
, 1, 2, 0,
1007 "Return t if OBJECT is a valid normal character.\n\
1008 If optional arg GENERICP is non-nil, also return t if OBJECT is\n\
1009 a valid generic character.")
1011 Lisp_Object object
, genericp
;
1013 if (! NATNUMP (object
))
1015 return (CHAR_VALID_P (XFASTINT (object
), !NILP (genericp
)) ? Qt
: Qnil
);
1018 DEFUN ("unibyte-char-to-multibyte", Funibyte_char_to_multibyte
,
1019 Sunibyte_char_to_multibyte
, 1, 1, 0,
1020 "Convert the unibyte character CH to multibyte character.\n\
1021 The conversion is done based on `nonascii-translation-table' (which see)\n\
1022 or `nonascii-insert-offset' (which see).")
1028 CHECK_NUMBER (ch
, 0);
1030 if (c
< 0 || c
>= 0400)
1031 error ("Invalid unibyte character: %d", c
);
1032 c
= unibyte_char_to_multibyte (c
);
1034 error ("Can't convert to multibyte character: %d", XINT (ch
));
1035 return make_number (c
);
1038 DEFUN ("multibyte-char-to-unibyte", Fmultibyte_char_to_unibyte
,
1039 Smultibyte_char_to_unibyte
, 1, 1, 0,
1040 "Convert the multibyte character CH to unibyte character.\n\
1041 The conversion is done based on `nonascii-translation-table' (which see)\n\
1042 or `nonascii-insert-offset' (which see).")
1048 CHECK_NUMBER (ch
, 0);
1051 error ("Invalid multibyte character: %d", c
);
1052 c
= multibyte_char_to_unibyte (c
, Qnil
);
1054 error ("Can't convert to unibyte character: %d", XINT (ch
));
1055 return make_number (c
);
1058 DEFUN ("char-bytes", Fchar_bytes
, Schar_bytes
, 1, 1, 0,
1059 "Return 1 regardless of the argument CHAR.\n\
1060 This is now an obsolete function. We keep it just for backward compatibility.")
1066 CHECK_NUMBER (ch
, 0);
1067 return make_number (1);
1070 /* Return how many bytes C will occupy in a multibyte buffer.
1071 Don't call this function directly, instead use macro CHAR_BYTES. */
1078 if (COMPOSITE_CHAR_P (c
))
1080 unsigned int id
= COMPOSITE_CHAR_ID (c
);
1082 bytes
= (id
< n_cmpchars
? cmpchar_table
[id
]->len
: 1);
1086 int charset
= CHAR_CHARSET (c
);
1088 bytes
= CHARSET_DEFINED_P (charset
) ? CHARSET_BYTES (charset
) : 1;
1094 /* Return the width of character of which multi-byte form starts with
1095 C. The width is measured by how many columns occupied on the
1096 screen when displayed in the current buffer. */
1098 #define ONE_BYTE_CHAR_WIDTH(c) \
1101 ? XFASTINT (current_buffer->tab_width) \
1102 : (c == '\n' ? 0 : (NILP (current_buffer->ctl_arrow) ? 4 : 2))) \
1106 ? (NILP (current_buffer->ctl_arrow) ? 4 : 2) \
1107 : ((! NILP (current_buffer->enable_multibyte_characters) \
1108 && BASE_LEADING_CODE_P (c)) \
1109 ? WIDTH_BY_CHAR_HEAD (c) \
1112 DEFUN ("char-width", Fchar_width
, Schar_width
, 1, 1, 0,
1113 "Return width of CHAR when displayed in the current buffer.\n\
1114 The width is measured by how many columns it occupies on the screen.")
1118 Lisp_Object val
, disp
;
1120 struct Lisp_Char_Table
*dp
= buffer_display_table ();
1122 CHECK_NUMBER (ch
, 0);
1126 /* Get the way the display table would display it. */
1127 disp
= dp
? DISP_CHAR_VECTOR (dp
, c
) : Qnil
;
1130 XSETINT (val
, XVECTOR (disp
)->size
);
1131 else if (SINGLE_BYTE_CHAR_P (c
))
1132 XSETINT (val
, ONE_BYTE_CHAR_WIDTH (c
));
1133 else if (COMPOSITE_CHAR_P (c
))
1135 int id
= COMPOSITE_CHAR_ID (XFASTINT (ch
));
1136 XSETFASTINT (val
, (id
< n_cmpchars
? cmpchar_table
[id
]->width
: 0));
1140 int charset
= CHAR_CHARSET (c
);
1142 XSETFASTINT (val
, CHARSET_WIDTH (charset
));
1147 /* Return width of string STR of length LEN when displayed in the
1148 current buffer. The width is measured by how many columns it
1149 occupies on the screen. */
1156 unsigned char *endp
= str
+ len
;
1158 struct Lisp_Char_Table
*dp
= buffer_display_table ();
1162 if (*str
== LEADING_CODE_COMPOSITION
)
1164 int id
= str_cmpchar_id (str
, endp
- str
);
1173 width
+= cmpchar_table
[id
]->width
;
1174 str
+= cmpchar_table
[id
]->len
;
1181 int c
= STRING_CHAR_AND_LENGTH (str
, endp
- str
, thislen
);
1183 /* Get the way the display table would display it. */
1185 disp
= DISP_CHAR_VECTOR (dp
, c
);
1190 width
+= XVECTOR (disp
)->size
;
1192 width
+= ONE_BYTE_CHAR_WIDTH (*str
);
1200 DEFUN ("string-width", Fstring_width
, Sstring_width
, 1, 1, 0,
1201 "Return width of STRING when displayed in the current buffer.\n\
1202 Width is measured by how many columns it occupies on the screen.\n\
1203 When calculating width of a multibyte character in STRING,\n\
1204 only the base leading-code is considered; the validity of\n\
1205 the following bytes is not checked.")
1211 CHECK_STRING (str
, 0);
1212 XSETFASTINT (val
, strwidth (XSTRING (str
)->data
,
1213 STRING_BYTES (XSTRING (str
))));
1217 DEFUN ("char-direction", Fchar_direction
, Schar_direction
, 1, 1, 0,
1218 "Return the direction of CHAR.\n\
1219 The returned value is 0 for left-to-right and 1 for right-to-left.")
1225 CHECK_NUMBER (ch
, 0);
1226 charset
= CHAR_CHARSET (XFASTINT (ch
));
1227 if (!CHARSET_DEFINED_P (charset
))
1228 invalid_character (XINT (ch
));
1229 return CHARSET_TABLE_INFO (charset
, CHARSET_DIRECTION_IDX
);
1232 DEFUN ("chars-in-region", Fchars_in_region
, Schars_in_region
, 2, 2, 0,
1233 "Return number of characters between BEG and END.")
1235 Lisp_Object beg
, end
;
1239 CHECK_NUMBER_COERCE_MARKER (beg
, 0);
1240 CHECK_NUMBER_COERCE_MARKER (end
, 1);
1242 from
= min (XFASTINT (beg
), XFASTINT (end
));
1243 to
= max (XFASTINT (beg
), XFASTINT (end
));
1245 return make_number (to
- from
);
1248 /* Return the number of characters in the NBYTES bytes at PTR.
1249 This works by looking at the contents and checking for multibyte sequences.
1250 However, if the current buffer has enable-multibyte-characters = nil,
1251 we treat each byte as a character. */
1254 chars_in_text (ptr
, nbytes
)
1258 unsigned char *endp
, c
;
1261 /* current_buffer is null at early stages of Emacs initialization. */
1262 if (current_buffer
== 0
1263 || NILP (current_buffer
->enable_multibyte_characters
))
1266 endp
= ptr
+ nbytes
;
1273 if (BASE_LEADING_CODE_P (c
))
1274 while (ptr
< endp
&& ! CHAR_HEAD_P (*ptr
)) ptr
++;
1281 /* Return the number of characters in the NBYTES bytes at PTR.
1282 This works by looking at the contents and checking for multibyte sequences.
1283 It ignores enable-multibyte-characters. */
1286 multibyte_chars_in_text (ptr
, nbytes
)
1290 unsigned char *endp
, c
;
1293 endp
= ptr
+ nbytes
;
1300 if (BASE_LEADING_CODE_P (c
))
1301 while (ptr
< endp
&& ! CHAR_HEAD_P (*ptr
)) ptr
++;
1308 DEFUN ("string", Fstring
, Sstring
, 1, MANY
, 0,
1309 "Concatenate all the argument characters and make the result a string.")
1316 = (unsigned char *) alloca (MAX_LENGTH_OF_MULTI_BYTE_FORM
* n
);
1317 unsigned char *p
= buf
;
1320 for (i
= 0; i
< n
; i
++)
1325 if (!INTEGERP (args
[i
]))
1326 CHECK_NUMBER (args
[i
], 0);
1328 len
= CHAR_STRING (c
, p
, str
);
1330 /* C is a composite character. */
1331 bcopy (str
, p
, len
);
1335 /* Here, we can't use make_string_from_bytes because of byte
1336 combining problem. */
1337 val
= make_string (buf
, p
- buf
);
1343 /*** Composite characters staffs ***/
1345 /* Each composite character is identified by CMPCHAR-ID which is
1346 assigned when Emacs needs the character code of the composite
1347 character (e.g. when displaying it on the screen). See the
1348 document "GENERAL NOTE on COMPOSITE CHARACTER" in `charset.h' how a
1349 composite character is represented in Emacs. */
1351 /* If `static' is defined, it means that it is defined to null string. */
1353 /* The following function is copied from lread.c. */
1355 hash_string (ptr
, len
)
1359 register unsigned char *p
= ptr
;
1360 register unsigned char *end
= p
+ len
;
1361 register unsigned char c
;
1362 register int hash
= 0;
1367 if (c
>= 0140) c
-= 40;
1368 hash
= ((hash
<<3) + (hash
>>28) + c
);
1370 return hash
& 07777777777;
1374 #define CMPCHAR_HASH_TABLE_SIZE 0xFFF
1376 static int *cmpchar_hash_table
[CMPCHAR_HASH_TABLE_SIZE
];
1378 /* Each element of `cmpchar_hash_table' is a pointer to an array of
1379 integer, where the 1st element is the size of the array, the 2nd
1380 element is how many elements are actually used in the array, and
1381 the remaining elements are CMPCHAR-IDs of composite characters of
1382 the same hash value. */
1383 #define CMPCHAR_HASH_SIZE(table) table[0]
1384 #define CMPCHAR_HASH_USED(table) table[1]
1385 #define CMPCHAR_HASH_CMPCHAR_ID(table, i) table[i]
1387 /* Return CMPCHAR-ID of the composite character in STR of the length
1388 LEN. If the composite character has not yet been registered,
1389 register it in `cmpchar_table' and assign new CMPCHAR-ID. This
1390 is the sole function for assigning CMPCHAR-ID. */
1392 str_cmpchar_id (str
, len
)
1393 const unsigned char *str
;
1396 int hash_idx
, *hashp
;
1398 int embedded_rule
; /* 1 if composition rule is embedded. */
1399 int chars
; /* number of components. */
1401 struct cmpchar_info
*cmpcharp
;
1403 /* The second byte 0xFF means compostion rule is embedded. */
1404 embedded_rule
= (str
[1] == 0xFF);
1406 /* At first, get the actual length of the composite character. */
1408 const unsigned char *p
, *endp
= str
+ 1, *lastp
= str
+ len
;
1411 while (endp
< lastp
&& ! CHAR_HEAD_P (*endp
)) endp
++;
1413 /* Any composite char have at least 5-byte length. */
1420 if (embedded_rule
) p
++;
1421 /* No need of checking if *P is 0xA0 because
1422 BYTES_BY_CHAR_HEAD (0x80) surely returns 2. */
1423 p
+= BYTES_BY_CHAR_HEAD (*p
- 0x20);
1426 if (p
> endp
|| chars
< 2 || chars
> MAX_COMPONENT_COUNT
)
1427 /* Invalid components. */
1431 hash_idx
= hash_string (str
, len
) % CMPCHAR_HASH_TABLE_SIZE
;
1432 hashp
= cmpchar_hash_table
[hash_idx
];
1434 /* Then, look into the hash table. */
1436 /* Find the correct one among composite characters of the same
1438 for (i
= 2; i
< CMPCHAR_HASH_USED (hashp
); i
++)
1440 cmpcharp
= cmpchar_table
[CMPCHAR_HASH_CMPCHAR_ID (hashp
, i
)];
1441 if (len
== cmpcharp
->len
1442 && ! bcmp (str
, cmpcharp
->data
, len
))
1443 return CMPCHAR_HASH_CMPCHAR_ID (hashp
, i
);
1446 /* We have to register the composite character in cmpchar_table. */
1447 if (n_cmpchars
> (CHAR_FIELD2_MASK
| CHAR_FIELD3_MASK
))
1448 /* No, we have no more room for a new composite character. */
1451 /* Make the entry in hash table. */
1454 /* Make a table for 8 composite characters initially. */
1455 hashp
= (cmpchar_hash_table
[hash_idx
]
1456 = (int *) xmalloc (sizeof (int) * (2 + 8)));
1457 CMPCHAR_HASH_SIZE (hashp
) = 10;
1458 CMPCHAR_HASH_USED (hashp
) = 2;
1460 else if (CMPCHAR_HASH_USED (hashp
) >= CMPCHAR_HASH_SIZE (hashp
))
1462 CMPCHAR_HASH_SIZE (hashp
) += 8;
1463 hashp
= (cmpchar_hash_table
[hash_idx
]
1464 = (int *) xrealloc (hashp
,
1465 sizeof (int) * CMPCHAR_HASH_SIZE (hashp
)));
1467 CMPCHAR_HASH_CMPCHAR_ID (hashp
, CMPCHAR_HASH_USED (hashp
)) = n_cmpchars
;
1468 CMPCHAR_HASH_USED (hashp
)++;
1470 /* Set information of the composite character in cmpchar_table. */
1471 if (cmpchar_table_size
== 0)
1473 /* This is the first composite character to be registered. */
1474 cmpchar_table_size
= 256;
1476 = (struct cmpchar_info
**) xmalloc (sizeof (cmpchar_table
[0])
1477 * cmpchar_table_size
);
1479 else if (cmpchar_table_size
<= n_cmpchars
)
1481 cmpchar_table_size
+= 256;
1483 = (struct cmpchar_info
**) xrealloc (cmpchar_table
,
1484 sizeof (cmpchar_table
[0])
1485 * cmpchar_table_size
);
1488 cmpcharp
= (struct cmpchar_info
*) xmalloc (sizeof (struct cmpchar_info
));
1490 cmpcharp
->len
= len
;
1491 cmpcharp
->data
= (unsigned char *) xmalloc (len
+ 1);
1492 bcopy (str
, cmpcharp
->data
, len
);
1493 cmpcharp
->data
[len
] = 0;
1494 cmpcharp
->glyph_len
= chars
;
1495 cmpcharp
->glyph
= (GLYPH
*) xmalloc (sizeof (GLYPH
) * chars
);
1498 cmpcharp
->cmp_rule
= (unsigned char *) xmalloc (chars
);
1499 cmpcharp
->col_offset
= (float *) xmalloc (sizeof (float) * chars
);
1503 cmpcharp
->cmp_rule
= NULL
;
1504 cmpcharp
->col_offset
= NULL
;
1507 /* Setup GLYPH data and composition rules (if any) so as not to make
1508 them every time on displaying. */
1510 unsigned char *bufp
;
1512 float leftmost
= 0.0, rightmost
= 1.0;
1515 /* At first, col_offset[N] is set to relative to col_offset[0]. */
1516 cmpcharp
->col_offset
[0] = 0;
1518 for (i
= 0, bufp
= cmpcharp
->data
+ 1; i
< chars
; i
++)
1521 cmpcharp
->cmp_rule
[i
] = *bufp
++;
1523 if (*bufp
== 0xA0) /* This is an ASCII character. */
1525 cmpcharp
->glyph
[i
] = FAST_MAKE_GLYPH ((*++bufp
& 0x7F), 0);
1529 else /* Multibyte character. */
1531 /* Make `bufp' point normal multi-byte form temporally. */
1534 = FAST_MAKE_GLYPH (string_to_non_ascii_char (bufp
, 4, 0, 0), 0);
1535 width
= WIDTH_BY_CHAR_HEAD (*bufp
);
1537 bufp
+= BYTES_BY_CHAR_HEAD (*bufp
- 0x20);
1540 if (embedded_rule
&& i
> 0)
1542 /* Reference points (global_ref and new_ref) are
1553 Now, we calculate the column offset of the new glyph
1554 from the left edge of the first glyph. This can avoid
1555 the same calculation everytime displaying this
1556 composite character. */
1558 /* Reference points of global glyph and new glyph. */
1559 int global_ref
= (cmpcharp
->cmp_rule
[i
] - 0xA0) / 9;
1560 int new_ref
= (cmpcharp
->cmp_rule
[i
] - 0xA0) % 9;
1561 /* Column offset relative to the first glyph. */
1562 float left
= (leftmost
1563 + (global_ref
% 3) * (rightmost
- leftmost
) / 2.0
1564 - (new_ref
% 3) * width
/ 2.0);
1566 cmpcharp
->col_offset
[i
] = left
;
1567 if (left
< leftmost
)
1569 if (left
+ width
> rightmost
)
1570 rightmost
= left
+ width
;
1574 if (width
> rightmost
)
1580 /* Now col_offset[N] are relative to the left edge of the
1581 first component. Make them relative to the left edge of
1583 for (i
= 0; i
< chars
; i
++)
1584 cmpcharp
->col_offset
[i
] -= leftmost
;
1585 /* Make rightmost holds width of overall glyph. */
1586 rightmost
-= leftmost
;
1589 cmpcharp
->width
= rightmost
;
1590 if (cmpcharp
->width
< rightmost
)
1591 /* To get a ceiling integer value. */
1595 cmpchar_table
[n_cmpchars
] = cmpcharp
;
1597 return n_cmpchars
++;
1600 /* Return the Nth element of the composite character C. */
1602 cmpchar_component (c
, n
)
1605 int id
= COMPOSITE_CHAR_ID (c
);
1607 if (id
>= n_cmpchars
/* C is not a valid composite character. */
1608 || n
>= cmpchar_table
[id
]->glyph_len
) /* No such component. */
1610 /* No face data is stored in glyph code. */
1611 return ((int) (cmpchar_table
[id
]->glyph
[n
]));
1614 DEFUN ("cmpcharp", Fcmpcharp
, Scmpcharp
, 1, 1, 0,
1615 "T if CHAR is a composite character.")
1619 CHECK_NUMBER (ch
, 0);
1620 return (COMPOSITE_CHAR_P (XINT (ch
)) ? Qt
: Qnil
);
1623 DEFUN ("composite-char-component", Fcmpchar_component
, Scmpchar_component
,
1625 "Return the IDXth component character of composite character CHARACTER.")
1627 Lisp_Object character
, idx
;
1631 CHECK_NUMBER (character
, 0);
1632 CHECK_NUMBER (idx
, 1);
1634 if ((c
= cmpchar_component (XINT (character
), XINT (idx
))) < 0)
1635 args_out_of_range (character
, idx
);
1637 return make_number (c
);
1640 DEFUN ("composite-char-composition-rule", Fcmpchar_cmp_rule
, Scmpchar_cmp_rule
,
1642 "Return the Nth composition rule embedded in composite character CHARACTER.\n\
1643 The returned rule is for composing the Nth component\n\
1644 on the (N-1)th component. If N is 0, the returned value is always 255.")
1646 Lisp_Object character
, n
;
1650 CHECK_NUMBER (character
, 0);
1651 CHECK_NUMBER (n
, 1);
1653 id
= COMPOSITE_CHAR_ID (XINT (character
));
1654 if (id
< 0 || id
>= n_cmpchars
)
1655 error ("Invalid composite character: %d", XINT (character
));
1657 if (i
> cmpchar_table
[id
]->glyph_len
)
1658 args_out_of_range (character
, n
);
1660 return make_number (cmpchar_table
[id
]->cmp_rule
[i
]);
1663 DEFUN ("composite-char-composition-rule-p", Fcmpchar_cmp_rule_p
,
1664 Scmpchar_cmp_rule_p
, 1, 1, 0,
1665 "Return non-nil if composite character CHARACTER contains a embedded rule.")
1667 Lisp_Object character
;
1671 CHECK_NUMBER (character
, 0);
1672 id
= COMPOSITE_CHAR_ID (XINT (character
));
1673 if (id
< 0 || id
>= n_cmpchars
)
1674 error ("Invalid composite character: %d", XINT (character
));
1676 return (cmpchar_table
[id
]->cmp_rule
? Qt
: Qnil
);
1679 DEFUN ("composite-char-component-count", Fcmpchar_cmp_count
,
1680 Scmpchar_cmp_count
, 1, 1, 0,
1681 "Return number of compoents of composite character CHARACTER.")
1683 Lisp_Object character
;
1687 CHECK_NUMBER (character
, 0);
1688 id
= COMPOSITE_CHAR_ID (XINT (character
));
1689 if (id
< 0 || id
>= n_cmpchars
)
1690 error ("Invalid composite character: %d", XINT (character
));
1692 return (make_number (cmpchar_table
[id
]->glyph_len
));
1695 DEFUN ("compose-string", Fcompose_string
, Scompose_string
,
1697 "Return one char string composed from all characters in STRING.")
1701 unsigned char buf
[MAX_LENGTH_OF_MULTI_BYTE_FORM
], *p
, *pend
, *ptemp
;
1704 CHECK_STRING (str
, 0);
1706 buf
[0] = LEADING_CODE_COMPOSITION
;
1707 p
= XSTRING (str
)->data
;
1708 pend
= p
+ STRING_BYTES (XSTRING (str
));
1712 if (*p
< 0x20 || *p
== 127) /* control code */
1713 error ("Invalid component character: %d", *p
);
1714 else if (*p
< 0x80) /* ASCII */
1716 if (i
+ 2 >= MAX_LENGTH_OF_MULTI_BYTE_FORM
)
1717 error ("Too long string to be composed: %s", XSTRING (str
)->data
);
1718 /* Prepend an ASCII charset indicator 0xA0, set MSB of the
1721 buf
[i
++] = *p
++ + 0x80;
1723 else if (*p
== LEADING_CODE_COMPOSITION
) /* composite char */
1725 /* Already composed. Eliminate the heading
1726 LEADING_CODE_COMPOSITION, keep the remaining bytes
1730 while (! CHAR_HEAD_P (*p
)) p
++;
1731 if (i
+ (p
- ptemp
) >= MAX_LENGTH_OF_MULTI_BYTE_FORM
)
1732 error ("Too long string to be composed: %s", XSTRING (str
)->data
);
1733 bcopy (ptemp
, buf
+ i
, p
- ptemp
);
1736 else /* multibyte char */
1738 /* Add 0x20 to the base leading-code, keep the remaining
1740 len
= BYTES_BY_CHAR_HEAD (*p
);
1741 if (i
+ len
>= MAX_LENGTH_OF_MULTI_BYTE_FORM
)
1742 error ("Too long string to be composed: %s", XSTRING (str
)->data
);
1743 bcopy (p
, buf
+ i
, len
);
1750 /* STR contains only one character, which can't be composed. */
1751 error ("Too short string to be composed: %s", XSTRING (str
)->data
);
1753 return make_string_from_bytes (buf
, 1, i
);
1758 charset_id_internal (charset_name
)
1763 val
= Fget (intern (charset_name
), Qcharset
);
1765 error ("Charset %s is not defined", charset_name
);
1767 return (XINT (XVECTOR (val
)->contents
[0]));
1770 DEFUN ("setup-special-charsets", Fsetup_special_charsets
,
1771 Ssetup_special_charsets
, 0, 0, 0, "Internal use only.")
1774 charset_latin_iso8859_1
= charset_id_internal ("latin-iso8859-1");
1775 charset_jisx0208_1978
= charset_id_internal ("japanese-jisx0208-1978");
1776 charset_jisx0208
= charset_id_internal ("japanese-jisx0208");
1777 charset_katakana_jisx0201
= charset_id_internal ("katakana-jisx0201");
1778 charset_latin_jisx0201
= charset_id_internal ("latin-jisx0201");
1779 charset_big5_1
= charset_id_internal ("chinese-big5-1");
1780 charset_big5_2
= charset_id_internal ("chinese-big5-2");
1785 init_charset_once ()
1789 staticpro (&Vcharset_table
);
1790 staticpro (&Vcharset_symbol_table
);
1791 staticpro (&Vgeneric_character_list
);
1793 /* This has to be done here, before we call Fmake_char_table. */
1794 Qcharset_table
= intern ("charset-table");
1795 staticpro (&Qcharset_table
);
1797 /* Intern this now in case it isn't already done.
1798 Setting this variable twice is harmless.
1799 But don't staticpro it here--that is done in alloc.c. */
1800 Qchar_table_extra_slots
= intern ("char-table-extra-slots");
1802 /* Now we are ready to set up this property, so we can
1803 create the charset table. */
1804 Fput (Qcharset_table
, Qchar_table_extra_slots
, make_number (0));
1805 Vcharset_table
= Fmake_char_table (Qcharset_table
, Qnil
);
1807 Vcharset_symbol_table
= Fmake_vector (make_number (MAX_CHARSET
+ 1), Qnil
);
1810 for (i
= 0; i
< 2; i
++)
1811 for (j
= 0; j
< 2; j
++)
1812 for (k
= 0; k
< 128; k
++)
1813 iso_charset_table
[i
][j
][k
] = -1;
1815 bzero (cmpchar_hash_table
, sizeof cmpchar_hash_table
);
1816 cmpchar_table_size
= n_cmpchars
= 0;
1818 for (i
= 0; i
< 256; i
++)
1819 BYTES_BY_CHAR_HEAD (i
) = 1;
1820 for (i
= MIN_CHARSET_OFFICIAL_DIMENSION1
;
1821 i
<= MAX_CHARSET_OFFICIAL_DIMENSION1
; i
++)
1822 BYTES_BY_CHAR_HEAD (i
) = 2;
1823 for (i
= MIN_CHARSET_OFFICIAL_DIMENSION2
;
1824 i
<= MAX_CHARSET_OFFICIAL_DIMENSION2
; i
++)
1825 BYTES_BY_CHAR_HEAD (i
) = 3;
1826 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_11
) = 3;
1827 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_12
) = 3;
1828 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_21
) = 4;
1829 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_22
) = 4;
1830 /* The followings don't reflect the actual bytes, but just to tell
1831 that it is a start of a multibyte character. */
1832 BYTES_BY_CHAR_HEAD (LEADING_CODE_COMPOSITION
) = 2;
1833 BYTES_BY_CHAR_HEAD (0x9E) = 2;
1834 BYTES_BY_CHAR_HEAD (0x9F) = 2;
1836 for (i
= 0; i
< 128; i
++)
1837 WIDTH_BY_CHAR_HEAD (i
) = 1;
1838 for (; i
< 256; i
++)
1839 WIDTH_BY_CHAR_HEAD (i
) = 4;
1840 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_11
) = 1;
1841 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_12
) = 2;
1842 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_21
) = 1;
1843 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_22
) = 2;
1849 for (i
= 0x81; i
< 0x90; i
++)
1850 val
= Fcons (make_number ((i
- 0x70) << 7), val
);
1851 for (; i
< 0x9A; i
++)
1852 val
= Fcons (make_number ((i
- 0x8F) << 14), val
);
1853 for (i
= 0xA0; i
< 0xF0; i
++)
1854 val
= Fcons (make_number ((i
- 0x70) << 7), val
);
1855 for (; i
< 0xFF; i
++)
1856 val
= Fcons (make_number ((i
- 0xE0) << 14), val
);
1857 val
= Fcons (make_number (GENERIC_COMPOSITION_CHAR
), val
);
1858 Vgeneric_character_list
= Fnreverse (val
);
1861 nonascii_insert_offset
= 0;
1862 Vnonascii_translation_table
= Qnil
;
1870 Qascii
= intern ("ascii");
1871 staticpro (&Qascii
);
1873 Qcharset
= intern ("charset");
1874 staticpro (&Qcharset
);
1876 /* Define ASCII charset now. */
1877 update_charset_table (make_number (CHARSET_ASCII
),
1878 make_number (1), make_number (94),
1883 build_string ("ASCII"),
1884 build_string ("ASCII"),
1885 build_string ("ASCII (ISO646 IRV)"));
1886 CHARSET_SYMBOL (CHARSET_ASCII
) = Qascii
;
1887 Fput (Qascii
, Qcharset
, CHARSET_TABLE_ENTRY (CHARSET_ASCII
));
1889 Qcomposition
= intern ("composition");
1890 staticpro (&Qcomposition
);
1891 CHARSET_SYMBOL (CHARSET_COMPOSITION
) = Qcomposition
;
1893 Qauto_fill_chars
= intern ("auto-fill-chars");
1894 staticpro (&Qauto_fill_chars
);
1895 Fput (Qauto_fill_chars
, Qchar_table_extra_slots
, make_number (0));
1897 defsubr (&Sdefine_charset
);
1898 defsubr (&Sgeneric_character_list
);
1899 defsubr (&Sget_unused_iso_final_char
);
1900 defsubr (&Sdeclare_equiv_charset
);
1901 defsubr (&Sfind_charset_region
);
1902 defsubr (&Sfind_charset_string
);
1903 defsubr (&Smake_char_internal
);
1904 defsubr (&Ssplit_char
);
1905 defsubr (&Schar_charset
);
1906 defsubr (&Scharset_after
);
1907 defsubr (&Siso_charset
);
1908 defsubr (&Schar_valid_p
);
1909 defsubr (&Sunibyte_char_to_multibyte
);
1910 defsubr (&Smultibyte_char_to_unibyte
);
1911 defsubr (&Schar_bytes
);
1912 defsubr (&Schar_width
);
1913 defsubr (&Sstring_width
);
1914 defsubr (&Schar_direction
);
1915 defsubr (&Schars_in_region
);
1917 defsubr (&Scmpcharp
);
1918 defsubr (&Scmpchar_component
);
1919 defsubr (&Scmpchar_cmp_rule
);
1920 defsubr (&Scmpchar_cmp_rule_p
);
1921 defsubr (&Scmpchar_cmp_count
);
1922 defsubr (&Scompose_string
);
1923 defsubr (&Ssetup_special_charsets
);
1925 DEFVAR_LISP ("charset-list", &Vcharset_list
,
1926 "List of charsets ever defined.");
1927 Vcharset_list
= Fcons (Qascii
, Qnil
);
1929 DEFVAR_LISP ("translation-table-vector", &Vtranslation_table_vector
,
1930 "Vector of cons cell of a symbol and translation table ever defined.\n\
1931 An ID of a translation table is an index of this vector.");
1932 Vtranslation_table_vector
= Fmake_vector (make_number (16), Qnil
);
1934 DEFVAR_INT ("leading-code-composition", &leading_code_composition
,
1935 "Leading-code of composite characters.");
1936 leading_code_composition
= LEADING_CODE_COMPOSITION
;
1938 DEFVAR_INT ("leading-code-private-11", &leading_code_private_11
,
1939 "Leading-code of private TYPE9N charset of column-width 1.");
1940 leading_code_private_11
= LEADING_CODE_PRIVATE_11
;
1942 DEFVAR_INT ("leading-code-private-12", &leading_code_private_12
,
1943 "Leading-code of private TYPE9N charset of column-width 2.");
1944 leading_code_private_12
= LEADING_CODE_PRIVATE_12
;
1946 DEFVAR_INT ("leading-code-private-21", &leading_code_private_21
,
1947 "Leading-code of private TYPE9Nx9N charset of column-width 1.");
1948 leading_code_private_21
= LEADING_CODE_PRIVATE_21
;
1950 DEFVAR_INT ("leading-code-private-22", &leading_code_private_22
,
1951 "Leading-code of private TYPE9Nx9N charset of column-width 2.");
1952 leading_code_private_22
= LEADING_CODE_PRIVATE_22
;
1954 DEFVAR_INT ("nonascii-insert-offset", &nonascii_insert_offset
,
1955 "Offset for converting non-ASCII unibyte codes 0240...0377 to multibyte.\n\
1956 This is used for converting unibyte text to multibyte,\n\
1957 and for inserting character codes specified by number.\n\n\
1958 This serves to convert a Latin-1 or similar 8-bit character code\n\
1959 to the corresponding Emacs multibyte character code.\n\
1960 Typically the value should be (- (make-char CHARSET 0) 128),\n\
1961 for your choice of character set.\n\
1962 If `nonascii-translation-table' is non-nil, it overrides this variable.");
1963 nonascii_insert_offset
= 0;
1965 DEFVAR_LISP ("nonascii-translation-table", &Vnonascii_translation_table
,
1966 "Translation table to convert non-ASCII unibyte codes to multibyte.\n\
1967 This is used for converting unibyte text to multibyte,\n\
1968 and for inserting character codes specified by number.\n\n\
1969 Conversion is performed only when multibyte characters are enabled,\n\
1970 and it serves to convert a Latin-1 or similar 8-bit character code\n\
1971 to the corresponding Emacs character code.\n\n\
1972 If this is nil, `nonascii-insert-offset' is used instead.\n\
1973 See also the docstring of `make-translation-table'.");
1974 Vnonascii_translation_table
= Qnil
;
1976 DEFVAR_INT ("min-composite-char", &min_composite_char
,
1977 "Minimum character code of a composite character.");
1978 min_composite_char
= MIN_CHAR_COMPOSITION
;
1980 DEFVAR_LISP ("auto-fill-chars", &Vauto_fill_chars
,
1981 "A char-table for characters which invoke auto-filling.\n\
1982 Such characters has value t in this table.");
1983 Vauto_fill_chars
= Fmake_char_table (Qauto_fill_chars
, Qnil
);
1984 CHAR_TABLE_SET (Vauto_fill_chars
, make_number (' '), Qt
);
1985 CHAR_TABLE_SET (Vauto_fill_chars
, make_number ('\n'), Qt
);