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 character translation table ever defined.
78 ID of a character translation table is used to index this vector. */
79 Lisp_Object Vcharacter_translation_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 #define min(X, Y) ((X) < (Y) ? (X) : (Y))
109 #define max(X, Y) ((X) > (Y) ? (X) : (Y))
112 invalid_character (c
)
115 error ("Invalid character: %o, %d, 0x%x", c
);
119 /* Set STR a pointer to the multi-byte form of the character C. If C
120 is not a composite character, the multi-byte form is set in WORKBUF
121 and STR points WORKBUF. The caller should allocate at least 4-byte
122 area at WORKBUF in advance. Returns the length of the multi-byte
123 form. If C is an invalid character to have a multi-byte form,
126 Use macro `CHAR_STRING (C, WORKBUF, STR)' instead of calling this
127 function directly if C can be an ASCII character. */
130 non_ascii_char_to_string (c
, workbuf
, str
)
132 unsigned char *workbuf
, **str
;
136 if (COMPOSITE_CHAR_P (c
))
138 int cmpchar_id
= COMPOSITE_CHAR_ID (c
);
140 if (cmpchar_id
< n_cmpchars
)
142 *str
= cmpchar_table
[cmpchar_id
]->data
;
143 return cmpchar_table
[cmpchar_id
]->len
;
147 invalid_character (c
);
151 SPLIT_NON_ASCII_CHAR (c
, charset
, c1
, c2
);
153 || ! CHARSET_DEFINED_P (charset
)
154 || c1
>= 0 && c1
< 32
155 || c2
>= 0 && c2
< 32)
156 invalid_character (c
);
159 *workbuf
++ = CHARSET_LEADING_CODE_BASE (charset
);
160 if (*workbuf
= CHARSET_LEADING_CODE_EXT (charset
))
162 *workbuf
++ = c1
| 0x80;
164 *workbuf
++ = c2
| 0x80;
166 return (workbuf
- *str
);
169 /* Return a non-ASCII character of which multi-byte form is at STR of
170 length LEN. If ACTUAL_LEN is not NULL, the actual length of the
171 character is set to the address ACTUAL_LEN.
173 Use macro `STRING_CHAR (STR, LEN)' instead of calling this function
174 directly if STR can hold an ASCII character. */
177 string_to_non_ascii_char (str
, len
, actual_len
)
178 const unsigned char *str
;
179 int len
, *actual_len
;
182 unsigned char c1
, c2
;
183 register int c
, bytes
;
188 if (BASE_LEADING_CODE_P (c
))
190 while (bytes
< len
&& ! CHAR_HEAD_P (str
[bytes
])) bytes
++;
192 if (c
== LEADING_CODE_COMPOSITION
)
194 int cmpchar_id
= str_cmpchar_id (str
, bytes
);
197 c
= MAKE_COMPOSITE_CHAR (cmpchar_id
);
201 int charset
= c
, c1
, c2
= 0;
204 if (c
>= LEADING_CODE_PRIVATE_11
)
206 if (BYTES_BY_CHAR_HEAD (c
) <= bytes
&& CHARSET_DEFINED_P (charset
))
209 if (CHARSET_DIMENSION (charset
) == 2)
211 c
= MAKE_NON_ASCII_CHAR (charset
, c1
, c2
);
221 /* Return the length of the multi-byte form at string STR of length LEN. */
223 multibyte_form_length (str
, len
)
224 const unsigned char *str
;
229 if (BASE_LEADING_CODE_P (*str
))
230 while (bytes
< len
&& ! CHAR_HEAD_P (str
[bytes
])) bytes
++;
235 /* Check if string STR of length LEN contains valid multi-byte form of
236 a character. If valid, charset and position codes of the character
237 is set at *CHARSET, *C1, and *C2, and return 0. If not valid,
238 return -1. This should be used only in the macro SPLIT_STRING
239 which checks range of STR in advance. */
242 split_non_ascii_string (str
, len
, charset
, c1
, c2
)
243 register const unsigned char *str
;
244 register unsigned char *c1
, *c2
;
245 register int len
, *charset
;
247 register unsigned int cs
= *str
++;
249 if (cs
== LEADING_CODE_COMPOSITION
)
251 int cmpchar_id
= str_cmpchar_id (str
- 1, len
);
255 *charset
= cs
, *c1
= cmpchar_id
>> 7, *c2
= cmpchar_id
& 0x7F;
257 else if ((cs
< LEADING_CODE_PRIVATE_11
|| (cs
= *str
++) >= 0xA0)
258 && CHARSET_DEFINED_P (cs
))
263 *c1
= (*str
++) & 0x7F;
264 if (CHARSET_DIMENSION (cs
) == 2)
268 *c2
= (*str
++) & 0x7F;
276 /* Translate character C by character translation table TABLE. If C
277 is negative, translate a character specified by CHARSET, C1, and C2
278 (C1 and C2 are code points of the character). If no translation is
279 found in TABLE, return C. */
281 translate_char (table
, c
, charset
, c1
, c2
)
283 int c
, charset
, c1
, c2
;
286 int alt_charset
, alt_c1
, alt_c2
, dimension
;
288 if (c
< 0) c
= MAKE_CHAR (charset
, c1
, c2
);
289 if (!CHAR_TABLE_P (table
)
290 || (ch
= Faref (table
, make_number (c
)), !INTEGERP (ch
))
294 SPLIT_CHAR (XFASTINT (ch
), alt_charset
, alt_c1
, alt_c2
);
295 dimension
= CHARSET_DIMENSION (alt_charset
);
296 if (dimension
== 1 && alt_c1
> 0 || dimension
== 2 && alt_c2
> 0)
297 /* CH is not a generic character, just return it. */
298 return XFASTINT (ch
);
300 /* Since CH is a generic character, we must return a specific
301 charater which has the same position codes as C from CH. */
303 SPLIT_CHAR (c
, charset
, c1
, c2
);
304 if (dimension
!= CHARSET_DIMENSION (charset
))
305 /* We can't make such a character because of dimension mismatch. */
307 return MAKE_CHAR (alt_charset
, c1
, c2
);
310 /* Convert the unibyte character C to multibyte based on
311 Vnonascii_translation_table or nonascii_insert_offset. If they can't
312 convert C to a valid multibyte character, convert it based on
313 DEFAULT_NONASCII_INSERT_OFFSET which makes C a Latin-1 character. */
316 unibyte_char_to_multibyte (c
)
319 if (c
>= 0240 && c
< 0400)
323 if (! NILP (Vnonascii_translation_table
))
324 c
= XINT (Faref (Vnonascii_translation_table
, make_number (c
)));
325 else if (nonascii_insert_offset
> 0)
326 c
+= nonascii_insert_offset
;
327 if (c
>= 0240 && (c
< 0400 || ! VALID_MULTIBYTE_CHAR_P (c
)))
328 c
= c_save
+ DEFAULT_NONASCII_INSERT_OFFSET
;
333 /* Update the table Vcharset_table with the given arguments (see the
334 document of `define-charset' for the meaning of each argument).
335 Several other table contents are also updated. The caller should
336 check the validity of CHARSET-ID and the remaining arguments in
340 update_charset_table (charset_id
, dimension
, chars
, width
, direction
,
341 iso_final_char
, iso_graphic_plane
,
342 short_name
, long_name
, description
)
343 Lisp_Object charset_id
, dimension
, chars
, width
, direction
;
344 Lisp_Object iso_final_char
, iso_graphic_plane
;
345 Lisp_Object short_name
, long_name
, description
;
347 int charset
= XINT (charset_id
);
349 unsigned char leading_code_base
, leading_code_ext
;
351 if (NILP (CHARSET_TABLE_ENTRY (charset
)))
352 CHARSET_TABLE_ENTRY (charset
)
353 = Fmake_vector (make_number (CHARSET_MAX_IDX
), Qnil
);
355 /* Get byte length of multibyte form, base leading-code, and
356 extended leading-code of the charset. See the comment under the
357 title "GENERAL NOTE on CHARACTER SET (CHARSET)" in charset.h. */
358 bytes
= XINT (dimension
);
359 if (charset
< MIN_CHARSET_PRIVATE_DIMENSION1
)
361 /* Official charset, it doesn't have an extended leading-code. */
362 if (charset
!= CHARSET_ASCII
)
363 bytes
+= 1; /* For a base leading-code. */
364 leading_code_base
= charset
;
365 leading_code_ext
= 0;
369 /* Private charset. */
370 bytes
+= 2; /* For base and extended leading-codes. */
372 = (charset
< LEADING_CODE_EXT_12
373 ? LEADING_CODE_PRIVATE_11
374 : (charset
< LEADING_CODE_EXT_21
375 ? LEADING_CODE_PRIVATE_12
376 : (charset
< LEADING_CODE_EXT_22
377 ? LEADING_CODE_PRIVATE_21
378 : LEADING_CODE_PRIVATE_22
)));
379 leading_code_ext
= charset
;
382 CHARSET_TABLE_INFO (charset
, CHARSET_ID_IDX
) = charset_id
;
383 CHARSET_TABLE_INFO (charset
, CHARSET_BYTES_IDX
) = make_number (bytes
);
384 CHARSET_TABLE_INFO (charset
, CHARSET_DIMENSION_IDX
) = dimension
;
385 CHARSET_TABLE_INFO (charset
, CHARSET_CHARS_IDX
) = chars
;
386 CHARSET_TABLE_INFO (charset
, CHARSET_WIDTH_IDX
) = width
;
387 CHARSET_TABLE_INFO (charset
, CHARSET_DIRECTION_IDX
) = direction
;
388 CHARSET_TABLE_INFO (charset
, CHARSET_LEADING_CODE_BASE_IDX
)
389 = make_number (leading_code_base
);
390 CHARSET_TABLE_INFO (charset
, CHARSET_LEADING_CODE_EXT_IDX
)
391 = make_number (leading_code_ext
);
392 CHARSET_TABLE_INFO (charset
, CHARSET_ISO_FINAL_CHAR_IDX
) = iso_final_char
;
393 CHARSET_TABLE_INFO (charset
, CHARSET_ISO_GRAPHIC_PLANE_IDX
)
395 CHARSET_TABLE_INFO (charset
, CHARSET_SHORT_NAME_IDX
) = short_name
;
396 CHARSET_TABLE_INFO (charset
, CHARSET_LONG_NAME_IDX
) = long_name
;
397 CHARSET_TABLE_INFO (charset
, CHARSET_DESCRIPTION_IDX
) = description
;
398 CHARSET_TABLE_INFO (charset
, CHARSET_PLIST_IDX
) = Qnil
;
401 /* If we have already defined a charset which has the same
402 DIMENSION, CHARS and ISO-FINAL-CHAR but the different
403 DIRECTION, we must update the entry REVERSE-CHARSET of both
404 charsets. If there's no such charset, the value of the entry
408 for (i
= 0; i
<= MAX_CHARSET
; i
++)
409 if (!NILP (CHARSET_TABLE_ENTRY (i
)))
411 if (CHARSET_DIMENSION (i
) == XINT (dimension
)
412 && CHARSET_CHARS (i
) == XINT (chars
)
413 && CHARSET_ISO_FINAL_CHAR (i
) == XINT (iso_final_char
)
414 && CHARSET_DIRECTION (i
) != XINT (direction
))
416 CHARSET_TABLE_INFO (charset
, CHARSET_REVERSE_CHARSET_IDX
)
418 CHARSET_TABLE_INFO (i
, CHARSET_REVERSE_CHARSET_IDX
) = charset_id
;
423 /* No such a charset. */
424 CHARSET_TABLE_INFO (charset
, CHARSET_REVERSE_CHARSET_IDX
)
428 if (charset
!= CHARSET_ASCII
429 && charset
< MIN_CHARSET_PRIVATE_DIMENSION1
)
431 /* Update tables bytes_by_char_head and width_by_char_head. */
432 bytes_by_char_head
[leading_code_base
] = bytes
;
433 width_by_char_head
[leading_code_base
] = XINT (width
);
435 /* Update table emacs_code_class. */
436 emacs_code_class
[charset
] = (bytes
== 2
437 ? EMACS_leading_code_2
439 ? EMACS_leading_code_3
440 : EMACS_leading_code_4
));
443 /* Update table iso_charset_table. */
444 if (ISO_CHARSET_TABLE (dimension
, chars
, iso_final_char
) < 0)
445 ISO_CHARSET_TABLE (dimension
, chars
, iso_final_char
) = charset
;
450 /* Return charset id of CHARSET_SYMBOL, or return -1 if CHARSET_SYMBOL
453 get_charset_id (charset_symbol
)
454 Lisp_Object charset_symbol
;
459 return ((SYMBOLP (charset_symbol
)
460 && (val
= Fget (charset_symbol
, Qcharset
), VECTORP (val
))
461 && (charset
= XINT (XVECTOR (val
)->contents
[CHARSET_ID_IDX
]),
462 CHARSET_VALID_P (charset
)))
466 /* Return an identification number for a new private charset of
467 DIMENSION and WIDTH. If there's no more room for the new charset,
470 get_new_private_charset_id (dimension
, width
)
471 int dimension
, width
;
473 int charset
, from
, to
;
478 from
= LEADING_CODE_EXT_11
, to
= LEADING_CODE_EXT_12
;
480 from
= LEADING_CODE_EXT_12
, to
= LEADING_CODE_EXT_21
;
485 from
= LEADING_CODE_EXT_21
, to
= LEADING_CODE_EXT_22
;
487 from
= LEADING_CODE_EXT_22
, to
= LEADING_CODE_EXT_MAX
+ 1;
490 for (charset
= from
; charset
< to
; charset
++)
491 if (!CHARSET_DEFINED_P (charset
)) break;
493 return make_number (charset
< to
? charset
: 0);
496 DEFUN ("define-charset", Fdefine_charset
, Sdefine_charset
, 3, 3, 0,
497 "Define CHARSET-ID as the identification number of CHARSET with INFO-VECTOR.\n\
498 If CHARSET-ID is nil, it is decided automatically, which means CHARSET is\n\
499 treated as a private charset.\n\
500 INFO-VECTOR is a vector of the format:\n\
501 [DIMENSION CHARS WIDTH DIRECTION ISO-FINAL-CHAR ISO-GRAPHIC-PLANE\n\
502 SHORT-NAME LONG-NAME DESCRIPTION]\n\
503 The meanings of each elements is as follows:\n\
504 DIMENSION (integer) is the number of bytes to represent a character: 1 or 2.\n\
505 CHARS (integer) is the number of characters in a dimension: 94 or 96.\n\
506 WIDTH (integer) is the number of columns a character in the charset\n\
507 occupies on the screen: one of 0, 1, and 2.\n\
509 DIRECTION (integer) is the rendering direction of characters in the\n\
510 charset when rendering. If 0, render from right to left, else\n\
511 render from left to right.\n\
513 ISO-FINAL-CHAR (character) is the final character of the\n\
514 corresponding ISO 2022 charset.\n\
516 ISO-GRAPHIC-PLANE (integer) is the graphic plane to be invoked\n\
517 while encoding to variants of ISO 2022 coding system, one of the\n\
518 following: 0/graphic-plane-left(GL), 1/graphic-plane-right(GR).\n\
520 SHORT-NAME (string) is the short name to refer to the charset.\n\
522 LONG-NAME (string) is the long name to refer to the charset.\n\
524 DESCRIPTION (string) is the description string of the charset.")
525 (charset_id
, charset_symbol
, info_vector
)
526 Lisp_Object charset_id
, charset_symbol
, info_vector
;
530 if (!NILP (charset_id
))
531 CHECK_NUMBER (charset_id
, 0);
532 CHECK_SYMBOL (charset_symbol
, 1);
533 CHECK_VECTOR (info_vector
, 2);
535 if (! NILP (charset_id
))
537 if (! CHARSET_VALID_P (XINT (charset_id
)))
538 error ("Invalid CHARSET: %d", XINT (charset_id
));
539 else if (CHARSET_DEFINED_P (XINT (charset_id
)))
540 error ("Already defined charset: %d", XINT (charset_id
));
543 vec
= XVECTOR (info_vector
)->contents
;
544 if (XVECTOR (info_vector
)->size
!= 9
545 || !INTEGERP (vec
[0]) || !(XINT (vec
[0]) == 1 || XINT (vec
[0]) == 2)
546 || !INTEGERP (vec
[1]) || !(XINT (vec
[1]) == 94 || XINT (vec
[1]) == 96)
547 || !INTEGERP (vec
[2]) || !(XINT (vec
[2]) == 1 || XINT (vec
[2]) == 2)
548 || !INTEGERP (vec
[3]) || !(XINT (vec
[3]) == 0 || XINT (vec
[3]) == 1)
549 || !INTEGERP (vec
[4]) || !(XINT (vec
[4]) >= '0' && XINT (vec
[4]) <= '~')
550 || !INTEGERP (vec
[5]) || !(XINT (vec
[5]) == 0 || XINT (vec
[5]) == 1)
553 || !STRINGP (vec
[8]))
554 error ("Invalid info-vector argument for defining charset %s",
555 XSYMBOL (charset_symbol
)->name
->data
);
557 if (NILP (charset_id
))
559 charset_id
= get_new_private_charset_id (XINT (vec
[0]), XINT (vec
[2]));
560 if (XINT (charset_id
) == 0)
561 error ("There's no room for a new private charset %s",
562 XSYMBOL (charset_symbol
)->name
->data
);
565 update_charset_table (charset_id
, vec
[0], vec
[1], vec
[2], vec
[3],
566 vec
[4], vec
[5], vec
[6], vec
[7], vec
[8]);
567 Fput (charset_symbol
, Qcharset
, CHARSET_TABLE_ENTRY (XINT (charset_id
)));
568 CHARSET_SYMBOL (XINT (charset_id
)) = charset_symbol
;
569 Vcharset_list
= Fcons (charset_symbol
, Vcharset_list
);
573 DEFUN ("get-unused-iso-final-char", Fget_unused_iso_final_char
,
574 Sget_unused_iso_final_char
, 2, 2, 0,
575 "Return an unsed ISO's final char for a charset of DIMENISION and CHARS.\n\
576 DIMENSION is the number of bytes to represent a character: 1 or 2.\n\
577 CHARS is the number of characters in a dimension: 94 or 96.\n\
579 This final char is for private use, thus the range is `0' (48) .. `?' (63).\n\
580 If there's no unused final char for the specified kind of charset,\n\
583 Lisp_Object dimension
, chars
;
587 CHECK_NUMBER (dimension
, 0);
588 CHECK_NUMBER (chars
, 1);
589 if (XINT (dimension
) != 1 && XINT (dimension
) != 2)
590 error ("Invalid charset dimension %d, it should be 1 or 2",
592 if (XINT (chars
) != 94 && XINT (chars
) != 96)
593 error ("Invalid charset chars %d, it should be 94 or 96",
595 for (final_char
= '0'; final_char
<= '?'; final_char
++)
597 if (ISO_CHARSET_TABLE (dimension
, chars
, make_number (final_char
)) < 0)
600 return (final_char
<= '?' ? make_number (final_char
) : Qnil
);
603 DEFUN ("declare-equiv-charset", Fdeclare_equiv_charset
, Sdeclare_equiv_charset
,
605 "Declare a charset of DIMENSION, CHARS, FINAL-CHAR is the same as CHARSET.\n\
606 CHARSET should be defined by `defined-charset' in advance.")
607 (dimension
, chars
, final_char
, charset_symbol
)
608 Lisp_Object dimension
, chars
, final_char
, charset_symbol
;
612 CHECK_NUMBER (dimension
, 0);
613 CHECK_NUMBER (chars
, 1);
614 CHECK_NUMBER (final_char
, 2);
615 CHECK_SYMBOL (charset_symbol
, 3);
617 if (XINT (dimension
) != 1 && XINT (dimension
) != 2)
618 error ("Invalid DIMENSION %d, it should be 1 or 2", XINT (dimension
));
619 if (XINT (chars
) != 94 && XINT (chars
) != 96)
620 error ("Invalid CHARS %d, it should be 94 or 96", XINT (chars
));
621 if (XINT (final_char
) < '0' || XFASTINT (final_char
) > '~')
622 error ("Invalid FINAL-CHAR %c, it should be `0'..`~'", XINT (chars
));
623 if ((charset
= get_charset_id (charset_symbol
)) < 0)
624 error ("Invalid charset %s", XSYMBOL (charset_symbol
)->name
->data
);
626 ISO_CHARSET_TABLE (dimension
, chars
, final_char
) = charset
;
630 /* Return number of different charsets in STR of length LEN. In
631 addition, for each found charset N, CHARSETS[N] is set 1. The
632 caller should allocate CHARSETS (MAX_CHARSET + 1 elements) in advance.
633 It may lookup a translation table TABLE if supplied. */
636 find_charset_in_str (str
, len
, charsets
, table
)
641 register int num
= 0, c
;
643 if (! CHAR_TABLE_P (table
))
651 if (c
== LEADING_CODE_COMPOSITION
)
653 int cmpchar_id
= str_cmpchar_id (str
, len
);
658 struct cmpchar_info
*cmpcharp
= cmpchar_table
[cmpchar_id
];
661 for (i
= 0; i
< cmpcharp
->glyph_len
; i
++)
663 c
= cmpcharp
->glyph
[i
];
666 if ((c
= translate_char (table
, c
, 0, 0, 0)) < 0)
667 c
= cmpcharp
->glyph
[i
];
669 if ((charset
= CHAR_CHARSET (c
)) < 0)
670 charset
= CHARSET_ASCII
;
671 if (!charsets
[charset
])
673 charsets
[charset
] = 1;
677 str
+= cmpcharp
->len
;
678 len
-= cmpcharp
->len
;
682 charset
= CHARSET_ASCII
;
687 c
= STRING_CHAR_AND_LENGTH (str
, len
, bytes
);
690 int c1
= translate_char (table
, c
, 0, 0, 0);
694 charset
= CHAR_CHARSET (c
);
697 if (!charsets
[charset
])
699 charsets
[charset
] = 1;
708 DEFUN ("find-charset-region", Ffind_charset_region
, Sfind_charset_region
,
710 "Return a list of charsets in the region between BEG and END.\n\
711 BEG and END are buffer positions.\n\
712 Optional arg TABLE if non-nil is a translation table to look up.")
714 Lisp_Object beg
, end
, table
;
716 int charsets
[MAX_CHARSET
+ 1];
717 int from
, from_byte
, to
, stop
, stop_byte
, i
;
720 validate_region (&beg
, &end
);
721 from
= XFASTINT (beg
);
722 stop
= to
= XFASTINT (end
);
724 if (from
< GPT
&& GPT
< to
)
727 stop_byte
= GPT_BYTE
;
730 stop_byte
= CHAR_TO_BYTE (stop
);
732 from_byte
= CHAR_TO_BYTE (from
);
734 bzero (charsets
, (MAX_CHARSET
+ 1) * sizeof (int));
737 find_charset_in_str (BYTE_POS_ADDR (from_byte
), stop_byte
- from_byte
,
741 from
= stop
, from_byte
= stop_byte
;
742 stop
= to
, stop_byte
= CHAR_TO_BYTE (stop
);
749 for (i
= MAX_CHARSET
; i
>= 0; i
--)
751 val
= Fcons (CHARSET_SYMBOL (i
), val
);
755 DEFUN ("find-charset-string", Ffind_charset_string
, Sfind_charset_string
,
757 "Return a list of charsets in STR.\n\
758 Optional arg TABLE if non-nil is a translation table to look up.")
760 Lisp_Object str
, table
;
762 int charsets
[MAX_CHARSET
+ 1];
766 CHECK_STRING (str
, 0);
768 if (! STRING_MULTIBYTE (str
))
771 bzero (charsets
, (MAX_CHARSET
+ 1) * sizeof (int));
772 find_charset_in_str (XSTRING (str
)->data
, STRING_BYTES (XSTRING (str
)),
775 for (i
= MAX_CHARSET
; i
>= 0; i
--)
777 val
= Fcons (CHARSET_SYMBOL (i
), val
);
781 DEFUN ("make-char-internal", Fmake_char_internal
, Smake_char_internal
, 1, 3, 0,
783 (charset
, code1
, code2
)
784 Lisp_Object charset
, code1
, code2
;
786 CHECK_NUMBER (charset
, 0);
789 XSETFASTINT (code1
, 0);
791 CHECK_NUMBER (code1
, 1);
793 XSETFASTINT (code2
, 0);
795 CHECK_NUMBER (code2
, 2);
797 if (!CHARSET_DEFINED_P (XINT (charset
)))
798 error ("Invalid charset: %d", XINT (charset
));
800 return make_number (MAKE_CHAR (XINT (charset
), XINT (code1
), XINT (code2
)));
803 DEFUN ("split-char", Fsplit_char
, Ssplit_char
, 1, 1, 0,
804 "Return list of charset and one or two position-codes of CHAR.")
811 CHECK_NUMBER (ch
, 0);
812 SPLIT_CHAR (XFASTINT (ch
), charset
, c1
, c2
);
814 ? Fcons (CHARSET_SYMBOL (charset
),
815 Fcons (make_number (c1
), Fcons (make_number (c2
), Qnil
)))
816 : Fcons (CHARSET_SYMBOL (charset
), Fcons (make_number (c1
), Qnil
)));
819 DEFUN ("char-charset", Fchar_charset
, Schar_charset
, 1, 1, 0,
820 "Return charset of CHAR.")
824 CHECK_NUMBER (ch
, 0);
826 return CHARSET_SYMBOL (CHAR_CHARSET (XINT (ch
)));
829 DEFUN ("charset-after", Fcharset_after
, Scharset_after
, 0, 1, 0,
830 "Return charset of a character in current buffer at position POS.\n\
831 If POS is nil, it defauls to the current point.")
835 register int pos_byte
, c
, charset
;
836 register unsigned char *p
;
840 else if (MARKERP (pos
))
841 pos_byte
= marker_byte_position (pos
);
844 CHECK_NUMBER (pos
, 0);
845 pos_byte
= CHAR_TO_BYTE (XINT (pos
));
847 p
= BYTE_POS_ADDR (pos_byte
);
848 c
= STRING_CHAR (p
, Z_BYTE
- pos_byte
);
849 charset
= CHAR_CHARSET (c
);
850 return CHARSET_SYMBOL (charset
);
853 DEFUN ("iso-charset", Fiso_charset
, Siso_charset
, 3, 3, 0,
854 "Return charset of ISO's specification DIMENSION, CHARS, and FINAL-CHAR.\n\
856 ISO 2022's designation sequence (escape sequence) distinguishes charsets\n\
857 by their DIMENSION, CHARS, and FINAL-CHAR,\n\
858 where as Emacs distinguishes them by charset symbol.\n\
859 See the documentation of the function `charset-info' for the meanings of\n\
860 DIMENSION, CHARS, and FINAL-CHAR.")
861 (dimension
, chars
, final_char
)
862 Lisp_Object dimension
, chars
, final_char
;
866 CHECK_NUMBER (dimension
, 0);
867 CHECK_NUMBER (chars
, 1);
868 CHECK_NUMBER (final_char
, 2);
870 if ((charset
= ISO_CHARSET_TABLE (dimension
, chars
, final_char
)) < 0)
872 return CHARSET_SYMBOL (charset
);
875 /* If GENERICP is nonzero, return nonzero iff C is a valid normal or
876 generic character. If GENERICP is zero, return nonzero iff C is a
877 valid normal character. Do not call this function directly,
878 instead use macro CHAR_VALID_P. */
880 char_valid_p (c
, genericp
)
887 if (SINGLE_BYTE_CHAR_P (c
))
889 SPLIT_NON_ASCII_CHAR (c
, charset
, c1
, c2
);
890 if (!CHARSET_VALID_P (charset
))
892 return (c
< MIN_CHAR_COMPOSITION
893 ? ((c
& CHAR_FIELD1_MASK
) /* i.e. dimension of C is two. */
894 ? (genericp
&& c1
== 0 && c2
== 0
895 || c1
>= 32 && c2
>= 32)
896 : (genericp
&& c1
== 0
898 : c
< MIN_CHAR_COMPOSITION
+ n_cmpchars
);
901 DEFUN ("char-valid-p", Fchar_valid_p
, Schar_valid_p
, 1, 2, 0,
902 "Return t if OBJECT is a valid normal character.\n\
903 If optional arg GENERICP is non-nil, also return t if OBJECT is\n\
904 a valid generic character.")
906 Lisp_Object object
, genericp
;
908 if (! NATNUMP (object
))
910 return (CHAR_VALID_P (XFASTINT (object
), !NILP (genericp
)) ? Qt
: Qnil
);
913 DEFUN ("unibyte-char-to-multibyte", Funibyte_char_to_multibyte
,
914 Sunibyte_char_to_multibyte
, 1, 1, 0,
915 "Convert the unibyte character CH to multibyte character.\n\
916 The conversion is done based on `nonascii-translate-table' (which see)\n\
917 or `nonascii-insert-offset' (which see).")
923 CHECK_NUMBER (ch
, 0);
925 if (c
< 0 || c
>= 0400)
926 error ("Invalid unibyte character: %d", c
);
927 c
= unibyte_char_to_multibyte (c
);
929 error ("Can't convert to multibyte character: %d", XINT (ch
));
930 return make_number (c
);
933 DEFUN ("char-bytes", Fchar_bytes
, Schar_bytes
, 1, 1, 0,
934 "Return byte length of multi-byte form of CHAR.")
941 CHECK_NUMBER (ch
, 0);
942 if (COMPOSITE_CHAR_P (XFASTINT (ch
)))
944 unsigned int id
= COMPOSITE_CHAR_ID (XFASTINT (ch
));
946 bytes
= (id
< n_cmpchars
? cmpchar_table
[id
]->len
: 1);
950 int charset
= CHAR_CHARSET (XFASTINT (ch
));
952 bytes
= CHARSET_DEFINED_P (charset
) ? CHARSET_BYTES (charset
) : 1;
955 XSETFASTINT (val
, bytes
);
959 /* Return the width of character of which multi-byte form starts with
960 C. The width is measured by how many columns occupied on the
961 screen when displayed in the current buffer. */
963 #define ONE_BYTE_CHAR_WIDTH(c) \
966 ? XFASTINT (current_buffer->tab_width) \
967 : (c == '\n' ? 0 : (NILP (current_buffer->ctl_arrow) ? 4 : 2))) \
971 ? (NILP (current_buffer->ctl_arrow) ? 4 : 2) \
972 : ((! NILP (current_buffer->enable_multibyte_characters) \
973 && BASE_LEADING_CODE_P (c)) \
974 ? WIDTH_BY_CHAR_HEAD (c) \
977 DEFUN ("char-width", Fchar_width
, Schar_width
, 1, 1, 0,
978 "Return width of CHAR when displayed in the current buffer.\n\
979 The width is measured by how many columns it occupies on the screen.")
983 Lisp_Object val
, disp
;
985 struct Lisp_Char_Table
*dp
= buffer_display_table ();
987 CHECK_NUMBER (ch
, 0);
991 /* Get the way the display table would display it. */
992 disp
= dp
? DISP_CHAR_VECTOR (dp
, c
) : Qnil
;
995 XSETINT (val
, XVECTOR (disp
)->size
);
996 else if (SINGLE_BYTE_CHAR_P (c
))
997 XSETINT (val
, ONE_BYTE_CHAR_WIDTH (c
));
998 else if (COMPOSITE_CHAR_P (c
))
1000 int id
= COMPOSITE_CHAR_ID (XFASTINT (ch
));
1001 XSETFASTINT (val
, (id
< n_cmpchars
? cmpchar_table
[id
]->width
: 0));
1005 int charset
= CHAR_CHARSET (c
);
1007 XSETFASTINT (val
, CHARSET_WIDTH (charset
));
1012 /* Return width of string STR of length LEN when displayed in the
1013 current buffer. The width is measured by how many columns it
1014 occupies on the screen. */
1021 unsigned char *endp
= str
+ len
;
1023 struct Lisp_Char_Table
*dp
= buffer_display_table ();
1027 if (*str
== LEADING_CODE_COMPOSITION
)
1029 int id
= str_cmpchar_id (str
, endp
- str
);
1038 width
+= cmpchar_table
[id
]->width
;
1039 str
+= cmpchar_table
[id
]->len
;
1046 int c
= STRING_CHAR_AND_LENGTH (str
, endp
- str
, thislen
);
1048 /* Get the way the display table would display it. */
1050 disp
= DISP_CHAR_VECTOR (dp
, c
);
1055 width
+= XVECTOR (disp
)->size
;
1057 width
+= ONE_BYTE_CHAR_WIDTH (*str
);
1065 DEFUN ("string-width", Fstring_width
, Sstring_width
, 1, 1, 0,
1066 "Return width of STRING when displayed in the current buffer.\n\
1067 Width is measured by how many columns it occupies on the screen.\n\
1068 When calculating width of a multibyte character in STRING,\n\
1069 only the base leading-code is considered; the validity of\n\
1070 the following bytes is not checked.")
1076 CHECK_STRING (str
, 0);
1077 XSETFASTINT (val
, strwidth (XSTRING (str
)->data
,
1078 STRING_BYTES (XSTRING (str
))));
1082 DEFUN ("char-direction", Fchar_direction
, Schar_direction
, 1, 1, 0,
1083 "Return the direction of CHAR.\n\
1084 The returned value is 0 for left-to-right and 1 for right-to-left.")
1090 CHECK_NUMBER (ch
, 0);
1091 charset
= CHAR_CHARSET (XFASTINT (ch
));
1092 if (!CHARSET_DEFINED_P (charset
))
1093 invalid_character (XINT (ch
));
1094 return CHARSET_TABLE_INFO (charset
, CHARSET_DIRECTION_IDX
);
1097 DEFUN ("chars-in-region", Fchars_in_region
, Schars_in_region
, 2, 2, 0,
1098 "Return number of characters between BEG and END.")
1100 Lisp_Object beg
, end
;
1104 from
= min (XFASTINT (beg
), XFASTINT (end
));
1105 to
= max (XFASTINT (beg
), XFASTINT (end
));
1107 return make_number (to
- from
);
1110 /* Return the number of characters in the NBYTES bytes at PTR.
1111 This works by looking at the contents and checking for multibyte sequences.
1112 However, if the current buffer has enable-multibyte-characters = nil,
1113 we treat each byte as a character. */
1116 chars_in_text (ptr
, nbytes
)
1120 unsigned char *endp
, c
;
1123 /* current_buffer is null at early stages of Emacs initialization. */
1124 if (current_buffer
== 0
1125 || NILP (current_buffer
->enable_multibyte_characters
))
1128 endp
= ptr
+ nbytes
;
1135 if (BASE_LEADING_CODE_P (c
))
1136 while (ptr
< endp
&& ! CHAR_HEAD_P (*ptr
)) ptr
++;
1143 /* Return the number of characters in the NBYTES bytes at PTR.
1144 This works by looking at the contents and checking for multibyte sequences.
1145 It ignores enable-multibyte-characters. */
1148 multibyte_chars_in_text (ptr
, nbytes
)
1152 unsigned char *endp
, c
;
1155 endp
= ptr
+ nbytes
;
1162 if (BASE_LEADING_CODE_P (c
))
1163 while (ptr
< endp
&& ! CHAR_HEAD_P (*ptr
)) ptr
++;
1170 DEFUN ("string", Fstring
, Sstring
, 1, MANY
, 0,
1171 "Concatenate all the argument characters and make the result a string.")
1178 = (unsigned char *) alloca (MAX_LENGTH_OF_MULTI_BYTE_FORM
* n
);
1179 unsigned char *p
= buf
;
1182 for (i
= 0; i
< n
; i
++)
1187 if (!INTEGERP (args
[i
]))
1188 CHECK_NUMBER (args
[i
], 0);
1190 len
= CHAR_STRING (c
, p
, str
);
1192 /* C is a composite character. */
1193 bcopy (str
, p
, len
);
1197 val
= make_string_from_bytes (buf
, n
, p
- buf
);
1203 /*** Composite characters staffs ***/
1205 /* Each composite character is identified by CMPCHAR-ID which is
1206 assigned when Emacs needs the character code of the composite
1207 character (e.g. when displaying it on the screen). See the
1208 document "GENERAL NOTE on COMPOSITE CHARACTER" in `charset.h' how a
1209 composite character is represented in Emacs. */
1211 /* If `static' is defined, it means that it is defined to null string. */
1213 /* The following function is copied from lread.c. */
1215 hash_string (ptr
, len
)
1219 register unsigned char *p
= ptr
;
1220 register unsigned char *end
= p
+ len
;
1221 register unsigned char c
;
1222 register int hash
= 0;
1227 if (c
>= 0140) c
-= 40;
1228 hash
= ((hash
<<3) + (hash
>>28) + c
);
1230 return hash
& 07777777777;
1234 #define CMPCHAR_HASH_TABLE_SIZE 0xFFF
1236 static int *cmpchar_hash_table
[CMPCHAR_HASH_TABLE_SIZE
];
1238 /* Each element of `cmpchar_hash_table' is a pointer to an array of
1239 integer, where the 1st element is the size of the array, the 2nd
1240 element is how many elements are actually used in the array, and
1241 the remaining elements are CMPCHAR-IDs of composite characters of
1242 the same hash value. */
1243 #define CMPCHAR_HASH_SIZE(table) table[0]
1244 #define CMPCHAR_HASH_USED(table) table[1]
1245 #define CMPCHAR_HASH_CMPCHAR_ID(table, i) table[i]
1247 /* Return CMPCHAR-ID of the composite character in STR of the length
1248 LEN. If the composite character has not yet been registered,
1249 register it in `cmpchar_table' and assign new CMPCHAR-ID. This
1250 is the sole function for assigning CMPCHAR-ID. */
1252 str_cmpchar_id (str
, len
)
1253 const unsigned char *str
;
1256 int hash_idx
, *hashp
;
1258 int embedded_rule
; /* 1 if composition rule is embedded. */
1259 int chars
; /* number of components. */
1261 struct cmpchar_info
*cmpcharp
;
1263 /* The second byte 0xFF means compostion rule is embedded. */
1264 embedded_rule
= (str
[1] == 0xFF);
1266 /* At first, get the actual length of the composite character. */
1268 const unsigned char *p
, *endp
= str
+ 1, *lastp
= str
+ len
;
1271 while (endp
< lastp
&& ! CHAR_HEAD_P (*endp
)) endp
++;
1273 /* Any composite char have at least 5-byte length. */
1280 if (embedded_rule
) p
++;
1281 /* No need of checking if *P is 0xA0 because
1282 BYTES_BY_CHAR_HEAD (0x80) surely returns 2. */
1283 p
+= BYTES_BY_CHAR_HEAD (*p
- 0x20);
1286 if (p
> endp
|| chars
< 2 || chars
> MAX_COMPONENT_COUNT
)
1287 /* Invalid components. */
1291 hash_idx
= hash_string (str
, len
) % CMPCHAR_HASH_TABLE_SIZE
;
1292 hashp
= cmpchar_hash_table
[hash_idx
];
1294 /* Then, look into the hash table. */
1296 /* Find the correct one among composite characters of the same
1298 for (i
= 2; i
< CMPCHAR_HASH_USED (hashp
); i
++)
1300 cmpcharp
= cmpchar_table
[CMPCHAR_HASH_CMPCHAR_ID (hashp
, i
)];
1301 if (len
== cmpcharp
->len
1302 && ! bcmp (str
, cmpcharp
->data
, len
))
1303 return CMPCHAR_HASH_CMPCHAR_ID (hashp
, i
);
1306 /* We have to register the composite character in cmpchar_table. */
1307 if (n_cmpchars
> (CHAR_FIELD2_MASK
| CHAR_FIELD3_MASK
))
1308 /* No, we have no more room for a new composite character. */
1311 /* Make the entry in hash table. */
1314 /* Make a table for 8 composite characters initially. */
1315 hashp
= (cmpchar_hash_table
[hash_idx
]
1316 = (int *) xmalloc (sizeof (int) * (2 + 8)));
1317 CMPCHAR_HASH_SIZE (hashp
) = 10;
1318 CMPCHAR_HASH_USED (hashp
) = 2;
1320 else if (CMPCHAR_HASH_USED (hashp
) >= CMPCHAR_HASH_SIZE (hashp
))
1322 CMPCHAR_HASH_SIZE (hashp
) += 8;
1323 hashp
= (cmpchar_hash_table
[hash_idx
]
1324 = (int *) xrealloc (hashp
,
1325 sizeof (int) * CMPCHAR_HASH_SIZE (hashp
)));
1327 CMPCHAR_HASH_CMPCHAR_ID (hashp
, CMPCHAR_HASH_USED (hashp
)) = n_cmpchars
;
1328 CMPCHAR_HASH_USED (hashp
)++;
1330 /* Set information of the composite character in cmpchar_table. */
1331 if (cmpchar_table_size
== 0)
1333 /* This is the first composite character to be registered. */
1334 cmpchar_table_size
= 256;
1336 = (struct cmpchar_info
**) xmalloc (sizeof (cmpchar_table
[0])
1337 * cmpchar_table_size
);
1339 else if (cmpchar_table_size
<= n_cmpchars
)
1341 cmpchar_table_size
+= 256;
1343 = (struct cmpchar_info
**) xrealloc (cmpchar_table
,
1344 sizeof (cmpchar_table
[0])
1345 * cmpchar_table_size
);
1348 cmpcharp
= (struct cmpchar_info
*) xmalloc (sizeof (struct cmpchar_info
));
1350 cmpcharp
->len
= len
;
1351 cmpcharp
->data
= (unsigned char *) xmalloc (len
+ 1);
1352 bcopy (str
, cmpcharp
->data
, len
);
1353 cmpcharp
->data
[len
] = 0;
1354 cmpcharp
->glyph_len
= chars
;
1355 cmpcharp
->glyph
= (GLYPH
*) xmalloc (sizeof (GLYPH
) * chars
);
1358 cmpcharp
->cmp_rule
= (unsigned char *) xmalloc (chars
);
1359 cmpcharp
->col_offset
= (float *) xmalloc (sizeof (float) * chars
);
1363 cmpcharp
->cmp_rule
= NULL
;
1364 cmpcharp
->col_offset
= NULL
;
1367 /* Setup GLYPH data and composition rules (if any) so as not to make
1368 them every time on displaying. */
1370 unsigned char *bufp
;
1372 float leftmost
= 0.0, rightmost
= 1.0;
1375 /* At first, col_offset[N] is set to relative to col_offset[0]. */
1376 cmpcharp
->col_offset
[0] = 0;
1378 for (i
= 0, bufp
= cmpcharp
->data
+ 1; i
< chars
; i
++)
1381 cmpcharp
->cmp_rule
[i
] = *bufp
++;
1383 if (*bufp
== 0xA0) /* This is an ASCII character. */
1385 cmpcharp
->glyph
[i
] = FAST_MAKE_GLYPH ((*++bufp
& 0x7F), 0);
1389 else /* Multibyte character. */
1391 /* Make `bufp' point normal multi-byte form temporally. */
1394 = FAST_MAKE_GLYPH (string_to_non_ascii_char (bufp
, 4, 0), 0);
1395 width
= WIDTH_BY_CHAR_HEAD (*bufp
);
1397 bufp
+= BYTES_BY_CHAR_HEAD (*bufp
- 0x20);
1400 if (embedded_rule
&& i
> 0)
1402 /* Reference points (global_ref and new_ref) are
1413 Now, we calculate the column offset of the new glyph
1414 from the left edge of the first glyph. This can avoid
1415 the same calculation everytime displaying this
1416 composite character. */
1418 /* Reference points of global glyph and new glyph. */
1419 int global_ref
= (cmpcharp
->cmp_rule
[i
] - 0xA0) / 9;
1420 int new_ref
= (cmpcharp
->cmp_rule
[i
] - 0xA0) % 9;
1421 /* Column offset relative to the first glyph. */
1422 float left
= (leftmost
1423 + (global_ref
% 3) * (rightmost
- leftmost
) / 2.0
1424 - (new_ref
% 3) * width
/ 2.0);
1426 cmpcharp
->col_offset
[i
] = left
;
1427 if (left
< leftmost
)
1429 if (left
+ width
> rightmost
)
1430 rightmost
= left
+ width
;
1434 if (width
> rightmost
)
1440 /* Now col_offset[N] are relative to the left edge of the
1441 first component. Make them relative to the left edge of
1443 for (i
= 0; i
< chars
; i
++)
1444 cmpcharp
->col_offset
[i
] -= leftmost
;
1445 /* Make rightmost holds width of overall glyph. */
1446 rightmost
-= leftmost
;
1449 cmpcharp
->width
= rightmost
;
1450 if (cmpcharp
->width
< rightmost
)
1451 /* To get a ceiling integer value. */
1455 cmpchar_table
[n_cmpchars
] = cmpcharp
;
1457 return n_cmpchars
++;
1460 /* Return the Nth element of the composite character C. */
1462 cmpchar_component (c
, n
)
1465 int id
= COMPOSITE_CHAR_ID (c
);
1467 if (id
>= n_cmpchars
/* C is not a valid composite character. */
1468 || n
>= cmpchar_table
[id
]->glyph_len
) /* No such component. */
1470 /* No face data is stored in glyph code. */
1471 return ((int) (cmpchar_table
[id
]->glyph
[n
]));
1474 DEFUN ("cmpcharp", Fcmpcharp
, Scmpcharp
, 1, 1, 0,
1475 "T if CHAR is a composite character.")
1479 CHECK_NUMBER (ch
, 0);
1480 return (COMPOSITE_CHAR_P (XINT (ch
)) ? Qt
: Qnil
);
1483 DEFUN ("composite-char-component", Fcmpchar_component
, Scmpchar_component
,
1485 "Return the IDXth component character of composite character CHARACTER.")
1487 Lisp_Object character
, idx
;
1491 CHECK_NUMBER (character
, 0);
1492 CHECK_NUMBER (idx
, 1);
1494 if ((c
= cmpchar_component (XINT (character
), XINT (idx
))) < 0)
1495 args_out_of_range (character
, idx
);
1497 return make_number (c
);
1500 DEFUN ("composite-char-composition-rule", Fcmpchar_cmp_rule
, Scmpchar_cmp_rule
,
1502 "Return the Nth composition rule embedded in composite character CHARACTER.\n\
1503 The returned rule is for composing the Nth component\n\
1504 on the (N-1)th component. If N is 0, the returned value is always 255.")
1506 Lisp_Object character
, n
;
1510 CHECK_NUMBER (character
, 0);
1511 CHECK_NUMBER (n
, 1);
1513 id
= COMPOSITE_CHAR_ID (XINT (character
));
1514 if (id
< 0 || id
>= n_cmpchars
)
1515 error ("Invalid composite character: %d", XINT (character
));
1517 if (i
> cmpchar_table
[id
]->glyph_len
)
1518 args_out_of_range (character
, n
);
1520 return make_number (cmpchar_table
[id
]->cmp_rule
[i
]);
1523 DEFUN ("composite-char-composition-rule-p", Fcmpchar_cmp_rule_p
,
1524 Scmpchar_cmp_rule_p
, 1, 1, 0,
1525 "Return non-nil if composite character CHARACTER contains a embedded rule.")
1527 Lisp_Object character
;
1531 CHECK_NUMBER (character
, 0);
1532 id
= COMPOSITE_CHAR_ID (XINT (character
));
1533 if (id
< 0 || id
>= n_cmpchars
)
1534 error ("Invalid composite character: %d", XINT (character
));
1536 return (cmpchar_table
[id
]->cmp_rule
? Qt
: Qnil
);
1539 DEFUN ("composite-char-component-count", Fcmpchar_cmp_count
,
1540 Scmpchar_cmp_count
, 1, 1, 0,
1541 "Return number of compoents of composite character CHARACTER.")
1543 Lisp_Object character
;
1547 CHECK_NUMBER (character
, 0);
1548 id
= COMPOSITE_CHAR_ID (XINT (character
));
1549 if (id
< 0 || id
>= n_cmpchars
)
1550 error ("Invalid composite character: %d", XINT (character
));
1552 return (make_number (cmpchar_table
[id
]->glyph_len
));
1555 DEFUN ("compose-string", Fcompose_string
, Scompose_string
,
1557 "Return one char string composed from all characters in STRING.")
1561 unsigned char buf
[MAX_LENGTH_OF_MULTI_BYTE_FORM
], *p
, *pend
, *ptemp
;
1564 CHECK_STRING (str
, 0);
1566 buf
[0] = LEADING_CODE_COMPOSITION
;
1567 p
= XSTRING (str
)->data
;
1568 pend
= p
+ STRING_BYTES (XSTRING (str
));
1572 if (*p
< 0x20 || *p
== 127) /* control code */
1573 error ("Invalid component character: %d", *p
);
1574 else if (*p
< 0x80) /* ASCII */
1576 if (i
+ 2 >= MAX_LENGTH_OF_MULTI_BYTE_FORM
)
1577 error ("Too long string to be composed: %s", XSTRING (str
)->data
);
1578 /* Prepend an ASCII charset indicator 0xA0, set MSB of the
1581 buf
[i
++] = *p
++ + 0x80;
1583 else if (*p
== LEADING_CODE_COMPOSITION
) /* composite char */
1585 /* Already composed. Eliminate the heading
1586 LEADING_CODE_COMPOSITION, keep the remaining bytes
1590 while (! CHAR_HEAD_P (*p
)) p
++;
1591 if (i
+ (p
- ptemp
) >= MAX_LENGTH_OF_MULTI_BYTE_FORM
)
1592 error ("Too long string to be composed: %s", XSTRING (str
)->data
);
1593 bcopy (ptemp
, buf
+ i
, p
- ptemp
);
1596 else /* multibyte char */
1598 /* Add 0x20 to the base leading-code, keep the remaining
1600 len
= BYTES_BY_CHAR_HEAD (*p
);
1601 if (i
+ len
>= MAX_LENGTH_OF_MULTI_BYTE_FORM
)
1602 error ("Too long string to be composed: %s", XSTRING (str
)->data
);
1603 bcopy (p
, buf
+ i
, len
);
1610 /* STR contains only one character, which can't be composed. */
1611 error ("Too short string to be composed: %s", XSTRING (str
)->data
);
1613 return make_string_from_bytes (buf
, 1, i
);
1618 charset_id_internal (charset_name
)
1621 Lisp_Object val
= Fget (intern (charset_name
), Qcharset
);
1624 error ("Charset %s is not defined", charset_name
);
1626 return (XINT (XVECTOR (val
)->contents
[0]));
1629 DEFUN ("setup-special-charsets", Fsetup_special_charsets
,
1630 Ssetup_special_charsets
, 0, 0, 0, "Internal use only.")
1633 charset_latin_iso8859_1
= charset_id_internal ("latin-iso8859-1");
1634 charset_jisx0208_1978
= charset_id_internal ("japanese-jisx0208-1978");
1635 charset_jisx0208
= charset_id_internal ("japanese-jisx0208");
1636 charset_katakana_jisx0201
= charset_id_internal ("katakana-jisx0201");
1637 charset_latin_jisx0201
= charset_id_internal ("latin-jisx0201");
1638 charset_big5_1
= charset_id_internal ("chinese-big5-1");
1639 charset_big5_2
= charset_id_internal ("chinese-big5-2");
1644 init_charset_once ()
1648 staticpro (&Vcharset_table
);
1649 staticpro (&Vcharset_symbol_table
);
1651 /* This has to be done here, before we call Fmake_char_table. */
1652 Qcharset_table
= intern ("charset-table");
1653 staticpro (&Qcharset_table
);
1655 /* Intern this now in case it isn't already done.
1656 Setting this variable twice is harmless.
1657 But don't staticpro it here--that is done in alloc.c. */
1658 Qchar_table_extra_slots
= intern ("char-table-extra-slots");
1660 /* Now we are ready to set up this property, so we can
1661 create the charset table. */
1662 Fput (Qcharset_table
, Qchar_table_extra_slots
, make_number (0));
1663 Vcharset_table
= Fmake_char_table (Qcharset_table
, Qnil
);
1665 Vcharset_symbol_table
= Fmake_vector (make_number (MAX_CHARSET
+ 1), Qnil
);
1668 for (i
= 0; i
< 2; i
++)
1669 for (j
= 0; j
< 2; j
++)
1670 for (k
= 0; k
< 128; k
++)
1671 iso_charset_table
[i
][j
][k
] = -1;
1673 bzero (cmpchar_hash_table
, sizeof cmpchar_hash_table
);
1674 cmpchar_table_size
= n_cmpchars
= 0;
1676 for (i
= 0; i
< 256; i
++)
1677 BYTES_BY_CHAR_HEAD (i
) = 1;
1678 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_11
) = 3;
1679 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_12
) = 3;
1680 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_21
) = 4;
1681 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_22
) = 4;
1682 /* The following doesn't reflect the actual bytes, but just to tell
1683 that it is a start of a multibyte character. */
1684 BYTES_BY_CHAR_HEAD (LEADING_CODE_COMPOSITION
) = 2;
1686 for (i
= 0; i
< 128; i
++)
1687 WIDTH_BY_CHAR_HEAD (i
) = 1;
1688 for (; i
< 256; i
++)
1689 WIDTH_BY_CHAR_HEAD (i
) = 4;
1690 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_11
) = 1;
1691 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_12
) = 2;
1692 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_21
) = 1;
1693 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_22
) = 2;
1701 Qascii
= intern ("ascii");
1702 staticpro (&Qascii
);
1704 Qcharset
= intern ("charset");
1705 staticpro (&Qcharset
);
1707 /* Define ASCII charset now. */
1708 update_charset_table (make_number (CHARSET_ASCII
),
1709 make_number (1), make_number (94),
1714 build_string ("ASCII"),
1715 build_string ("ASCII"),
1716 build_string ("ASCII (ISO646 IRV)"));
1717 CHARSET_SYMBOL (CHARSET_ASCII
) = Qascii
;
1718 Fput (Qascii
, Qcharset
, CHARSET_TABLE_ENTRY (CHARSET_ASCII
));
1720 Qcomposition
= intern ("composition");
1721 staticpro (&Qcomposition
);
1722 CHARSET_SYMBOL (CHARSET_COMPOSITION
) = Qcomposition
;
1724 defsubr (&Sdefine_charset
);
1725 defsubr (&Sget_unused_iso_final_char
);
1726 defsubr (&Sdeclare_equiv_charset
);
1727 defsubr (&Sfind_charset_region
);
1728 defsubr (&Sfind_charset_string
);
1729 defsubr (&Smake_char_internal
);
1730 defsubr (&Ssplit_char
);
1731 defsubr (&Schar_charset
);
1732 defsubr (&Scharset_after
);
1733 defsubr (&Siso_charset
);
1734 defsubr (&Schar_valid_p
);
1735 defsubr (&Sunibyte_char_to_multibyte
);
1736 defsubr (&Schar_bytes
);
1737 defsubr (&Schar_width
);
1738 defsubr (&Sstring_width
);
1739 defsubr (&Schar_direction
);
1740 defsubr (&Schars_in_region
);
1742 defsubr (&Scmpcharp
);
1743 defsubr (&Scmpchar_component
);
1744 defsubr (&Scmpchar_cmp_rule
);
1745 defsubr (&Scmpchar_cmp_rule_p
);
1746 defsubr (&Scmpchar_cmp_count
);
1747 defsubr (&Scompose_string
);
1748 defsubr (&Ssetup_special_charsets
);
1750 DEFVAR_LISP ("charset-list", &Vcharset_list
,
1751 "List of charsets ever defined.");
1752 Vcharset_list
= Fcons (Qascii
, Qnil
);
1754 DEFVAR_LISP ("character-translation-table-vector",
1755 &Vcharacter_translation_table_vector
,
1756 "Vector of cons cell of a symbol and translation table ever defined.\n\
1757 An ID of a translation table is an index of this vector.");
1758 Vcharacter_translation_table_vector
= Fmake_vector (make_number (16), Qnil
);
1760 DEFVAR_INT ("leading-code-composition", &leading_code_composition
,
1761 "Leading-code of composite characters.");
1762 leading_code_composition
= LEADING_CODE_COMPOSITION
;
1764 DEFVAR_INT ("leading-code-private-11", &leading_code_private_11
,
1765 "Leading-code of private TYPE9N charset of column-width 1.");
1766 leading_code_private_11
= LEADING_CODE_PRIVATE_11
;
1768 DEFVAR_INT ("leading-code-private-12", &leading_code_private_12
,
1769 "Leading-code of private TYPE9N charset of column-width 2.");
1770 leading_code_private_12
= LEADING_CODE_PRIVATE_12
;
1772 DEFVAR_INT ("leading-code-private-21", &leading_code_private_21
,
1773 "Leading-code of private TYPE9Nx9N charset of column-width 1.");
1774 leading_code_private_21
= LEADING_CODE_PRIVATE_21
;
1776 DEFVAR_INT ("leading-code-private-22", &leading_code_private_22
,
1777 "Leading-code of private TYPE9Nx9N charset of column-width 2.");
1778 leading_code_private_22
= LEADING_CODE_PRIVATE_22
;
1780 DEFVAR_INT ("nonascii-insert-offset", &nonascii_insert_offset
,
1781 "Offset for converting non-ASCII unibyte codes 0240...0377 to multibyte.\n\
1782 This is used for converting unibyte text to multibyte,\n\
1783 and for inserting character codes specified by number.\n\n\
1784 This serves to convert a Latin-1 or similar 8-bit character code\n\
1785 to the corresponding Emacs multibyte character code.\n\
1786 Typically the value should be (- (make-char CHARSET 0) 128),\n\
1787 for your choice of character set.\n\
1788 If `nonascii-translate-table' is non-nil, it overrides this variable.");
1789 nonascii_insert_offset
= 0;
1791 DEFVAR_LISP ("nonascii-translation-table", &Vnonascii_translation_table
,
1792 "Character translation table to convert non-ASCII unibyte codes to multibyte.\n\
1793 This is used for converting unibyte text to multibyte,\n\
1794 and for inserting character codes specified by number.\n\n\
1795 Conversion is performed only when multibyte characters are enabled,\n\
1796 and it serves to convert a Latin-1 or similar 8-bit character code\n\
1797 to the corresponding Emacs character code.\n\n\
1798 If this is nil, `nonascii-insert-offset' is used instead.
1799 See also the docstring of `make-translation-table'.");
1800 Vnonascii_translation_table
= Qnil
;
1802 DEFVAR_INT ("min-composite-char", &min_composite_char
,
1803 "Minimum character code of a composite character.");
1804 min_composite_char
= MIN_CHAR_COMPOSITION
;