1 /* Basic multilingual character support.
2 Copyright (C) 1995, 1997, 1998 Electrotechnical Laboratory, JAPAN.
3 Licensed to the Free Software Foundation.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
22 /* At first, see the document in `charset.h' to understand the code in
29 #include <sys/types.h>
43 Lisp_Object Qcharset
, Qascii
, Qcomposition
;
45 /* Declaration of special leading-codes. */
46 int leading_code_composition
; /* for composite characters */
47 int leading_code_private_11
; /* for private DIMENSION1 of 1-column */
48 int leading_code_private_12
; /* for private DIMENSION1 of 2-column */
49 int leading_code_private_21
; /* for private DIMENSION2 of 1-column */
50 int leading_code_private_22
; /* for private DIMENSION2 of 2-column */
52 /* Declaration of special charsets. */
53 int charset_ascii
; /* ASCII */
54 int charset_composition
; /* for a composite character */
55 int charset_latin_iso8859_1
; /* ISO8859-1 (Latin-1) */
56 int charset_jisx0208_1978
; /* JISX0208.1978 (Japanese Kanji old set) */
57 int charset_jisx0208
; /* JISX0208.1983 (Japanese Kanji) */
58 int charset_katakana_jisx0201
; /* JISX0201.Kana (Japanese Katakana) */
59 int charset_latin_jisx0201
; /* JISX0201.Roman (Japanese Roman) */
60 int charset_big5_1
; /* Big5 Level 1 (Chinese Traditional) */
61 int charset_big5_2
; /* Big5 Level 2 (Chinese Traditional) */
63 int min_composite_char
;
65 Lisp_Object Qcharset_table
;
67 /* A char-table containing information of each character set. */
68 Lisp_Object Vcharset_table
;
70 /* A vector of charset symbol indexed by charset-id. This is used
71 only for returning charset symbol from C functions. */
72 Lisp_Object Vcharset_symbol_table
;
74 /* A list of charset symbols ever defined. */
75 Lisp_Object Vcharset_list
;
77 /* Vector of translation table ever defined.
78 ID of a translation table is used to index this vector. */
79 Lisp_Object Vtranslation_table_vector
;
81 /* Tables used by macros BYTES_BY_CHAR_HEAD and WIDTH_BY_CHAR_HEAD. */
82 int bytes_by_char_head
[256];
83 int width_by_char_head
[256];
85 /* Mapping table from ISO2022's charset (specified by DIMENSION,
86 CHARS, and FINAL-CHAR) to Emacs' charset. */
87 int iso_charset_table
[2][2][128];
89 /* Table of pointers to the structure `cmpchar_info' indexed by
91 struct cmpchar_info
**cmpchar_table
;
92 /* The current size of `cmpchar_table'. */
93 static int cmpchar_table_size
;
94 /* Number of the current composite characters. */
97 /* Variables used locally in the macro FETCH_MULTIBYTE_CHAR. */
98 unsigned char *_fetch_multibyte_char_p
;
99 int _fetch_multibyte_char_len
;
101 /* Offset to add to a non-ASCII value when inserting it. */
102 int nonascii_insert_offset
;
104 /* Translation table for converting non-ASCII unibyte characters
105 to multibyte codes, or nil. */
106 Lisp_Object Vnonascii_translation_table
;
108 /* List of all possible generic characters. */
109 Lisp_Object Vgeneric_character_list
;
111 #define min(X, Y) ((X) < (Y) ? (X) : (Y))
112 #define max(X, Y) ((X) > (Y) ? (X) : (Y))
115 invalid_character (c
)
118 error ("Invalid character: %o, %d, 0x%x", c
);
122 /* Set STR a pointer to the multi-byte form of the character C. If C
123 is not a composite character, the multi-byte form is set in WORKBUF
124 and STR points WORKBUF. The caller should allocate at least 4-byte
125 area at WORKBUF in advance. Returns the length of the multi-byte
126 form. If C is an invalid character to have a multi-byte form,
129 Use macro `CHAR_STRING (C, WORKBUF, STR)' instead of calling this
130 function directly if C can be an ASCII character. */
133 non_ascii_char_to_string (c
, workbuf
, str
)
135 unsigned char *workbuf
, **str
;
139 if (COMPOSITE_CHAR_P (c
))
141 int cmpchar_id
= COMPOSITE_CHAR_ID (c
);
143 if (cmpchar_id
< n_cmpchars
)
145 *str
= cmpchar_table
[cmpchar_id
]->data
;
146 return cmpchar_table
[cmpchar_id
]->len
;
150 invalid_character (c
);
154 SPLIT_NON_ASCII_CHAR (c
, charset
, c1
, c2
);
156 || ! CHARSET_DEFINED_P (charset
)
157 || c1
>= 0 && c1
< 32
158 || c2
>= 0 && c2
< 32)
159 invalid_character (c
);
162 *workbuf
++ = CHARSET_LEADING_CODE_BASE (charset
);
163 if (*workbuf
= CHARSET_LEADING_CODE_EXT (charset
))
165 *workbuf
++ = c1
| 0x80;
167 *workbuf
++ = c2
| 0x80;
169 return (workbuf
- *str
);
172 /* Return a non-ASCII character of which multi-byte form is at STR of
173 length LEN. If ACTUAL_LEN is not NULL, the actual length of the
174 multibyte form is set to the address ACTUAL_LEN.
176 If exclude_tail_garbage is nonzero, ACTUAL_LEN excludes gabage
177 bytes following the non-ASCII character.
179 Use macro `STRING_CHAR (STR, LEN)' instead of calling this function
180 directly if STR can hold an ASCII character. */
183 string_to_non_ascii_char (str
, len
, actual_len
, exclude_tail_garbage
)
184 const unsigned char *str
;
185 int len
, *actual_len
, exclude_tail_garbage
;
188 unsigned char c1
, c2
;
189 register int c
, bytes
;
194 if (BASE_LEADING_CODE_P (c
))
196 while (bytes
< len
&& ! CHAR_HEAD_P (str
[bytes
])) bytes
++;
198 if (c
== LEADING_CODE_COMPOSITION
)
200 int cmpchar_id
= str_cmpchar_id (str
, bytes
);
204 c
= MAKE_COMPOSITE_CHAR (cmpchar_id
);
205 if (exclude_tail_garbage
)
206 bytes
= cmpchar_table
[cmpchar_id
]->len
;
211 int charset
= c
, c1
, c2
= 0;
212 int char_bytes
= BYTES_BY_CHAR_HEAD (c
);
215 if (c
>= LEADING_CODE_PRIVATE_11
)
217 if (char_bytes
<= bytes
&& CHARSET_DEFINED_P (charset
))
220 if (CHARSET_DIMENSION (charset
) == 2)
222 c
= MAKE_NON_ASCII_CHAR (charset
, c1
, c2
);
223 if (exclude_tail_garbage
)
234 /* Return the length of the multi-byte form at string STR of length LEN. */
236 multibyte_form_length (str
, len
)
237 const unsigned char *str
;
242 if (BASE_LEADING_CODE_P (*str
))
243 while (bytes
< len
&& ! CHAR_HEAD_P (str
[bytes
])) bytes
++;
248 /* Check if string STR of length LEN contains valid multi-byte form of
249 a character. If valid, charset and position codes of the character
250 is set at *CHARSET, *C1, and *C2, and return 0. If not valid,
251 return -1. This should be used only in the macro SPLIT_STRING
252 which checks range of STR in advance. */
255 split_non_ascii_string (str
, len
, charset
, c1
, c2
)
256 register const unsigned char *str
;
257 register unsigned char *c1
, *c2
;
258 register int len
, *charset
;
260 register unsigned int cs
= *str
++;
262 if (cs
== LEADING_CODE_COMPOSITION
)
264 int cmpchar_id
= str_cmpchar_id (str
- 1, len
);
268 *charset
= cs
, *c1
= cmpchar_id
>> 7, *c2
= cmpchar_id
& 0x7F;
270 else if ((cs
< LEADING_CODE_PRIVATE_11
|| (cs
= *str
++) >= 0xA0)
271 && CHARSET_DEFINED_P (cs
))
276 *c1
= (*str
++) & 0x7F;
277 if (CHARSET_DIMENSION (cs
) == 2)
281 *c2
= (*str
++) & 0x7F;
289 /* Translate character C by translation table TABLE. If C
290 is negative, translate a character specified by CHARSET, C1, and C2
291 (C1 and C2 are code points of the character). If no translation is
292 found in TABLE, return C. */
294 translate_char (table
, c
, charset
, c1
, c2
)
296 int c
, charset
, c1
, c2
;
299 int alt_charset
, alt_c1
, alt_c2
, dimension
;
301 if (c
< 0) c
= MAKE_CHAR (charset
, c1
, c2
);
302 if (!CHAR_TABLE_P (table
)
303 || (ch
= Faref (table
, make_number (c
)), !INTEGERP (ch
))
307 SPLIT_CHAR (XFASTINT (ch
), alt_charset
, alt_c1
, alt_c2
);
308 dimension
= CHARSET_DIMENSION (alt_charset
);
309 if (dimension
== 1 && alt_c1
> 0 || dimension
== 2 && alt_c2
> 0)
310 /* CH is not a generic character, just return it. */
311 return XFASTINT (ch
);
313 /* Since CH is a generic character, we must return a specific
314 charater which has the same position codes as C from CH. */
316 SPLIT_CHAR (c
, charset
, c1
, c2
);
317 if (dimension
!= CHARSET_DIMENSION (charset
))
318 /* We can't make such a character because of dimension mismatch. */
320 return MAKE_CHAR (alt_charset
, c1
, c2
);
323 /* Convert the unibyte character C to multibyte based on
324 Vnonascii_translation_table or nonascii_insert_offset. If they can't
325 convert C to a valid multibyte character, convert it based on
326 DEFAULT_NONASCII_INSERT_OFFSET which makes C a Latin-1 character. */
329 unibyte_char_to_multibyte (c
)
332 if (c
>= 0240 && c
< 0400)
336 if (! NILP (Vnonascii_translation_table
))
337 c
= XINT (Faref (Vnonascii_translation_table
, make_number (c
)));
338 else if (nonascii_insert_offset
> 0)
339 c
+= nonascii_insert_offset
;
340 if (c
>= 0240 && (c
< 0400 || ! VALID_MULTIBYTE_CHAR_P (c
)))
341 c
= c_save
+ DEFAULT_NONASCII_INSERT_OFFSET
;
346 /* Update the table Vcharset_table with the given arguments (see the
347 document of `define-charset' for the meaning of each argument).
348 Several other table contents are also updated. The caller should
349 check the validity of CHARSET-ID and the remaining arguments in
353 update_charset_table (charset_id
, dimension
, chars
, width
, direction
,
354 iso_final_char
, iso_graphic_plane
,
355 short_name
, long_name
, description
)
356 Lisp_Object charset_id
, dimension
, chars
, width
, direction
;
357 Lisp_Object iso_final_char
, iso_graphic_plane
;
358 Lisp_Object short_name
, long_name
, description
;
360 int charset
= XINT (charset_id
);
362 unsigned char leading_code_base
, leading_code_ext
;
364 if (NILP (CHARSET_TABLE_ENTRY (charset
)))
365 CHARSET_TABLE_ENTRY (charset
)
366 = Fmake_vector (make_number (CHARSET_MAX_IDX
), Qnil
);
368 /* Get byte length of multibyte form, base leading-code, and
369 extended leading-code of the charset. See the comment under the
370 title "GENERAL NOTE on CHARACTER SET (CHARSET)" in charset.h. */
371 bytes
= XINT (dimension
);
372 if (charset
< MIN_CHARSET_PRIVATE_DIMENSION1
)
374 /* Official charset, it doesn't have an extended leading-code. */
375 if (charset
!= CHARSET_ASCII
)
376 bytes
+= 1; /* For a base leading-code. */
377 leading_code_base
= charset
;
378 leading_code_ext
= 0;
382 /* Private charset. */
383 bytes
+= 2; /* For base and extended leading-codes. */
385 = (charset
< LEADING_CODE_EXT_12
386 ? LEADING_CODE_PRIVATE_11
387 : (charset
< LEADING_CODE_EXT_21
388 ? LEADING_CODE_PRIVATE_12
389 : (charset
< LEADING_CODE_EXT_22
390 ? LEADING_CODE_PRIVATE_21
391 : LEADING_CODE_PRIVATE_22
)));
392 leading_code_ext
= charset
;
395 CHARSET_TABLE_INFO (charset
, CHARSET_ID_IDX
) = charset_id
;
396 CHARSET_TABLE_INFO (charset
, CHARSET_BYTES_IDX
) = make_number (bytes
);
397 CHARSET_TABLE_INFO (charset
, CHARSET_DIMENSION_IDX
) = dimension
;
398 CHARSET_TABLE_INFO (charset
, CHARSET_CHARS_IDX
) = chars
;
399 CHARSET_TABLE_INFO (charset
, CHARSET_WIDTH_IDX
) = width
;
400 CHARSET_TABLE_INFO (charset
, CHARSET_DIRECTION_IDX
) = direction
;
401 CHARSET_TABLE_INFO (charset
, CHARSET_LEADING_CODE_BASE_IDX
)
402 = make_number (leading_code_base
);
403 CHARSET_TABLE_INFO (charset
, CHARSET_LEADING_CODE_EXT_IDX
)
404 = make_number (leading_code_ext
);
405 CHARSET_TABLE_INFO (charset
, CHARSET_ISO_FINAL_CHAR_IDX
) = iso_final_char
;
406 CHARSET_TABLE_INFO (charset
, CHARSET_ISO_GRAPHIC_PLANE_IDX
)
408 CHARSET_TABLE_INFO (charset
, CHARSET_SHORT_NAME_IDX
) = short_name
;
409 CHARSET_TABLE_INFO (charset
, CHARSET_LONG_NAME_IDX
) = long_name
;
410 CHARSET_TABLE_INFO (charset
, CHARSET_DESCRIPTION_IDX
) = description
;
411 CHARSET_TABLE_INFO (charset
, CHARSET_PLIST_IDX
) = Qnil
;
414 /* If we have already defined a charset which has the same
415 DIMENSION, CHARS and ISO-FINAL-CHAR but the different
416 DIRECTION, we must update the entry REVERSE-CHARSET of both
417 charsets. If there's no such charset, the value of the entry
421 for (i
= 0; i
<= MAX_CHARSET
; i
++)
422 if (!NILP (CHARSET_TABLE_ENTRY (i
)))
424 if (CHARSET_DIMENSION (i
) == XINT (dimension
)
425 && CHARSET_CHARS (i
) == XINT (chars
)
426 && CHARSET_ISO_FINAL_CHAR (i
) == XINT (iso_final_char
)
427 && CHARSET_DIRECTION (i
) != XINT (direction
))
429 CHARSET_TABLE_INFO (charset
, CHARSET_REVERSE_CHARSET_IDX
)
431 CHARSET_TABLE_INFO (i
, CHARSET_REVERSE_CHARSET_IDX
) = charset_id
;
436 /* No such a charset. */
437 CHARSET_TABLE_INFO (charset
, CHARSET_REVERSE_CHARSET_IDX
)
441 if (charset
!= CHARSET_ASCII
442 && charset
< MIN_CHARSET_PRIVATE_DIMENSION1
)
444 /* Update tables bytes_by_char_head and width_by_char_head. */
445 bytes_by_char_head
[leading_code_base
] = bytes
;
446 width_by_char_head
[leading_code_base
] = XINT (width
);
448 /* Update table emacs_code_class. */
449 emacs_code_class
[charset
] = (bytes
== 2
450 ? EMACS_leading_code_2
452 ? EMACS_leading_code_3
453 : EMACS_leading_code_4
));
456 /* Update table iso_charset_table. */
457 if (ISO_CHARSET_TABLE (dimension
, chars
, iso_final_char
) < 0)
458 ISO_CHARSET_TABLE (dimension
, chars
, iso_final_char
) = charset
;
463 /* Return charset id of CHARSET_SYMBOL, or return -1 if CHARSET_SYMBOL
466 get_charset_id (charset_symbol
)
467 Lisp_Object charset_symbol
;
472 return ((SYMBOLP (charset_symbol
)
473 && (val
= Fget (charset_symbol
, Qcharset
), VECTORP (val
))
474 && (charset
= XINT (XVECTOR (val
)->contents
[CHARSET_ID_IDX
]),
475 CHARSET_VALID_P (charset
)))
479 /* Return an identification number for a new private charset of
480 DIMENSION and WIDTH. If there's no more room for the new charset,
483 get_new_private_charset_id (dimension
, width
)
484 int dimension
, width
;
486 int charset
, from
, to
;
491 from
= LEADING_CODE_EXT_11
, to
= LEADING_CODE_EXT_12
;
493 from
= LEADING_CODE_EXT_12
, to
= LEADING_CODE_EXT_21
;
498 from
= LEADING_CODE_EXT_21
, to
= LEADING_CODE_EXT_22
;
500 from
= LEADING_CODE_EXT_22
, to
= LEADING_CODE_EXT_MAX
+ 1;
503 for (charset
= from
; charset
< to
; charset
++)
504 if (!CHARSET_DEFINED_P (charset
)) break;
506 return make_number (charset
< to
? charset
: 0);
509 DEFUN ("define-charset", Fdefine_charset
, Sdefine_charset
, 3, 3, 0,
510 "Define CHARSET-ID as the identification number of CHARSET with INFO-VECTOR.\n\
511 If CHARSET-ID is nil, it is decided automatically, which means CHARSET is\n\
512 treated as a private charset.\n\
513 INFO-VECTOR is a vector of the format:\n\
514 [DIMENSION CHARS WIDTH DIRECTION ISO-FINAL-CHAR ISO-GRAPHIC-PLANE\n\
515 SHORT-NAME LONG-NAME DESCRIPTION]\n\
516 The meanings of each elements is as follows:\n\
517 DIMENSION (integer) is the number of bytes to represent a character: 1 or 2.\n\
518 CHARS (integer) is the number of characters in a dimension: 94 or 96.\n\
519 WIDTH (integer) is the number of columns a character in the charset\n\
520 occupies on the screen: one of 0, 1, and 2.\n\
522 DIRECTION (integer) is the rendering direction of characters in the\n\
523 charset when rendering. If 0, render from right to left, else\n\
524 render from left to right.\n\
526 ISO-FINAL-CHAR (character) is the final character of the\n\
527 corresponding ISO 2022 charset.\n\
529 ISO-GRAPHIC-PLANE (integer) is the graphic plane to be invoked\n\
530 while encoding to variants of ISO 2022 coding system, one of the\n\
531 following: 0/graphic-plane-left(GL), 1/graphic-plane-right(GR).\n\
533 SHORT-NAME (string) is the short name to refer to the charset.\n\
535 LONG-NAME (string) is the long name to refer to the charset.\n\
537 DESCRIPTION (string) is the description string of the charset.")
538 (charset_id
, charset_symbol
, info_vector
)
539 Lisp_Object charset_id
, charset_symbol
, info_vector
;
543 if (!NILP (charset_id
))
544 CHECK_NUMBER (charset_id
, 0);
545 CHECK_SYMBOL (charset_symbol
, 1);
546 CHECK_VECTOR (info_vector
, 2);
548 if (! NILP (charset_id
))
550 if (! CHARSET_VALID_P (XINT (charset_id
)))
551 error ("Invalid CHARSET: %d", XINT (charset_id
));
552 else if (CHARSET_DEFINED_P (XINT (charset_id
)))
553 error ("Already defined charset: %d", XINT (charset_id
));
556 vec
= XVECTOR (info_vector
)->contents
;
557 if (XVECTOR (info_vector
)->size
!= 9
558 || !INTEGERP (vec
[0]) || !(XINT (vec
[0]) == 1 || XINT (vec
[0]) == 2)
559 || !INTEGERP (vec
[1]) || !(XINT (vec
[1]) == 94 || XINT (vec
[1]) == 96)
560 || !INTEGERP (vec
[2]) || !(XINT (vec
[2]) == 1 || XINT (vec
[2]) == 2)
561 || !INTEGERP (vec
[3]) || !(XINT (vec
[3]) == 0 || XINT (vec
[3]) == 1)
562 || !INTEGERP (vec
[4]) || !(XINT (vec
[4]) >= '0' && XINT (vec
[4]) <= '~')
563 || !INTEGERP (vec
[5]) || !(XINT (vec
[5]) == 0 || XINT (vec
[5]) == 1)
566 || !STRINGP (vec
[8]))
567 error ("Invalid info-vector argument for defining charset %s",
568 XSYMBOL (charset_symbol
)->name
->data
);
570 if (NILP (charset_id
))
572 charset_id
= get_new_private_charset_id (XINT (vec
[0]), XINT (vec
[2]));
573 if (XINT (charset_id
) == 0)
574 error ("There's no room for a new private charset %s",
575 XSYMBOL (charset_symbol
)->name
->data
);
578 update_charset_table (charset_id
, vec
[0], vec
[1], vec
[2], vec
[3],
579 vec
[4], vec
[5], vec
[6], vec
[7], vec
[8]);
580 Fput (charset_symbol
, Qcharset
, CHARSET_TABLE_ENTRY (XINT (charset_id
)));
581 CHARSET_SYMBOL (XINT (charset_id
)) = charset_symbol
;
582 Vcharset_list
= Fcons (charset_symbol
, Vcharset_list
);
586 DEFUN ("generic-character-list", Fgeneric_character_list
,
587 Sgeneric_character_list
, 0, 0, 0,
588 "Return a list of all possible generic characters.\n\
589 It includes a generic character for a charset not yet defined.")
592 return Vgeneric_character_list
;
595 DEFUN ("get-unused-iso-final-char", Fget_unused_iso_final_char
,
596 Sget_unused_iso_final_char
, 2, 2, 0,
597 "Return an unsed ISO's final char for a charset of DIMENISION and CHARS.\n\
598 DIMENSION is the number of bytes to represent a character: 1 or 2.\n\
599 CHARS is the number of characters in a dimension: 94 or 96.\n\
601 This final char is for private use, thus the range is `0' (48) .. `?' (63).\n\
602 If there's no unused final char for the specified kind of charset,\n\
605 Lisp_Object dimension
, chars
;
609 CHECK_NUMBER (dimension
, 0);
610 CHECK_NUMBER (chars
, 1);
611 if (XINT (dimension
) != 1 && XINT (dimension
) != 2)
612 error ("Invalid charset dimension %d, it should be 1 or 2",
614 if (XINT (chars
) != 94 && XINT (chars
) != 96)
615 error ("Invalid charset chars %d, it should be 94 or 96",
617 for (final_char
= '0'; final_char
<= '?'; final_char
++)
619 if (ISO_CHARSET_TABLE (dimension
, chars
, make_number (final_char
)) < 0)
622 return (final_char
<= '?' ? make_number (final_char
) : Qnil
);
625 DEFUN ("declare-equiv-charset", Fdeclare_equiv_charset
, Sdeclare_equiv_charset
,
627 "Declare a charset of DIMENSION, CHARS, FINAL-CHAR is the same as CHARSET.\n\
628 CHARSET should be defined by `defined-charset' in advance.")
629 (dimension
, chars
, final_char
, charset_symbol
)
630 Lisp_Object dimension
, chars
, final_char
, charset_symbol
;
634 CHECK_NUMBER (dimension
, 0);
635 CHECK_NUMBER (chars
, 1);
636 CHECK_NUMBER (final_char
, 2);
637 CHECK_SYMBOL (charset_symbol
, 3);
639 if (XINT (dimension
) != 1 && XINT (dimension
) != 2)
640 error ("Invalid DIMENSION %d, it should be 1 or 2", XINT (dimension
));
641 if (XINT (chars
) != 94 && XINT (chars
) != 96)
642 error ("Invalid CHARS %d, it should be 94 or 96", XINT (chars
));
643 if (XINT (final_char
) < '0' || XFASTINT (final_char
) > '~')
644 error ("Invalid FINAL-CHAR %c, it should be `0'..`~'", XINT (chars
));
645 if ((charset
= get_charset_id (charset_symbol
)) < 0)
646 error ("Invalid charset %s", XSYMBOL (charset_symbol
)->name
->data
);
648 ISO_CHARSET_TABLE (dimension
, chars
, final_char
) = charset
;
652 /* Return number of different charsets in STR of length LEN. In
653 addition, for each found charset N, CHARSETS[N] is set 1. The
654 caller should allocate CHARSETS (MAX_CHARSET + 1 elements) in advance.
655 It may lookup a translation table TABLE if supplied.
657 If CMPCHARP is nonzero and some composite character is found,
658 CHARSETS[128] is also set 1 and the returned number is incremented
662 find_charset_in_str (str
, len
, charsets
, table
, cmpcharp
)
668 register int num
= 0, c
;
670 if (! CHAR_TABLE_P (table
))
678 if (c
== LEADING_CODE_COMPOSITION
)
680 int cmpchar_id
= str_cmpchar_id (str
, len
);
685 struct cmpchar_info
*cmpcharp
= cmpchar_table
[cmpchar_id
];
688 for (i
= 0; i
< cmpcharp
->glyph_len
; i
++)
690 c
= cmpcharp
->glyph
[i
];
693 if ((c
= translate_char (table
, c
, 0, 0, 0)) < 0)
694 c
= cmpcharp
->glyph
[i
];
696 if ((charset
= CHAR_CHARSET (c
)) < 0)
697 charset
= CHARSET_ASCII
;
698 if (!charsets
[charset
])
700 charsets
[charset
] = 1;
704 str
+= cmpcharp
->len
;
705 len
-= cmpcharp
->len
;
709 charset
= CHARSET_ASCII
;
714 c
= STRING_CHAR_AND_LENGTH (str
, len
, bytes
);
717 int c1
= translate_char (table
, c
, 0, 0, 0);
721 charset
= CHAR_CHARSET (c
);
724 if (!charsets
[charset
])
726 charsets
[charset
] = 1;
735 DEFUN ("find-charset-region", Ffind_charset_region
, Sfind_charset_region
,
737 "Return a list of charsets in the region between BEG and END.\n\
738 BEG and END are buffer positions.\n\
739 Optional arg TABLE if non-nil is a translation table to look up.")
741 Lisp_Object beg
, end
, table
;
743 int charsets
[MAX_CHARSET
+ 1];
744 int from
, from_byte
, to
, stop
, stop_byte
, i
;
747 validate_region (&beg
, &end
);
748 from
= XFASTINT (beg
);
749 stop
= to
= XFASTINT (end
);
751 if (from
< GPT
&& GPT
< to
)
754 stop_byte
= GPT_BYTE
;
757 stop_byte
= CHAR_TO_BYTE (stop
);
759 from_byte
= CHAR_TO_BYTE (from
);
761 bzero (charsets
, (MAX_CHARSET
+ 1) * sizeof (int));
764 find_charset_in_str (BYTE_POS_ADDR (from_byte
), stop_byte
- from_byte
,
768 from
= stop
, from_byte
= stop_byte
;
769 stop
= to
, stop_byte
= CHAR_TO_BYTE (stop
);
776 for (i
= MAX_CHARSET
; i
>= 0; i
--)
778 val
= Fcons (CHARSET_SYMBOL (i
), val
);
782 DEFUN ("find-charset-string", Ffind_charset_string
, Sfind_charset_string
,
784 "Return a list of charsets in STR.\n\
785 Optional arg TABLE if non-nil is a translation table to look up.")
787 Lisp_Object str
, table
;
789 int charsets
[MAX_CHARSET
+ 1];
793 CHECK_STRING (str
, 0);
795 if (! STRING_MULTIBYTE (str
))
798 bzero (charsets
, (MAX_CHARSET
+ 1) * sizeof (int));
799 find_charset_in_str (XSTRING (str
)->data
, STRING_BYTES (XSTRING (str
)),
802 for (i
= MAX_CHARSET
; i
>= 0; i
--)
804 val
= Fcons (CHARSET_SYMBOL (i
), val
);
808 DEFUN ("make-char-internal", Fmake_char_internal
, Smake_char_internal
, 1, 3, 0,
810 (charset
, code1
, code2
)
811 Lisp_Object charset
, code1
, code2
;
813 CHECK_NUMBER (charset
, 0);
816 XSETFASTINT (code1
, 0);
818 CHECK_NUMBER (code1
, 1);
820 XSETFASTINT (code2
, 0);
822 CHECK_NUMBER (code2
, 2);
824 if (!CHARSET_DEFINED_P (XINT (charset
)))
825 error ("Invalid charset: %d", XINT (charset
));
827 return make_number (MAKE_CHAR (XINT (charset
), XINT (code1
), XINT (code2
)));
830 DEFUN ("split-char", Fsplit_char
, Ssplit_char
, 1, 1, 0,
831 "Return list of charset and one or two position-codes of CHAR.")
838 CHECK_NUMBER (ch
, 0);
839 SPLIT_CHAR (XFASTINT (ch
), charset
, c1
, c2
);
841 ? Fcons (CHARSET_SYMBOL (charset
),
842 Fcons (make_number (c1
), Fcons (make_number (c2
), Qnil
)))
843 : Fcons (CHARSET_SYMBOL (charset
), Fcons (make_number (c1
), Qnil
)));
846 DEFUN ("char-charset", Fchar_charset
, Schar_charset
, 1, 1, 0,
847 "Return charset of CHAR.")
851 CHECK_NUMBER (ch
, 0);
853 return CHARSET_SYMBOL (CHAR_CHARSET (XINT (ch
)));
856 DEFUN ("charset-after", Fcharset_after
, Scharset_after
, 0, 1, 0,
857 "Return charset of a character in current buffer at position POS.\n\
858 If POS is nil, it defauls to the current point.")
862 register int pos_byte
, c
, charset
;
863 register unsigned char *p
;
867 else if (MARKERP (pos
))
868 pos_byte
= marker_byte_position (pos
);
871 CHECK_NUMBER (pos
, 0);
872 pos_byte
= CHAR_TO_BYTE (XINT (pos
));
874 p
= BYTE_POS_ADDR (pos_byte
);
875 c
= STRING_CHAR (p
, Z_BYTE
- pos_byte
);
876 charset
= CHAR_CHARSET (c
);
877 return CHARSET_SYMBOL (charset
);
880 DEFUN ("iso-charset", Fiso_charset
, Siso_charset
, 3, 3, 0,
881 "Return charset of ISO's specification DIMENSION, CHARS, and FINAL-CHAR.\n\
883 ISO 2022's designation sequence (escape sequence) distinguishes charsets\n\
884 by their DIMENSION, CHARS, and FINAL-CHAR,\n\
885 where as Emacs distinguishes them by charset symbol.\n\
886 See the documentation of the function `charset-info' for the meanings of\n\
887 DIMENSION, CHARS, and FINAL-CHAR.")
888 (dimension
, chars
, final_char
)
889 Lisp_Object dimension
, chars
, final_char
;
893 CHECK_NUMBER (dimension
, 0);
894 CHECK_NUMBER (chars
, 1);
895 CHECK_NUMBER (final_char
, 2);
897 if ((charset
= ISO_CHARSET_TABLE (dimension
, chars
, final_char
)) < 0)
899 return CHARSET_SYMBOL (charset
);
902 /* If GENERICP is nonzero, return nonzero iff C is a valid normal or
903 generic character. If GENERICP is zero, return nonzero iff C is a
904 valid normal character. Do not call this function directly,
905 instead use macro CHAR_VALID_P. */
907 char_valid_p (c
, genericp
)
914 if (SINGLE_BYTE_CHAR_P (c
))
916 SPLIT_NON_ASCII_CHAR (c
, charset
, c1
, c2
);
917 if (!CHARSET_VALID_P (charset
))
919 return (c
< MIN_CHAR_COMPOSITION
920 ? ((c
& CHAR_FIELD1_MASK
) /* i.e. dimension of C is two. */
921 ? (genericp
&& c1
== 0 && c2
== 0
922 || c1
>= 32 && c2
>= 32)
923 : (genericp
&& c1
== 0
925 : c
< MIN_CHAR_COMPOSITION
+ n_cmpchars
);
928 DEFUN ("char-valid-p", Fchar_valid_p
, Schar_valid_p
, 1, 2, 0,
929 "Return t if OBJECT is a valid normal character.\n\
930 If optional arg GENERICP is non-nil, also return t if OBJECT is\n\
931 a valid generic character.")
933 Lisp_Object object
, genericp
;
935 if (! NATNUMP (object
))
937 return (CHAR_VALID_P (XFASTINT (object
), !NILP (genericp
)) ? Qt
: Qnil
);
940 DEFUN ("unibyte-char-to-multibyte", Funibyte_char_to_multibyte
,
941 Sunibyte_char_to_multibyte
, 1, 1, 0,
942 "Convert the unibyte character CH to multibyte character.\n\
943 The conversion is done based on `nonascii-translation-table' (which see)\n\
944 or `nonascii-insert-offset' (which see).")
950 CHECK_NUMBER (ch
, 0);
952 if (c
< 0 || c
>= 0400)
953 error ("Invalid unibyte character: %d", c
);
954 c
= unibyte_char_to_multibyte (c
);
956 error ("Can't convert to multibyte character: %d", XINT (ch
));
957 return make_number (c
);
960 DEFUN ("char-bytes", Fchar_bytes
, Schar_bytes
, 1, 1, 0,
961 "Return byte length of multi-byte form of CHAR.")
968 CHECK_NUMBER (ch
, 0);
969 if (COMPOSITE_CHAR_P (XFASTINT (ch
)))
971 unsigned int id
= COMPOSITE_CHAR_ID (XFASTINT (ch
));
973 bytes
= (id
< n_cmpchars
? cmpchar_table
[id
]->len
: 1);
977 int charset
= CHAR_CHARSET (XFASTINT (ch
));
979 bytes
= CHARSET_DEFINED_P (charset
) ? CHARSET_BYTES (charset
) : 1;
982 XSETFASTINT (val
, bytes
);
986 /* Return the width of character of which multi-byte form starts with
987 C. The width is measured by how many columns occupied on the
988 screen when displayed in the current buffer. */
990 #define ONE_BYTE_CHAR_WIDTH(c) \
993 ? XFASTINT (current_buffer->tab_width) \
994 : (c == '\n' ? 0 : (NILP (current_buffer->ctl_arrow) ? 4 : 2))) \
998 ? (NILP (current_buffer->ctl_arrow) ? 4 : 2) \
999 : ((! NILP (current_buffer->enable_multibyte_characters) \
1000 && BASE_LEADING_CODE_P (c)) \
1001 ? WIDTH_BY_CHAR_HEAD (c) \
1004 DEFUN ("char-width", Fchar_width
, Schar_width
, 1, 1, 0,
1005 "Return width of CHAR when displayed in the current buffer.\n\
1006 The width is measured by how many columns it occupies on the screen.")
1010 Lisp_Object val
, disp
;
1012 struct Lisp_Char_Table
*dp
= buffer_display_table ();
1014 CHECK_NUMBER (ch
, 0);
1018 /* Get the way the display table would display it. */
1019 disp
= dp
? DISP_CHAR_VECTOR (dp
, c
) : Qnil
;
1022 XSETINT (val
, XVECTOR (disp
)->size
);
1023 else if (SINGLE_BYTE_CHAR_P (c
))
1024 XSETINT (val
, ONE_BYTE_CHAR_WIDTH (c
));
1025 else if (COMPOSITE_CHAR_P (c
))
1027 int id
= COMPOSITE_CHAR_ID (XFASTINT (ch
));
1028 XSETFASTINT (val
, (id
< n_cmpchars
? cmpchar_table
[id
]->width
: 0));
1032 int charset
= CHAR_CHARSET (c
);
1034 XSETFASTINT (val
, CHARSET_WIDTH (charset
));
1039 /* Return width of string STR of length LEN when displayed in the
1040 current buffer. The width is measured by how many columns it
1041 occupies on the screen. */
1048 unsigned char *endp
= str
+ len
;
1050 struct Lisp_Char_Table
*dp
= buffer_display_table ();
1054 if (*str
== LEADING_CODE_COMPOSITION
)
1056 int id
= str_cmpchar_id (str
, endp
- str
);
1065 width
+= cmpchar_table
[id
]->width
;
1066 str
+= cmpchar_table
[id
]->len
;
1073 int c
= STRING_CHAR_AND_LENGTH (str
, endp
- str
, thislen
);
1075 /* Get the way the display table would display it. */
1077 disp
= DISP_CHAR_VECTOR (dp
, c
);
1082 width
+= XVECTOR (disp
)->size
;
1084 width
+= ONE_BYTE_CHAR_WIDTH (*str
);
1092 DEFUN ("string-width", Fstring_width
, Sstring_width
, 1, 1, 0,
1093 "Return width of STRING when displayed in the current buffer.\n\
1094 Width is measured by how many columns it occupies on the screen.\n\
1095 When calculating width of a multibyte character in STRING,\n\
1096 only the base leading-code is considered; the validity of\n\
1097 the following bytes is not checked.")
1103 CHECK_STRING (str
, 0);
1104 XSETFASTINT (val
, strwidth (XSTRING (str
)->data
,
1105 STRING_BYTES (XSTRING (str
))));
1109 DEFUN ("char-direction", Fchar_direction
, Schar_direction
, 1, 1, 0,
1110 "Return the direction of CHAR.\n\
1111 The returned value is 0 for left-to-right and 1 for right-to-left.")
1117 CHECK_NUMBER (ch
, 0);
1118 charset
= CHAR_CHARSET (XFASTINT (ch
));
1119 if (!CHARSET_DEFINED_P (charset
))
1120 invalid_character (XINT (ch
));
1121 return CHARSET_TABLE_INFO (charset
, CHARSET_DIRECTION_IDX
);
1124 DEFUN ("chars-in-region", Fchars_in_region
, Schars_in_region
, 2, 2, 0,
1125 "Return number of characters between BEG and END.")
1127 Lisp_Object beg
, end
;
1131 from
= min (XFASTINT (beg
), XFASTINT (end
));
1132 to
= max (XFASTINT (beg
), XFASTINT (end
));
1134 return make_number (to
- from
);
1137 /* Return the number of characters in the NBYTES bytes at PTR.
1138 This works by looking at the contents and checking for multibyte sequences.
1139 However, if the current buffer has enable-multibyte-characters = nil,
1140 we treat each byte as a character. */
1143 chars_in_text (ptr
, nbytes
)
1147 unsigned char *endp
, c
;
1150 /* current_buffer is null at early stages of Emacs initialization. */
1151 if (current_buffer
== 0
1152 || NILP (current_buffer
->enable_multibyte_characters
))
1155 endp
= ptr
+ nbytes
;
1162 if (BASE_LEADING_CODE_P (c
))
1163 while (ptr
< endp
&& ! CHAR_HEAD_P (*ptr
)) ptr
++;
1170 /* Return the number of characters in the NBYTES bytes at PTR.
1171 This works by looking at the contents and checking for multibyte sequences.
1172 It ignores enable-multibyte-characters. */
1175 multibyte_chars_in_text (ptr
, nbytes
)
1179 unsigned char *endp
, c
;
1182 endp
= ptr
+ nbytes
;
1189 if (BASE_LEADING_CODE_P (c
))
1190 while (ptr
< endp
&& ! CHAR_HEAD_P (*ptr
)) ptr
++;
1197 DEFUN ("string", Fstring
, Sstring
, 1, MANY
, 0,
1198 "Concatenate all the argument characters and make the result a string.")
1205 = (unsigned char *) alloca (MAX_LENGTH_OF_MULTI_BYTE_FORM
* n
);
1206 unsigned char *p
= buf
;
1209 for (i
= 0; i
< n
; i
++)
1214 if (!INTEGERP (args
[i
]))
1215 CHECK_NUMBER (args
[i
], 0);
1217 len
= CHAR_STRING (c
, p
, str
);
1219 /* C is a composite character. */
1220 bcopy (str
, p
, len
);
1224 val
= make_string_from_bytes (buf
, n
, p
- buf
);
1230 /*** Composite characters staffs ***/
1232 /* Each composite character is identified by CMPCHAR-ID which is
1233 assigned when Emacs needs the character code of the composite
1234 character (e.g. when displaying it on the screen). See the
1235 document "GENERAL NOTE on COMPOSITE CHARACTER" in `charset.h' how a
1236 composite character is represented in Emacs. */
1238 /* If `static' is defined, it means that it is defined to null string. */
1240 /* The following function is copied from lread.c. */
1242 hash_string (ptr
, len
)
1246 register unsigned char *p
= ptr
;
1247 register unsigned char *end
= p
+ len
;
1248 register unsigned char c
;
1249 register int hash
= 0;
1254 if (c
>= 0140) c
-= 40;
1255 hash
= ((hash
<<3) + (hash
>>28) + c
);
1257 return hash
& 07777777777;
1261 #define CMPCHAR_HASH_TABLE_SIZE 0xFFF
1263 static int *cmpchar_hash_table
[CMPCHAR_HASH_TABLE_SIZE
];
1265 /* Each element of `cmpchar_hash_table' is a pointer to an array of
1266 integer, where the 1st element is the size of the array, the 2nd
1267 element is how many elements are actually used in the array, and
1268 the remaining elements are CMPCHAR-IDs of composite characters of
1269 the same hash value. */
1270 #define CMPCHAR_HASH_SIZE(table) table[0]
1271 #define CMPCHAR_HASH_USED(table) table[1]
1272 #define CMPCHAR_HASH_CMPCHAR_ID(table, i) table[i]
1274 /* Return CMPCHAR-ID of the composite character in STR of the length
1275 LEN. If the composite character has not yet been registered,
1276 register it in `cmpchar_table' and assign new CMPCHAR-ID. This
1277 is the sole function for assigning CMPCHAR-ID. */
1279 str_cmpchar_id (str
, len
)
1280 const unsigned char *str
;
1283 int hash_idx
, *hashp
;
1285 int embedded_rule
; /* 1 if composition rule is embedded. */
1286 int chars
; /* number of components. */
1288 struct cmpchar_info
*cmpcharp
;
1290 /* The second byte 0xFF means compostion rule is embedded. */
1291 embedded_rule
= (str
[1] == 0xFF);
1293 /* At first, get the actual length of the composite character. */
1295 const unsigned char *p
, *endp
= str
+ 1, *lastp
= str
+ len
;
1298 while (endp
< lastp
&& ! CHAR_HEAD_P (*endp
)) endp
++;
1300 /* Any composite char have at least 5-byte length. */
1307 if (embedded_rule
) p
++;
1308 /* No need of checking if *P is 0xA0 because
1309 BYTES_BY_CHAR_HEAD (0x80) surely returns 2. */
1310 p
+= BYTES_BY_CHAR_HEAD (*p
- 0x20);
1313 if (p
> endp
|| chars
< 2 || chars
> MAX_COMPONENT_COUNT
)
1314 /* Invalid components. */
1318 hash_idx
= hash_string (str
, len
) % CMPCHAR_HASH_TABLE_SIZE
;
1319 hashp
= cmpchar_hash_table
[hash_idx
];
1321 /* Then, look into the hash table. */
1323 /* Find the correct one among composite characters of the same
1325 for (i
= 2; i
< CMPCHAR_HASH_USED (hashp
); i
++)
1327 cmpcharp
= cmpchar_table
[CMPCHAR_HASH_CMPCHAR_ID (hashp
, i
)];
1328 if (len
== cmpcharp
->len
1329 && ! bcmp (str
, cmpcharp
->data
, len
))
1330 return CMPCHAR_HASH_CMPCHAR_ID (hashp
, i
);
1333 /* We have to register the composite character in cmpchar_table. */
1334 if (n_cmpchars
> (CHAR_FIELD2_MASK
| CHAR_FIELD3_MASK
))
1335 /* No, we have no more room for a new composite character. */
1338 /* Make the entry in hash table. */
1341 /* Make a table for 8 composite characters initially. */
1342 hashp
= (cmpchar_hash_table
[hash_idx
]
1343 = (int *) xmalloc (sizeof (int) * (2 + 8)));
1344 CMPCHAR_HASH_SIZE (hashp
) = 10;
1345 CMPCHAR_HASH_USED (hashp
) = 2;
1347 else if (CMPCHAR_HASH_USED (hashp
) >= CMPCHAR_HASH_SIZE (hashp
))
1349 CMPCHAR_HASH_SIZE (hashp
) += 8;
1350 hashp
= (cmpchar_hash_table
[hash_idx
]
1351 = (int *) xrealloc (hashp
,
1352 sizeof (int) * CMPCHAR_HASH_SIZE (hashp
)));
1354 CMPCHAR_HASH_CMPCHAR_ID (hashp
, CMPCHAR_HASH_USED (hashp
)) = n_cmpchars
;
1355 CMPCHAR_HASH_USED (hashp
)++;
1357 /* Set information of the composite character in cmpchar_table. */
1358 if (cmpchar_table_size
== 0)
1360 /* This is the first composite character to be registered. */
1361 cmpchar_table_size
= 256;
1363 = (struct cmpchar_info
**) xmalloc (sizeof (cmpchar_table
[0])
1364 * cmpchar_table_size
);
1366 else if (cmpchar_table_size
<= n_cmpchars
)
1368 cmpchar_table_size
+= 256;
1370 = (struct cmpchar_info
**) xrealloc (cmpchar_table
,
1371 sizeof (cmpchar_table
[0])
1372 * cmpchar_table_size
);
1375 cmpcharp
= (struct cmpchar_info
*) xmalloc (sizeof (struct cmpchar_info
));
1377 cmpcharp
->len
= len
;
1378 cmpcharp
->data
= (unsigned char *) xmalloc (len
+ 1);
1379 bcopy (str
, cmpcharp
->data
, len
);
1380 cmpcharp
->data
[len
] = 0;
1381 cmpcharp
->glyph_len
= chars
;
1382 cmpcharp
->glyph
= (GLYPH
*) xmalloc (sizeof (GLYPH
) * chars
);
1385 cmpcharp
->cmp_rule
= (unsigned char *) xmalloc (chars
);
1386 cmpcharp
->col_offset
= (float *) xmalloc (sizeof (float) * chars
);
1390 cmpcharp
->cmp_rule
= NULL
;
1391 cmpcharp
->col_offset
= NULL
;
1394 /* Setup GLYPH data and composition rules (if any) so as not to make
1395 them every time on displaying. */
1397 unsigned char *bufp
;
1399 float leftmost
= 0.0, rightmost
= 1.0;
1402 /* At first, col_offset[N] is set to relative to col_offset[0]. */
1403 cmpcharp
->col_offset
[0] = 0;
1405 for (i
= 0, bufp
= cmpcharp
->data
+ 1; i
< chars
; i
++)
1408 cmpcharp
->cmp_rule
[i
] = *bufp
++;
1410 if (*bufp
== 0xA0) /* This is an ASCII character. */
1412 cmpcharp
->glyph
[i
] = FAST_MAKE_GLYPH ((*++bufp
& 0x7F), 0);
1416 else /* Multibyte character. */
1418 /* Make `bufp' point normal multi-byte form temporally. */
1421 = FAST_MAKE_GLYPH (string_to_non_ascii_char (bufp
, 4, 0, 0), 0);
1422 width
= WIDTH_BY_CHAR_HEAD (*bufp
);
1424 bufp
+= BYTES_BY_CHAR_HEAD (*bufp
- 0x20);
1427 if (embedded_rule
&& i
> 0)
1429 /* Reference points (global_ref and new_ref) are
1440 Now, we calculate the column offset of the new glyph
1441 from the left edge of the first glyph. This can avoid
1442 the same calculation everytime displaying this
1443 composite character. */
1445 /* Reference points of global glyph and new glyph. */
1446 int global_ref
= (cmpcharp
->cmp_rule
[i
] - 0xA0) / 9;
1447 int new_ref
= (cmpcharp
->cmp_rule
[i
] - 0xA0) % 9;
1448 /* Column offset relative to the first glyph. */
1449 float left
= (leftmost
1450 + (global_ref
% 3) * (rightmost
- leftmost
) / 2.0
1451 - (new_ref
% 3) * width
/ 2.0);
1453 cmpcharp
->col_offset
[i
] = left
;
1454 if (left
< leftmost
)
1456 if (left
+ width
> rightmost
)
1457 rightmost
= left
+ width
;
1461 if (width
> rightmost
)
1467 /* Now col_offset[N] are relative to the left edge of the
1468 first component. Make them relative to the left edge of
1470 for (i
= 0; i
< chars
; i
++)
1471 cmpcharp
->col_offset
[i
] -= leftmost
;
1472 /* Make rightmost holds width of overall glyph. */
1473 rightmost
-= leftmost
;
1476 cmpcharp
->width
= rightmost
;
1477 if (cmpcharp
->width
< rightmost
)
1478 /* To get a ceiling integer value. */
1482 cmpchar_table
[n_cmpchars
] = cmpcharp
;
1484 return n_cmpchars
++;
1487 /* Return the Nth element of the composite character C. */
1489 cmpchar_component (c
, n
)
1492 int id
= COMPOSITE_CHAR_ID (c
);
1494 if (id
>= n_cmpchars
/* C is not a valid composite character. */
1495 || n
>= cmpchar_table
[id
]->glyph_len
) /* No such component. */
1497 /* No face data is stored in glyph code. */
1498 return ((int) (cmpchar_table
[id
]->glyph
[n
]));
1501 DEFUN ("cmpcharp", Fcmpcharp
, Scmpcharp
, 1, 1, 0,
1502 "T if CHAR is a composite character.")
1506 CHECK_NUMBER (ch
, 0);
1507 return (COMPOSITE_CHAR_P (XINT (ch
)) ? Qt
: Qnil
);
1510 DEFUN ("composite-char-component", Fcmpchar_component
, Scmpchar_component
,
1512 "Return the IDXth component character of composite character CHARACTER.")
1514 Lisp_Object character
, idx
;
1518 CHECK_NUMBER (character
, 0);
1519 CHECK_NUMBER (idx
, 1);
1521 if ((c
= cmpchar_component (XINT (character
), XINT (idx
))) < 0)
1522 args_out_of_range (character
, idx
);
1524 return make_number (c
);
1527 DEFUN ("composite-char-composition-rule", Fcmpchar_cmp_rule
, Scmpchar_cmp_rule
,
1529 "Return the Nth composition rule embedded in composite character CHARACTER.\n\
1530 The returned rule is for composing the Nth component\n\
1531 on the (N-1)th component. If N is 0, the returned value is always 255.")
1533 Lisp_Object character
, n
;
1537 CHECK_NUMBER (character
, 0);
1538 CHECK_NUMBER (n
, 1);
1540 id
= COMPOSITE_CHAR_ID (XINT (character
));
1541 if (id
< 0 || id
>= n_cmpchars
)
1542 error ("Invalid composite character: %d", XINT (character
));
1544 if (i
> cmpchar_table
[id
]->glyph_len
)
1545 args_out_of_range (character
, n
);
1547 return make_number (cmpchar_table
[id
]->cmp_rule
[i
]);
1550 DEFUN ("composite-char-composition-rule-p", Fcmpchar_cmp_rule_p
,
1551 Scmpchar_cmp_rule_p
, 1, 1, 0,
1552 "Return non-nil if composite character CHARACTER contains a embedded rule.")
1554 Lisp_Object character
;
1558 CHECK_NUMBER (character
, 0);
1559 id
= COMPOSITE_CHAR_ID (XINT (character
));
1560 if (id
< 0 || id
>= n_cmpchars
)
1561 error ("Invalid composite character: %d", XINT (character
));
1563 return (cmpchar_table
[id
]->cmp_rule
? Qt
: Qnil
);
1566 DEFUN ("composite-char-component-count", Fcmpchar_cmp_count
,
1567 Scmpchar_cmp_count
, 1, 1, 0,
1568 "Return number of compoents of composite character CHARACTER.")
1570 Lisp_Object character
;
1574 CHECK_NUMBER (character
, 0);
1575 id
= COMPOSITE_CHAR_ID (XINT (character
));
1576 if (id
< 0 || id
>= n_cmpchars
)
1577 error ("Invalid composite character: %d", XINT (character
));
1579 return (make_number (cmpchar_table
[id
]->glyph_len
));
1582 DEFUN ("compose-string", Fcompose_string
, Scompose_string
,
1584 "Return one char string composed from all characters in STRING.")
1588 unsigned char buf
[MAX_LENGTH_OF_MULTI_BYTE_FORM
], *p
, *pend
, *ptemp
;
1591 CHECK_STRING (str
, 0);
1593 buf
[0] = LEADING_CODE_COMPOSITION
;
1594 p
= XSTRING (str
)->data
;
1595 pend
= p
+ STRING_BYTES (XSTRING (str
));
1599 if (*p
< 0x20 || *p
== 127) /* control code */
1600 error ("Invalid component character: %d", *p
);
1601 else if (*p
< 0x80) /* ASCII */
1603 if (i
+ 2 >= MAX_LENGTH_OF_MULTI_BYTE_FORM
)
1604 error ("Too long string to be composed: %s", XSTRING (str
)->data
);
1605 /* Prepend an ASCII charset indicator 0xA0, set MSB of the
1608 buf
[i
++] = *p
++ + 0x80;
1610 else if (*p
== LEADING_CODE_COMPOSITION
) /* composite char */
1612 /* Already composed. Eliminate the heading
1613 LEADING_CODE_COMPOSITION, keep the remaining bytes
1617 while (! CHAR_HEAD_P (*p
)) p
++;
1618 if (i
+ (p
- ptemp
) >= MAX_LENGTH_OF_MULTI_BYTE_FORM
)
1619 error ("Too long string to be composed: %s", XSTRING (str
)->data
);
1620 bcopy (ptemp
, buf
+ i
, p
- ptemp
);
1623 else /* multibyte char */
1625 /* Add 0x20 to the base leading-code, keep the remaining
1627 len
= BYTES_BY_CHAR_HEAD (*p
);
1628 if (i
+ len
>= MAX_LENGTH_OF_MULTI_BYTE_FORM
)
1629 error ("Too long string to be composed: %s", XSTRING (str
)->data
);
1630 bcopy (p
, buf
+ i
, len
);
1637 /* STR contains only one character, which can't be composed. */
1638 error ("Too short string to be composed: %s", XSTRING (str
)->data
);
1640 return make_string_from_bytes (buf
, 1, i
);
1645 charset_id_internal (charset_name
)
1648 Lisp_Object val
= Fget (intern (charset_name
), Qcharset
);
1651 error ("Charset %s is not defined", charset_name
);
1653 return (XINT (XVECTOR (val
)->contents
[0]));
1656 DEFUN ("setup-special-charsets", Fsetup_special_charsets
,
1657 Ssetup_special_charsets
, 0, 0, 0, "Internal use only.")
1660 charset_latin_iso8859_1
= charset_id_internal ("latin-iso8859-1");
1661 charset_jisx0208_1978
= charset_id_internal ("japanese-jisx0208-1978");
1662 charset_jisx0208
= charset_id_internal ("japanese-jisx0208");
1663 charset_katakana_jisx0201
= charset_id_internal ("katakana-jisx0201");
1664 charset_latin_jisx0201
= charset_id_internal ("latin-jisx0201");
1665 charset_big5_1
= charset_id_internal ("chinese-big5-1");
1666 charset_big5_2
= charset_id_internal ("chinese-big5-2");
1671 init_charset_once ()
1675 staticpro (&Vcharset_table
);
1676 staticpro (&Vcharset_symbol_table
);
1677 staticpro (&Vgeneric_character_list
);
1679 /* This has to be done here, before we call Fmake_char_table. */
1680 Qcharset_table
= intern ("charset-table");
1681 staticpro (&Qcharset_table
);
1683 /* Intern this now in case it isn't already done.
1684 Setting this variable twice is harmless.
1685 But don't staticpro it here--that is done in alloc.c. */
1686 Qchar_table_extra_slots
= intern ("char-table-extra-slots");
1688 /* Now we are ready to set up this property, so we can
1689 create the charset table. */
1690 Fput (Qcharset_table
, Qchar_table_extra_slots
, make_number (0));
1691 Vcharset_table
= Fmake_char_table (Qcharset_table
, Qnil
);
1693 Vcharset_symbol_table
= Fmake_vector (make_number (MAX_CHARSET
+ 1), Qnil
);
1696 for (i
= 0; i
< 2; i
++)
1697 for (j
= 0; j
< 2; j
++)
1698 for (k
= 0; k
< 128; k
++)
1699 iso_charset_table
[i
][j
][k
] = -1;
1701 bzero (cmpchar_hash_table
, sizeof cmpchar_hash_table
);
1702 cmpchar_table_size
= n_cmpchars
= 0;
1704 for (i
= 0; i
< 256; i
++)
1705 BYTES_BY_CHAR_HEAD (i
) = 1;
1706 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_11
) = 3;
1707 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_12
) = 3;
1708 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_21
) = 4;
1709 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_22
) = 4;
1710 /* The following doesn't reflect the actual bytes, but just to tell
1711 that it is a start of a multibyte character. */
1712 BYTES_BY_CHAR_HEAD (LEADING_CODE_COMPOSITION
) = 2;
1714 for (i
= 0; i
< 128; i
++)
1715 WIDTH_BY_CHAR_HEAD (i
) = 1;
1716 for (; i
< 256; i
++)
1717 WIDTH_BY_CHAR_HEAD (i
) = 4;
1718 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_11
) = 1;
1719 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_12
) = 2;
1720 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_21
) = 1;
1721 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_22
) = 2;
1724 Lisp_Object val
= Qnil
;
1726 for (i
= 0x81; i
< 0x90; i
++)
1727 val
= Fcons (make_number ((i
- 0x70) << 7), val
);
1728 for (; i
< 0x9A; i
++)
1729 val
= Fcons (make_number ((i
- 0x8F) << 14), val
);
1730 for (i
= 0xA0; i
< 0xF0; i
++)
1731 val
= Fcons (make_number ((i
- 0x70) << 7), val
);
1732 for (; i
< 0xFF; i
++)
1733 val
= Fcons (make_number ((i
- 0xE0) << 14), val
);
1734 val
= Fcons (make_number (GENERIC_COMPOSITION_CHAR
), val
);
1735 Vgeneric_character_list
= Fnreverse (val
);
1744 Qascii
= intern ("ascii");
1745 staticpro (&Qascii
);
1747 Qcharset
= intern ("charset");
1748 staticpro (&Qcharset
);
1750 /* Define ASCII charset now. */
1751 update_charset_table (make_number (CHARSET_ASCII
),
1752 make_number (1), make_number (94),
1757 build_string ("ASCII"),
1758 build_string ("ASCII"),
1759 build_string ("ASCII (ISO646 IRV)"));
1760 CHARSET_SYMBOL (CHARSET_ASCII
) = Qascii
;
1761 Fput (Qascii
, Qcharset
, CHARSET_TABLE_ENTRY (CHARSET_ASCII
));
1763 Qcomposition
= intern ("composition");
1764 staticpro (&Qcomposition
);
1765 CHARSET_SYMBOL (CHARSET_COMPOSITION
) = Qcomposition
;
1767 defsubr (&Sdefine_charset
);
1768 defsubr (&Sgeneric_character_list
);
1769 defsubr (&Sget_unused_iso_final_char
);
1770 defsubr (&Sdeclare_equiv_charset
);
1771 defsubr (&Sfind_charset_region
);
1772 defsubr (&Sfind_charset_string
);
1773 defsubr (&Smake_char_internal
);
1774 defsubr (&Ssplit_char
);
1775 defsubr (&Schar_charset
);
1776 defsubr (&Scharset_after
);
1777 defsubr (&Siso_charset
);
1778 defsubr (&Schar_valid_p
);
1779 defsubr (&Sunibyte_char_to_multibyte
);
1780 defsubr (&Schar_bytes
);
1781 defsubr (&Schar_width
);
1782 defsubr (&Sstring_width
);
1783 defsubr (&Schar_direction
);
1784 defsubr (&Schars_in_region
);
1786 defsubr (&Scmpcharp
);
1787 defsubr (&Scmpchar_component
);
1788 defsubr (&Scmpchar_cmp_rule
);
1789 defsubr (&Scmpchar_cmp_rule_p
);
1790 defsubr (&Scmpchar_cmp_count
);
1791 defsubr (&Scompose_string
);
1792 defsubr (&Ssetup_special_charsets
);
1794 DEFVAR_LISP ("charset-list", &Vcharset_list
,
1795 "List of charsets ever defined.");
1796 Vcharset_list
= Fcons (Qascii
, Qnil
);
1798 DEFVAR_LISP ("translation-table-vector", &Vtranslation_table_vector
,
1799 "Vector of cons cell of a symbol and translation table ever defined.\n\
1800 An ID of a translation table is an index of this vector.");
1801 Vtranslation_table_vector
= Fmake_vector (make_number (16), Qnil
);
1803 DEFVAR_INT ("leading-code-composition", &leading_code_composition
,
1804 "Leading-code of composite characters.");
1805 leading_code_composition
= LEADING_CODE_COMPOSITION
;
1807 DEFVAR_INT ("leading-code-private-11", &leading_code_private_11
,
1808 "Leading-code of private TYPE9N charset of column-width 1.");
1809 leading_code_private_11
= LEADING_CODE_PRIVATE_11
;
1811 DEFVAR_INT ("leading-code-private-12", &leading_code_private_12
,
1812 "Leading-code of private TYPE9N charset of column-width 2.");
1813 leading_code_private_12
= LEADING_CODE_PRIVATE_12
;
1815 DEFVAR_INT ("leading-code-private-21", &leading_code_private_21
,
1816 "Leading-code of private TYPE9Nx9N charset of column-width 1.");
1817 leading_code_private_21
= LEADING_CODE_PRIVATE_21
;
1819 DEFVAR_INT ("leading-code-private-22", &leading_code_private_22
,
1820 "Leading-code of private TYPE9Nx9N charset of column-width 2.");
1821 leading_code_private_22
= LEADING_CODE_PRIVATE_22
;
1823 DEFVAR_INT ("nonascii-insert-offset", &nonascii_insert_offset
,
1824 "Offset for converting non-ASCII unibyte codes 0240...0377 to multibyte.\n\
1825 This is used for converting unibyte text to multibyte,\n\
1826 and for inserting character codes specified by number.\n\n\
1827 This serves to convert a Latin-1 or similar 8-bit character code\n\
1828 to the corresponding Emacs multibyte character code.\n\
1829 Typically the value should be (- (make-char CHARSET 0) 128),\n\
1830 for your choice of character set.\n\
1831 If `nonascii-translation-table' is non-nil, it overrides this variable.");
1832 nonascii_insert_offset
= 0;
1834 DEFVAR_LISP ("nonascii-translation-table", &Vnonascii_translation_table
,
1835 "Translation table to convert non-ASCII unibyte codes to multibyte.\n\
1836 This is used for converting unibyte text to multibyte,\n\
1837 and for inserting character codes specified by number.\n\n\
1838 Conversion is performed only when multibyte characters are enabled,\n\
1839 and it serves to convert a Latin-1 or similar 8-bit character code\n\
1840 to the corresponding Emacs character code.\n\n\
1841 If this is nil, `nonascii-insert-offset' is used instead.\n\
1842 See also the docstring of `make-translation-table'.");
1843 Vnonascii_translation_table
= Qnil
;
1845 DEFVAR_INT ("min-composite-char", &min_composite_char
,
1846 "Minimum character code of a composite character.");
1847 min_composite_char
= MIN_CHAR_COMPOSITION
;