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: %o, %d, 0x%x", 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
)
332 if (c
>= 0240 && c
< 0400)
336 if (! NILP (Vnonascii_translation_table
))
337 c
= XINT (Faref (Vnonascii_translation_table
, make_number (c
)));
338 else if (nonascii_insert_offset
> 0)
339 c
+= nonascii_insert_offset
;
340 if (c
>= 0240 && (c
< 0400 || ! VALID_MULTIBYTE_CHAR_P (c
)))
341 c
= c_save
+ DEFAULT_NONASCII_INSERT_OFFSET
;
347 /* Convert the multibyte character C to unibyte 8-bit character based
348 on Vnonascii_translation_table or nonascii_insert_offset. If
349 REV_TBL is non-nil, it should be a reverse table of
350 Vnonascii_translation_table, i.e. what given by:
351 Fchar_table_extra_slot (Vnonascii_translation_table, make_number (0)) */
354 multibyte_char_to_unibyte (c
, rev_tbl
)
358 if (!SINGLE_BYTE_CHAR_P (c
))
362 if (! CHAR_TABLE_P (rev_tbl
)
363 && CHAR_TABLE_P (Vnonascii_translation_table
))
364 rev_tbl
= Fchar_table_extra_slot (Vnonascii_translation_table
,
366 if (CHAR_TABLE_P (rev_tbl
))
369 temp
= Faref (rev_tbl
, make_number (c
));
373 else if (nonascii_insert_offset
> 0)
374 c
-= nonascii_insert_offset
;
375 if (c
< 128 || c
>= 256)
376 c
= (c_save
& 0177) + 0200;
383 /* Update the table Vcharset_table with the given arguments (see the
384 document of `define-charset' for the meaning of each argument).
385 Several other table contents are also updated. The caller should
386 check the validity of CHARSET-ID and the remaining arguments in
390 update_charset_table (charset_id
, dimension
, chars
, width
, direction
,
391 iso_final_char
, iso_graphic_plane
,
392 short_name
, long_name
, description
)
393 Lisp_Object charset_id
, dimension
, chars
, width
, direction
;
394 Lisp_Object iso_final_char
, iso_graphic_plane
;
395 Lisp_Object short_name
, long_name
, description
;
397 int charset
= XINT (charset_id
);
399 unsigned char leading_code_base
, leading_code_ext
;
401 if (NILP (CHARSET_TABLE_ENTRY (charset
)))
402 CHARSET_TABLE_ENTRY (charset
)
403 = Fmake_vector (make_number (CHARSET_MAX_IDX
), Qnil
);
405 /* Get byte length of multibyte form, base leading-code, and
406 extended leading-code of the charset. See the comment under the
407 title "GENERAL NOTE on CHARACTER SET (CHARSET)" in charset.h. */
408 bytes
= XINT (dimension
);
409 if (charset
< MIN_CHARSET_PRIVATE_DIMENSION1
)
411 /* Official charset, it doesn't have an extended leading-code. */
412 if (charset
!= CHARSET_ASCII
)
413 bytes
+= 1; /* For a base leading-code. */
414 leading_code_base
= charset
;
415 leading_code_ext
= 0;
419 /* Private charset. */
420 bytes
+= 2; /* For base and extended leading-codes. */
422 = (charset
< LEADING_CODE_EXT_12
423 ? LEADING_CODE_PRIVATE_11
424 : (charset
< LEADING_CODE_EXT_21
425 ? LEADING_CODE_PRIVATE_12
426 : (charset
< LEADING_CODE_EXT_22
427 ? LEADING_CODE_PRIVATE_21
428 : LEADING_CODE_PRIVATE_22
)));
429 leading_code_ext
= charset
;
432 CHARSET_TABLE_INFO (charset
, CHARSET_ID_IDX
) = charset_id
;
433 CHARSET_TABLE_INFO (charset
, CHARSET_BYTES_IDX
) = make_number (bytes
);
434 CHARSET_TABLE_INFO (charset
, CHARSET_DIMENSION_IDX
) = dimension
;
435 CHARSET_TABLE_INFO (charset
, CHARSET_CHARS_IDX
) = chars
;
436 CHARSET_TABLE_INFO (charset
, CHARSET_WIDTH_IDX
) = width
;
437 CHARSET_TABLE_INFO (charset
, CHARSET_DIRECTION_IDX
) = direction
;
438 CHARSET_TABLE_INFO (charset
, CHARSET_LEADING_CODE_BASE_IDX
)
439 = make_number (leading_code_base
);
440 CHARSET_TABLE_INFO (charset
, CHARSET_LEADING_CODE_EXT_IDX
)
441 = make_number (leading_code_ext
);
442 CHARSET_TABLE_INFO (charset
, CHARSET_ISO_FINAL_CHAR_IDX
) = iso_final_char
;
443 CHARSET_TABLE_INFO (charset
, CHARSET_ISO_GRAPHIC_PLANE_IDX
)
445 CHARSET_TABLE_INFO (charset
, CHARSET_SHORT_NAME_IDX
) = short_name
;
446 CHARSET_TABLE_INFO (charset
, CHARSET_LONG_NAME_IDX
) = long_name
;
447 CHARSET_TABLE_INFO (charset
, CHARSET_DESCRIPTION_IDX
) = description
;
448 CHARSET_TABLE_INFO (charset
, CHARSET_PLIST_IDX
) = Qnil
;
451 /* If we have already defined a charset which has the same
452 DIMENSION, CHARS and ISO-FINAL-CHAR but the different
453 DIRECTION, we must update the entry REVERSE-CHARSET of both
454 charsets. If there's no such charset, the value of the entry
458 for (i
= 0; i
<= MAX_CHARSET
; i
++)
459 if (!NILP (CHARSET_TABLE_ENTRY (i
)))
461 if (CHARSET_DIMENSION (i
) == XINT (dimension
)
462 && CHARSET_CHARS (i
) == XINT (chars
)
463 && CHARSET_ISO_FINAL_CHAR (i
) == XINT (iso_final_char
)
464 && CHARSET_DIRECTION (i
) != XINT (direction
))
466 CHARSET_TABLE_INFO (charset
, CHARSET_REVERSE_CHARSET_IDX
)
468 CHARSET_TABLE_INFO (i
, CHARSET_REVERSE_CHARSET_IDX
) = charset_id
;
473 /* No such a charset. */
474 CHARSET_TABLE_INFO (charset
, CHARSET_REVERSE_CHARSET_IDX
)
478 if (charset
!= CHARSET_ASCII
479 && charset
< MIN_CHARSET_PRIVATE_DIMENSION1
)
481 /* Update tables bytes_by_char_head and width_by_char_head. */
482 bytes_by_char_head
[leading_code_base
] = bytes
;
483 width_by_char_head
[leading_code_base
] = XINT (width
);
485 /* Update table emacs_code_class. */
486 emacs_code_class
[charset
] = (bytes
== 2
487 ? EMACS_leading_code_2
489 ? EMACS_leading_code_3
490 : EMACS_leading_code_4
));
493 /* Update table iso_charset_table. */
494 if (ISO_CHARSET_TABLE (dimension
, chars
, iso_final_char
) < 0)
495 ISO_CHARSET_TABLE (dimension
, chars
, iso_final_char
) = charset
;
500 /* Return charset id of CHARSET_SYMBOL, or return -1 if CHARSET_SYMBOL
503 get_charset_id (charset_symbol
)
504 Lisp_Object charset_symbol
;
509 return ((SYMBOLP (charset_symbol
)
510 && (val
= Fget (charset_symbol
, Qcharset
), VECTORP (val
))
511 && (charset
= XINT (XVECTOR (val
)->contents
[CHARSET_ID_IDX
]),
512 CHARSET_VALID_P (charset
)))
516 /* Return an identification number for a new private charset of
517 DIMENSION and WIDTH. If there's no more room for the new charset,
520 get_new_private_charset_id (dimension
, width
)
521 int dimension
, width
;
523 int charset
, from
, to
;
528 from
= LEADING_CODE_EXT_11
, to
= LEADING_CODE_EXT_12
;
530 from
= LEADING_CODE_EXT_12
, to
= LEADING_CODE_EXT_21
;
535 from
= LEADING_CODE_EXT_21
, to
= LEADING_CODE_EXT_22
;
537 from
= LEADING_CODE_EXT_22
, to
= LEADING_CODE_EXT_MAX
+ 1;
540 for (charset
= from
; charset
< to
; charset
++)
541 if (!CHARSET_DEFINED_P (charset
)) break;
543 return make_number (charset
< to
? charset
: 0);
546 DEFUN ("define-charset", Fdefine_charset
, Sdefine_charset
, 3, 3, 0,
547 "Define CHARSET-ID as the identification number of CHARSET with INFO-VECTOR.\n\
548 If CHARSET-ID is nil, it is decided automatically, which means CHARSET is\n\
549 treated as a private charset.\n\
550 INFO-VECTOR is a vector of the format:\n\
551 [DIMENSION CHARS WIDTH DIRECTION ISO-FINAL-CHAR ISO-GRAPHIC-PLANE\n\
552 SHORT-NAME LONG-NAME DESCRIPTION]\n\
553 The meanings of each elements is as follows:\n\
554 DIMENSION (integer) is the number of bytes to represent a character: 1 or 2.\n\
555 CHARS (integer) is the number of characters in a dimension: 94 or 96.\n\
556 WIDTH (integer) is the number of columns a character in the charset\n\
557 occupies on the screen: one of 0, 1, and 2.\n\
559 DIRECTION (integer) is the rendering direction of characters in the\n\
560 charset when rendering. If 0, render from left to right, else\n\
561 render from right to left.\n\
563 ISO-FINAL-CHAR (character) is the final character of the\n\
564 corresponding ISO 2022 charset.\n\
566 ISO-GRAPHIC-PLANE (integer) is the graphic plane to be invoked\n\
567 while encoding to variants of ISO 2022 coding system, one of the\n\
568 following: 0/graphic-plane-left(GL), 1/graphic-plane-right(GR).\n\
570 SHORT-NAME (string) is the short name to refer to the charset.\n\
572 LONG-NAME (string) is the long name to refer to the charset.\n\
574 DESCRIPTION (string) is the description string of the charset.")
575 (charset_id
, charset_symbol
, info_vector
)
576 Lisp_Object charset_id
, charset_symbol
, info_vector
;
580 if (!NILP (charset_id
))
581 CHECK_NUMBER (charset_id
, 0);
582 CHECK_SYMBOL (charset_symbol
, 1);
583 CHECK_VECTOR (info_vector
, 2);
585 if (! NILP (charset_id
))
587 if (! CHARSET_VALID_P (XINT (charset_id
)))
588 error ("Invalid CHARSET: %d", XINT (charset_id
));
589 else if (CHARSET_DEFINED_P (XINT (charset_id
)))
590 error ("Already defined charset: %d", XINT (charset_id
));
593 vec
= XVECTOR (info_vector
)->contents
;
594 if (XVECTOR (info_vector
)->size
!= 9
595 || !INTEGERP (vec
[0]) || !(XINT (vec
[0]) == 1 || XINT (vec
[0]) == 2)
596 || !INTEGERP (vec
[1]) || !(XINT (vec
[1]) == 94 || XINT (vec
[1]) == 96)
597 || !INTEGERP (vec
[2]) || !(XINT (vec
[2]) == 1 || XINT (vec
[2]) == 2)
598 || !INTEGERP (vec
[3]) || !(XINT (vec
[3]) == 0 || XINT (vec
[3]) == 1)
599 || !INTEGERP (vec
[4]) || !(XINT (vec
[4]) >= '0' && XINT (vec
[4]) <= '~')
600 || !INTEGERP (vec
[5]) || !(XINT (vec
[5]) == 0 || XINT (vec
[5]) == 1)
603 || !STRINGP (vec
[8]))
604 error ("Invalid info-vector argument for defining charset %s",
605 XSYMBOL (charset_symbol
)->name
->data
);
607 if (NILP (charset_id
))
609 charset_id
= get_new_private_charset_id (XINT (vec
[0]), XINT (vec
[2]));
610 if (XINT (charset_id
) == 0)
611 error ("There's no room for a new private charset %s",
612 XSYMBOL (charset_symbol
)->name
->data
);
615 update_charset_table (charset_id
, vec
[0], vec
[1], vec
[2], vec
[3],
616 vec
[4], vec
[5], vec
[6], vec
[7], vec
[8]);
617 Fput (charset_symbol
, Qcharset
, CHARSET_TABLE_ENTRY (XINT (charset_id
)));
618 CHARSET_SYMBOL (XINT (charset_id
)) = charset_symbol
;
619 Vcharset_list
= Fcons (charset_symbol
, Vcharset_list
);
623 DEFUN ("generic-character-list", Fgeneric_character_list
,
624 Sgeneric_character_list
, 0, 0, 0,
625 "Return a list of all possible generic characters.\n\
626 It includes a generic character for a charset not yet defined.")
629 return Vgeneric_character_list
;
632 DEFUN ("get-unused-iso-final-char", Fget_unused_iso_final_char
,
633 Sget_unused_iso_final_char
, 2, 2, 0,
634 "Return an unsed ISO's final char for a charset of DIMENISION and CHARS.\n\
635 DIMENSION is the number of bytes to represent a character: 1 or 2.\n\
636 CHARS is the number of characters in a dimension: 94 or 96.\n\
638 This final char is for private use, thus the range is `0' (48) .. `?' (63).\n\
639 If there's no unused final char for the specified kind of charset,\n\
642 Lisp_Object dimension
, chars
;
646 CHECK_NUMBER (dimension
, 0);
647 CHECK_NUMBER (chars
, 1);
648 if (XINT (dimension
) != 1 && XINT (dimension
) != 2)
649 error ("Invalid charset dimension %d, it should be 1 or 2",
651 if (XINT (chars
) != 94 && XINT (chars
) != 96)
652 error ("Invalid charset chars %d, it should be 94 or 96",
654 for (final_char
= '0'; final_char
<= '?'; final_char
++)
656 if (ISO_CHARSET_TABLE (dimension
, chars
, make_number (final_char
)) < 0)
659 return (final_char
<= '?' ? make_number (final_char
) : Qnil
);
662 DEFUN ("declare-equiv-charset", Fdeclare_equiv_charset
, Sdeclare_equiv_charset
,
664 "Declare a charset of DIMENSION, CHARS, FINAL-CHAR is the same as CHARSET.\n\
665 CHARSET should be defined by `defined-charset' in advance.")
666 (dimension
, chars
, final_char
, charset_symbol
)
667 Lisp_Object dimension
, chars
, final_char
, charset_symbol
;
671 CHECK_NUMBER (dimension
, 0);
672 CHECK_NUMBER (chars
, 1);
673 CHECK_NUMBER (final_char
, 2);
674 CHECK_SYMBOL (charset_symbol
, 3);
676 if (XINT (dimension
) != 1 && XINT (dimension
) != 2)
677 error ("Invalid DIMENSION %d, it should be 1 or 2", XINT (dimension
));
678 if (XINT (chars
) != 94 && XINT (chars
) != 96)
679 error ("Invalid CHARS %d, it should be 94 or 96", XINT (chars
));
680 if (XINT (final_char
) < '0' || XFASTINT (final_char
) > '~')
681 error ("Invalid FINAL-CHAR %c, it should be `0'..`~'", XINT (chars
));
682 if ((charset
= get_charset_id (charset_symbol
)) < 0)
683 error ("Invalid charset %s", XSYMBOL (charset_symbol
)->name
->data
);
685 ISO_CHARSET_TABLE (dimension
, chars
, final_char
) = charset
;
689 /* Return number of different charsets in STR of length LEN. In
690 addition, for each found charset N, CHARSETS[N] is set 1. The
691 caller should allocate CHARSETS (MAX_CHARSET + 1 elements) in advance.
692 It may lookup a translation table TABLE if supplied.
694 If CMPCHARP is nonzero and some composite character is found,
695 CHARSETS[128] is also set 1 and the returned number is incremented
699 find_charset_in_str (str
, len
, charsets
, table
, cmpcharp
)
705 register int num
= 0, c
;
707 if (! CHAR_TABLE_P (table
))
715 if (c
== LEADING_CODE_COMPOSITION
)
717 int cmpchar_id
= str_cmpchar_id (str
, len
);
722 struct cmpchar_info
*cmpcharp
= cmpchar_table
[cmpchar_id
];
725 for (i
= 0; i
< cmpcharp
->glyph_len
; i
++)
727 c
= cmpcharp
->glyph
[i
];
730 if ((c
= translate_char (table
, c
, 0, 0, 0)) < 0)
731 c
= cmpcharp
->glyph
[i
];
733 if ((charset
= CHAR_CHARSET (c
)) < 0)
734 charset
= CHARSET_ASCII
;
735 if (!charsets
[charset
])
737 charsets
[charset
] = 1;
741 str
+= cmpcharp
->len
;
742 len
-= cmpcharp
->len
;
746 charset
= CHARSET_ASCII
;
751 c
= STRING_CHAR_AND_LENGTH (str
, len
, bytes
);
754 int c1
= translate_char (table
, c
, 0, 0, 0);
758 charset
= CHAR_CHARSET (c
);
761 if (!charsets
[charset
])
763 charsets
[charset
] = 1;
772 DEFUN ("find-charset-region", Ffind_charset_region
, Sfind_charset_region
,
774 "Return a list of charsets in the region between BEG and END.\n\
775 BEG and END are buffer positions.\n\
776 Optional arg TABLE if non-nil is a translation table to look up.")
778 Lisp_Object beg
, end
, table
;
780 int charsets
[MAX_CHARSET
+ 1];
781 int from
, from_byte
, to
, stop
, stop_byte
, i
;
784 validate_region (&beg
, &end
);
785 from
= XFASTINT (beg
);
786 stop
= to
= XFASTINT (end
);
788 if (from
< GPT
&& GPT
< to
)
791 stop_byte
= GPT_BYTE
;
794 stop_byte
= CHAR_TO_BYTE (stop
);
796 from_byte
= CHAR_TO_BYTE (from
);
798 bzero (charsets
, (MAX_CHARSET
+ 1) * sizeof (int));
801 find_charset_in_str (BYTE_POS_ADDR (from_byte
), stop_byte
- from_byte
,
805 from
= stop
, from_byte
= stop_byte
;
806 stop
= to
, stop_byte
= CHAR_TO_BYTE (stop
);
813 for (i
= MAX_CHARSET
; i
>= 0; i
--)
815 val
= Fcons (CHARSET_SYMBOL (i
), val
);
819 DEFUN ("find-charset-string", Ffind_charset_string
, Sfind_charset_string
,
821 "Return a list of charsets in STR.\n\
822 Optional arg TABLE if non-nil is a translation table to look up.")
824 Lisp_Object str
, table
;
826 int charsets
[MAX_CHARSET
+ 1];
830 CHECK_STRING (str
, 0);
832 if (! STRING_MULTIBYTE (str
))
835 bzero (charsets
, (MAX_CHARSET
+ 1) * sizeof (int));
836 find_charset_in_str (XSTRING (str
)->data
, STRING_BYTES (XSTRING (str
)),
839 for (i
= MAX_CHARSET
; i
>= 0; i
--)
841 val
= Fcons (CHARSET_SYMBOL (i
), val
);
845 DEFUN ("make-char-internal", Fmake_char_internal
, Smake_char_internal
, 1, 3, 0,
847 (charset
, code1
, code2
)
848 Lisp_Object charset
, code1
, code2
;
850 CHECK_NUMBER (charset
, 0);
853 XSETFASTINT (code1
, 0);
855 CHECK_NUMBER (code1
, 1);
857 XSETFASTINT (code2
, 0);
859 CHECK_NUMBER (code2
, 2);
861 if (!CHARSET_DEFINED_P (XINT (charset
)))
862 error ("Invalid charset: %d", XINT (charset
));
864 return make_number (MAKE_CHAR (XINT (charset
), XINT (code1
), XINT (code2
)));
867 DEFUN ("split-char", Fsplit_char
, Ssplit_char
, 1, 1, 0,
868 "Return list of charset and one or two position-codes of CHAR.")
875 CHECK_NUMBER (ch
, 0);
876 SPLIT_CHAR (XFASTINT (ch
), charset
, c1
, c2
);
878 ? Fcons (CHARSET_SYMBOL (charset
),
879 Fcons (make_number (c1
), Fcons (make_number (c2
), Qnil
)))
880 : Fcons (CHARSET_SYMBOL (charset
), Fcons (make_number (c1
), Qnil
)));
883 DEFUN ("char-charset", Fchar_charset
, Schar_charset
, 1, 1, 0,
884 "Return charset of CHAR.")
888 CHECK_NUMBER (ch
, 0);
890 return CHARSET_SYMBOL (CHAR_CHARSET (XINT (ch
)));
893 DEFUN ("charset-after", Fcharset_after
, Scharset_after
, 0, 1, 0,
894 "Return charset of a character in current buffer at position POS.\n\
895 If POS is nil, it defauls to the current point.")
899 register int pos_byte
, c
, charset
;
900 register unsigned char *p
;
904 else if (MARKERP (pos
))
905 pos_byte
= marker_byte_position (pos
);
908 CHECK_NUMBER (pos
, 0);
909 pos_byte
= CHAR_TO_BYTE (XINT (pos
));
911 p
= BYTE_POS_ADDR (pos_byte
);
912 c
= STRING_CHAR (p
, Z_BYTE
- pos_byte
);
913 charset
= CHAR_CHARSET (c
);
914 return CHARSET_SYMBOL (charset
);
917 DEFUN ("iso-charset", Fiso_charset
, Siso_charset
, 3, 3, 0,
918 "Return charset of ISO's specification DIMENSION, CHARS, and FINAL-CHAR.\n\
920 ISO 2022's designation sequence (escape sequence) distinguishes charsets\n\
921 by their DIMENSION, CHARS, and FINAL-CHAR,\n\
922 where as Emacs distinguishes them by charset symbol.\n\
923 See the documentation of the function `charset-info' for the meanings of\n\
924 DIMENSION, CHARS, and FINAL-CHAR.")
925 (dimension
, chars
, final_char
)
926 Lisp_Object dimension
, chars
, final_char
;
930 CHECK_NUMBER (dimension
, 0);
931 CHECK_NUMBER (chars
, 1);
932 CHECK_NUMBER (final_char
, 2);
934 if ((charset
= ISO_CHARSET_TABLE (dimension
, chars
, final_char
)) < 0)
936 return CHARSET_SYMBOL (charset
);
939 /* If GENERICP is nonzero, return nonzero iff C is a valid normal or
940 generic character. If GENERICP is zero, return nonzero iff C is a
941 valid normal character. Do not call this function directly,
942 instead use macro CHAR_VALID_P. */
944 char_valid_p (c
, genericp
)
951 if (SINGLE_BYTE_CHAR_P (c
))
953 SPLIT_NON_ASCII_CHAR (c
, charset
, c1
, c2
);
954 if (!CHARSET_VALID_P (charset
))
956 return (c
< MIN_CHAR_COMPOSITION
957 ? ((c
& CHAR_FIELD1_MASK
) /* i.e. dimension of C is two. */
958 ? (genericp
&& c1
== 0 && c2
== 0
959 || c1
>= 32 && c2
>= 32)
960 : (genericp
&& c1
== 0
962 : c
< MIN_CHAR_COMPOSITION
+ n_cmpchars
);
965 DEFUN ("char-valid-p", Fchar_valid_p
, Schar_valid_p
, 1, 2, 0,
966 "Return t if OBJECT is a valid normal character.\n\
967 If optional arg GENERICP is non-nil, also return t if OBJECT is\n\
968 a valid generic character.")
970 Lisp_Object object
, genericp
;
972 if (! NATNUMP (object
))
974 return (CHAR_VALID_P (XFASTINT (object
), !NILP (genericp
)) ? Qt
: Qnil
);
977 DEFUN ("unibyte-char-to-multibyte", Funibyte_char_to_multibyte
,
978 Sunibyte_char_to_multibyte
, 1, 1, 0,
979 "Convert the unibyte character CH to multibyte character.\n\
980 The conversion is done based on `nonascii-translation-table' (which see)\n\
981 or `nonascii-insert-offset' (which see).")
987 CHECK_NUMBER (ch
, 0);
989 if (c
< 0 || c
>= 0400)
990 error ("Invalid unibyte character: %d", c
);
991 c
= unibyte_char_to_multibyte (c
);
993 error ("Can't convert to multibyte character: %d", XINT (ch
));
994 return make_number (c
);
997 DEFUN ("multibyte-char-to-unibyte", Fmultibyte_char_to_unibyte
,
998 Smultibyte_char_to_unibyte
, 1, 1, 0,
999 "Convert the multibyte character CH to unibyte character.\n\
1000 The conversion is done based on `nonascii-translation-table' (which see)\n\
1001 or `nonascii-insert-offset' (which see).")
1007 CHECK_NUMBER (ch
, 0);
1010 error ("Invalid multibyte character: %d", c
);
1011 c
= multibyte_char_to_unibyte (c
, Qnil
);
1013 error ("Can't convert to unibyte character: %d", XINT (ch
));
1014 return make_number (c
);
1017 DEFUN ("char-bytes", Fchar_bytes
, Schar_bytes
, 1, 1, 0,
1018 "Return 1 regardless of the argument CHAR.
1019 This is now an obsolte function. We keep is just for backward compatibility.")
1025 CHECK_NUMBER (ch
, 0);
1026 return make_number (1);
1029 /* Return how many bytes C will occupy in a multibyte buffer.
1030 Don't call this function directly, instead use macro CHAR_BYTES. */
1037 if (COMPOSITE_CHAR_P (c
))
1039 unsigned int id
= COMPOSITE_CHAR_ID (c
);
1041 bytes
= (id
< n_cmpchars
? cmpchar_table
[id
]->len
: 1);
1045 int charset
= CHAR_CHARSET (c
);
1047 bytes
= CHARSET_DEFINED_P (charset
) ? CHARSET_BYTES (charset
) : 1;
1050 return make_number (bytes
);
1053 /* Return the width of character of which multi-byte form starts with
1054 C. The width is measured by how many columns occupied on the
1055 screen when displayed in the current buffer. */
1057 #define ONE_BYTE_CHAR_WIDTH(c) \
1060 ? XFASTINT (current_buffer->tab_width) \
1061 : (c == '\n' ? 0 : (NILP (current_buffer->ctl_arrow) ? 4 : 2))) \
1065 ? (NILP (current_buffer->ctl_arrow) ? 4 : 2) \
1066 : ((! NILP (current_buffer->enable_multibyte_characters) \
1067 && BASE_LEADING_CODE_P (c)) \
1068 ? WIDTH_BY_CHAR_HEAD (c) \
1071 DEFUN ("char-width", Fchar_width
, Schar_width
, 1, 1, 0,
1072 "Return width of CHAR when displayed in the current buffer.\n\
1073 The width is measured by how many columns it occupies on the screen.")
1077 Lisp_Object val
, disp
;
1079 struct Lisp_Char_Table
*dp
= buffer_display_table ();
1081 CHECK_NUMBER (ch
, 0);
1085 /* Get the way the display table would display it. */
1086 disp
= dp
? DISP_CHAR_VECTOR (dp
, c
) : Qnil
;
1089 XSETINT (val
, XVECTOR (disp
)->size
);
1090 else if (SINGLE_BYTE_CHAR_P (c
))
1091 XSETINT (val
, ONE_BYTE_CHAR_WIDTH (c
));
1092 else if (COMPOSITE_CHAR_P (c
))
1094 int id
= COMPOSITE_CHAR_ID (XFASTINT (ch
));
1095 XSETFASTINT (val
, (id
< n_cmpchars
? cmpchar_table
[id
]->width
: 0));
1099 int charset
= CHAR_CHARSET (c
);
1101 XSETFASTINT (val
, CHARSET_WIDTH (charset
));
1106 /* Return width of string STR of length LEN when displayed in the
1107 current buffer. The width is measured by how many columns it
1108 occupies on the screen. */
1115 unsigned char *endp
= str
+ len
;
1117 struct Lisp_Char_Table
*dp
= buffer_display_table ();
1121 if (*str
== LEADING_CODE_COMPOSITION
)
1123 int id
= str_cmpchar_id (str
, endp
- str
);
1132 width
+= cmpchar_table
[id
]->width
;
1133 str
+= cmpchar_table
[id
]->len
;
1140 int c
= STRING_CHAR_AND_LENGTH (str
, endp
- str
, thislen
);
1142 /* Get the way the display table would display it. */
1144 disp
= DISP_CHAR_VECTOR (dp
, c
);
1149 width
+= XVECTOR (disp
)->size
;
1151 width
+= ONE_BYTE_CHAR_WIDTH (*str
);
1159 DEFUN ("string-width", Fstring_width
, Sstring_width
, 1, 1, 0,
1160 "Return width of STRING when displayed in the current buffer.\n\
1161 Width is measured by how many columns it occupies on the screen.\n\
1162 When calculating width of a multibyte character in STRING,\n\
1163 only the base leading-code is considered; the validity of\n\
1164 the following bytes is not checked.")
1170 CHECK_STRING (str
, 0);
1171 XSETFASTINT (val
, strwidth (XSTRING (str
)->data
,
1172 STRING_BYTES (XSTRING (str
))));
1176 DEFUN ("char-direction", Fchar_direction
, Schar_direction
, 1, 1, 0,
1177 "Return the direction of CHAR.\n\
1178 The returned value is 0 for left-to-right and 1 for right-to-left.")
1184 CHECK_NUMBER (ch
, 0);
1185 charset
= CHAR_CHARSET (XFASTINT (ch
));
1186 if (!CHARSET_DEFINED_P (charset
))
1187 invalid_character (XINT (ch
));
1188 return CHARSET_TABLE_INFO (charset
, CHARSET_DIRECTION_IDX
);
1191 DEFUN ("chars-in-region", Fchars_in_region
, Schars_in_region
, 2, 2, 0,
1192 "Return number of characters between BEG and END.")
1194 Lisp_Object beg
, end
;
1198 CHECK_NUMBER_COERCE_MARKER (beg
, 0);
1199 CHECK_NUMBER_COERCE_MARKER (end
, 1);
1201 from
= min (XFASTINT (beg
), XFASTINT (end
));
1202 to
= max (XFASTINT (beg
), XFASTINT (end
));
1204 return make_number (to
- from
);
1207 /* Return the number of characters in the NBYTES bytes at PTR.
1208 This works by looking at the contents and checking for multibyte sequences.
1209 However, if the current buffer has enable-multibyte-characters = nil,
1210 we treat each byte as a character. */
1213 chars_in_text (ptr
, nbytes
)
1217 unsigned char *endp
, c
;
1220 /* current_buffer is null at early stages of Emacs initialization. */
1221 if (current_buffer
== 0
1222 || NILP (current_buffer
->enable_multibyte_characters
))
1225 endp
= ptr
+ nbytes
;
1232 if (BASE_LEADING_CODE_P (c
))
1233 while (ptr
< endp
&& ! CHAR_HEAD_P (*ptr
)) ptr
++;
1240 /* Return the number of characters in the NBYTES bytes at PTR.
1241 This works by looking at the contents and checking for multibyte sequences.
1242 It ignores enable-multibyte-characters. */
1245 multibyte_chars_in_text (ptr
, nbytes
)
1249 unsigned char *endp
, c
;
1252 endp
= ptr
+ nbytes
;
1259 if (BASE_LEADING_CODE_P (c
))
1260 while (ptr
< endp
&& ! CHAR_HEAD_P (*ptr
)) ptr
++;
1267 DEFUN ("string", Fstring
, Sstring
, 1, MANY
, 0,
1268 "Concatenate all the argument characters and make the result a string.")
1275 = (unsigned char *) alloca (MAX_LENGTH_OF_MULTI_BYTE_FORM
* n
);
1276 unsigned char *p
= buf
;
1279 for (i
= 0; i
< n
; i
++)
1284 if (!INTEGERP (args
[i
]))
1285 CHECK_NUMBER (args
[i
], 0);
1287 len
= CHAR_STRING (c
, p
, str
);
1289 /* C is a composite character. */
1290 bcopy (str
, p
, len
);
1294 val
= make_string_from_bytes (buf
, n
, p
- buf
);
1300 /*** Composite characters staffs ***/
1302 /* Each composite character is identified by CMPCHAR-ID which is
1303 assigned when Emacs needs the character code of the composite
1304 character (e.g. when displaying it on the screen). See the
1305 document "GENERAL NOTE on COMPOSITE CHARACTER" in `charset.h' how a
1306 composite character is represented in Emacs. */
1308 /* If `static' is defined, it means that it is defined to null string. */
1310 /* The following function is copied from lread.c. */
1312 hash_string (ptr
, len
)
1316 register unsigned char *p
= ptr
;
1317 register unsigned char *end
= p
+ len
;
1318 register unsigned char c
;
1319 register int hash
= 0;
1324 if (c
>= 0140) c
-= 40;
1325 hash
= ((hash
<<3) + (hash
>>28) + c
);
1327 return hash
& 07777777777;
1331 #define CMPCHAR_HASH_TABLE_SIZE 0xFFF
1333 static int *cmpchar_hash_table
[CMPCHAR_HASH_TABLE_SIZE
];
1335 /* Each element of `cmpchar_hash_table' is a pointer to an array of
1336 integer, where the 1st element is the size of the array, the 2nd
1337 element is how many elements are actually used in the array, and
1338 the remaining elements are CMPCHAR-IDs of composite characters of
1339 the same hash value. */
1340 #define CMPCHAR_HASH_SIZE(table) table[0]
1341 #define CMPCHAR_HASH_USED(table) table[1]
1342 #define CMPCHAR_HASH_CMPCHAR_ID(table, i) table[i]
1344 /* Return CMPCHAR-ID of the composite character in STR of the length
1345 LEN. If the composite character has not yet been registered,
1346 register it in `cmpchar_table' and assign new CMPCHAR-ID. This
1347 is the sole function for assigning CMPCHAR-ID. */
1349 str_cmpchar_id (str
, len
)
1350 const unsigned char *str
;
1353 int hash_idx
, *hashp
;
1355 int embedded_rule
; /* 1 if composition rule is embedded. */
1356 int chars
; /* number of components. */
1358 struct cmpchar_info
*cmpcharp
;
1360 /* The second byte 0xFF means compostion rule is embedded. */
1361 embedded_rule
= (str
[1] == 0xFF);
1363 /* At first, get the actual length of the composite character. */
1365 const unsigned char *p
, *endp
= str
+ 1, *lastp
= str
+ len
;
1368 while (endp
< lastp
&& ! CHAR_HEAD_P (*endp
)) endp
++;
1370 /* Any composite char have at least 5-byte length. */
1377 if (embedded_rule
) p
++;
1378 /* No need of checking if *P is 0xA0 because
1379 BYTES_BY_CHAR_HEAD (0x80) surely returns 2. */
1380 p
+= BYTES_BY_CHAR_HEAD (*p
- 0x20);
1383 if (p
> endp
|| chars
< 2 || chars
> MAX_COMPONENT_COUNT
)
1384 /* Invalid components. */
1388 hash_idx
= hash_string (str
, len
) % CMPCHAR_HASH_TABLE_SIZE
;
1389 hashp
= cmpchar_hash_table
[hash_idx
];
1391 /* Then, look into the hash table. */
1393 /* Find the correct one among composite characters of the same
1395 for (i
= 2; i
< CMPCHAR_HASH_USED (hashp
); i
++)
1397 cmpcharp
= cmpchar_table
[CMPCHAR_HASH_CMPCHAR_ID (hashp
, i
)];
1398 if (len
== cmpcharp
->len
1399 && ! bcmp (str
, cmpcharp
->data
, len
))
1400 return CMPCHAR_HASH_CMPCHAR_ID (hashp
, i
);
1403 /* We have to register the composite character in cmpchar_table. */
1404 if (n_cmpchars
> (CHAR_FIELD2_MASK
| CHAR_FIELD3_MASK
))
1405 /* No, we have no more room for a new composite character. */
1408 /* Make the entry in hash table. */
1411 /* Make a table for 8 composite characters initially. */
1412 hashp
= (cmpchar_hash_table
[hash_idx
]
1413 = (int *) xmalloc (sizeof (int) * (2 + 8)));
1414 CMPCHAR_HASH_SIZE (hashp
) = 10;
1415 CMPCHAR_HASH_USED (hashp
) = 2;
1417 else if (CMPCHAR_HASH_USED (hashp
) >= CMPCHAR_HASH_SIZE (hashp
))
1419 CMPCHAR_HASH_SIZE (hashp
) += 8;
1420 hashp
= (cmpchar_hash_table
[hash_idx
]
1421 = (int *) xrealloc (hashp
,
1422 sizeof (int) * CMPCHAR_HASH_SIZE (hashp
)));
1424 CMPCHAR_HASH_CMPCHAR_ID (hashp
, CMPCHAR_HASH_USED (hashp
)) = n_cmpchars
;
1425 CMPCHAR_HASH_USED (hashp
)++;
1427 /* Set information of the composite character in cmpchar_table. */
1428 if (cmpchar_table_size
== 0)
1430 /* This is the first composite character to be registered. */
1431 cmpchar_table_size
= 256;
1433 = (struct cmpchar_info
**) xmalloc (sizeof (cmpchar_table
[0])
1434 * cmpchar_table_size
);
1436 else if (cmpchar_table_size
<= n_cmpchars
)
1438 cmpchar_table_size
+= 256;
1440 = (struct cmpchar_info
**) xrealloc (cmpchar_table
,
1441 sizeof (cmpchar_table
[0])
1442 * cmpchar_table_size
);
1445 cmpcharp
= (struct cmpchar_info
*) xmalloc (sizeof (struct cmpchar_info
));
1447 cmpcharp
->len
= len
;
1448 cmpcharp
->data
= (unsigned char *) xmalloc (len
+ 1);
1449 bcopy (str
, cmpcharp
->data
, len
);
1450 cmpcharp
->data
[len
] = 0;
1451 cmpcharp
->glyph_len
= chars
;
1452 cmpcharp
->glyph
= (GLYPH
*) xmalloc (sizeof (GLYPH
) * chars
);
1455 cmpcharp
->cmp_rule
= (unsigned char *) xmalloc (chars
);
1456 cmpcharp
->col_offset
= (float *) xmalloc (sizeof (float) * chars
);
1460 cmpcharp
->cmp_rule
= NULL
;
1461 cmpcharp
->col_offset
= NULL
;
1464 /* Setup GLYPH data and composition rules (if any) so as not to make
1465 them every time on displaying. */
1467 unsigned char *bufp
;
1469 float leftmost
= 0.0, rightmost
= 1.0;
1472 /* At first, col_offset[N] is set to relative to col_offset[0]. */
1473 cmpcharp
->col_offset
[0] = 0;
1475 for (i
= 0, bufp
= cmpcharp
->data
+ 1; i
< chars
; i
++)
1478 cmpcharp
->cmp_rule
[i
] = *bufp
++;
1480 if (*bufp
== 0xA0) /* This is an ASCII character. */
1482 cmpcharp
->glyph
[i
] = FAST_MAKE_GLYPH ((*++bufp
& 0x7F), 0);
1486 else /* Multibyte character. */
1488 /* Make `bufp' point normal multi-byte form temporally. */
1491 = FAST_MAKE_GLYPH (string_to_non_ascii_char (bufp
, 4, 0, 0), 0);
1492 width
= WIDTH_BY_CHAR_HEAD (*bufp
);
1494 bufp
+= BYTES_BY_CHAR_HEAD (*bufp
- 0x20);
1497 if (embedded_rule
&& i
> 0)
1499 /* Reference points (global_ref and new_ref) are
1510 Now, we calculate the column offset of the new glyph
1511 from the left edge of the first glyph. This can avoid
1512 the same calculation everytime displaying this
1513 composite character. */
1515 /* Reference points of global glyph and new glyph. */
1516 int global_ref
= (cmpcharp
->cmp_rule
[i
] - 0xA0) / 9;
1517 int new_ref
= (cmpcharp
->cmp_rule
[i
] - 0xA0) % 9;
1518 /* Column offset relative to the first glyph. */
1519 float left
= (leftmost
1520 + (global_ref
% 3) * (rightmost
- leftmost
) / 2.0
1521 - (new_ref
% 3) * width
/ 2.0);
1523 cmpcharp
->col_offset
[i
] = left
;
1524 if (left
< leftmost
)
1526 if (left
+ width
> rightmost
)
1527 rightmost
= left
+ width
;
1531 if (width
> rightmost
)
1537 /* Now col_offset[N] are relative to the left edge of the
1538 first component. Make them relative to the left edge of
1540 for (i
= 0; i
< chars
; i
++)
1541 cmpcharp
->col_offset
[i
] -= leftmost
;
1542 /* Make rightmost holds width of overall glyph. */
1543 rightmost
-= leftmost
;
1546 cmpcharp
->width
= rightmost
;
1547 if (cmpcharp
->width
< rightmost
)
1548 /* To get a ceiling integer value. */
1552 cmpchar_table
[n_cmpchars
] = cmpcharp
;
1554 return n_cmpchars
++;
1557 /* Return the Nth element of the composite character C. */
1559 cmpchar_component (c
, n
)
1562 int id
= COMPOSITE_CHAR_ID (c
);
1564 if (id
>= n_cmpchars
/* C is not a valid composite character. */
1565 || n
>= cmpchar_table
[id
]->glyph_len
) /* No such component. */
1567 /* No face data is stored in glyph code. */
1568 return ((int) (cmpchar_table
[id
]->glyph
[n
]));
1571 DEFUN ("cmpcharp", Fcmpcharp
, Scmpcharp
, 1, 1, 0,
1572 "T if CHAR is a composite character.")
1576 CHECK_NUMBER (ch
, 0);
1577 return (COMPOSITE_CHAR_P (XINT (ch
)) ? Qt
: Qnil
);
1580 DEFUN ("composite-char-component", Fcmpchar_component
, Scmpchar_component
,
1582 "Return the IDXth component character of composite character CHARACTER.")
1584 Lisp_Object character
, idx
;
1588 CHECK_NUMBER (character
, 0);
1589 CHECK_NUMBER (idx
, 1);
1591 if ((c
= cmpchar_component (XINT (character
), XINT (idx
))) < 0)
1592 args_out_of_range (character
, idx
);
1594 return make_number (c
);
1597 DEFUN ("composite-char-composition-rule", Fcmpchar_cmp_rule
, Scmpchar_cmp_rule
,
1599 "Return the Nth composition rule embedded in composite character CHARACTER.\n\
1600 The returned rule is for composing the Nth component\n\
1601 on the (N-1)th component. If N is 0, the returned value is always 255.")
1603 Lisp_Object character
, n
;
1607 CHECK_NUMBER (character
, 0);
1608 CHECK_NUMBER (n
, 1);
1610 id
= COMPOSITE_CHAR_ID (XINT (character
));
1611 if (id
< 0 || id
>= n_cmpchars
)
1612 error ("Invalid composite character: %d", XINT (character
));
1614 if (i
> cmpchar_table
[id
]->glyph_len
)
1615 args_out_of_range (character
, n
);
1617 return make_number (cmpchar_table
[id
]->cmp_rule
[i
]);
1620 DEFUN ("composite-char-composition-rule-p", Fcmpchar_cmp_rule_p
,
1621 Scmpchar_cmp_rule_p
, 1, 1, 0,
1622 "Return non-nil if composite character CHARACTER contains a embedded rule.")
1624 Lisp_Object character
;
1628 CHECK_NUMBER (character
, 0);
1629 id
= COMPOSITE_CHAR_ID (XINT (character
));
1630 if (id
< 0 || id
>= n_cmpchars
)
1631 error ("Invalid composite character: %d", XINT (character
));
1633 return (cmpchar_table
[id
]->cmp_rule
? Qt
: Qnil
);
1636 DEFUN ("composite-char-component-count", Fcmpchar_cmp_count
,
1637 Scmpchar_cmp_count
, 1, 1, 0,
1638 "Return number of compoents of composite character CHARACTER.")
1640 Lisp_Object character
;
1644 CHECK_NUMBER (character
, 0);
1645 id
= COMPOSITE_CHAR_ID (XINT (character
));
1646 if (id
< 0 || id
>= n_cmpchars
)
1647 error ("Invalid composite character: %d", XINT (character
));
1649 return (make_number (cmpchar_table
[id
]->glyph_len
));
1652 DEFUN ("compose-string", Fcompose_string
, Scompose_string
,
1654 "Return one char string composed from all characters in STRING.")
1658 unsigned char buf
[MAX_LENGTH_OF_MULTI_BYTE_FORM
], *p
, *pend
, *ptemp
;
1661 CHECK_STRING (str
, 0);
1663 buf
[0] = LEADING_CODE_COMPOSITION
;
1664 p
= XSTRING (str
)->data
;
1665 pend
= p
+ STRING_BYTES (XSTRING (str
));
1669 if (*p
< 0x20 || *p
== 127) /* control code */
1670 error ("Invalid component character: %d", *p
);
1671 else if (*p
< 0x80) /* ASCII */
1673 if (i
+ 2 >= MAX_LENGTH_OF_MULTI_BYTE_FORM
)
1674 error ("Too long string to be composed: %s", XSTRING (str
)->data
);
1675 /* Prepend an ASCII charset indicator 0xA0, set MSB of the
1678 buf
[i
++] = *p
++ + 0x80;
1680 else if (*p
== LEADING_CODE_COMPOSITION
) /* composite char */
1682 /* Already composed. Eliminate the heading
1683 LEADING_CODE_COMPOSITION, keep the remaining bytes
1687 while (! CHAR_HEAD_P (*p
)) p
++;
1688 if (i
+ (p
- ptemp
) >= MAX_LENGTH_OF_MULTI_BYTE_FORM
)
1689 error ("Too long string to be composed: %s", XSTRING (str
)->data
);
1690 bcopy (ptemp
, buf
+ i
, p
- ptemp
);
1693 else /* multibyte char */
1695 /* Add 0x20 to the base leading-code, keep the remaining
1697 len
= BYTES_BY_CHAR_HEAD (*p
);
1698 if (i
+ len
>= MAX_LENGTH_OF_MULTI_BYTE_FORM
)
1699 error ("Too long string to be composed: %s", XSTRING (str
)->data
);
1700 bcopy (p
, buf
+ i
, len
);
1707 /* STR contains only one character, which can't be composed. */
1708 error ("Too short string to be composed: %s", XSTRING (str
)->data
);
1710 return make_string_from_bytes (buf
, 1, i
);
1715 charset_id_internal (charset_name
)
1720 val
= Fget (intern (charset_name
), Qcharset
);
1722 error ("Charset %s is not defined", charset_name
);
1724 return (XINT (XVECTOR (val
)->contents
[0]));
1727 DEFUN ("setup-special-charsets", Fsetup_special_charsets
,
1728 Ssetup_special_charsets
, 0, 0, 0, "Internal use only.")
1731 charset_latin_iso8859_1
= charset_id_internal ("latin-iso8859-1");
1732 charset_jisx0208_1978
= charset_id_internal ("japanese-jisx0208-1978");
1733 charset_jisx0208
= charset_id_internal ("japanese-jisx0208");
1734 charset_katakana_jisx0201
= charset_id_internal ("katakana-jisx0201");
1735 charset_latin_jisx0201
= charset_id_internal ("latin-jisx0201");
1736 charset_big5_1
= charset_id_internal ("chinese-big5-1");
1737 charset_big5_2
= charset_id_internal ("chinese-big5-2");
1742 init_charset_once ()
1746 staticpro (&Vcharset_table
);
1747 staticpro (&Vcharset_symbol_table
);
1748 staticpro (&Vgeneric_character_list
);
1750 /* This has to be done here, before we call Fmake_char_table. */
1751 Qcharset_table
= intern ("charset-table");
1752 staticpro (&Qcharset_table
);
1754 /* Intern this now in case it isn't already done.
1755 Setting this variable twice is harmless.
1756 But don't staticpro it here--that is done in alloc.c. */
1757 Qchar_table_extra_slots
= intern ("char-table-extra-slots");
1759 /* Now we are ready to set up this property, so we can
1760 create the charset table. */
1761 Fput (Qcharset_table
, Qchar_table_extra_slots
, make_number (0));
1762 Vcharset_table
= Fmake_char_table (Qcharset_table
, Qnil
);
1764 Vcharset_symbol_table
= Fmake_vector (make_number (MAX_CHARSET
+ 1), Qnil
);
1767 for (i
= 0; i
< 2; i
++)
1768 for (j
= 0; j
< 2; j
++)
1769 for (k
= 0; k
< 128; k
++)
1770 iso_charset_table
[i
][j
][k
] = -1;
1772 bzero (cmpchar_hash_table
, sizeof cmpchar_hash_table
);
1773 cmpchar_table_size
= n_cmpchars
= 0;
1775 for (i
= 0; i
< 256; i
++)
1776 BYTES_BY_CHAR_HEAD (i
) = 1;
1777 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_11
) = 3;
1778 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_12
) = 3;
1779 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_21
) = 4;
1780 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_22
) = 4;
1781 /* The following doesn't reflect the actual bytes, but just to tell
1782 that it is a start of a multibyte character. */
1783 BYTES_BY_CHAR_HEAD (LEADING_CODE_COMPOSITION
) = 2;
1785 for (i
= 0; i
< 128; i
++)
1786 WIDTH_BY_CHAR_HEAD (i
) = 1;
1787 for (; i
< 256; i
++)
1788 WIDTH_BY_CHAR_HEAD (i
) = 4;
1789 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_11
) = 1;
1790 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_12
) = 2;
1791 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_21
) = 1;
1792 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_22
) = 2;
1798 for (i
= 0x81; i
< 0x90; i
++)
1799 val
= Fcons (make_number ((i
- 0x70) << 7), val
);
1800 for (; i
< 0x9A; i
++)
1801 val
= Fcons (make_number ((i
- 0x8F) << 14), val
);
1802 for (i
= 0xA0; i
< 0xF0; i
++)
1803 val
= Fcons (make_number ((i
- 0x70) << 7), val
);
1804 for (; i
< 0xFF; i
++)
1805 val
= Fcons (make_number ((i
- 0xE0) << 14), val
);
1806 val
= Fcons (make_number (GENERIC_COMPOSITION_CHAR
), val
);
1807 Vgeneric_character_list
= Fnreverse (val
);
1816 Qascii
= intern ("ascii");
1817 staticpro (&Qascii
);
1819 Qcharset
= intern ("charset");
1820 staticpro (&Qcharset
);
1822 /* Define ASCII charset now. */
1823 update_charset_table (make_number (CHARSET_ASCII
),
1824 make_number (1), make_number (94),
1829 build_string ("ASCII"),
1830 build_string ("ASCII"),
1831 build_string ("ASCII (ISO646 IRV)"));
1832 CHARSET_SYMBOL (CHARSET_ASCII
) = Qascii
;
1833 Fput (Qascii
, Qcharset
, CHARSET_TABLE_ENTRY (CHARSET_ASCII
));
1835 Qcomposition
= intern ("composition");
1836 staticpro (&Qcomposition
);
1837 CHARSET_SYMBOL (CHARSET_COMPOSITION
) = Qcomposition
;
1839 defsubr (&Sdefine_charset
);
1840 defsubr (&Sgeneric_character_list
);
1841 defsubr (&Sget_unused_iso_final_char
);
1842 defsubr (&Sdeclare_equiv_charset
);
1843 defsubr (&Sfind_charset_region
);
1844 defsubr (&Sfind_charset_string
);
1845 defsubr (&Smake_char_internal
);
1846 defsubr (&Ssplit_char
);
1847 defsubr (&Schar_charset
);
1848 defsubr (&Scharset_after
);
1849 defsubr (&Siso_charset
);
1850 defsubr (&Schar_valid_p
);
1851 defsubr (&Sunibyte_char_to_multibyte
);
1852 defsubr (&Smultibyte_char_to_unibyte
);
1853 defsubr (&Schar_bytes
);
1854 defsubr (&Schar_width
);
1855 defsubr (&Sstring_width
);
1856 defsubr (&Schar_direction
);
1857 defsubr (&Schars_in_region
);
1859 defsubr (&Scmpcharp
);
1860 defsubr (&Scmpchar_component
);
1861 defsubr (&Scmpchar_cmp_rule
);
1862 defsubr (&Scmpchar_cmp_rule_p
);
1863 defsubr (&Scmpchar_cmp_count
);
1864 defsubr (&Scompose_string
);
1865 defsubr (&Ssetup_special_charsets
);
1867 DEFVAR_LISP ("charset-list", &Vcharset_list
,
1868 "List of charsets ever defined.");
1869 Vcharset_list
= Fcons (Qascii
, Qnil
);
1871 DEFVAR_LISP ("translation-table-vector", &Vtranslation_table_vector
,
1872 "Vector of cons cell of a symbol and translation table ever defined.\n\
1873 An ID of a translation table is an index of this vector.");
1874 Vtranslation_table_vector
= Fmake_vector (make_number (16), Qnil
);
1876 DEFVAR_INT ("leading-code-composition", &leading_code_composition
,
1877 "Leading-code of composite characters.");
1878 leading_code_composition
= LEADING_CODE_COMPOSITION
;
1880 DEFVAR_INT ("leading-code-private-11", &leading_code_private_11
,
1881 "Leading-code of private TYPE9N charset of column-width 1.");
1882 leading_code_private_11
= LEADING_CODE_PRIVATE_11
;
1884 DEFVAR_INT ("leading-code-private-12", &leading_code_private_12
,
1885 "Leading-code of private TYPE9N charset of column-width 2.");
1886 leading_code_private_12
= LEADING_CODE_PRIVATE_12
;
1888 DEFVAR_INT ("leading-code-private-21", &leading_code_private_21
,
1889 "Leading-code of private TYPE9Nx9N charset of column-width 1.");
1890 leading_code_private_21
= LEADING_CODE_PRIVATE_21
;
1892 DEFVAR_INT ("leading-code-private-22", &leading_code_private_22
,
1893 "Leading-code of private TYPE9Nx9N charset of column-width 2.");
1894 leading_code_private_22
= LEADING_CODE_PRIVATE_22
;
1896 DEFVAR_INT ("nonascii-insert-offset", &nonascii_insert_offset
,
1897 "Offset for converting non-ASCII unibyte codes 0240...0377 to multibyte.\n\
1898 This is used for converting unibyte text to multibyte,\n\
1899 and for inserting character codes specified by number.\n\n\
1900 This serves to convert a Latin-1 or similar 8-bit character code\n\
1901 to the corresponding Emacs multibyte character code.\n\
1902 Typically the value should be (- (make-char CHARSET 0) 128),\n\
1903 for your choice of character set.\n\
1904 If `nonascii-translation-table' is non-nil, it overrides this variable.");
1905 nonascii_insert_offset
= 0;
1907 DEFVAR_LISP ("nonascii-translation-table", &Vnonascii_translation_table
,
1908 "Translation table to convert non-ASCII unibyte codes to multibyte.\n\
1909 This is used for converting unibyte text to multibyte,\n\
1910 and for inserting character codes specified by number.\n\n\
1911 Conversion is performed only when multibyte characters are enabled,\n\
1912 and it serves to convert a Latin-1 or similar 8-bit character code\n\
1913 to the corresponding Emacs character code.\n\n\
1914 If this is nil, `nonascii-insert-offset' is used instead.\n\
1915 See also the docstring of `make-translation-table'.");
1916 Vnonascii_translation_table
= Qnil
;
1918 DEFVAR_INT ("min-composite-char", &min_composite_char
,
1919 "Minimum character code of a composite character.");
1920 min_composite_char
= MIN_CHAR_COMPOSITION
;