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 #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 multibyte form is set to the address ACTUAL_LEN.
173 If exclude_tail_garbage is nonzero, ACTUAL_LEN excludes gabage
174 bytes following the non-ASCII character.
176 Use macro `STRING_CHAR (STR, LEN)' instead of calling this function
177 directly if STR can hold an ASCII character. */
180 string_to_non_ascii_char (str
, len
, actual_len
, exclude_tail_garbage
)
181 const unsigned char *str
;
182 int len
, *actual_len
, exclude_tail_garbage
;
185 unsigned char c1
, c2
;
186 register int c
, bytes
;
191 if (BASE_LEADING_CODE_P (c
))
193 while (bytes
< len
&& ! CHAR_HEAD_P (str
[bytes
])) bytes
++;
195 if (c
== LEADING_CODE_COMPOSITION
)
197 int cmpchar_id
= str_cmpchar_id (str
, bytes
);
201 c
= MAKE_COMPOSITE_CHAR (cmpchar_id
);
202 if (exclude_tail_garbage
)
203 bytes
= cmpchar_table
[cmpchar_id
]->len
;
208 int charset
= c
, c1
, c2
= 0;
209 int char_bytes
= BYTES_BY_CHAR_HEAD (c
);
212 if (c
>= LEADING_CODE_PRIVATE_11
)
214 if (char_bytes
<= bytes
&& CHARSET_DEFINED_P (charset
))
217 if (CHARSET_DIMENSION (charset
) == 2)
219 c
= MAKE_NON_ASCII_CHAR (charset
, c1
, c2
);
220 if (exclude_tail_garbage
)
231 /* Return the length of the multi-byte form at string STR of length LEN. */
233 multibyte_form_length (str
, len
)
234 const unsigned char *str
;
239 if (BASE_LEADING_CODE_P (*str
))
240 while (bytes
< len
&& ! CHAR_HEAD_P (str
[bytes
])) bytes
++;
245 /* Check if string STR of length LEN contains valid multi-byte form of
246 a character. If valid, charset and position codes of the character
247 is set at *CHARSET, *C1, and *C2, and return 0. If not valid,
248 return -1. This should be used only in the macro SPLIT_STRING
249 which checks range of STR in advance. */
252 split_non_ascii_string (str
, len
, charset
, c1
, c2
)
253 register const unsigned char *str
;
254 register unsigned char *c1
, *c2
;
255 register int len
, *charset
;
257 register unsigned int cs
= *str
++;
259 if (cs
== LEADING_CODE_COMPOSITION
)
261 int cmpchar_id
= str_cmpchar_id (str
- 1, len
);
265 *charset
= cs
, *c1
= cmpchar_id
>> 7, *c2
= cmpchar_id
& 0x7F;
267 else if ((cs
< LEADING_CODE_PRIVATE_11
|| (cs
= *str
++) >= 0xA0)
268 && CHARSET_DEFINED_P (cs
))
273 *c1
= (*str
++) & 0x7F;
274 if (CHARSET_DIMENSION (cs
) == 2)
278 *c2
= (*str
++) & 0x7F;
286 /* Translate character C by translation table TABLE. If C
287 is negative, translate a character specified by CHARSET, C1, and C2
288 (C1 and C2 are code points of the character). If no translation is
289 found in TABLE, return C. */
291 translate_char (table
, c
, charset
, c1
, c2
)
293 int c
, charset
, c1
, c2
;
296 int alt_charset
, alt_c1
, alt_c2
, dimension
;
298 if (c
< 0) c
= MAKE_CHAR (charset
, c1
, c2
);
299 if (!CHAR_TABLE_P (table
)
300 || (ch
= Faref (table
, make_number (c
)), !INTEGERP (ch
))
304 SPLIT_CHAR (XFASTINT (ch
), alt_charset
, alt_c1
, alt_c2
);
305 dimension
= CHARSET_DIMENSION (alt_charset
);
306 if (dimension
== 1 && alt_c1
> 0 || dimension
== 2 && alt_c2
> 0)
307 /* CH is not a generic character, just return it. */
308 return XFASTINT (ch
);
310 /* Since CH is a generic character, we must return a specific
311 charater which has the same position codes as C from CH. */
313 SPLIT_CHAR (c
, charset
, c1
, c2
);
314 if (dimension
!= CHARSET_DIMENSION (charset
))
315 /* We can't make such a character because of dimension mismatch. */
317 return MAKE_CHAR (alt_charset
, c1
, c2
);
320 /* Convert the unibyte character C to multibyte based on
321 Vnonascii_translation_table or nonascii_insert_offset. If they can't
322 convert C to a valid multibyte character, convert it based on
323 DEFAULT_NONASCII_INSERT_OFFSET which makes C a Latin-1 character. */
326 unibyte_char_to_multibyte (c
)
329 if (c
>= 0240 && c
< 0400)
333 if (! NILP (Vnonascii_translation_table
))
334 c
= XINT (Faref (Vnonascii_translation_table
, make_number (c
)));
335 else if (nonascii_insert_offset
> 0)
336 c
+= nonascii_insert_offset
;
337 if (c
>= 0240 && (c
< 0400 || ! VALID_MULTIBYTE_CHAR_P (c
)))
338 c
= c_save
+ DEFAULT_NONASCII_INSERT_OFFSET
;
343 /* Update the table Vcharset_table with the given arguments (see the
344 document of `define-charset' for the meaning of each argument).
345 Several other table contents are also updated. The caller should
346 check the validity of CHARSET-ID and the remaining arguments in
350 update_charset_table (charset_id
, dimension
, chars
, width
, direction
,
351 iso_final_char
, iso_graphic_plane
,
352 short_name
, long_name
, description
)
353 Lisp_Object charset_id
, dimension
, chars
, width
, direction
;
354 Lisp_Object iso_final_char
, iso_graphic_plane
;
355 Lisp_Object short_name
, long_name
, description
;
357 int charset
= XINT (charset_id
);
359 unsigned char leading_code_base
, leading_code_ext
;
361 if (NILP (CHARSET_TABLE_ENTRY (charset
)))
362 CHARSET_TABLE_ENTRY (charset
)
363 = Fmake_vector (make_number (CHARSET_MAX_IDX
), Qnil
);
365 /* Get byte length of multibyte form, base leading-code, and
366 extended leading-code of the charset. See the comment under the
367 title "GENERAL NOTE on CHARACTER SET (CHARSET)" in charset.h. */
368 bytes
= XINT (dimension
);
369 if (charset
< MIN_CHARSET_PRIVATE_DIMENSION1
)
371 /* Official charset, it doesn't have an extended leading-code. */
372 if (charset
!= CHARSET_ASCII
)
373 bytes
+= 1; /* For a base leading-code. */
374 leading_code_base
= charset
;
375 leading_code_ext
= 0;
379 /* Private charset. */
380 bytes
+= 2; /* For base and extended leading-codes. */
382 = (charset
< LEADING_CODE_EXT_12
383 ? LEADING_CODE_PRIVATE_11
384 : (charset
< LEADING_CODE_EXT_21
385 ? LEADING_CODE_PRIVATE_12
386 : (charset
< LEADING_CODE_EXT_22
387 ? LEADING_CODE_PRIVATE_21
388 : LEADING_CODE_PRIVATE_22
)));
389 leading_code_ext
= charset
;
392 CHARSET_TABLE_INFO (charset
, CHARSET_ID_IDX
) = charset_id
;
393 CHARSET_TABLE_INFO (charset
, CHARSET_BYTES_IDX
) = make_number (bytes
);
394 CHARSET_TABLE_INFO (charset
, CHARSET_DIMENSION_IDX
) = dimension
;
395 CHARSET_TABLE_INFO (charset
, CHARSET_CHARS_IDX
) = chars
;
396 CHARSET_TABLE_INFO (charset
, CHARSET_WIDTH_IDX
) = width
;
397 CHARSET_TABLE_INFO (charset
, CHARSET_DIRECTION_IDX
) = direction
;
398 CHARSET_TABLE_INFO (charset
, CHARSET_LEADING_CODE_BASE_IDX
)
399 = make_number (leading_code_base
);
400 CHARSET_TABLE_INFO (charset
, CHARSET_LEADING_CODE_EXT_IDX
)
401 = make_number (leading_code_ext
);
402 CHARSET_TABLE_INFO (charset
, CHARSET_ISO_FINAL_CHAR_IDX
) = iso_final_char
;
403 CHARSET_TABLE_INFO (charset
, CHARSET_ISO_GRAPHIC_PLANE_IDX
)
405 CHARSET_TABLE_INFO (charset
, CHARSET_SHORT_NAME_IDX
) = short_name
;
406 CHARSET_TABLE_INFO (charset
, CHARSET_LONG_NAME_IDX
) = long_name
;
407 CHARSET_TABLE_INFO (charset
, CHARSET_DESCRIPTION_IDX
) = description
;
408 CHARSET_TABLE_INFO (charset
, CHARSET_PLIST_IDX
) = Qnil
;
411 /* If we have already defined a charset which has the same
412 DIMENSION, CHARS and ISO-FINAL-CHAR but the different
413 DIRECTION, we must update the entry REVERSE-CHARSET of both
414 charsets. If there's no such charset, the value of the entry
418 for (i
= 0; i
<= MAX_CHARSET
; i
++)
419 if (!NILP (CHARSET_TABLE_ENTRY (i
)))
421 if (CHARSET_DIMENSION (i
) == XINT (dimension
)
422 && CHARSET_CHARS (i
) == XINT (chars
)
423 && CHARSET_ISO_FINAL_CHAR (i
) == XINT (iso_final_char
)
424 && CHARSET_DIRECTION (i
) != XINT (direction
))
426 CHARSET_TABLE_INFO (charset
, CHARSET_REVERSE_CHARSET_IDX
)
428 CHARSET_TABLE_INFO (i
, CHARSET_REVERSE_CHARSET_IDX
) = charset_id
;
433 /* No such a charset. */
434 CHARSET_TABLE_INFO (charset
, CHARSET_REVERSE_CHARSET_IDX
)
438 if (charset
!= CHARSET_ASCII
439 && charset
< MIN_CHARSET_PRIVATE_DIMENSION1
)
441 /* Update tables bytes_by_char_head and width_by_char_head. */
442 bytes_by_char_head
[leading_code_base
] = bytes
;
443 width_by_char_head
[leading_code_base
] = XINT (width
);
445 /* Update table emacs_code_class. */
446 emacs_code_class
[charset
] = (bytes
== 2
447 ? EMACS_leading_code_2
449 ? EMACS_leading_code_3
450 : EMACS_leading_code_4
));
453 /* Update table iso_charset_table. */
454 if (ISO_CHARSET_TABLE (dimension
, chars
, iso_final_char
) < 0)
455 ISO_CHARSET_TABLE (dimension
, chars
, iso_final_char
) = charset
;
460 /* Return charset id of CHARSET_SYMBOL, or return -1 if CHARSET_SYMBOL
463 get_charset_id (charset_symbol
)
464 Lisp_Object charset_symbol
;
469 return ((SYMBOLP (charset_symbol
)
470 && (val
= Fget (charset_symbol
, Qcharset
), VECTORP (val
))
471 && (charset
= XINT (XVECTOR (val
)->contents
[CHARSET_ID_IDX
]),
472 CHARSET_VALID_P (charset
)))
476 /* Return an identification number for a new private charset of
477 DIMENSION and WIDTH. If there's no more room for the new charset,
480 get_new_private_charset_id (dimension
, width
)
481 int dimension
, width
;
483 int charset
, from
, to
;
488 from
= LEADING_CODE_EXT_11
, to
= LEADING_CODE_EXT_12
;
490 from
= LEADING_CODE_EXT_12
, to
= LEADING_CODE_EXT_21
;
495 from
= LEADING_CODE_EXT_21
, to
= LEADING_CODE_EXT_22
;
497 from
= LEADING_CODE_EXT_22
, to
= LEADING_CODE_EXT_MAX
+ 1;
500 for (charset
= from
; charset
< to
; charset
++)
501 if (!CHARSET_DEFINED_P (charset
)) break;
503 return make_number (charset
< to
? charset
: 0);
506 DEFUN ("define-charset", Fdefine_charset
, Sdefine_charset
, 3, 3, 0,
507 "Define CHARSET-ID as the identification number of CHARSET with INFO-VECTOR.\n\
508 If CHARSET-ID is nil, it is decided automatically, which means CHARSET is\n\
509 treated as a private charset.\n\
510 INFO-VECTOR is a vector of the format:\n\
511 [DIMENSION CHARS WIDTH DIRECTION ISO-FINAL-CHAR ISO-GRAPHIC-PLANE\n\
512 SHORT-NAME LONG-NAME DESCRIPTION]\n\
513 The meanings of each elements is as follows:\n\
514 DIMENSION (integer) is the number of bytes to represent a character: 1 or 2.\n\
515 CHARS (integer) is the number of characters in a dimension: 94 or 96.\n\
516 WIDTH (integer) is the number of columns a character in the charset\n\
517 occupies on the screen: one of 0, 1, and 2.\n\
519 DIRECTION (integer) is the rendering direction of characters in the\n\
520 charset when rendering. If 0, render from right to left, else\n\
521 render from left to right.\n\
523 ISO-FINAL-CHAR (character) is the final character of the\n\
524 corresponding ISO 2022 charset.\n\
526 ISO-GRAPHIC-PLANE (integer) is the graphic plane to be invoked\n\
527 while encoding to variants of ISO 2022 coding system, one of the\n\
528 following: 0/graphic-plane-left(GL), 1/graphic-plane-right(GR).\n\
530 SHORT-NAME (string) is the short name to refer to the charset.\n\
532 LONG-NAME (string) is the long name to refer to the charset.\n\
534 DESCRIPTION (string) is the description string of the charset.")
535 (charset_id
, charset_symbol
, info_vector
)
536 Lisp_Object charset_id
, charset_symbol
, info_vector
;
540 if (!NILP (charset_id
))
541 CHECK_NUMBER (charset_id
, 0);
542 CHECK_SYMBOL (charset_symbol
, 1);
543 CHECK_VECTOR (info_vector
, 2);
545 if (! NILP (charset_id
))
547 if (! CHARSET_VALID_P (XINT (charset_id
)))
548 error ("Invalid CHARSET: %d", XINT (charset_id
));
549 else if (CHARSET_DEFINED_P (XINT (charset_id
)))
550 error ("Already defined charset: %d", XINT (charset_id
));
553 vec
= XVECTOR (info_vector
)->contents
;
554 if (XVECTOR (info_vector
)->size
!= 9
555 || !INTEGERP (vec
[0]) || !(XINT (vec
[0]) == 1 || XINT (vec
[0]) == 2)
556 || !INTEGERP (vec
[1]) || !(XINT (vec
[1]) == 94 || XINT (vec
[1]) == 96)
557 || !INTEGERP (vec
[2]) || !(XINT (vec
[2]) == 1 || XINT (vec
[2]) == 2)
558 || !INTEGERP (vec
[3]) || !(XINT (vec
[3]) == 0 || XINT (vec
[3]) == 1)
559 || !INTEGERP (vec
[4]) || !(XINT (vec
[4]) >= '0' && XINT (vec
[4]) <= '~')
560 || !INTEGERP (vec
[5]) || !(XINT (vec
[5]) == 0 || XINT (vec
[5]) == 1)
563 || !STRINGP (vec
[8]))
564 error ("Invalid info-vector argument for defining charset %s",
565 XSYMBOL (charset_symbol
)->name
->data
);
567 if (NILP (charset_id
))
569 charset_id
= get_new_private_charset_id (XINT (vec
[0]), XINT (vec
[2]));
570 if (XINT (charset_id
) == 0)
571 error ("There's no room for a new private charset %s",
572 XSYMBOL (charset_symbol
)->name
->data
);
575 update_charset_table (charset_id
, vec
[0], vec
[1], vec
[2], vec
[3],
576 vec
[4], vec
[5], vec
[6], vec
[7], vec
[8]);
577 Fput (charset_symbol
, Qcharset
, CHARSET_TABLE_ENTRY (XINT (charset_id
)));
578 CHARSET_SYMBOL (XINT (charset_id
)) = charset_symbol
;
579 Vcharset_list
= Fcons (charset_symbol
, Vcharset_list
);
583 DEFUN ("get-unused-iso-final-char", Fget_unused_iso_final_char
,
584 Sget_unused_iso_final_char
, 2, 2, 0,
585 "Return an unsed ISO's final char for a charset of DIMENISION and CHARS.\n\
586 DIMENSION is the number of bytes to represent a character: 1 or 2.\n\
587 CHARS is the number of characters in a dimension: 94 or 96.\n\
589 This final char is for private use, thus the range is `0' (48) .. `?' (63).\n\
590 If there's no unused final char for the specified kind of charset,\n\
593 Lisp_Object dimension
, chars
;
597 CHECK_NUMBER (dimension
, 0);
598 CHECK_NUMBER (chars
, 1);
599 if (XINT (dimension
) != 1 && XINT (dimension
) != 2)
600 error ("Invalid charset dimension %d, it should be 1 or 2",
602 if (XINT (chars
) != 94 && XINT (chars
) != 96)
603 error ("Invalid charset chars %d, it should be 94 or 96",
605 for (final_char
= '0'; final_char
<= '?'; final_char
++)
607 if (ISO_CHARSET_TABLE (dimension
, chars
, make_number (final_char
)) < 0)
610 return (final_char
<= '?' ? make_number (final_char
) : Qnil
);
613 DEFUN ("declare-equiv-charset", Fdeclare_equiv_charset
, Sdeclare_equiv_charset
,
615 "Declare a charset of DIMENSION, CHARS, FINAL-CHAR is the same as CHARSET.\n\
616 CHARSET should be defined by `defined-charset' in advance.")
617 (dimension
, chars
, final_char
, charset_symbol
)
618 Lisp_Object dimension
, chars
, final_char
, charset_symbol
;
622 CHECK_NUMBER (dimension
, 0);
623 CHECK_NUMBER (chars
, 1);
624 CHECK_NUMBER (final_char
, 2);
625 CHECK_SYMBOL (charset_symbol
, 3);
627 if (XINT (dimension
) != 1 && XINT (dimension
) != 2)
628 error ("Invalid DIMENSION %d, it should be 1 or 2", XINT (dimension
));
629 if (XINT (chars
) != 94 && XINT (chars
) != 96)
630 error ("Invalid CHARS %d, it should be 94 or 96", XINT (chars
));
631 if (XINT (final_char
) < '0' || XFASTINT (final_char
) > '~')
632 error ("Invalid FINAL-CHAR %c, it should be `0'..`~'", XINT (chars
));
633 if ((charset
= get_charset_id (charset_symbol
)) < 0)
634 error ("Invalid charset %s", XSYMBOL (charset_symbol
)->name
->data
);
636 ISO_CHARSET_TABLE (dimension
, chars
, final_char
) = charset
;
640 /* Return number of different charsets in STR of length LEN. In
641 addition, for each found charset N, CHARSETS[N] is set 1. The
642 caller should allocate CHARSETS (MAX_CHARSET + 1 elements) in advance.
643 It may lookup a translation table TABLE if supplied.
645 If CMPCHARP is nonzero and some composite character is found,
646 CHARSETS[128] is also set 1 and the returned number is incremented
650 find_charset_in_str (str
, len
, charsets
, table
, cmpcharp
)
656 register int num
= 0, c
;
658 if (! CHAR_TABLE_P (table
))
666 if (c
== LEADING_CODE_COMPOSITION
)
668 int cmpchar_id
= str_cmpchar_id (str
, len
);
673 struct cmpchar_info
*cmpcharp
= cmpchar_table
[cmpchar_id
];
676 for (i
= 0; i
< cmpcharp
->glyph_len
; i
++)
678 c
= cmpcharp
->glyph
[i
];
681 if ((c
= translate_char (table
, c
, 0, 0, 0)) < 0)
682 c
= cmpcharp
->glyph
[i
];
684 if ((charset
= CHAR_CHARSET (c
)) < 0)
685 charset
= CHARSET_ASCII
;
686 if (!charsets
[charset
])
688 charsets
[charset
] = 1;
692 str
+= cmpcharp
->len
;
693 len
-= cmpcharp
->len
;
697 charset
= CHARSET_ASCII
;
702 c
= STRING_CHAR_AND_LENGTH (str
, len
, bytes
);
705 int c1
= translate_char (table
, c
, 0, 0, 0);
709 charset
= CHAR_CHARSET (c
);
712 if (!charsets
[charset
])
714 charsets
[charset
] = 1;
723 DEFUN ("find-charset-region", Ffind_charset_region
, Sfind_charset_region
,
725 "Return a list of charsets in the region between BEG and END.\n\
726 BEG and END are buffer positions.\n\
727 Optional arg TABLE if non-nil is a translation table to look up.")
729 Lisp_Object beg
, end
, table
;
731 int charsets
[MAX_CHARSET
+ 1];
732 int from
, from_byte
, to
, stop
, stop_byte
, i
;
735 validate_region (&beg
, &end
);
736 from
= XFASTINT (beg
);
737 stop
= to
= XFASTINT (end
);
739 if (from
< GPT
&& GPT
< to
)
742 stop_byte
= GPT_BYTE
;
745 stop_byte
= CHAR_TO_BYTE (stop
);
747 from_byte
= CHAR_TO_BYTE (from
);
749 bzero (charsets
, (MAX_CHARSET
+ 1) * sizeof (int));
752 find_charset_in_str (BYTE_POS_ADDR (from_byte
), stop_byte
- from_byte
,
756 from
= stop
, from_byte
= stop_byte
;
757 stop
= to
, stop_byte
= CHAR_TO_BYTE (stop
);
764 for (i
= MAX_CHARSET
; i
>= 0; i
--)
766 val
= Fcons (CHARSET_SYMBOL (i
), val
);
770 DEFUN ("find-charset-string", Ffind_charset_string
, Sfind_charset_string
,
772 "Return a list of charsets in STR.\n\
773 Optional arg TABLE if non-nil is a translation table to look up.")
775 Lisp_Object str
, table
;
777 int charsets
[MAX_CHARSET
+ 1];
781 CHECK_STRING (str
, 0);
783 if (! STRING_MULTIBYTE (str
))
786 bzero (charsets
, (MAX_CHARSET
+ 1) * sizeof (int));
787 find_charset_in_str (XSTRING (str
)->data
, STRING_BYTES (XSTRING (str
)),
790 for (i
= MAX_CHARSET
; i
>= 0; i
--)
792 val
= Fcons (CHARSET_SYMBOL (i
), val
);
796 DEFUN ("make-char-internal", Fmake_char_internal
, Smake_char_internal
, 1, 3, 0,
798 (charset
, code1
, code2
)
799 Lisp_Object charset
, code1
, code2
;
801 CHECK_NUMBER (charset
, 0);
804 XSETFASTINT (code1
, 0);
806 CHECK_NUMBER (code1
, 1);
808 XSETFASTINT (code2
, 0);
810 CHECK_NUMBER (code2
, 2);
812 if (!CHARSET_DEFINED_P (XINT (charset
)))
813 error ("Invalid charset: %d", XINT (charset
));
815 return make_number (MAKE_CHAR (XINT (charset
), XINT (code1
), XINT (code2
)));
818 DEFUN ("split-char", Fsplit_char
, Ssplit_char
, 1, 1, 0,
819 "Return list of charset and one or two position-codes of CHAR.")
826 CHECK_NUMBER (ch
, 0);
827 SPLIT_CHAR (XFASTINT (ch
), charset
, c1
, c2
);
829 ? Fcons (CHARSET_SYMBOL (charset
),
830 Fcons (make_number (c1
), Fcons (make_number (c2
), Qnil
)))
831 : Fcons (CHARSET_SYMBOL (charset
), Fcons (make_number (c1
), Qnil
)));
834 DEFUN ("char-charset", Fchar_charset
, Schar_charset
, 1, 1, 0,
835 "Return charset of CHAR.")
839 CHECK_NUMBER (ch
, 0);
841 return CHARSET_SYMBOL (CHAR_CHARSET (XINT (ch
)));
844 DEFUN ("charset-after", Fcharset_after
, Scharset_after
, 0, 1, 0,
845 "Return charset of a character in current buffer at position POS.\n\
846 If POS is nil, it defauls to the current point.")
850 register int pos_byte
, c
, charset
;
851 register unsigned char *p
;
855 else if (MARKERP (pos
))
856 pos_byte
= marker_byte_position (pos
);
859 CHECK_NUMBER (pos
, 0);
860 pos_byte
= CHAR_TO_BYTE (XINT (pos
));
862 p
= BYTE_POS_ADDR (pos_byte
);
863 c
= STRING_CHAR (p
, Z_BYTE
- pos_byte
);
864 charset
= CHAR_CHARSET (c
);
865 return CHARSET_SYMBOL (charset
);
868 DEFUN ("iso-charset", Fiso_charset
, Siso_charset
, 3, 3, 0,
869 "Return charset of ISO's specification DIMENSION, CHARS, and FINAL-CHAR.\n\
871 ISO 2022's designation sequence (escape sequence) distinguishes charsets\n\
872 by their DIMENSION, CHARS, and FINAL-CHAR,\n\
873 where as Emacs distinguishes them by charset symbol.\n\
874 See the documentation of the function `charset-info' for the meanings of\n\
875 DIMENSION, CHARS, and FINAL-CHAR.")
876 (dimension
, chars
, final_char
)
877 Lisp_Object dimension
, chars
, final_char
;
881 CHECK_NUMBER (dimension
, 0);
882 CHECK_NUMBER (chars
, 1);
883 CHECK_NUMBER (final_char
, 2);
885 if ((charset
= ISO_CHARSET_TABLE (dimension
, chars
, final_char
)) < 0)
887 return CHARSET_SYMBOL (charset
);
890 /* If GENERICP is nonzero, return nonzero iff C is a valid normal or
891 generic character. If GENERICP is zero, return nonzero iff C is a
892 valid normal character. Do not call this function directly,
893 instead use macro CHAR_VALID_P. */
895 char_valid_p (c
, genericp
)
902 if (SINGLE_BYTE_CHAR_P (c
))
904 SPLIT_NON_ASCII_CHAR (c
, charset
, c1
, c2
);
905 if (!CHARSET_VALID_P (charset
))
907 return (c
< MIN_CHAR_COMPOSITION
908 ? ((c
& CHAR_FIELD1_MASK
) /* i.e. dimension of C is two. */
909 ? (genericp
&& c1
== 0 && c2
== 0
910 || c1
>= 32 && c2
>= 32)
911 : (genericp
&& c1
== 0
913 : c
< MIN_CHAR_COMPOSITION
+ n_cmpchars
);
916 DEFUN ("char-valid-p", Fchar_valid_p
, Schar_valid_p
, 1, 2, 0,
917 "Return t if OBJECT is a valid normal character.\n\
918 If optional arg GENERICP is non-nil, also return t if OBJECT is\n\
919 a valid generic character.")
921 Lisp_Object object
, genericp
;
923 if (! NATNUMP (object
))
925 return (CHAR_VALID_P (XFASTINT (object
), !NILP (genericp
)) ? Qt
: Qnil
);
928 DEFUN ("unibyte-char-to-multibyte", Funibyte_char_to_multibyte
,
929 Sunibyte_char_to_multibyte
, 1, 1, 0,
930 "Convert the unibyte character CH to multibyte character.\n\
931 The conversion is done based on `nonascii-translation-table' (which see)\n\
932 or `nonascii-insert-offset' (which see).")
938 CHECK_NUMBER (ch
, 0);
940 if (c
< 0 || c
>= 0400)
941 error ("Invalid unibyte character: %d", c
);
942 c
= unibyte_char_to_multibyte (c
);
944 error ("Can't convert to multibyte character: %d", XINT (ch
));
945 return make_number (c
);
948 DEFUN ("char-bytes", Fchar_bytes
, Schar_bytes
, 1, 1, 0,
949 "Return byte length of multi-byte form of CHAR.")
956 CHECK_NUMBER (ch
, 0);
957 if (COMPOSITE_CHAR_P (XFASTINT (ch
)))
959 unsigned int id
= COMPOSITE_CHAR_ID (XFASTINT (ch
));
961 bytes
= (id
< n_cmpchars
? cmpchar_table
[id
]->len
: 1);
965 int charset
= CHAR_CHARSET (XFASTINT (ch
));
967 bytes
= CHARSET_DEFINED_P (charset
) ? CHARSET_BYTES (charset
) : 1;
970 XSETFASTINT (val
, bytes
);
974 /* Return the width of character of which multi-byte form starts with
975 C. The width is measured by how many columns occupied on the
976 screen when displayed in the current buffer. */
978 #define ONE_BYTE_CHAR_WIDTH(c) \
981 ? XFASTINT (current_buffer->tab_width) \
982 : (c == '\n' ? 0 : (NILP (current_buffer->ctl_arrow) ? 4 : 2))) \
986 ? (NILP (current_buffer->ctl_arrow) ? 4 : 2) \
987 : ((! NILP (current_buffer->enable_multibyte_characters) \
988 && BASE_LEADING_CODE_P (c)) \
989 ? WIDTH_BY_CHAR_HEAD (c) \
992 DEFUN ("char-width", Fchar_width
, Schar_width
, 1, 1, 0,
993 "Return width of CHAR when displayed in the current buffer.\n\
994 The width is measured by how many columns it occupies on the screen.")
998 Lisp_Object val
, disp
;
1000 struct Lisp_Char_Table
*dp
= buffer_display_table ();
1002 CHECK_NUMBER (ch
, 0);
1006 /* Get the way the display table would display it. */
1007 disp
= dp
? DISP_CHAR_VECTOR (dp
, c
) : Qnil
;
1010 XSETINT (val
, XVECTOR (disp
)->size
);
1011 else if (SINGLE_BYTE_CHAR_P (c
))
1012 XSETINT (val
, ONE_BYTE_CHAR_WIDTH (c
));
1013 else if (COMPOSITE_CHAR_P (c
))
1015 int id
= COMPOSITE_CHAR_ID (XFASTINT (ch
));
1016 XSETFASTINT (val
, (id
< n_cmpchars
? cmpchar_table
[id
]->width
: 0));
1020 int charset
= CHAR_CHARSET (c
);
1022 XSETFASTINT (val
, CHARSET_WIDTH (charset
));
1027 /* Return width of string STR of length LEN when displayed in the
1028 current buffer. The width is measured by how many columns it
1029 occupies on the screen. */
1036 unsigned char *endp
= str
+ len
;
1038 struct Lisp_Char_Table
*dp
= buffer_display_table ();
1042 if (*str
== LEADING_CODE_COMPOSITION
)
1044 int id
= str_cmpchar_id (str
, endp
- str
);
1053 width
+= cmpchar_table
[id
]->width
;
1054 str
+= cmpchar_table
[id
]->len
;
1061 int c
= STRING_CHAR_AND_LENGTH (str
, endp
- str
, thislen
);
1063 /* Get the way the display table would display it. */
1065 disp
= DISP_CHAR_VECTOR (dp
, c
);
1070 width
+= XVECTOR (disp
)->size
;
1072 width
+= ONE_BYTE_CHAR_WIDTH (*str
);
1080 DEFUN ("string-width", Fstring_width
, Sstring_width
, 1, 1, 0,
1081 "Return width of STRING when displayed in the current buffer.\n\
1082 Width is measured by how many columns it occupies on the screen.\n\
1083 When calculating width of a multibyte character in STRING,\n\
1084 only the base leading-code is considered; the validity of\n\
1085 the following bytes is not checked.")
1091 CHECK_STRING (str
, 0);
1092 XSETFASTINT (val
, strwidth (XSTRING (str
)->data
,
1093 STRING_BYTES (XSTRING (str
))));
1097 DEFUN ("char-direction", Fchar_direction
, Schar_direction
, 1, 1, 0,
1098 "Return the direction of CHAR.\n\
1099 The returned value is 0 for left-to-right and 1 for right-to-left.")
1105 CHECK_NUMBER (ch
, 0);
1106 charset
= CHAR_CHARSET (XFASTINT (ch
));
1107 if (!CHARSET_DEFINED_P (charset
))
1108 invalid_character (XINT (ch
));
1109 return CHARSET_TABLE_INFO (charset
, CHARSET_DIRECTION_IDX
);
1112 DEFUN ("chars-in-region", Fchars_in_region
, Schars_in_region
, 2, 2, 0,
1113 "Return number of characters between BEG and END.")
1115 Lisp_Object beg
, end
;
1119 from
= min (XFASTINT (beg
), XFASTINT (end
));
1120 to
= max (XFASTINT (beg
), XFASTINT (end
));
1122 return make_number (to
- from
);
1125 /* Return the number of characters in the NBYTES bytes at PTR.
1126 This works by looking at the contents and checking for multibyte sequences.
1127 However, if the current buffer has enable-multibyte-characters = nil,
1128 we treat each byte as a character. */
1131 chars_in_text (ptr
, nbytes
)
1135 unsigned char *endp
, c
;
1138 /* current_buffer is null at early stages of Emacs initialization. */
1139 if (current_buffer
== 0
1140 || NILP (current_buffer
->enable_multibyte_characters
))
1143 endp
= ptr
+ nbytes
;
1150 if (BASE_LEADING_CODE_P (c
))
1151 while (ptr
< endp
&& ! CHAR_HEAD_P (*ptr
)) ptr
++;
1158 /* Return the number of characters in the NBYTES bytes at PTR.
1159 This works by looking at the contents and checking for multibyte sequences.
1160 It ignores enable-multibyte-characters. */
1163 multibyte_chars_in_text (ptr
, nbytes
)
1167 unsigned char *endp
, c
;
1170 endp
= ptr
+ nbytes
;
1177 if (BASE_LEADING_CODE_P (c
))
1178 while (ptr
< endp
&& ! CHAR_HEAD_P (*ptr
)) ptr
++;
1185 DEFUN ("string", Fstring
, Sstring
, 1, MANY
, 0,
1186 "Concatenate all the argument characters and make the result a string.")
1193 = (unsigned char *) alloca (MAX_LENGTH_OF_MULTI_BYTE_FORM
* n
);
1194 unsigned char *p
= buf
;
1197 for (i
= 0; i
< n
; i
++)
1202 if (!INTEGERP (args
[i
]))
1203 CHECK_NUMBER (args
[i
], 0);
1205 len
= CHAR_STRING (c
, p
, str
);
1207 /* C is a composite character. */
1208 bcopy (str
, p
, len
);
1212 val
= make_string_from_bytes (buf
, n
, p
- buf
);
1218 /*** Composite characters staffs ***/
1220 /* Each composite character is identified by CMPCHAR-ID which is
1221 assigned when Emacs needs the character code of the composite
1222 character (e.g. when displaying it on the screen). See the
1223 document "GENERAL NOTE on COMPOSITE CHARACTER" in `charset.h' how a
1224 composite character is represented in Emacs. */
1226 /* If `static' is defined, it means that it is defined to null string. */
1228 /* The following function is copied from lread.c. */
1230 hash_string (ptr
, len
)
1234 register unsigned char *p
= ptr
;
1235 register unsigned char *end
= p
+ len
;
1236 register unsigned char c
;
1237 register int hash
= 0;
1242 if (c
>= 0140) c
-= 40;
1243 hash
= ((hash
<<3) + (hash
>>28) + c
);
1245 return hash
& 07777777777;
1249 #define CMPCHAR_HASH_TABLE_SIZE 0xFFF
1251 static int *cmpchar_hash_table
[CMPCHAR_HASH_TABLE_SIZE
];
1253 /* Each element of `cmpchar_hash_table' is a pointer to an array of
1254 integer, where the 1st element is the size of the array, the 2nd
1255 element is how many elements are actually used in the array, and
1256 the remaining elements are CMPCHAR-IDs of composite characters of
1257 the same hash value. */
1258 #define CMPCHAR_HASH_SIZE(table) table[0]
1259 #define CMPCHAR_HASH_USED(table) table[1]
1260 #define CMPCHAR_HASH_CMPCHAR_ID(table, i) table[i]
1262 /* Return CMPCHAR-ID of the composite character in STR of the length
1263 LEN. If the composite character has not yet been registered,
1264 register it in `cmpchar_table' and assign new CMPCHAR-ID. This
1265 is the sole function for assigning CMPCHAR-ID. */
1267 str_cmpchar_id (str
, len
)
1268 const unsigned char *str
;
1271 int hash_idx
, *hashp
;
1273 int embedded_rule
; /* 1 if composition rule is embedded. */
1274 int chars
; /* number of components. */
1276 struct cmpchar_info
*cmpcharp
;
1278 /* The second byte 0xFF means compostion rule is embedded. */
1279 embedded_rule
= (str
[1] == 0xFF);
1281 /* At first, get the actual length of the composite character. */
1283 const unsigned char *p
, *endp
= str
+ 1, *lastp
= str
+ len
;
1286 while (endp
< lastp
&& ! CHAR_HEAD_P (*endp
)) endp
++;
1288 /* Any composite char have at least 5-byte length. */
1295 if (embedded_rule
) p
++;
1296 /* No need of checking if *P is 0xA0 because
1297 BYTES_BY_CHAR_HEAD (0x80) surely returns 2. */
1298 p
+= BYTES_BY_CHAR_HEAD (*p
- 0x20);
1301 if (p
> endp
|| chars
< 2 || chars
> MAX_COMPONENT_COUNT
)
1302 /* Invalid components. */
1306 hash_idx
= hash_string (str
, len
) % CMPCHAR_HASH_TABLE_SIZE
;
1307 hashp
= cmpchar_hash_table
[hash_idx
];
1309 /* Then, look into the hash table. */
1311 /* Find the correct one among composite characters of the same
1313 for (i
= 2; i
< CMPCHAR_HASH_USED (hashp
); i
++)
1315 cmpcharp
= cmpchar_table
[CMPCHAR_HASH_CMPCHAR_ID (hashp
, i
)];
1316 if (len
== cmpcharp
->len
1317 && ! bcmp (str
, cmpcharp
->data
, len
))
1318 return CMPCHAR_HASH_CMPCHAR_ID (hashp
, i
);
1321 /* We have to register the composite character in cmpchar_table. */
1322 if (n_cmpchars
> (CHAR_FIELD2_MASK
| CHAR_FIELD3_MASK
))
1323 /* No, we have no more room for a new composite character. */
1326 /* Make the entry in hash table. */
1329 /* Make a table for 8 composite characters initially. */
1330 hashp
= (cmpchar_hash_table
[hash_idx
]
1331 = (int *) xmalloc (sizeof (int) * (2 + 8)));
1332 CMPCHAR_HASH_SIZE (hashp
) = 10;
1333 CMPCHAR_HASH_USED (hashp
) = 2;
1335 else if (CMPCHAR_HASH_USED (hashp
) >= CMPCHAR_HASH_SIZE (hashp
))
1337 CMPCHAR_HASH_SIZE (hashp
) += 8;
1338 hashp
= (cmpchar_hash_table
[hash_idx
]
1339 = (int *) xrealloc (hashp
,
1340 sizeof (int) * CMPCHAR_HASH_SIZE (hashp
)));
1342 CMPCHAR_HASH_CMPCHAR_ID (hashp
, CMPCHAR_HASH_USED (hashp
)) = n_cmpchars
;
1343 CMPCHAR_HASH_USED (hashp
)++;
1345 /* Set information of the composite character in cmpchar_table. */
1346 if (cmpchar_table_size
== 0)
1348 /* This is the first composite character to be registered. */
1349 cmpchar_table_size
= 256;
1351 = (struct cmpchar_info
**) xmalloc (sizeof (cmpchar_table
[0])
1352 * cmpchar_table_size
);
1354 else if (cmpchar_table_size
<= n_cmpchars
)
1356 cmpchar_table_size
+= 256;
1358 = (struct cmpchar_info
**) xrealloc (cmpchar_table
,
1359 sizeof (cmpchar_table
[0])
1360 * cmpchar_table_size
);
1363 cmpcharp
= (struct cmpchar_info
*) xmalloc (sizeof (struct cmpchar_info
));
1365 cmpcharp
->len
= len
;
1366 cmpcharp
->data
= (unsigned char *) xmalloc (len
+ 1);
1367 bcopy (str
, cmpcharp
->data
, len
);
1368 cmpcharp
->data
[len
] = 0;
1369 cmpcharp
->glyph_len
= chars
;
1370 cmpcharp
->glyph
= (GLYPH
*) xmalloc (sizeof (GLYPH
) * chars
);
1373 cmpcharp
->cmp_rule
= (unsigned char *) xmalloc (chars
);
1374 cmpcharp
->col_offset
= (float *) xmalloc (sizeof (float) * chars
);
1378 cmpcharp
->cmp_rule
= NULL
;
1379 cmpcharp
->col_offset
= NULL
;
1382 /* Setup GLYPH data and composition rules (if any) so as not to make
1383 them every time on displaying. */
1385 unsigned char *bufp
;
1387 float leftmost
= 0.0, rightmost
= 1.0;
1390 /* At first, col_offset[N] is set to relative to col_offset[0]. */
1391 cmpcharp
->col_offset
[0] = 0;
1393 for (i
= 0, bufp
= cmpcharp
->data
+ 1; i
< chars
; i
++)
1396 cmpcharp
->cmp_rule
[i
] = *bufp
++;
1398 if (*bufp
== 0xA0) /* This is an ASCII character. */
1400 cmpcharp
->glyph
[i
] = FAST_MAKE_GLYPH ((*++bufp
& 0x7F), 0);
1404 else /* Multibyte character. */
1406 /* Make `bufp' point normal multi-byte form temporally. */
1409 = FAST_MAKE_GLYPH (string_to_non_ascii_char (bufp
, 4, 0, 0), 0);
1410 width
= WIDTH_BY_CHAR_HEAD (*bufp
);
1412 bufp
+= BYTES_BY_CHAR_HEAD (*bufp
- 0x20);
1415 if (embedded_rule
&& i
> 0)
1417 /* Reference points (global_ref and new_ref) are
1428 Now, we calculate the column offset of the new glyph
1429 from the left edge of the first glyph. This can avoid
1430 the same calculation everytime displaying this
1431 composite character. */
1433 /* Reference points of global glyph and new glyph. */
1434 int global_ref
= (cmpcharp
->cmp_rule
[i
] - 0xA0) / 9;
1435 int new_ref
= (cmpcharp
->cmp_rule
[i
] - 0xA0) % 9;
1436 /* Column offset relative to the first glyph. */
1437 float left
= (leftmost
1438 + (global_ref
% 3) * (rightmost
- leftmost
) / 2.0
1439 - (new_ref
% 3) * width
/ 2.0);
1441 cmpcharp
->col_offset
[i
] = left
;
1442 if (left
< leftmost
)
1444 if (left
+ width
> rightmost
)
1445 rightmost
= left
+ width
;
1449 if (width
> rightmost
)
1455 /* Now col_offset[N] are relative to the left edge of the
1456 first component. Make them relative to the left edge of
1458 for (i
= 0; i
< chars
; i
++)
1459 cmpcharp
->col_offset
[i
] -= leftmost
;
1460 /* Make rightmost holds width of overall glyph. */
1461 rightmost
-= leftmost
;
1464 cmpcharp
->width
= rightmost
;
1465 if (cmpcharp
->width
< rightmost
)
1466 /* To get a ceiling integer value. */
1470 cmpchar_table
[n_cmpchars
] = cmpcharp
;
1472 return n_cmpchars
++;
1475 /* Return the Nth element of the composite character C. */
1477 cmpchar_component (c
, n
)
1480 int id
= COMPOSITE_CHAR_ID (c
);
1482 if (id
>= n_cmpchars
/* C is not a valid composite character. */
1483 || n
>= cmpchar_table
[id
]->glyph_len
) /* No such component. */
1485 /* No face data is stored in glyph code. */
1486 return ((int) (cmpchar_table
[id
]->glyph
[n
]));
1489 DEFUN ("cmpcharp", Fcmpcharp
, Scmpcharp
, 1, 1, 0,
1490 "T if CHAR is a composite character.")
1494 CHECK_NUMBER (ch
, 0);
1495 return (COMPOSITE_CHAR_P (XINT (ch
)) ? Qt
: Qnil
);
1498 DEFUN ("composite-char-component", Fcmpchar_component
, Scmpchar_component
,
1500 "Return the IDXth component character of composite character CHARACTER.")
1502 Lisp_Object character
, idx
;
1506 CHECK_NUMBER (character
, 0);
1507 CHECK_NUMBER (idx
, 1);
1509 if ((c
= cmpchar_component (XINT (character
), XINT (idx
))) < 0)
1510 args_out_of_range (character
, idx
);
1512 return make_number (c
);
1515 DEFUN ("composite-char-composition-rule", Fcmpchar_cmp_rule
, Scmpchar_cmp_rule
,
1517 "Return the Nth composition rule embedded in composite character CHARACTER.\n\
1518 The returned rule is for composing the Nth component\n\
1519 on the (N-1)th component. If N is 0, the returned value is always 255.")
1521 Lisp_Object character
, n
;
1525 CHECK_NUMBER (character
, 0);
1526 CHECK_NUMBER (n
, 1);
1528 id
= COMPOSITE_CHAR_ID (XINT (character
));
1529 if (id
< 0 || id
>= n_cmpchars
)
1530 error ("Invalid composite character: %d", XINT (character
));
1532 if (i
> cmpchar_table
[id
]->glyph_len
)
1533 args_out_of_range (character
, n
);
1535 return make_number (cmpchar_table
[id
]->cmp_rule
[i
]);
1538 DEFUN ("composite-char-composition-rule-p", Fcmpchar_cmp_rule_p
,
1539 Scmpchar_cmp_rule_p
, 1, 1, 0,
1540 "Return non-nil if composite character CHARACTER contains a embedded rule.")
1542 Lisp_Object character
;
1546 CHECK_NUMBER (character
, 0);
1547 id
= COMPOSITE_CHAR_ID (XINT (character
));
1548 if (id
< 0 || id
>= n_cmpchars
)
1549 error ("Invalid composite character: %d", XINT (character
));
1551 return (cmpchar_table
[id
]->cmp_rule
? Qt
: Qnil
);
1554 DEFUN ("composite-char-component-count", Fcmpchar_cmp_count
,
1555 Scmpchar_cmp_count
, 1, 1, 0,
1556 "Return number of compoents of composite character CHARACTER.")
1558 Lisp_Object character
;
1562 CHECK_NUMBER (character
, 0);
1563 id
= COMPOSITE_CHAR_ID (XINT (character
));
1564 if (id
< 0 || id
>= n_cmpchars
)
1565 error ("Invalid composite character: %d", XINT (character
));
1567 return (make_number (cmpchar_table
[id
]->glyph_len
));
1570 DEFUN ("compose-string", Fcompose_string
, Scompose_string
,
1572 "Return one char string composed from all characters in STRING.")
1576 unsigned char buf
[MAX_LENGTH_OF_MULTI_BYTE_FORM
], *p
, *pend
, *ptemp
;
1579 CHECK_STRING (str
, 0);
1581 buf
[0] = LEADING_CODE_COMPOSITION
;
1582 p
= XSTRING (str
)->data
;
1583 pend
= p
+ STRING_BYTES (XSTRING (str
));
1587 if (*p
< 0x20 || *p
== 127) /* control code */
1588 error ("Invalid component character: %d", *p
);
1589 else if (*p
< 0x80) /* ASCII */
1591 if (i
+ 2 >= MAX_LENGTH_OF_MULTI_BYTE_FORM
)
1592 error ("Too long string to be composed: %s", XSTRING (str
)->data
);
1593 /* Prepend an ASCII charset indicator 0xA0, set MSB of the
1596 buf
[i
++] = *p
++ + 0x80;
1598 else if (*p
== LEADING_CODE_COMPOSITION
) /* composite char */
1600 /* Already composed. Eliminate the heading
1601 LEADING_CODE_COMPOSITION, keep the remaining bytes
1605 while (! CHAR_HEAD_P (*p
)) p
++;
1606 if (i
+ (p
- ptemp
) >= MAX_LENGTH_OF_MULTI_BYTE_FORM
)
1607 error ("Too long string to be composed: %s", XSTRING (str
)->data
);
1608 bcopy (ptemp
, buf
+ i
, p
- ptemp
);
1611 else /* multibyte char */
1613 /* Add 0x20 to the base leading-code, keep the remaining
1615 len
= BYTES_BY_CHAR_HEAD (*p
);
1616 if (i
+ len
>= MAX_LENGTH_OF_MULTI_BYTE_FORM
)
1617 error ("Too long string to be composed: %s", XSTRING (str
)->data
);
1618 bcopy (p
, buf
+ i
, len
);
1625 /* STR contains only one character, which can't be composed. */
1626 error ("Too short string to be composed: %s", XSTRING (str
)->data
);
1628 return make_string_from_bytes (buf
, 1, i
);
1633 charset_id_internal (charset_name
)
1636 Lisp_Object val
= Fget (intern (charset_name
), Qcharset
);
1639 error ("Charset %s is not defined", charset_name
);
1641 return (XINT (XVECTOR (val
)->contents
[0]));
1644 DEFUN ("setup-special-charsets", Fsetup_special_charsets
,
1645 Ssetup_special_charsets
, 0, 0, 0, "Internal use only.")
1648 charset_latin_iso8859_1
= charset_id_internal ("latin-iso8859-1");
1649 charset_jisx0208_1978
= charset_id_internal ("japanese-jisx0208-1978");
1650 charset_jisx0208
= charset_id_internal ("japanese-jisx0208");
1651 charset_katakana_jisx0201
= charset_id_internal ("katakana-jisx0201");
1652 charset_latin_jisx0201
= charset_id_internal ("latin-jisx0201");
1653 charset_big5_1
= charset_id_internal ("chinese-big5-1");
1654 charset_big5_2
= charset_id_internal ("chinese-big5-2");
1659 init_charset_once ()
1663 staticpro (&Vcharset_table
);
1664 staticpro (&Vcharset_symbol_table
);
1666 /* This has to be done here, before we call Fmake_char_table. */
1667 Qcharset_table
= intern ("charset-table");
1668 staticpro (&Qcharset_table
);
1670 /* Intern this now in case it isn't already done.
1671 Setting this variable twice is harmless.
1672 But don't staticpro it here--that is done in alloc.c. */
1673 Qchar_table_extra_slots
= intern ("char-table-extra-slots");
1675 /* Now we are ready to set up this property, so we can
1676 create the charset table. */
1677 Fput (Qcharset_table
, Qchar_table_extra_slots
, make_number (0));
1678 Vcharset_table
= Fmake_char_table (Qcharset_table
, Qnil
);
1680 Vcharset_symbol_table
= Fmake_vector (make_number (MAX_CHARSET
+ 1), Qnil
);
1683 for (i
= 0; i
< 2; i
++)
1684 for (j
= 0; j
< 2; j
++)
1685 for (k
= 0; k
< 128; k
++)
1686 iso_charset_table
[i
][j
][k
] = -1;
1688 bzero (cmpchar_hash_table
, sizeof cmpchar_hash_table
);
1689 cmpchar_table_size
= n_cmpchars
= 0;
1691 for (i
= 0; i
< 256; i
++)
1692 BYTES_BY_CHAR_HEAD (i
) = 1;
1693 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_11
) = 3;
1694 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_12
) = 3;
1695 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_21
) = 4;
1696 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_22
) = 4;
1697 /* The following doesn't reflect the actual bytes, but just to tell
1698 that it is a start of a multibyte character. */
1699 BYTES_BY_CHAR_HEAD (LEADING_CODE_COMPOSITION
) = 2;
1701 for (i
= 0; i
< 128; i
++)
1702 WIDTH_BY_CHAR_HEAD (i
) = 1;
1703 for (; i
< 256; i
++)
1704 WIDTH_BY_CHAR_HEAD (i
) = 4;
1705 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_11
) = 1;
1706 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_12
) = 2;
1707 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_21
) = 1;
1708 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_22
) = 2;
1716 Qascii
= intern ("ascii");
1717 staticpro (&Qascii
);
1719 Qcharset
= intern ("charset");
1720 staticpro (&Qcharset
);
1722 /* Define ASCII charset now. */
1723 update_charset_table (make_number (CHARSET_ASCII
),
1724 make_number (1), make_number (94),
1729 build_string ("ASCII"),
1730 build_string ("ASCII"),
1731 build_string ("ASCII (ISO646 IRV)"));
1732 CHARSET_SYMBOL (CHARSET_ASCII
) = Qascii
;
1733 Fput (Qascii
, Qcharset
, CHARSET_TABLE_ENTRY (CHARSET_ASCII
));
1735 Qcomposition
= intern ("composition");
1736 staticpro (&Qcomposition
);
1737 CHARSET_SYMBOL (CHARSET_COMPOSITION
) = Qcomposition
;
1739 defsubr (&Sdefine_charset
);
1740 defsubr (&Sget_unused_iso_final_char
);
1741 defsubr (&Sdeclare_equiv_charset
);
1742 defsubr (&Sfind_charset_region
);
1743 defsubr (&Sfind_charset_string
);
1744 defsubr (&Smake_char_internal
);
1745 defsubr (&Ssplit_char
);
1746 defsubr (&Schar_charset
);
1747 defsubr (&Scharset_after
);
1748 defsubr (&Siso_charset
);
1749 defsubr (&Schar_valid_p
);
1750 defsubr (&Sunibyte_char_to_multibyte
);
1751 defsubr (&Schar_bytes
);
1752 defsubr (&Schar_width
);
1753 defsubr (&Sstring_width
);
1754 defsubr (&Schar_direction
);
1755 defsubr (&Schars_in_region
);
1757 defsubr (&Scmpcharp
);
1758 defsubr (&Scmpchar_component
);
1759 defsubr (&Scmpchar_cmp_rule
);
1760 defsubr (&Scmpchar_cmp_rule_p
);
1761 defsubr (&Scmpchar_cmp_count
);
1762 defsubr (&Scompose_string
);
1763 defsubr (&Ssetup_special_charsets
);
1765 DEFVAR_LISP ("charset-list", &Vcharset_list
,
1766 "List of charsets ever defined.");
1767 Vcharset_list
= Fcons (Qascii
, Qnil
);
1769 DEFVAR_LISP ("translation-table-vector", &Vtranslation_table_vector
,
1770 "Vector of cons cell of a symbol and translation table ever defined.\n\
1771 An ID of a translation table is an index of this vector.");
1772 Vtranslation_table_vector
= Fmake_vector (make_number (16), Qnil
);
1774 DEFVAR_INT ("leading-code-composition", &leading_code_composition
,
1775 "Leading-code of composite characters.");
1776 leading_code_composition
= LEADING_CODE_COMPOSITION
;
1778 DEFVAR_INT ("leading-code-private-11", &leading_code_private_11
,
1779 "Leading-code of private TYPE9N charset of column-width 1.");
1780 leading_code_private_11
= LEADING_CODE_PRIVATE_11
;
1782 DEFVAR_INT ("leading-code-private-12", &leading_code_private_12
,
1783 "Leading-code of private TYPE9N charset of column-width 2.");
1784 leading_code_private_12
= LEADING_CODE_PRIVATE_12
;
1786 DEFVAR_INT ("leading-code-private-21", &leading_code_private_21
,
1787 "Leading-code of private TYPE9Nx9N charset of column-width 1.");
1788 leading_code_private_21
= LEADING_CODE_PRIVATE_21
;
1790 DEFVAR_INT ("leading-code-private-22", &leading_code_private_22
,
1791 "Leading-code of private TYPE9Nx9N charset of column-width 2.");
1792 leading_code_private_22
= LEADING_CODE_PRIVATE_22
;
1794 DEFVAR_INT ("nonascii-insert-offset", &nonascii_insert_offset
,
1795 "Offset for converting non-ASCII unibyte codes 0240...0377 to multibyte.\n\
1796 This is used for converting unibyte text to multibyte,\n\
1797 and for inserting character codes specified by number.\n\n\
1798 This serves to convert a Latin-1 or similar 8-bit character code\n\
1799 to the corresponding Emacs multibyte character code.\n\
1800 Typically the value should be (- (make-char CHARSET 0) 128),\n\
1801 for your choice of character set.\n\
1802 If `nonascii-translation-table' is non-nil, it overrides this variable.");
1803 nonascii_insert_offset
= 0;
1805 DEFVAR_LISP ("nonascii-translation-table", &Vnonascii_translation_table
,
1806 "Translation table to convert non-ASCII unibyte codes to multibyte.\n\
1807 This is used for converting unibyte text to multibyte,\n\
1808 and for inserting character codes specified by number.\n\n\
1809 Conversion is performed only when multibyte characters are enabled,\n\
1810 and it serves to convert a Latin-1 or similar 8-bit character code\n\
1811 to the corresponding Emacs character code.\n\n\
1812 If this is nil, `nonascii-insert-offset' is used instead.\n\
1813 See also the docstring of `make-translation-table'.");
1814 Vnonascii_translation_table
= Qnil
;
1816 DEFVAR_INT ("min-composite-char", &min_composite_char
,
1817 "Minimum character code of a composite character.");
1818 min_composite_char
= MIN_CHAR_COMPOSITION
;