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 /* Tables used by macros BYTES_BY_CHAR_HEAD and WIDTH_BY_CHAR_HEAD. */
82 int bytes_by_char_head
[256];
83 int width_by_char_head
[256];
85 /* Mapping table from ISO2022's charset (specified by DIMENSION,
86 CHARS, and FINAL-CHAR) to Emacs' charset. */
87 int iso_charset_table
[2][2][128];
89 /* Table of pointers to the structure `cmpchar_info' indexed by
91 struct cmpchar_info
**cmpchar_table
;
92 /* The current size of `cmpchar_table'. */
93 static int cmpchar_table_size
;
94 /* Number of the current composite characters. */
97 /* Variables used locally in the macro FETCH_MULTIBYTE_CHAR. */
98 unsigned char *_fetch_multibyte_char_p
;
99 int _fetch_multibyte_char_len
;
101 /* Offset to add to a non-ASCII value when inserting it. */
102 int nonascii_insert_offset
;
104 /* Translation table for converting non-ASCII unibyte characters
105 to multibyte codes, or nil. */
106 Lisp_Object Vnonascii_translation_table
;
108 /* List of all possible generic characters. */
109 Lisp_Object Vgeneric_character_list
;
111 #define min(X, Y) ((X) < (Y) ? (X) : (Y))
112 #define max(X, Y) ((X) > (Y) ? (X) : (Y))
115 invalid_character (c
)
118 error ("Invalid character: 0%o, %d, 0x%x", c
, c
, c
);
122 /* Set STR a pointer to the multi-byte form of the character C. If C
123 is not a composite character, the multi-byte form is set in WORKBUF
124 and STR points WORKBUF. The caller should allocate at least 4-byte
125 area at WORKBUF in advance. Returns the length of the multi-byte
126 form. If C is an invalid character to have a multi-byte form,
129 Use macro `CHAR_STRING (C, WORKBUF, STR)' instead of calling this
130 function directly if C can be an ASCII character. */
133 non_ascii_char_to_string (c
, workbuf
, str
)
135 unsigned char *workbuf
, **str
;
139 if (COMPOSITE_CHAR_P (c
))
141 int cmpchar_id
= COMPOSITE_CHAR_ID (c
);
143 if (cmpchar_id
< n_cmpchars
)
145 *str
= cmpchar_table
[cmpchar_id
]->data
;
146 return cmpchar_table
[cmpchar_id
]->len
;
150 invalid_character (c
);
154 SPLIT_NON_ASCII_CHAR (c
, charset
, c1
, c2
);
156 || ! CHARSET_DEFINED_P (charset
)
157 || c1
>= 0 && c1
< 32
158 || c2
>= 0 && c2
< 32)
159 invalid_character (c
);
162 *workbuf
++ = CHARSET_LEADING_CODE_BASE (charset
);
163 if (*workbuf
= CHARSET_LEADING_CODE_EXT (charset
))
165 *workbuf
++ = c1
| 0x80;
167 *workbuf
++ = c2
| 0x80;
169 return (workbuf
- *str
);
172 /* Return a non-ASCII character of which multi-byte form is at STR of
173 length LEN. If ACTUAL_LEN is not NULL, the actual length of the
174 multibyte form is set to the address ACTUAL_LEN.
176 If exclude_tail_garbage is nonzero, ACTUAL_LEN excludes gabage
177 bytes following the non-ASCII character.
179 Use macro `STRING_CHAR (STR, LEN)' instead of calling this function
180 directly if STR can hold an ASCII character. */
183 string_to_non_ascii_char (str
, len
, actual_len
, exclude_tail_garbage
)
184 const unsigned char *str
;
185 int len
, *actual_len
, exclude_tail_garbage
;
188 unsigned char c1
, c2
;
189 register int c
, bytes
;
194 if (BASE_LEADING_CODE_P (c
))
196 while (bytes
< len
&& ! CHAR_HEAD_P (str
[bytes
])) bytes
++;
198 if (c
== LEADING_CODE_COMPOSITION
)
200 int cmpchar_id
= str_cmpchar_id (str
, bytes
);
204 c
= MAKE_COMPOSITE_CHAR (cmpchar_id
);
205 if (exclude_tail_garbage
)
206 bytes
= cmpchar_table
[cmpchar_id
]->len
;
211 int charset
= c
, c1
, c2
= 0;
212 int char_bytes
= BYTES_BY_CHAR_HEAD (c
);
215 if (c
>= LEADING_CODE_PRIVATE_11
)
217 if (char_bytes
<= bytes
&& CHARSET_DEFINED_P (charset
))
220 if (CHARSET_DIMENSION (charset
) == 2)
222 c
= MAKE_NON_ASCII_CHAR (charset
, c1
, c2
);
223 if (exclude_tail_garbage
)
234 /* Return the length of the multi-byte form at string STR of length LEN. */
236 multibyte_form_length (str
, len
)
237 const unsigned char *str
;
242 if (BASE_LEADING_CODE_P (*str
))
243 while (bytes
< len
&& ! CHAR_HEAD_P (str
[bytes
])) bytes
++;
248 /* Check if string STR of length LEN contains valid multi-byte form of
249 a character. If valid, charset and position codes of the character
250 is set at *CHARSET, *C1, and *C2, and return 0. If not valid,
251 return -1. This should be used only in the macro SPLIT_STRING
252 which checks range of STR in advance. */
255 split_non_ascii_string (str
, len
, charset
, c1
, c2
)
256 register const unsigned char *str
;
257 register unsigned char *c1
, *c2
;
258 register int len
, *charset
;
260 register unsigned int cs
= *str
++;
262 if (cs
== LEADING_CODE_COMPOSITION
)
264 int cmpchar_id
= str_cmpchar_id (str
- 1, len
);
268 *charset
= cs
, *c1
= cmpchar_id
>> 7, *c2
= cmpchar_id
& 0x7F;
270 else if ((cs
< LEADING_CODE_PRIVATE_11
|| (cs
= *str
++) >= 0xA0)
271 && CHARSET_DEFINED_P (cs
))
276 *c1
= (*str
++) & 0x7F;
277 if (CHARSET_DIMENSION (cs
) == 2)
281 *c2
= (*str
++) & 0x7F;
289 /* Translate character C by translation table TABLE. If C
290 is negative, translate a character specified by CHARSET, C1, and C2
291 (C1 and C2 are code points of the character). If no translation is
292 found in TABLE, return C. */
294 translate_char (table
, c
, charset
, c1
, c2
)
296 int c
, charset
, c1
, c2
;
299 int alt_charset
, alt_c1
, alt_c2
, dimension
;
301 if (c
< 0) c
= MAKE_CHAR (charset
, c1
, c2
);
302 if (!CHAR_TABLE_P (table
)
303 || (ch
= Faref (table
, make_number (c
)), !INTEGERP (ch
))
307 SPLIT_CHAR (XFASTINT (ch
), alt_charset
, alt_c1
, alt_c2
);
308 dimension
= CHARSET_DIMENSION (alt_charset
);
309 if (dimension
== 1 && alt_c1
> 0 || dimension
== 2 && alt_c2
> 0)
310 /* CH is not a generic character, just return it. */
311 return XFASTINT (ch
);
313 /* Since CH is a generic character, we must return a specific
314 charater which has the same position codes as C from CH. */
316 SPLIT_CHAR (c
, charset
, c1
, c2
);
317 if (dimension
!= CHARSET_DIMENSION (charset
))
318 /* We can't make such a character because of dimension mismatch. */
320 return MAKE_CHAR (alt_charset
, c1
, c2
);
323 /* Convert the unibyte character C to multibyte based on
324 Vnonascii_translation_table or nonascii_insert_offset. If they can't
325 convert C to a valid multibyte character, convert it based on
326 DEFAULT_NONASCII_INSERT_OFFSET which makes C a Latin-1 character. */
329 unibyte_char_to_multibyte (c
)
336 if (! NILP (Vnonascii_translation_table
))
338 c
= XINT (Faref (Vnonascii_translation_table
, make_number (c
)));
339 if (c
>= 0400 && ! VALID_MULTIBYTE_CHAR_P (c
))
340 c
= c_save
+ DEFAULT_NONASCII_INSERT_OFFSET
;
342 else if (c
>= 0240 && nonascii_insert_offset
> 0)
344 c
+= nonascii_insert_offset
;
345 if (c
< 0400 || ! VALID_MULTIBYTE_CHAR_P (c
))
346 c
= c_save
+ DEFAULT_NONASCII_INSERT_OFFSET
;
349 c
= c_save
+ DEFAULT_NONASCII_INSERT_OFFSET
;
355 /* Convert the multibyte character C to unibyte 8-bit character based
356 on Vnonascii_translation_table or nonascii_insert_offset. If
357 REV_TBL is non-nil, it should be a reverse table of
358 Vnonascii_translation_table, i.e. what given by:
359 Fchar_table_extra_slot (Vnonascii_translation_table, make_number (0)) */
362 multibyte_char_to_unibyte (c
, rev_tbl
)
366 if (!SINGLE_BYTE_CHAR_P (c
))
370 if (! CHAR_TABLE_P (rev_tbl
)
371 && CHAR_TABLE_P (Vnonascii_translation_table
))
372 rev_tbl
= Fchar_table_extra_slot (Vnonascii_translation_table
,
374 if (CHAR_TABLE_P (rev_tbl
))
377 temp
= Faref (rev_tbl
, make_number (c
));
381 c
= (c_save
& 0177) + 0200;
385 if (nonascii_insert_offset
> 0)
386 c
-= nonascii_insert_offset
;
387 if (c
< 128 || c
>= 256)
388 c
= (c_save
& 0177) + 0200;
396 /* Update the table Vcharset_table with the given arguments (see the
397 document of `define-charset' for the meaning of each argument).
398 Several other table contents are also updated. The caller should
399 check the validity of CHARSET-ID and the remaining arguments in
403 update_charset_table (charset_id
, dimension
, chars
, width
, direction
,
404 iso_final_char
, iso_graphic_plane
,
405 short_name
, long_name
, description
)
406 Lisp_Object charset_id
, dimension
, chars
, width
, direction
;
407 Lisp_Object iso_final_char
, iso_graphic_plane
;
408 Lisp_Object short_name
, long_name
, description
;
410 int charset
= XINT (charset_id
);
412 unsigned char leading_code_base
, leading_code_ext
;
414 if (NILP (CHARSET_TABLE_ENTRY (charset
)))
415 CHARSET_TABLE_ENTRY (charset
)
416 = Fmake_vector (make_number (CHARSET_MAX_IDX
), Qnil
);
418 /* Get byte length of multibyte form, base leading-code, and
419 extended leading-code of the charset. See the comment under the
420 title "GENERAL NOTE on CHARACTER SET (CHARSET)" in charset.h. */
421 bytes
= XINT (dimension
);
422 if (charset
< MIN_CHARSET_PRIVATE_DIMENSION1
)
424 /* Official charset, it doesn't have an extended leading-code. */
425 if (charset
!= CHARSET_ASCII
)
426 bytes
+= 1; /* For a base leading-code. */
427 leading_code_base
= charset
;
428 leading_code_ext
= 0;
432 /* Private charset. */
433 bytes
+= 2; /* For base and extended leading-codes. */
435 = (charset
< LEADING_CODE_EXT_12
436 ? LEADING_CODE_PRIVATE_11
437 : (charset
< LEADING_CODE_EXT_21
438 ? LEADING_CODE_PRIVATE_12
439 : (charset
< LEADING_CODE_EXT_22
440 ? LEADING_CODE_PRIVATE_21
441 : LEADING_CODE_PRIVATE_22
)));
442 leading_code_ext
= charset
;
445 CHARSET_TABLE_INFO (charset
, CHARSET_ID_IDX
) = charset_id
;
446 CHARSET_TABLE_INFO (charset
, CHARSET_BYTES_IDX
) = make_number (bytes
);
447 CHARSET_TABLE_INFO (charset
, CHARSET_DIMENSION_IDX
) = dimension
;
448 CHARSET_TABLE_INFO (charset
, CHARSET_CHARS_IDX
) = chars
;
449 CHARSET_TABLE_INFO (charset
, CHARSET_WIDTH_IDX
) = width
;
450 CHARSET_TABLE_INFO (charset
, CHARSET_DIRECTION_IDX
) = direction
;
451 CHARSET_TABLE_INFO (charset
, CHARSET_LEADING_CODE_BASE_IDX
)
452 = make_number (leading_code_base
);
453 CHARSET_TABLE_INFO (charset
, CHARSET_LEADING_CODE_EXT_IDX
)
454 = make_number (leading_code_ext
);
455 CHARSET_TABLE_INFO (charset
, CHARSET_ISO_FINAL_CHAR_IDX
) = iso_final_char
;
456 CHARSET_TABLE_INFO (charset
, CHARSET_ISO_GRAPHIC_PLANE_IDX
)
458 CHARSET_TABLE_INFO (charset
, CHARSET_SHORT_NAME_IDX
) = short_name
;
459 CHARSET_TABLE_INFO (charset
, CHARSET_LONG_NAME_IDX
) = long_name
;
460 CHARSET_TABLE_INFO (charset
, CHARSET_DESCRIPTION_IDX
) = description
;
461 CHARSET_TABLE_INFO (charset
, CHARSET_PLIST_IDX
) = Qnil
;
464 /* If we have already defined a charset which has the same
465 DIMENSION, CHARS and ISO-FINAL-CHAR but the different
466 DIRECTION, we must update the entry REVERSE-CHARSET of both
467 charsets. If there's no such charset, the value of the entry
471 for (i
= 0; i
<= MAX_CHARSET
; i
++)
472 if (!NILP (CHARSET_TABLE_ENTRY (i
)))
474 if (CHARSET_DIMENSION (i
) == XINT (dimension
)
475 && CHARSET_CHARS (i
) == XINT (chars
)
476 && CHARSET_ISO_FINAL_CHAR (i
) == XINT (iso_final_char
)
477 && CHARSET_DIRECTION (i
) != XINT (direction
))
479 CHARSET_TABLE_INFO (charset
, CHARSET_REVERSE_CHARSET_IDX
)
481 CHARSET_TABLE_INFO (i
, CHARSET_REVERSE_CHARSET_IDX
) = charset_id
;
486 /* No such a charset. */
487 CHARSET_TABLE_INFO (charset
, CHARSET_REVERSE_CHARSET_IDX
)
491 if (charset
!= CHARSET_ASCII
492 && charset
< MIN_CHARSET_PRIVATE_DIMENSION1
)
494 /* Update tables bytes_by_char_head and width_by_char_head. */
495 bytes_by_char_head
[leading_code_base
] = bytes
;
496 width_by_char_head
[leading_code_base
] = XINT (width
);
498 /* Update table emacs_code_class. */
499 emacs_code_class
[charset
] = (bytes
== 2
500 ? EMACS_leading_code_2
502 ? EMACS_leading_code_3
503 : EMACS_leading_code_4
));
506 /* Update table iso_charset_table. */
507 if (ISO_CHARSET_TABLE (dimension
, chars
, iso_final_char
) < 0)
508 ISO_CHARSET_TABLE (dimension
, chars
, iso_final_char
) = charset
;
513 /* Return charset id of CHARSET_SYMBOL, or return -1 if CHARSET_SYMBOL
516 get_charset_id (charset_symbol
)
517 Lisp_Object charset_symbol
;
522 return ((SYMBOLP (charset_symbol
)
523 && (val
= Fget (charset_symbol
, Qcharset
), VECTORP (val
))
524 && (charset
= XINT (XVECTOR (val
)->contents
[CHARSET_ID_IDX
]),
525 CHARSET_VALID_P (charset
)))
529 /* Return an identification number for a new private charset of
530 DIMENSION and WIDTH. If there's no more room for the new charset,
533 get_new_private_charset_id (dimension
, width
)
534 int dimension
, width
;
536 int charset
, from
, to
;
541 from
= LEADING_CODE_EXT_11
, to
= LEADING_CODE_EXT_12
;
543 from
= LEADING_CODE_EXT_12
, to
= LEADING_CODE_EXT_21
;
548 from
= LEADING_CODE_EXT_21
, to
= LEADING_CODE_EXT_22
;
550 from
= LEADING_CODE_EXT_22
, to
= LEADING_CODE_EXT_MAX
+ 1;
553 for (charset
= from
; charset
< to
; charset
++)
554 if (!CHARSET_DEFINED_P (charset
)) break;
556 return make_number (charset
< to
? charset
: 0);
559 DEFUN ("define-charset", Fdefine_charset
, Sdefine_charset
, 3, 3, 0,
560 "Define CHARSET-ID as the identification number of CHARSET with INFO-VECTOR.\n\
561 If CHARSET-ID is nil, it is decided automatically, which means CHARSET is\n\
562 treated as a private charset.\n\
563 INFO-VECTOR is a vector of the format:\n\
564 [DIMENSION CHARS WIDTH DIRECTION ISO-FINAL-CHAR ISO-GRAPHIC-PLANE\n\
565 SHORT-NAME LONG-NAME DESCRIPTION]\n\
566 The meanings of each elements is as follows:\n\
567 DIMENSION (integer) is the number of bytes to represent a character: 1 or 2.\n\
568 CHARS (integer) is the number of characters in a dimension: 94 or 96.\n\
569 WIDTH (integer) is the number of columns a character in the charset\n\
570 occupies on the screen: one of 0, 1, and 2.\n\
572 DIRECTION (integer) is the rendering direction of characters in the\n\
573 charset when rendering. If 0, render from left to right, else\n\
574 render from right to left.\n\
576 ISO-FINAL-CHAR (character) is the final character of the\n\
577 corresponding ISO 2022 charset.\n\
579 ISO-GRAPHIC-PLANE (integer) is the graphic plane to be invoked\n\
580 while encoding to variants of ISO 2022 coding system, one of the\n\
581 following: 0/graphic-plane-left(GL), 1/graphic-plane-right(GR).\n\
583 SHORT-NAME (string) is the short name to refer to the charset.\n\
585 LONG-NAME (string) is the long name to refer to the charset.\n\
587 DESCRIPTION (string) is the description string of the charset.")
588 (charset_id
, charset_symbol
, info_vector
)
589 Lisp_Object charset_id
, charset_symbol
, info_vector
;
593 if (!NILP (charset_id
))
594 CHECK_NUMBER (charset_id
, 0);
595 CHECK_SYMBOL (charset_symbol
, 1);
596 CHECK_VECTOR (info_vector
, 2);
598 if (! NILP (charset_id
))
600 if (! CHARSET_VALID_P (XINT (charset_id
)))
601 error ("Invalid CHARSET: %d", XINT (charset_id
));
602 else if (CHARSET_DEFINED_P (XINT (charset_id
)))
603 error ("Already defined charset: %d", XINT (charset_id
));
606 vec
= XVECTOR (info_vector
)->contents
;
607 if (XVECTOR (info_vector
)->size
!= 9
608 || !INTEGERP (vec
[0]) || !(XINT (vec
[0]) == 1 || XINT (vec
[0]) == 2)
609 || !INTEGERP (vec
[1]) || !(XINT (vec
[1]) == 94 || XINT (vec
[1]) == 96)
610 || !INTEGERP (vec
[2]) || !(XINT (vec
[2]) == 1 || XINT (vec
[2]) == 2)
611 || !INTEGERP (vec
[3]) || !(XINT (vec
[3]) == 0 || XINT (vec
[3]) == 1)
612 || !INTEGERP (vec
[4]) || !(XINT (vec
[4]) >= '0' && XINT (vec
[4]) <= '~')
613 || !INTEGERP (vec
[5]) || !(XINT (vec
[5]) == 0 || XINT (vec
[5]) == 1)
616 || !STRINGP (vec
[8]))
617 error ("Invalid info-vector argument for defining charset %s",
618 XSYMBOL (charset_symbol
)->name
->data
);
620 if (NILP (charset_id
))
622 charset_id
= get_new_private_charset_id (XINT (vec
[0]), XINT (vec
[2]));
623 if (XINT (charset_id
) == 0)
624 error ("There's no room for a new private charset %s",
625 XSYMBOL (charset_symbol
)->name
->data
);
628 update_charset_table (charset_id
, vec
[0], vec
[1], vec
[2], vec
[3],
629 vec
[4], vec
[5], vec
[6], vec
[7], vec
[8]);
630 Fput (charset_symbol
, Qcharset
, CHARSET_TABLE_ENTRY (XINT (charset_id
)));
631 CHARSET_SYMBOL (XINT (charset_id
)) = charset_symbol
;
632 Vcharset_list
= Fcons (charset_symbol
, Vcharset_list
);
636 DEFUN ("generic-character-list", Fgeneric_character_list
,
637 Sgeneric_character_list
, 0, 0, 0,
638 "Return a list of all possible generic characters.\n\
639 It includes a generic character for a charset not yet defined.")
642 return Vgeneric_character_list
;
645 DEFUN ("get-unused-iso-final-char", Fget_unused_iso_final_char
,
646 Sget_unused_iso_final_char
, 2, 2, 0,
647 "Return an unsed ISO's final char for a charset of DIMENISION and CHARS.\n\
648 DIMENSION is the number of bytes to represent a character: 1 or 2.\n\
649 CHARS is the number of characters in a dimension: 94 or 96.\n\
651 This final char is for private use, thus the range is `0' (48) .. `?' (63).\n\
652 If there's no unused final char for the specified kind of charset,\n\
655 Lisp_Object dimension
, chars
;
659 CHECK_NUMBER (dimension
, 0);
660 CHECK_NUMBER (chars
, 1);
661 if (XINT (dimension
) != 1 && XINT (dimension
) != 2)
662 error ("Invalid charset dimension %d, it should be 1 or 2",
664 if (XINT (chars
) != 94 && XINT (chars
) != 96)
665 error ("Invalid charset chars %d, it should be 94 or 96",
667 for (final_char
= '0'; final_char
<= '?'; final_char
++)
669 if (ISO_CHARSET_TABLE (dimension
, chars
, make_number (final_char
)) < 0)
672 return (final_char
<= '?' ? make_number (final_char
) : Qnil
);
675 DEFUN ("declare-equiv-charset", Fdeclare_equiv_charset
, Sdeclare_equiv_charset
,
677 "Declare a charset of DIMENSION, CHARS, FINAL-CHAR is the same as CHARSET.\n\
678 CHARSET should be defined by `defined-charset' in advance.")
679 (dimension
, chars
, final_char
, charset_symbol
)
680 Lisp_Object dimension
, chars
, final_char
, charset_symbol
;
684 CHECK_NUMBER (dimension
, 0);
685 CHECK_NUMBER (chars
, 1);
686 CHECK_NUMBER (final_char
, 2);
687 CHECK_SYMBOL (charset_symbol
, 3);
689 if (XINT (dimension
) != 1 && XINT (dimension
) != 2)
690 error ("Invalid DIMENSION %d, it should be 1 or 2", XINT (dimension
));
691 if (XINT (chars
) != 94 && XINT (chars
) != 96)
692 error ("Invalid CHARS %d, it should be 94 or 96", XINT (chars
));
693 if (XINT (final_char
) < '0' || XFASTINT (final_char
) > '~')
694 error ("Invalid FINAL-CHAR %c, it should be `0'..`~'", XINT (chars
));
695 if ((charset
= get_charset_id (charset_symbol
)) < 0)
696 error ("Invalid charset %s", XSYMBOL (charset_symbol
)->name
->data
);
698 ISO_CHARSET_TABLE (dimension
, chars
, final_char
) = charset
;
702 /* Return number of different charsets in STR of length LEN. In
703 addition, for each found charset N, CHARSETS[N] is set 1. The
704 caller should allocate CHARSETS (MAX_CHARSET + 1 elements) in advance.
705 It may lookup a translation table TABLE if supplied.
707 If CMPCHARP is nonzero and some composite character is found,
708 CHARSETS[128] is also set 1 and the returned number is incremented
712 find_charset_in_str (str
, len
, charsets
, table
, cmpcharp
)
718 register int num
= 0, c
;
720 if (! CHAR_TABLE_P (table
))
728 if (c
== LEADING_CODE_COMPOSITION
)
730 int cmpchar_id
= str_cmpchar_id (str
, len
);
735 struct cmpchar_info
*cmp_p
= cmpchar_table
[cmpchar_id
];
738 for (i
= 0; i
< cmp_p
->glyph_len
; i
++)
743 if ((c
= translate_char (table
, c
, 0, 0, 0)) < 0)
746 if ((charset
= CHAR_CHARSET (c
)) < 0)
747 charset
= CHARSET_ASCII
;
748 if (!charsets
[charset
])
750 charsets
[charset
] = 1;
756 if (cmpcharp
&& !charsets
[CHARSET_COMPOSITION
])
758 charsets
[CHARSET_COMPOSITION
] = 1;
764 charset
= CHARSET_ASCII
;
769 c
= STRING_CHAR_AND_LENGTH (str
, len
, bytes
);
772 int c1
= translate_char (table
, c
, 0, 0, 0);
776 charset
= CHAR_CHARSET (c
);
779 if (!charsets
[charset
])
781 charsets
[charset
] = 1;
790 DEFUN ("find-charset-region", Ffind_charset_region
, Sfind_charset_region
,
792 "Return a list of charsets in the region between BEG and END.\n\
793 BEG and END are buffer positions.\n\
794 If the region contains any composite character,\n\
795 `composition' is included in the returned list.\n\
796 Optional arg TABLE if non-nil is a translation table to look up.")
798 Lisp_Object beg
, end
, table
;
800 int charsets
[MAX_CHARSET
+ 1];
801 int from
, from_byte
, to
, stop
, stop_byte
, i
;
804 validate_region (&beg
, &end
);
805 from
= XFASTINT (beg
);
806 stop
= to
= XFASTINT (end
);
808 if (NILP (current_buffer
->enable_multibyte_characters
))
811 : Fcons (Qascii
, Qnil
));
813 if (from
< GPT
&& GPT
< to
)
816 stop_byte
= GPT_BYTE
;
819 stop_byte
= CHAR_TO_BYTE (stop
);
821 from_byte
= CHAR_TO_BYTE (from
);
823 bzero (charsets
, (MAX_CHARSET
+ 1) * sizeof (int));
826 find_charset_in_str (BYTE_POS_ADDR (from_byte
), stop_byte
- from_byte
,
830 from
= stop
, from_byte
= stop_byte
;
831 stop
= to
, stop_byte
= CHAR_TO_BYTE (stop
);
838 for (i
= MAX_CHARSET
; i
>= 0; i
--)
840 val
= Fcons (CHARSET_SYMBOL (i
), val
);
844 DEFUN ("find-charset-string", Ffind_charset_string
, Sfind_charset_string
,
846 "Return a list of charsets in STR.\n\
847 If the string contains any composite characters,\n\
848 `composition' is included in the returned list.\n\
849 Optional arg TABLE if non-nil is a translation table to look up.")
851 Lisp_Object str
, table
;
853 int charsets
[MAX_CHARSET
+ 1];
857 CHECK_STRING (str
, 0);
859 if (! STRING_MULTIBYTE (str
))
860 return (XSTRING (str
)->size
== 0
862 : Fcons (Qascii
, Qnil
));
864 bzero (charsets
, (MAX_CHARSET
+ 1) * sizeof (int));
865 find_charset_in_str (XSTRING (str
)->data
, STRING_BYTES (XSTRING (str
)),
868 for (i
= MAX_CHARSET
; i
>= 0; i
--)
870 val
= Fcons (CHARSET_SYMBOL (i
), val
);
874 DEFUN ("make-char-internal", Fmake_char_internal
, Smake_char_internal
, 1, 3, 0,
876 (charset
, code1
, code2
)
877 Lisp_Object charset
, code1
, code2
;
879 CHECK_NUMBER (charset
, 0);
882 XSETFASTINT (code1
, 0);
884 CHECK_NUMBER (code1
, 1);
886 XSETFASTINT (code2
, 0);
888 CHECK_NUMBER (code2
, 2);
890 if (!CHARSET_DEFINED_P (XINT (charset
)))
891 error ("Invalid charset: %d", XINT (charset
));
893 return make_number (MAKE_CHAR (XINT (charset
), XINT (code1
), XINT (code2
)));
896 DEFUN ("split-char", Fsplit_char
, Ssplit_char
, 1, 1, 0,
897 "Return list of charset and one or two position-codes of CHAR.")
904 CHECK_NUMBER (ch
, 0);
905 SPLIT_CHAR (XFASTINT (ch
), charset
, c1
, c2
);
907 ? Fcons (CHARSET_SYMBOL (charset
),
908 Fcons (make_number (c1
), Fcons (make_number (c2
), Qnil
)))
909 : Fcons (CHARSET_SYMBOL (charset
), Fcons (make_number (c1
), Qnil
)));
912 DEFUN ("char-charset", Fchar_charset
, Schar_charset
, 1, 1, 0,
913 "Return charset of CHAR.")
917 CHECK_NUMBER (ch
, 0);
919 return CHARSET_SYMBOL (CHAR_CHARSET (XINT (ch
)));
922 DEFUN ("charset-after", Fcharset_after
, Scharset_after
, 0, 1, 0,
923 "Return charset of a character in current buffer at position POS.\n\
924 If POS is nil, it defauls to the current point.")
928 register int pos_byte
, c
, charset
;
929 register unsigned char *p
;
933 else if (MARKERP (pos
))
934 pos_byte
= marker_byte_position (pos
);
937 CHECK_NUMBER (pos
, 0);
938 pos_byte
= CHAR_TO_BYTE (XINT (pos
));
940 p
= BYTE_POS_ADDR (pos_byte
);
941 c
= STRING_CHAR (p
, Z_BYTE
- pos_byte
);
942 charset
= CHAR_CHARSET (c
);
943 return CHARSET_SYMBOL (charset
);
946 DEFUN ("iso-charset", Fiso_charset
, Siso_charset
, 3, 3, 0,
947 "Return charset of ISO's specification DIMENSION, CHARS, and FINAL-CHAR.\n\
949 ISO 2022's designation sequence (escape sequence) distinguishes charsets\n\
950 by their DIMENSION, CHARS, and FINAL-CHAR,\n\
951 where as Emacs distinguishes them by charset symbol.\n\
952 See the documentation of the function `charset-info' for the meanings of\n\
953 DIMENSION, CHARS, and FINAL-CHAR.")
954 (dimension
, chars
, final_char
)
955 Lisp_Object dimension
, chars
, final_char
;
959 CHECK_NUMBER (dimension
, 0);
960 CHECK_NUMBER (chars
, 1);
961 CHECK_NUMBER (final_char
, 2);
963 if ((charset
= ISO_CHARSET_TABLE (dimension
, chars
, final_char
)) < 0)
965 return CHARSET_SYMBOL (charset
);
968 /* If GENERICP is nonzero, return nonzero iff C is a valid normal or
969 generic character. If GENERICP is zero, return nonzero iff C is a
970 valid normal character. Do not call this function directly,
971 instead use macro CHAR_VALID_P. */
973 char_valid_p (c
, genericp
)
980 if (SINGLE_BYTE_CHAR_P (c
))
982 SPLIT_NON_ASCII_CHAR (c
, charset
, c1
, c2
);
983 if (!CHARSET_VALID_P (charset
))
985 return (c
< MIN_CHAR_COMPOSITION
986 ? ((c
& CHAR_FIELD1_MASK
) /* i.e. dimension of C is two. */
987 ? (genericp
&& c1
== 0 && c2
== 0
988 || c1
>= 32 && c2
>= 32)
989 : (genericp
&& c1
== 0
991 : c
< MIN_CHAR_COMPOSITION
+ n_cmpchars
);
994 DEFUN ("char-valid-p", Fchar_valid_p
, Schar_valid_p
, 1, 2, 0,
995 "Return t if OBJECT is a valid normal character.\n\
996 If optional arg GENERICP is non-nil, also return t if OBJECT is\n\
997 a valid generic character.")
999 Lisp_Object object
, genericp
;
1001 if (! NATNUMP (object
))
1003 return (CHAR_VALID_P (XFASTINT (object
), !NILP (genericp
)) ? Qt
: Qnil
);
1006 DEFUN ("unibyte-char-to-multibyte", Funibyte_char_to_multibyte
,
1007 Sunibyte_char_to_multibyte
, 1, 1, 0,
1008 "Convert the unibyte character CH to multibyte character.\n\
1009 The conversion is done based on `nonascii-translation-table' (which see)\n\
1010 or `nonascii-insert-offset' (which see).")
1016 CHECK_NUMBER (ch
, 0);
1018 if (c
< 0 || c
>= 0400)
1019 error ("Invalid unibyte character: %d", c
);
1020 c
= unibyte_char_to_multibyte (c
);
1022 error ("Can't convert to multibyte character: %d", XINT (ch
));
1023 return make_number (c
);
1026 DEFUN ("multibyte-char-to-unibyte", Fmultibyte_char_to_unibyte
,
1027 Smultibyte_char_to_unibyte
, 1, 1, 0,
1028 "Convert the multibyte character CH to unibyte character.\n\
1029 The conversion is done based on `nonascii-translation-table' (which see)\n\
1030 or `nonascii-insert-offset' (which see).")
1036 CHECK_NUMBER (ch
, 0);
1039 error ("Invalid multibyte character: %d", c
);
1040 c
= multibyte_char_to_unibyte (c
, Qnil
);
1042 error ("Can't convert to unibyte character: %d", XINT (ch
));
1043 return make_number (c
);
1046 DEFUN ("char-bytes", Fchar_bytes
, Schar_bytes
, 1, 1, 0,
1047 "Return 1 regardless of the argument CHAR.\n\
1048 This is now an obsolte function. We keep is just for backward compatibility.")
1054 CHECK_NUMBER (ch
, 0);
1055 return make_number (1);
1058 /* Return how many bytes C will occupy in a multibyte buffer.
1059 Don't call this function directly, instead use macro CHAR_BYTES. */
1066 if (COMPOSITE_CHAR_P (c
))
1068 unsigned int id
= COMPOSITE_CHAR_ID (c
);
1070 bytes
= (id
< n_cmpchars
? cmpchar_table
[id
]->len
: 1);
1074 int charset
= CHAR_CHARSET (c
);
1076 bytes
= CHARSET_DEFINED_P (charset
) ? CHARSET_BYTES (charset
) : 1;
1079 return make_number (bytes
);
1082 /* Return the width of character of which multi-byte form starts with
1083 C. The width is measured by how many columns occupied on the
1084 screen when displayed in the current buffer. */
1086 #define ONE_BYTE_CHAR_WIDTH(c) \
1089 ? XFASTINT (current_buffer->tab_width) \
1090 : (c == '\n' ? 0 : (NILP (current_buffer->ctl_arrow) ? 4 : 2))) \
1094 ? (NILP (current_buffer->ctl_arrow) ? 4 : 2) \
1095 : ((! NILP (current_buffer->enable_multibyte_characters) \
1096 && BASE_LEADING_CODE_P (c)) \
1097 ? WIDTH_BY_CHAR_HEAD (c) \
1100 DEFUN ("char-width", Fchar_width
, Schar_width
, 1, 1, 0,
1101 "Return width of CHAR when displayed in the current buffer.\n\
1102 The width is measured by how many columns it occupies on the screen.")
1106 Lisp_Object val
, disp
;
1108 struct Lisp_Char_Table
*dp
= buffer_display_table ();
1110 CHECK_NUMBER (ch
, 0);
1114 /* Get the way the display table would display it. */
1115 disp
= dp
? DISP_CHAR_VECTOR (dp
, c
) : Qnil
;
1118 XSETINT (val
, XVECTOR (disp
)->size
);
1119 else if (SINGLE_BYTE_CHAR_P (c
))
1120 XSETINT (val
, ONE_BYTE_CHAR_WIDTH (c
));
1121 else if (COMPOSITE_CHAR_P (c
))
1123 int id
= COMPOSITE_CHAR_ID (XFASTINT (ch
));
1124 XSETFASTINT (val
, (id
< n_cmpchars
? cmpchar_table
[id
]->width
: 0));
1128 int charset
= CHAR_CHARSET (c
);
1130 XSETFASTINT (val
, CHARSET_WIDTH (charset
));
1135 /* Return width of string STR of length LEN when displayed in the
1136 current buffer. The width is measured by how many columns it
1137 occupies on the screen. */
1144 unsigned char *endp
= str
+ len
;
1146 struct Lisp_Char_Table
*dp
= buffer_display_table ();
1150 if (*str
== LEADING_CODE_COMPOSITION
)
1152 int id
= str_cmpchar_id (str
, endp
- str
);
1161 width
+= cmpchar_table
[id
]->width
;
1162 str
+= cmpchar_table
[id
]->len
;
1169 int c
= STRING_CHAR_AND_LENGTH (str
, endp
- str
, thislen
);
1171 /* Get the way the display table would display it. */
1173 disp
= DISP_CHAR_VECTOR (dp
, c
);
1178 width
+= XVECTOR (disp
)->size
;
1180 width
+= ONE_BYTE_CHAR_WIDTH (*str
);
1188 DEFUN ("string-width", Fstring_width
, Sstring_width
, 1, 1, 0,
1189 "Return width of STRING when displayed in the current buffer.\n\
1190 Width is measured by how many columns it occupies on the screen.\n\
1191 When calculating width of a multibyte character in STRING,\n\
1192 only the base leading-code is considered; the validity of\n\
1193 the following bytes is not checked.")
1199 CHECK_STRING (str
, 0);
1200 XSETFASTINT (val
, strwidth (XSTRING (str
)->data
,
1201 STRING_BYTES (XSTRING (str
))));
1205 DEFUN ("char-direction", Fchar_direction
, Schar_direction
, 1, 1, 0,
1206 "Return the direction of CHAR.\n\
1207 The returned value is 0 for left-to-right and 1 for right-to-left.")
1213 CHECK_NUMBER (ch
, 0);
1214 charset
= CHAR_CHARSET (XFASTINT (ch
));
1215 if (!CHARSET_DEFINED_P (charset
))
1216 invalid_character (XINT (ch
));
1217 return CHARSET_TABLE_INFO (charset
, CHARSET_DIRECTION_IDX
);
1220 DEFUN ("chars-in-region", Fchars_in_region
, Schars_in_region
, 2, 2, 0,
1221 "Return number of characters between BEG and END.")
1223 Lisp_Object beg
, end
;
1227 CHECK_NUMBER_COERCE_MARKER (beg
, 0);
1228 CHECK_NUMBER_COERCE_MARKER (end
, 1);
1230 from
= min (XFASTINT (beg
), XFASTINT (end
));
1231 to
= max (XFASTINT (beg
), XFASTINT (end
));
1233 return make_number (to
- from
);
1236 /* Return the number of characters in the NBYTES bytes at PTR.
1237 This works by looking at the contents and checking for multibyte sequences.
1238 However, if the current buffer has enable-multibyte-characters = nil,
1239 we treat each byte as a character. */
1242 chars_in_text (ptr
, nbytes
)
1246 unsigned char *endp
, c
;
1249 /* current_buffer is null at early stages of Emacs initialization. */
1250 if (current_buffer
== 0
1251 || NILP (current_buffer
->enable_multibyte_characters
))
1254 endp
= ptr
+ nbytes
;
1261 if (BASE_LEADING_CODE_P (c
))
1262 while (ptr
< endp
&& ! CHAR_HEAD_P (*ptr
)) ptr
++;
1269 /* Return the number of characters in the NBYTES bytes at PTR.
1270 This works by looking at the contents and checking for multibyte sequences.
1271 It ignores enable-multibyte-characters. */
1274 multibyte_chars_in_text (ptr
, nbytes
)
1278 unsigned char *endp
, c
;
1281 endp
= ptr
+ nbytes
;
1288 if (BASE_LEADING_CODE_P (c
))
1289 while (ptr
< endp
&& ! CHAR_HEAD_P (*ptr
)) ptr
++;
1296 DEFUN ("string", Fstring
, Sstring
, 1, MANY
, 0,
1297 "Concatenate all the argument characters and make the result a string.")
1304 = (unsigned char *) alloca (MAX_LENGTH_OF_MULTI_BYTE_FORM
* n
);
1305 unsigned char *p
= buf
;
1308 for (i
= 0; i
< n
; i
++)
1313 if (!INTEGERP (args
[i
]))
1314 CHECK_NUMBER (args
[i
], 0);
1316 len
= CHAR_STRING (c
, p
, str
);
1318 /* C is a composite character. */
1319 bcopy (str
, p
, len
);
1323 /* Here, we can't use make_string_from_bytes because of byte
1324 combining problem. */
1325 val
= make_string (buf
, p
- buf
);
1331 /*** Composite characters staffs ***/
1333 /* Each composite character is identified by CMPCHAR-ID which is
1334 assigned when Emacs needs the character code of the composite
1335 character (e.g. when displaying it on the screen). See the
1336 document "GENERAL NOTE on COMPOSITE CHARACTER" in `charset.h' how a
1337 composite character is represented in Emacs. */
1339 /* If `static' is defined, it means that it is defined to null string. */
1341 /* The following function is copied from lread.c. */
1343 hash_string (ptr
, len
)
1347 register unsigned char *p
= ptr
;
1348 register unsigned char *end
= p
+ len
;
1349 register unsigned char c
;
1350 register int hash
= 0;
1355 if (c
>= 0140) c
-= 40;
1356 hash
= ((hash
<<3) + (hash
>>28) + c
);
1358 return hash
& 07777777777;
1362 #define CMPCHAR_HASH_TABLE_SIZE 0xFFF
1364 static int *cmpchar_hash_table
[CMPCHAR_HASH_TABLE_SIZE
];
1366 /* Each element of `cmpchar_hash_table' is a pointer to an array of
1367 integer, where the 1st element is the size of the array, the 2nd
1368 element is how many elements are actually used in the array, and
1369 the remaining elements are CMPCHAR-IDs of composite characters of
1370 the same hash value. */
1371 #define CMPCHAR_HASH_SIZE(table) table[0]
1372 #define CMPCHAR_HASH_USED(table) table[1]
1373 #define CMPCHAR_HASH_CMPCHAR_ID(table, i) table[i]
1375 /* Return CMPCHAR-ID of the composite character in STR of the length
1376 LEN. If the composite character has not yet been registered,
1377 register it in `cmpchar_table' and assign new CMPCHAR-ID. This
1378 is the sole function for assigning CMPCHAR-ID. */
1380 str_cmpchar_id (str
, len
)
1381 const unsigned char *str
;
1384 int hash_idx
, *hashp
;
1386 int embedded_rule
; /* 1 if composition rule is embedded. */
1387 int chars
; /* number of components. */
1389 struct cmpchar_info
*cmpcharp
;
1391 /* The second byte 0xFF means compostion rule is embedded. */
1392 embedded_rule
= (str
[1] == 0xFF);
1394 /* At first, get the actual length of the composite character. */
1396 const unsigned char *p
, *endp
= str
+ 1, *lastp
= str
+ len
;
1399 while (endp
< lastp
&& ! CHAR_HEAD_P (*endp
)) endp
++;
1401 /* Any composite char have at least 5-byte length. */
1408 if (embedded_rule
) p
++;
1409 /* No need of checking if *P is 0xA0 because
1410 BYTES_BY_CHAR_HEAD (0x80) surely returns 2. */
1411 p
+= BYTES_BY_CHAR_HEAD (*p
- 0x20);
1414 if (p
> endp
|| chars
< 2 || chars
> MAX_COMPONENT_COUNT
)
1415 /* Invalid components. */
1419 hash_idx
= hash_string (str
, len
) % CMPCHAR_HASH_TABLE_SIZE
;
1420 hashp
= cmpchar_hash_table
[hash_idx
];
1422 /* Then, look into the hash table. */
1424 /* Find the correct one among composite characters of the same
1426 for (i
= 2; i
< CMPCHAR_HASH_USED (hashp
); i
++)
1428 cmpcharp
= cmpchar_table
[CMPCHAR_HASH_CMPCHAR_ID (hashp
, i
)];
1429 if (len
== cmpcharp
->len
1430 && ! bcmp (str
, cmpcharp
->data
, len
))
1431 return CMPCHAR_HASH_CMPCHAR_ID (hashp
, i
);
1434 /* We have to register the composite character in cmpchar_table. */
1435 if (n_cmpchars
> (CHAR_FIELD2_MASK
| CHAR_FIELD3_MASK
))
1436 /* No, we have no more room for a new composite character. */
1439 /* Make the entry in hash table. */
1442 /* Make a table for 8 composite characters initially. */
1443 hashp
= (cmpchar_hash_table
[hash_idx
]
1444 = (int *) xmalloc (sizeof (int) * (2 + 8)));
1445 CMPCHAR_HASH_SIZE (hashp
) = 10;
1446 CMPCHAR_HASH_USED (hashp
) = 2;
1448 else if (CMPCHAR_HASH_USED (hashp
) >= CMPCHAR_HASH_SIZE (hashp
))
1450 CMPCHAR_HASH_SIZE (hashp
) += 8;
1451 hashp
= (cmpchar_hash_table
[hash_idx
]
1452 = (int *) xrealloc (hashp
,
1453 sizeof (int) * CMPCHAR_HASH_SIZE (hashp
)));
1455 CMPCHAR_HASH_CMPCHAR_ID (hashp
, CMPCHAR_HASH_USED (hashp
)) = n_cmpchars
;
1456 CMPCHAR_HASH_USED (hashp
)++;
1458 /* Set information of the composite character in cmpchar_table. */
1459 if (cmpchar_table_size
== 0)
1461 /* This is the first composite character to be registered. */
1462 cmpchar_table_size
= 256;
1464 = (struct cmpchar_info
**) xmalloc (sizeof (cmpchar_table
[0])
1465 * cmpchar_table_size
);
1467 else if (cmpchar_table_size
<= n_cmpchars
)
1469 cmpchar_table_size
+= 256;
1471 = (struct cmpchar_info
**) xrealloc (cmpchar_table
,
1472 sizeof (cmpchar_table
[0])
1473 * cmpchar_table_size
);
1476 cmpcharp
= (struct cmpchar_info
*) xmalloc (sizeof (struct cmpchar_info
));
1478 cmpcharp
->len
= len
;
1479 cmpcharp
->data
= (unsigned char *) xmalloc (len
+ 1);
1480 bcopy (str
, cmpcharp
->data
, len
);
1481 cmpcharp
->data
[len
] = 0;
1482 cmpcharp
->glyph_len
= chars
;
1483 cmpcharp
->glyph
= (GLYPH
*) xmalloc (sizeof (GLYPH
) * chars
);
1486 cmpcharp
->cmp_rule
= (unsigned char *) xmalloc (chars
);
1487 cmpcharp
->col_offset
= (float *) xmalloc (sizeof (float) * chars
);
1491 cmpcharp
->cmp_rule
= NULL
;
1492 cmpcharp
->col_offset
= NULL
;
1495 /* Setup GLYPH data and composition rules (if any) so as not to make
1496 them every time on displaying. */
1498 unsigned char *bufp
;
1500 float leftmost
= 0.0, rightmost
= 1.0;
1503 /* At first, col_offset[N] is set to relative to col_offset[0]. */
1504 cmpcharp
->col_offset
[0] = 0;
1506 for (i
= 0, bufp
= cmpcharp
->data
+ 1; i
< chars
; i
++)
1509 cmpcharp
->cmp_rule
[i
] = *bufp
++;
1511 if (*bufp
== 0xA0) /* This is an ASCII character. */
1513 cmpcharp
->glyph
[i
] = FAST_MAKE_GLYPH ((*++bufp
& 0x7F), 0);
1517 else /* Multibyte character. */
1519 /* Make `bufp' point normal multi-byte form temporally. */
1522 = FAST_MAKE_GLYPH (string_to_non_ascii_char (bufp
, 4, 0, 0), 0);
1523 width
= WIDTH_BY_CHAR_HEAD (*bufp
);
1525 bufp
+= BYTES_BY_CHAR_HEAD (*bufp
- 0x20);
1528 if (embedded_rule
&& i
> 0)
1530 /* Reference points (global_ref and new_ref) are
1541 Now, we calculate the column offset of the new glyph
1542 from the left edge of the first glyph. This can avoid
1543 the same calculation everytime displaying this
1544 composite character. */
1546 /* Reference points of global glyph and new glyph. */
1547 int global_ref
= (cmpcharp
->cmp_rule
[i
] - 0xA0) / 9;
1548 int new_ref
= (cmpcharp
->cmp_rule
[i
] - 0xA0) % 9;
1549 /* Column offset relative to the first glyph. */
1550 float left
= (leftmost
1551 + (global_ref
% 3) * (rightmost
- leftmost
) / 2.0
1552 - (new_ref
% 3) * width
/ 2.0);
1554 cmpcharp
->col_offset
[i
] = left
;
1555 if (left
< leftmost
)
1557 if (left
+ width
> rightmost
)
1558 rightmost
= left
+ width
;
1562 if (width
> rightmost
)
1568 /* Now col_offset[N] are relative to the left edge of the
1569 first component. Make them relative to the left edge of
1571 for (i
= 0; i
< chars
; i
++)
1572 cmpcharp
->col_offset
[i
] -= leftmost
;
1573 /* Make rightmost holds width of overall glyph. */
1574 rightmost
-= leftmost
;
1577 cmpcharp
->width
= rightmost
;
1578 if (cmpcharp
->width
< rightmost
)
1579 /* To get a ceiling integer value. */
1583 cmpchar_table
[n_cmpchars
] = cmpcharp
;
1585 return n_cmpchars
++;
1588 /* Return the Nth element of the composite character C. */
1590 cmpchar_component (c
, n
)
1593 int id
= COMPOSITE_CHAR_ID (c
);
1595 if (id
>= n_cmpchars
/* C is not a valid composite character. */
1596 || n
>= cmpchar_table
[id
]->glyph_len
) /* No such component. */
1598 /* No face data is stored in glyph code. */
1599 return ((int) (cmpchar_table
[id
]->glyph
[n
]));
1602 DEFUN ("cmpcharp", Fcmpcharp
, Scmpcharp
, 1, 1, 0,
1603 "T if CHAR is a composite character.")
1607 CHECK_NUMBER (ch
, 0);
1608 return (COMPOSITE_CHAR_P (XINT (ch
)) ? Qt
: Qnil
);
1611 DEFUN ("composite-char-component", Fcmpchar_component
, Scmpchar_component
,
1613 "Return the IDXth component character of composite character CHARACTER.")
1615 Lisp_Object character
, idx
;
1619 CHECK_NUMBER (character
, 0);
1620 CHECK_NUMBER (idx
, 1);
1622 if ((c
= cmpchar_component (XINT (character
), XINT (idx
))) < 0)
1623 args_out_of_range (character
, idx
);
1625 return make_number (c
);
1628 DEFUN ("composite-char-composition-rule", Fcmpchar_cmp_rule
, Scmpchar_cmp_rule
,
1630 "Return the Nth composition rule embedded in composite character CHARACTER.\n\
1631 The returned rule is for composing the Nth component\n\
1632 on the (N-1)th component. If N is 0, the returned value is always 255.")
1634 Lisp_Object character
, n
;
1638 CHECK_NUMBER (character
, 0);
1639 CHECK_NUMBER (n
, 1);
1641 id
= COMPOSITE_CHAR_ID (XINT (character
));
1642 if (id
< 0 || id
>= n_cmpchars
)
1643 error ("Invalid composite character: %d", XINT (character
));
1645 if (i
> cmpchar_table
[id
]->glyph_len
)
1646 args_out_of_range (character
, n
);
1648 return make_number (cmpchar_table
[id
]->cmp_rule
[i
]);
1651 DEFUN ("composite-char-composition-rule-p", Fcmpchar_cmp_rule_p
,
1652 Scmpchar_cmp_rule_p
, 1, 1, 0,
1653 "Return non-nil if composite character CHARACTER contains a embedded rule.")
1655 Lisp_Object character
;
1659 CHECK_NUMBER (character
, 0);
1660 id
= COMPOSITE_CHAR_ID (XINT (character
));
1661 if (id
< 0 || id
>= n_cmpchars
)
1662 error ("Invalid composite character: %d", XINT (character
));
1664 return (cmpchar_table
[id
]->cmp_rule
? Qt
: Qnil
);
1667 DEFUN ("composite-char-component-count", Fcmpchar_cmp_count
,
1668 Scmpchar_cmp_count
, 1, 1, 0,
1669 "Return number of compoents of composite character CHARACTER.")
1671 Lisp_Object character
;
1675 CHECK_NUMBER (character
, 0);
1676 id
= COMPOSITE_CHAR_ID (XINT (character
));
1677 if (id
< 0 || id
>= n_cmpchars
)
1678 error ("Invalid composite character: %d", XINT (character
));
1680 return (make_number (cmpchar_table
[id
]->glyph_len
));
1683 DEFUN ("compose-string", Fcompose_string
, Scompose_string
,
1685 "Return one char string composed from all characters in STRING.")
1689 unsigned char buf
[MAX_LENGTH_OF_MULTI_BYTE_FORM
], *p
, *pend
, *ptemp
;
1692 CHECK_STRING (str
, 0);
1694 buf
[0] = LEADING_CODE_COMPOSITION
;
1695 p
= XSTRING (str
)->data
;
1696 pend
= p
+ STRING_BYTES (XSTRING (str
));
1700 if (*p
< 0x20 || *p
== 127) /* control code */
1701 error ("Invalid component character: %d", *p
);
1702 else if (*p
< 0x80) /* ASCII */
1704 if (i
+ 2 >= MAX_LENGTH_OF_MULTI_BYTE_FORM
)
1705 error ("Too long string to be composed: %s", XSTRING (str
)->data
);
1706 /* Prepend an ASCII charset indicator 0xA0, set MSB of the
1709 buf
[i
++] = *p
++ + 0x80;
1711 else if (*p
== LEADING_CODE_COMPOSITION
) /* composite char */
1713 /* Already composed. Eliminate the heading
1714 LEADING_CODE_COMPOSITION, keep the remaining bytes
1718 while (! CHAR_HEAD_P (*p
)) p
++;
1719 if (i
+ (p
- ptemp
) >= MAX_LENGTH_OF_MULTI_BYTE_FORM
)
1720 error ("Too long string to be composed: %s", XSTRING (str
)->data
);
1721 bcopy (ptemp
, buf
+ i
, p
- ptemp
);
1724 else /* multibyte char */
1726 /* Add 0x20 to the base leading-code, keep the remaining
1728 len
= BYTES_BY_CHAR_HEAD (*p
);
1729 if (i
+ len
>= MAX_LENGTH_OF_MULTI_BYTE_FORM
)
1730 error ("Too long string to be composed: %s", XSTRING (str
)->data
);
1731 bcopy (p
, buf
+ i
, len
);
1738 /* STR contains only one character, which can't be composed. */
1739 error ("Too short string to be composed: %s", XSTRING (str
)->data
);
1741 return make_string_from_bytes (buf
, 1, i
);
1746 charset_id_internal (charset_name
)
1751 val
= Fget (intern (charset_name
), Qcharset
);
1753 error ("Charset %s is not defined", charset_name
);
1755 return (XINT (XVECTOR (val
)->contents
[0]));
1758 DEFUN ("setup-special-charsets", Fsetup_special_charsets
,
1759 Ssetup_special_charsets
, 0, 0, 0, "Internal use only.")
1762 charset_latin_iso8859_1
= charset_id_internal ("latin-iso8859-1");
1763 charset_jisx0208_1978
= charset_id_internal ("japanese-jisx0208-1978");
1764 charset_jisx0208
= charset_id_internal ("japanese-jisx0208");
1765 charset_katakana_jisx0201
= charset_id_internal ("katakana-jisx0201");
1766 charset_latin_jisx0201
= charset_id_internal ("latin-jisx0201");
1767 charset_big5_1
= charset_id_internal ("chinese-big5-1");
1768 charset_big5_2
= charset_id_internal ("chinese-big5-2");
1773 init_charset_once ()
1777 staticpro (&Vcharset_table
);
1778 staticpro (&Vcharset_symbol_table
);
1779 staticpro (&Vgeneric_character_list
);
1781 /* This has to be done here, before we call Fmake_char_table. */
1782 Qcharset_table
= intern ("charset-table");
1783 staticpro (&Qcharset_table
);
1785 /* Intern this now in case it isn't already done.
1786 Setting this variable twice is harmless.
1787 But don't staticpro it here--that is done in alloc.c. */
1788 Qchar_table_extra_slots
= intern ("char-table-extra-slots");
1790 /* Now we are ready to set up this property, so we can
1791 create the charset table. */
1792 Fput (Qcharset_table
, Qchar_table_extra_slots
, make_number (0));
1793 Vcharset_table
= Fmake_char_table (Qcharset_table
, Qnil
);
1795 Vcharset_symbol_table
= Fmake_vector (make_number (MAX_CHARSET
+ 1), Qnil
);
1798 for (i
= 0; i
< 2; i
++)
1799 for (j
= 0; j
< 2; j
++)
1800 for (k
= 0; k
< 128; k
++)
1801 iso_charset_table
[i
][j
][k
] = -1;
1803 bzero (cmpchar_hash_table
, sizeof cmpchar_hash_table
);
1804 cmpchar_table_size
= n_cmpchars
= 0;
1806 for (i
= 0; i
< 256; i
++)
1807 BYTES_BY_CHAR_HEAD (i
) = 1;
1808 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_11
) = 3;
1809 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_12
) = 3;
1810 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_21
) = 4;
1811 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_22
) = 4;
1812 /* The following doesn't reflect the actual bytes, but just to tell
1813 that it is a start of a multibyte character. */
1814 BYTES_BY_CHAR_HEAD (LEADING_CODE_COMPOSITION
) = 2;
1816 for (i
= 0; i
< 128; i
++)
1817 WIDTH_BY_CHAR_HEAD (i
) = 1;
1818 for (; i
< 256; i
++)
1819 WIDTH_BY_CHAR_HEAD (i
) = 4;
1820 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_11
) = 1;
1821 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_12
) = 2;
1822 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_21
) = 1;
1823 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_22
) = 2;
1829 for (i
= 0x81; i
< 0x90; i
++)
1830 val
= Fcons (make_number ((i
- 0x70) << 7), val
);
1831 for (; i
< 0x9A; i
++)
1832 val
= Fcons (make_number ((i
- 0x8F) << 14), val
);
1833 for (i
= 0xA0; i
< 0xF0; i
++)
1834 val
= Fcons (make_number ((i
- 0x70) << 7), val
);
1835 for (; i
< 0xFF; i
++)
1836 val
= Fcons (make_number ((i
- 0xE0) << 14), val
);
1837 val
= Fcons (make_number (GENERIC_COMPOSITION_CHAR
), val
);
1838 Vgeneric_character_list
= Fnreverse (val
);
1841 nonascii_insert_offset
= 0;
1842 Vnonascii_translation_table
= Qnil
;
1850 Qascii
= intern ("ascii");
1851 staticpro (&Qascii
);
1853 Qcharset
= intern ("charset");
1854 staticpro (&Qcharset
);
1856 /* Define ASCII charset now. */
1857 update_charset_table (make_number (CHARSET_ASCII
),
1858 make_number (1), make_number (94),
1863 build_string ("ASCII"),
1864 build_string ("ASCII"),
1865 build_string ("ASCII (ISO646 IRV)"));
1866 CHARSET_SYMBOL (CHARSET_ASCII
) = Qascii
;
1867 Fput (Qascii
, Qcharset
, CHARSET_TABLE_ENTRY (CHARSET_ASCII
));
1869 Qcomposition
= intern ("composition");
1870 staticpro (&Qcomposition
);
1871 CHARSET_SYMBOL (CHARSET_COMPOSITION
) = Qcomposition
;
1873 defsubr (&Sdefine_charset
);
1874 defsubr (&Sgeneric_character_list
);
1875 defsubr (&Sget_unused_iso_final_char
);
1876 defsubr (&Sdeclare_equiv_charset
);
1877 defsubr (&Sfind_charset_region
);
1878 defsubr (&Sfind_charset_string
);
1879 defsubr (&Smake_char_internal
);
1880 defsubr (&Ssplit_char
);
1881 defsubr (&Schar_charset
);
1882 defsubr (&Scharset_after
);
1883 defsubr (&Siso_charset
);
1884 defsubr (&Schar_valid_p
);
1885 defsubr (&Sunibyte_char_to_multibyte
);
1886 defsubr (&Smultibyte_char_to_unibyte
);
1887 defsubr (&Schar_bytes
);
1888 defsubr (&Schar_width
);
1889 defsubr (&Sstring_width
);
1890 defsubr (&Schar_direction
);
1891 defsubr (&Schars_in_region
);
1893 defsubr (&Scmpcharp
);
1894 defsubr (&Scmpchar_component
);
1895 defsubr (&Scmpchar_cmp_rule
);
1896 defsubr (&Scmpchar_cmp_rule_p
);
1897 defsubr (&Scmpchar_cmp_count
);
1898 defsubr (&Scompose_string
);
1899 defsubr (&Ssetup_special_charsets
);
1901 DEFVAR_LISP ("charset-list", &Vcharset_list
,
1902 "List of charsets ever defined.");
1903 Vcharset_list
= Fcons (Qascii
, Qnil
);
1905 DEFVAR_LISP ("translation-table-vector", &Vtranslation_table_vector
,
1906 "Vector of cons cell of a symbol and translation table ever defined.\n\
1907 An ID of a translation table is an index of this vector.");
1908 Vtranslation_table_vector
= Fmake_vector (make_number (16), Qnil
);
1910 DEFVAR_INT ("leading-code-composition", &leading_code_composition
,
1911 "Leading-code of composite characters.");
1912 leading_code_composition
= LEADING_CODE_COMPOSITION
;
1914 DEFVAR_INT ("leading-code-private-11", &leading_code_private_11
,
1915 "Leading-code of private TYPE9N charset of column-width 1.");
1916 leading_code_private_11
= LEADING_CODE_PRIVATE_11
;
1918 DEFVAR_INT ("leading-code-private-12", &leading_code_private_12
,
1919 "Leading-code of private TYPE9N charset of column-width 2.");
1920 leading_code_private_12
= LEADING_CODE_PRIVATE_12
;
1922 DEFVAR_INT ("leading-code-private-21", &leading_code_private_21
,
1923 "Leading-code of private TYPE9Nx9N charset of column-width 1.");
1924 leading_code_private_21
= LEADING_CODE_PRIVATE_21
;
1926 DEFVAR_INT ("leading-code-private-22", &leading_code_private_22
,
1927 "Leading-code of private TYPE9Nx9N charset of column-width 2.");
1928 leading_code_private_22
= LEADING_CODE_PRIVATE_22
;
1930 DEFVAR_INT ("nonascii-insert-offset", &nonascii_insert_offset
,
1931 "Offset for converting non-ASCII unibyte codes 0240...0377 to multibyte.\n\
1932 This is used for converting unibyte text to multibyte,\n\
1933 and for inserting character codes specified by number.\n\n\
1934 This serves to convert a Latin-1 or similar 8-bit character code\n\
1935 to the corresponding Emacs multibyte character code.\n\
1936 Typically the value should be (- (make-char CHARSET 0) 128),\n\
1937 for your choice of character set.\n\
1938 If `nonascii-translation-table' is non-nil, it overrides this variable.");
1939 nonascii_insert_offset
= 0;
1941 DEFVAR_LISP ("nonascii-translation-table", &Vnonascii_translation_table
,
1942 "Translation table to convert non-ASCII unibyte codes to multibyte.\n\
1943 This is used for converting unibyte text to multibyte,\n\
1944 and for inserting character codes specified by number.\n\n\
1945 Conversion is performed only when multibyte characters are enabled,\n\
1946 and it serves to convert a Latin-1 or similar 8-bit character code\n\
1947 to the corresponding Emacs character code.\n\n\
1948 If this is nil, `nonascii-insert-offset' is used instead.\n\
1949 See also the docstring of `make-translation-table'.");
1950 Vnonascii_translation_table
= Qnil
;
1952 DEFVAR_INT ("min-composite-char", &min_composite_char
,
1953 "Minimum character code of a composite character.");
1954 min_composite_char
= MIN_CHAR_COMPOSITION
;