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 /* A char-table for characters which may invoke auto-filling. */
82 Lisp_Object Vauto_fill_chars
;
84 Lisp_Object Qauto_fill_chars
;
86 /* Tables used by macros BYTES_BY_CHAR_HEAD and WIDTH_BY_CHAR_HEAD. */
87 int bytes_by_char_head
[256];
88 int width_by_char_head
[256];
90 /* Mapping table from ISO2022's charset (specified by DIMENSION,
91 CHARS, and FINAL-CHAR) to Emacs' charset. */
92 int iso_charset_table
[2][2][128];
94 /* Table of pointers to the structure `cmpchar_info' indexed by
96 struct cmpchar_info
**cmpchar_table
;
97 /* The current size of `cmpchar_table'. */
98 static int cmpchar_table_size
;
99 /* Number of the current composite characters. */
102 /* Variables used locally in the macro FETCH_MULTIBYTE_CHAR. */
103 unsigned char *_fetch_multibyte_char_p
;
104 int _fetch_multibyte_char_len
;
106 /* Offset to add to a non-ASCII value when inserting it. */
107 int nonascii_insert_offset
;
109 /* Translation table for converting non-ASCII unibyte characters
110 to multibyte codes, or nil. */
111 Lisp_Object Vnonascii_translation_table
;
113 /* List of all possible generic characters. */
114 Lisp_Object Vgeneric_character_list
;
116 #define min(X, Y) ((X) < (Y) ? (X) : (Y))
117 #define max(X, Y) ((X) > (Y) ? (X) : (Y))
120 invalid_character (c
)
123 error ("Invalid character: 0%o, %d, 0x%x", c
, c
, c
);
127 /* Set STR a pointer to the multi-byte form of the character C. If C
128 is not a composite character, the multi-byte form is set in WORKBUF
129 and STR points WORKBUF. The caller should allocate at least 4-byte
130 area at WORKBUF in advance. Returns the length of the multi-byte
131 form. If C is an invalid character to have a multi-byte form,
134 Use macro `CHAR_STRING (C, WORKBUF, STR)' instead of calling this
135 function directly if C can be an ASCII character. */
138 non_ascii_char_to_string (c
, workbuf
, str
)
140 unsigned char *workbuf
, **str
;
144 if (COMPOSITE_CHAR_P (c
))
146 int cmpchar_id
= COMPOSITE_CHAR_ID (c
);
148 if (cmpchar_id
< n_cmpchars
)
150 *str
= cmpchar_table
[cmpchar_id
]->data
;
151 return cmpchar_table
[cmpchar_id
]->len
;
155 invalid_character (c
);
159 SPLIT_NON_ASCII_CHAR (c
, charset
, c1
, c2
);
161 || ! CHARSET_DEFINED_P (charset
)
162 || c1
>= 0 && c1
< 32
163 || c2
>= 0 && c2
< 32)
164 invalid_character (c
);
167 *workbuf
++ = CHARSET_LEADING_CODE_BASE (charset
);
168 if (*workbuf
= CHARSET_LEADING_CODE_EXT (charset
))
170 *workbuf
++ = c1
| 0x80;
172 *workbuf
++ = c2
| 0x80;
174 return (workbuf
- *str
);
177 /* Return a non-ASCII character of which multi-byte form is at STR of
178 length LEN. If ACTUAL_LEN is not NULL, the actual length of the
179 multibyte form is set to the address ACTUAL_LEN.
181 If exclude_tail_garbage is nonzero, ACTUAL_LEN excludes gabage
182 bytes following the non-ASCII character.
184 Use macro `STRING_CHAR (STR, LEN)' instead of calling this function
185 directly if STR can hold an ASCII character. */
188 string_to_non_ascii_char (str
, len
, actual_len
, exclude_tail_garbage
)
189 const unsigned char *str
;
190 int len
, *actual_len
, exclude_tail_garbage
;
193 unsigned char c1
, c2
;
195 const unsigned char *begp
= str
;
200 if (BASE_LEADING_CODE_P (c
))
202 while (bytes
< len
&& ! CHAR_HEAD_P (begp
[bytes
])) bytes
++;
204 if (c
== LEADING_CODE_COMPOSITION
)
206 int cmpchar_id
= str_cmpchar_id (begp
, bytes
);
210 c
= MAKE_COMPOSITE_CHAR (cmpchar_id
);
211 str
+= cmpchar_table
[cmpchar_id
]->len
;
216 const unsigned char *endp
= begp
+ bytes
;
217 int charset
= c
, c1
, c2
= 0;
219 if (str
>= endp
) break;
220 if (c
>= LEADING_CODE_PRIVATE_11
&& c
<= LEADING_CODE_PRIVATE_22
)
226 c1
= charset
, charset
= c
;
230 if (CHARSET_DEFINED_P (charset
)
231 && CHARSET_DIMENSION (charset
) == 2
234 c
= MAKE_NON_ASCII_CHAR (charset
, c1
, c2
);
239 *actual_len
= exclude_tail_garbage
? str
- begp
: bytes
;
243 /* Return the length of the multi-byte form at string STR of length LEN. */
245 multibyte_form_length (str
, len
)
246 const unsigned char *str
;
251 if (BASE_LEADING_CODE_P (*str
))
252 while (bytes
< len
&& ! CHAR_HEAD_P (str
[bytes
])) bytes
++;
257 /* Check if string STR of length LEN contains valid multi-byte form of
258 a character. If valid, charset and position codes of the character
259 is set at *CHARSET, *C1, and *C2, and return 0. If not valid,
260 return -1. This should be used only in the macro SPLIT_STRING
261 which checks range of STR in advance. */
264 split_non_ascii_string (str
, len
, charset
, c1
, c2
)
265 register const unsigned char *str
;
266 register unsigned char *c1
, *c2
;
267 register int len
, *charset
;
269 register unsigned int cs
= *str
++;
271 if (cs
== LEADING_CODE_COMPOSITION
)
273 int cmpchar_id
= str_cmpchar_id (str
- 1, len
);
277 *charset
= cs
, *c1
= cmpchar_id
>> 7, *c2
= cmpchar_id
& 0x7F;
279 else if ((cs
< LEADING_CODE_PRIVATE_11
|| (cs
= *str
++) >= 0xA0)
280 && CHARSET_DEFINED_P (cs
))
285 *c1
= (*str
++) & 0x7F;
286 if (CHARSET_DIMENSION (cs
) == 2)
290 *c2
= (*str
++) & 0x7F;
298 /* Translate character C by translation table TABLE. If C
299 is negative, translate a character specified by CHARSET, C1, and C2
300 (C1 and C2 are code points of the character). If no translation is
301 found in TABLE, return C. */
303 translate_char (table
, c
, charset
, c1
, c2
)
305 int c
, charset
, c1
, c2
;
308 int alt_charset
, alt_c1
, alt_c2
, dimension
;
310 if (c
< 0) c
= MAKE_CHAR (charset
, c1
, c2
);
311 if (!CHAR_TABLE_P (table
)
312 || (ch
= Faref (table
, make_number (c
)), !INTEGERP (ch
))
316 SPLIT_CHAR (XFASTINT (ch
), alt_charset
, alt_c1
, alt_c2
);
317 dimension
= CHARSET_DIMENSION (alt_charset
);
318 if (dimension
== 1 && alt_c1
> 0 || dimension
== 2 && alt_c2
> 0)
319 /* CH is not a generic character, just return it. */
320 return XFASTINT (ch
);
322 /* Since CH is a generic character, we must return a specific
323 charater which has the same position codes as C from CH. */
325 SPLIT_CHAR (c
, charset
, c1
, c2
);
326 if (dimension
!= CHARSET_DIMENSION (charset
))
327 /* We can't make such a character because of dimension mismatch. */
329 return MAKE_CHAR (alt_charset
, c1
, c2
);
332 /* Convert the unibyte character C to multibyte based on
333 Vnonascii_translation_table or nonascii_insert_offset. If they can't
334 convert C to a valid multibyte character, convert it based on
335 DEFAULT_NONASCII_INSERT_OFFSET which makes C a Latin-1 character. */
338 unibyte_char_to_multibyte (c
)
345 if (! NILP (Vnonascii_translation_table
))
347 c
= XINT (Faref (Vnonascii_translation_table
, make_number (c
)));
348 if (c
>= 0400 && ! VALID_MULTIBYTE_CHAR_P (c
))
349 c
= c_save
+ DEFAULT_NONASCII_INSERT_OFFSET
;
351 else if (c
>= 0240 && nonascii_insert_offset
> 0)
353 c
+= nonascii_insert_offset
;
354 if (c
< 0400 || ! VALID_MULTIBYTE_CHAR_P (c
))
355 c
= c_save
+ DEFAULT_NONASCII_INSERT_OFFSET
;
358 c
= c_save
+ DEFAULT_NONASCII_INSERT_OFFSET
;
364 /* Convert the multibyte character C to unibyte 8-bit character based
365 on Vnonascii_translation_table or nonascii_insert_offset. If
366 REV_TBL is non-nil, it should be a reverse table of
367 Vnonascii_translation_table, i.e. what given by:
368 Fchar_table_extra_slot (Vnonascii_translation_table, make_number (0)) */
371 multibyte_char_to_unibyte (c
, rev_tbl
)
375 if (!SINGLE_BYTE_CHAR_P (c
))
379 if (! CHAR_TABLE_P (rev_tbl
)
380 && CHAR_TABLE_P (Vnonascii_translation_table
))
381 rev_tbl
= Fchar_table_extra_slot (Vnonascii_translation_table
,
383 if (CHAR_TABLE_P (rev_tbl
))
386 temp
= Faref (rev_tbl
, make_number (c
));
390 c
= (c_save
& 0177) + 0200;
394 if (nonascii_insert_offset
> 0)
395 c
-= nonascii_insert_offset
;
396 if (c
< 128 || c
>= 256)
397 c
= (c_save
& 0177) + 0200;
405 /* Update the table Vcharset_table with the given arguments (see the
406 document of `define-charset' for the meaning of each argument).
407 Several other table contents are also updated. The caller should
408 check the validity of CHARSET-ID and the remaining arguments in
412 update_charset_table (charset_id
, dimension
, chars
, width
, direction
,
413 iso_final_char
, iso_graphic_plane
,
414 short_name
, long_name
, description
)
415 Lisp_Object charset_id
, dimension
, chars
, width
, direction
;
416 Lisp_Object iso_final_char
, iso_graphic_plane
;
417 Lisp_Object short_name
, long_name
, description
;
419 int charset
= XINT (charset_id
);
421 unsigned char leading_code_base
, leading_code_ext
;
423 if (NILP (CHARSET_TABLE_ENTRY (charset
)))
424 CHARSET_TABLE_ENTRY (charset
)
425 = Fmake_vector (make_number (CHARSET_MAX_IDX
), Qnil
);
427 /* Get byte length of multibyte form, base leading-code, and
428 extended leading-code of the charset. See the comment under the
429 title "GENERAL NOTE on CHARACTER SET (CHARSET)" in charset.h. */
430 bytes
= XINT (dimension
);
431 if (charset
< MIN_CHARSET_PRIVATE_DIMENSION1
)
433 /* Official charset, it doesn't have an extended leading-code. */
434 if (charset
!= CHARSET_ASCII
)
435 bytes
+= 1; /* For a base leading-code. */
436 leading_code_base
= charset
;
437 leading_code_ext
= 0;
441 /* Private charset. */
442 bytes
+= 2; /* For base and extended leading-codes. */
444 = (charset
< LEADING_CODE_EXT_12
445 ? LEADING_CODE_PRIVATE_11
446 : (charset
< LEADING_CODE_EXT_21
447 ? LEADING_CODE_PRIVATE_12
448 : (charset
< LEADING_CODE_EXT_22
449 ? LEADING_CODE_PRIVATE_21
450 : LEADING_CODE_PRIVATE_22
)));
451 leading_code_ext
= charset
;
454 if (BYTES_BY_CHAR_HEAD (leading_code_base
) != bytes
)
455 error ("Invalid dimension for the charset-ID %d", charset
);
457 CHARSET_TABLE_INFO (charset
, CHARSET_ID_IDX
) = charset_id
;
458 CHARSET_TABLE_INFO (charset
, CHARSET_BYTES_IDX
) = make_number (bytes
);
459 CHARSET_TABLE_INFO (charset
, CHARSET_DIMENSION_IDX
) = dimension
;
460 CHARSET_TABLE_INFO (charset
, CHARSET_CHARS_IDX
) = chars
;
461 CHARSET_TABLE_INFO (charset
, CHARSET_WIDTH_IDX
) = width
;
462 CHARSET_TABLE_INFO (charset
, CHARSET_DIRECTION_IDX
) = direction
;
463 CHARSET_TABLE_INFO (charset
, CHARSET_LEADING_CODE_BASE_IDX
)
464 = make_number (leading_code_base
);
465 CHARSET_TABLE_INFO (charset
, CHARSET_LEADING_CODE_EXT_IDX
)
466 = make_number (leading_code_ext
);
467 CHARSET_TABLE_INFO (charset
, CHARSET_ISO_FINAL_CHAR_IDX
) = iso_final_char
;
468 CHARSET_TABLE_INFO (charset
, CHARSET_ISO_GRAPHIC_PLANE_IDX
)
470 CHARSET_TABLE_INFO (charset
, CHARSET_SHORT_NAME_IDX
) = short_name
;
471 CHARSET_TABLE_INFO (charset
, CHARSET_LONG_NAME_IDX
) = long_name
;
472 CHARSET_TABLE_INFO (charset
, CHARSET_DESCRIPTION_IDX
) = description
;
473 CHARSET_TABLE_INFO (charset
, CHARSET_PLIST_IDX
) = Qnil
;
476 /* If we have already defined a charset which has the same
477 DIMENSION, CHARS and ISO-FINAL-CHAR but the different
478 DIRECTION, we must update the entry REVERSE-CHARSET of both
479 charsets. If there's no such charset, the value of the entry
483 for (i
= 0; i
<= MAX_CHARSET
; i
++)
484 if (!NILP (CHARSET_TABLE_ENTRY (i
)))
486 if (CHARSET_DIMENSION (i
) == XINT (dimension
)
487 && CHARSET_CHARS (i
) == XINT (chars
)
488 && CHARSET_ISO_FINAL_CHAR (i
) == XINT (iso_final_char
)
489 && CHARSET_DIRECTION (i
) != XINT (direction
))
491 CHARSET_TABLE_INFO (charset
, CHARSET_REVERSE_CHARSET_IDX
)
493 CHARSET_TABLE_INFO (i
, CHARSET_REVERSE_CHARSET_IDX
) = charset_id
;
498 /* No such a charset. */
499 CHARSET_TABLE_INFO (charset
, CHARSET_REVERSE_CHARSET_IDX
)
503 if (charset
!= CHARSET_ASCII
504 && charset
< MIN_CHARSET_PRIVATE_DIMENSION1
)
506 width_by_char_head
[leading_code_base
] = XINT (width
);
508 /* Update table emacs_code_class. */
509 emacs_code_class
[charset
] = (bytes
== 2
510 ? EMACS_leading_code_2
512 ? EMACS_leading_code_3
513 : EMACS_leading_code_4
));
516 /* Update table iso_charset_table. */
517 if (ISO_CHARSET_TABLE (dimension
, chars
, iso_final_char
) < 0)
518 ISO_CHARSET_TABLE (dimension
, chars
, iso_final_char
) = charset
;
523 /* Return charset id of CHARSET_SYMBOL, or return -1 if CHARSET_SYMBOL
526 get_charset_id (charset_symbol
)
527 Lisp_Object charset_symbol
;
532 return ((SYMBOLP (charset_symbol
)
533 && (val
= Fget (charset_symbol
, Qcharset
), VECTORP (val
))
534 && (charset
= XINT (XVECTOR (val
)->contents
[CHARSET_ID_IDX
]),
535 CHARSET_VALID_P (charset
)))
539 /* Return an identification number for a new private charset of
540 DIMENSION and WIDTH. If there's no more room for the new charset,
543 get_new_private_charset_id (dimension
, width
)
544 int dimension
, width
;
546 int charset
, from
, to
;
551 from
= LEADING_CODE_EXT_11
, to
= LEADING_CODE_EXT_12
;
553 from
= LEADING_CODE_EXT_12
, to
= LEADING_CODE_EXT_21
;
558 from
= LEADING_CODE_EXT_21
, to
= LEADING_CODE_EXT_22
;
560 from
= LEADING_CODE_EXT_22
, to
= LEADING_CODE_EXT_MAX
+ 1;
563 for (charset
= from
; charset
< to
; charset
++)
564 if (!CHARSET_DEFINED_P (charset
)) break;
566 return make_number (charset
< to
? charset
: 0);
569 DEFUN ("define-charset", Fdefine_charset
, Sdefine_charset
, 3, 3, 0,
570 "Define CHARSET-ID as the identification number of CHARSET with INFO-VECTOR.\n\
571 If CHARSET-ID is nil, it is decided automatically, which means CHARSET is\n\
572 treated as a private charset.\n\
573 INFO-VECTOR is a vector of the format:\n\
574 [DIMENSION CHARS WIDTH DIRECTION ISO-FINAL-CHAR ISO-GRAPHIC-PLANE\n\
575 SHORT-NAME LONG-NAME DESCRIPTION]\n\
576 The meanings of each elements is as follows:\n\
577 DIMENSION (integer) is the number of bytes to represent a character: 1 or 2.\n\
578 CHARS (integer) is the number of characters in a dimension: 94 or 96.\n\
579 WIDTH (integer) is the number of columns a character in the charset\n\
580 occupies on the screen: one of 0, 1, and 2.\n\
582 DIRECTION (integer) is the rendering direction of characters in the\n\
583 charset when rendering. If 0, render from left to right, else\n\
584 render from right to left.\n\
586 ISO-FINAL-CHAR (character) is the final character of the\n\
587 corresponding ISO 2022 charset.\n\
589 ISO-GRAPHIC-PLANE (integer) is the graphic plane to be invoked\n\
590 while encoding to variants of ISO 2022 coding system, one of the\n\
591 following: 0/graphic-plane-left(GL), 1/graphic-plane-right(GR).\n\
593 SHORT-NAME (string) is the short name to refer to the charset.\n\
595 LONG-NAME (string) is the long name to refer to the charset.\n\
597 DESCRIPTION (string) is the description string of the charset.")
598 (charset_id
, charset_symbol
, info_vector
)
599 Lisp_Object charset_id
, charset_symbol
, info_vector
;
603 if (!NILP (charset_id
))
604 CHECK_NUMBER (charset_id
, 0);
605 CHECK_SYMBOL (charset_symbol
, 1);
606 CHECK_VECTOR (info_vector
, 2);
608 if (! NILP (charset_id
))
610 if (! CHARSET_VALID_P (XINT (charset_id
)))
611 error ("Invalid CHARSET: %d", XINT (charset_id
));
612 else if (CHARSET_DEFINED_P (XINT (charset_id
)))
613 error ("Already defined charset: %d", XINT (charset_id
));
616 vec
= XVECTOR (info_vector
)->contents
;
617 if (XVECTOR (info_vector
)->size
!= 9
618 || !INTEGERP (vec
[0]) || !(XINT (vec
[0]) == 1 || XINT (vec
[0]) == 2)
619 || !INTEGERP (vec
[1]) || !(XINT (vec
[1]) == 94 || XINT (vec
[1]) == 96)
620 || !INTEGERP (vec
[2]) || !(XINT (vec
[2]) == 1 || XINT (vec
[2]) == 2)
621 || !INTEGERP (vec
[3]) || !(XINT (vec
[3]) == 0 || XINT (vec
[3]) == 1)
622 || !INTEGERP (vec
[4]) || !(XINT (vec
[4]) >= '0' && XINT (vec
[4]) <= '~')
623 || !INTEGERP (vec
[5]) || !(XINT (vec
[5]) == 0 || XINT (vec
[5]) == 1)
626 || !STRINGP (vec
[8]))
627 error ("Invalid info-vector argument for defining charset %s",
628 XSYMBOL (charset_symbol
)->name
->data
);
630 if (NILP (charset_id
))
632 charset_id
= get_new_private_charset_id (XINT (vec
[0]), XINT (vec
[2]));
633 if (XINT (charset_id
) == 0)
634 error ("There's no room for a new private charset %s",
635 XSYMBOL (charset_symbol
)->name
->data
);
638 update_charset_table (charset_id
, vec
[0], vec
[1], vec
[2], vec
[3],
639 vec
[4], vec
[5], vec
[6], vec
[7], vec
[8]);
640 Fput (charset_symbol
, Qcharset
, CHARSET_TABLE_ENTRY (XINT (charset_id
)));
641 CHARSET_SYMBOL (XINT (charset_id
)) = charset_symbol
;
642 Vcharset_list
= Fcons (charset_symbol
, Vcharset_list
);
646 DEFUN ("generic-character-list", Fgeneric_character_list
,
647 Sgeneric_character_list
, 0, 0, 0,
648 "Return a list of all possible generic characters.\n\
649 It includes a generic character for a charset not yet defined.")
652 return Vgeneric_character_list
;
655 DEFUN ("get-unused-iso-final-char", Fget_unused_iso_final_char
,
656 Sget_unused_iso_final_char
, 2, 2, 0,
657 "Return an unsed ISO's final char for a charset of DIMENISION and CHARS.\n\
658 DIMENSION is the number of bytes to represent a character: 1 or 2.\n\
659 CHARS is the number of characters in a dimension: 94 or 96.\n\
661 This final char is for private use, thus the range is `0' (48) .. `?' (63).\n\
662 If there's no unused final char for the specified kind of charset,\n\
665 Lisp_Object dimension
, chars
;
669 CHECK_NUMBER (dimension
, 0);
670 CHECK_NUMBER (chars
, 1);
671 if (XINT (dimension
) != 1 && XINT (dimension
) != 2)
672 error ("Invalid charset dimension %d, it should be 1 or 2",
674 if (XINT (chars
) != 94 && XINT (chars
) != 96)
675 error ("Invalid charset chars %d, it should be 94 or 96",
677 for (final_char
= '0'; final_char
<= '?'; final_char
++)
679 if (ISO_CHARSET_TABLE (dimension
, chars
, make_number (final_char
)) < 0)
682 return (final_char
<= '?' ? make_number (final_char
) : Qnil
);
685 DEFUN ("declare-equiv-charset", Fdeclare_equiv_charset
, Sdeclare_equiv_charset
,
687 "Declare a charset of DIMENSION, CHARS, FINAL-CHAR is the same as CHARSET.\n\
688 CHARSET should be defined by `defined-charset' in advance.")
689 (dimension
, chars
, final_char
, charset_symbol
)
690 Lisp_Object dimension
, chars
, final_char
, charset_symbol
;
694 CHECK_NUMBER (dimension
, 0);
695 CHECK_NUMBER (chars
, 1);
696 CHECK_NUMBER (final_char
, 2);
697 CHECK_SYMBOL (charset_symbol
, 3);
699 if (XINT (dimension
) != 1 && XINT (dimension
) != 2)
700 error ("Invalid DIMENSION %d, it should be 1 or 2", XINT (dimension
));
701 if (XINT (chars
) != 94 && XINT (chars
) != 96)
702 error ("Invalid CHARS %d, it should be 94 or 96", XINT (chars
));
703 if (XINT (final_char
) < '0' || XFASTINT (final_char
) > '~')
704 error ("Invalid FINAL-CHAR %c, it should be `0'..`~'", XINT (chars
));
705 if ((charset
= get_charset_id (charset_symbol
)) < 0)
706 error ("Invalid charset %s", XSYMBOL (charset_symbol
)->name
->data
);
708 ISO_CHARSET_TABLE (dimension
, chars
, final_char
) = charset
;
712 /* Return number of different charsets in STR of length LEN. In
713 addition, for each found charset N, CHARSETS[N] is set 1. The
714 caller should allocate CHARSETS (MAX_CHARSET + 1 elements) in advance.
715 It may lookup a translation table TABLE if supplied.
717 If CMPCHARP is nonzero and some composite character is found,
718 CHARSETS[128] is also set 1 and the returned number is incremented
722 find_charset_in_str (str
, len
, charsets
, table
, cmpcharp
)
728 register int num
= 0, c
;
730 if (! CHAR_TABLE_P (table
))
738 if (c
== LEADING_CODE_COMPOSITION
)
740 int cmpchar_id
= str_cmpchar_id (str
, len
);
745 struct cmpchar_info
*cmp_p
= cmpchar_table
[cmpchar_id
];
748 for (i
= 0; i
< cmp_p
->glyph_len
; i
++)
753 if ((c
= translate_char (table
, c
, 0, 0, 0)) < 0)
756 if ((charset
= CHAR_CHARSET (c
)) < 0)
757 charset
= CHARSET_ASCII
;
758 if (!charsets
[charset
])
760 charsets
[charset
] = 1;
766 if (cmpcharp
&& !charsets
[CHARSET_COMPOSITION
])
768 charsets
[CHARSET_COMPOSITION
] = 1;
774 charset
= CHARSET_ASCII
;
779 c
= STRING_CHAR_AND_LENGTH (str
, len
, bytes
);
782 int c1
= translate_char (table
, c
, 0, 0, 0);
786 charset
= CHAR_CHARSET (c
);
789 if (!charsets
[charset
])
791 charsets
[charset
] = 1;
800 DEFUN ("find-charset-region", Ffind_charset_region
, Sfind_charset_region
,
802 "Return a list of charsets in the region between BEG and END.\n\
803 BEG and END are buffer positions.\n\
804 If the region contains any composite character,\n\
805 `composition' is included in the returned list.\n\
806 Optional arg TABLE if non-nil is a translation table to look up.")
808 Lisp_Object beg
, end
, table
;
810 int charsets
[MAX_CHARSET
+ 1];
811 int from
, from_byte
, to
, stop
, stop_byte
, i
;
814 validate_region (&beg
, &end
);
815 from
= XFASTINT (beg
);
816 stop
= to
= XFASTINT (end
);
818 if (NILP (current_buffer
->enable_multibyte_characters
))
821 : Fcons (Qascii
, Qnil
));
823 if (from
< GPT
&& GPT
< to
)
826 stop_byte
= GPT_BYTE
;
829 stop_byte
= CHAR_TO_BYTE (stop
);
831 from_byte
= CHAR_TO_BYTE (from
);
833 bzero (charsets
, (MAX_CHARSET
+ 1) * sizeof (int));
836 find_charset_in_str (BYTE_POS_ADDR (from_byte
), stop_byte
- from_byte
,
840 from
= stop
, from_byte
= stop_byte
;
841 stop
= to
, stop_byte
= CHAR_TO_BYTE (stop
);
848 for (i
= MAX_CHARSET
; i
>= 0; i
--)
850 val
= Fcons (CHARSET_SYMBOL (i
), val
);
854 DEFUN ("find-charset-string", Ffind_charset_string
, Sfind_charset_string
,
856 "Return a list of charsets in STR.\n\
857 If the string contains any composite characters,\n\
858 `composition' is included in the returned list.\n\
859 Optional arg TABLE if non-nil is a translation table to look up.")
861 Lisp_Object str
, table
;
863 int charsets
[MAX_CHARSET
+ 1];
867 CHECK_STRING (str
, 0);
869 if (! STRING_MULTIBYTE (str
))
870 return (XSTRING (str
)->size
== 0
872 : Fcons (Qascii
, Qnil
));
874 bzero (charsets
, (MAX_CHARSET
+ 1) * sizeof (int));
875 find_charset_in_str (XSTRING (str
)->data
, STRING_BYTES (XSTRING (str
)),
878 for (i
= MAX_CHARSET
; i
>= 0; i
--)
880 val
= Fcons (CHARSET_SYMBOL (i
), val
);
884 DEFUN ("make-char-internal", Fmake_char_internal
, Smake_char_internal
, 1, 3, 0,
886 (charset
, code1
, code2
)
887 Lisp_Object charset
, code1
, code2
;
889 CHECK_NUMBER (charset
, 0);
892 XSETFASTINT (code1
, 0);
894 CHECK_NUMBER (code1
, 1);
896 XSETFASTINT (code2
, 0);
898 CHECK_NUMBER (code2
, 2);
900 if (!CHARSET_DEFINED_P (XINT (charset
)))
901 error ("Invalid charset: %d", XINT (charset
));
903 return make_number (MAKE_CHAR (XINT (charset
), XINT (code1
), XINT (code2
)));
906 DEFUN ("split-char", Fsplit_char
, Ssplit_char
, 1, 1, 0,
907 "Return list of charset and one or two position-codes of CHAR.")
914 CHECK_NUMBER (ch
, 0);
915 SPLIT_CHAR (XFASTINT (ch
), charset
, c1
, c2
);
917 ? Fcons (CHARSET_SYMBOL (charset
),
918 Fcons (make_number (c1
), Fcons (make_number (c2
), Qnil
)))
919 : Fcons (CHARSET_SYMBOL (charset
), Fcons (make_number (c1
), Qnil
)));
922 DEFUN ("char-charset", Fchar_charset
, Schar_charset
, 1, 1, 0,
923 "Return charset of CHAR.")
927 CHECK_NUMBER (ch
, 0);
929 return CHARSET_SYMBOL (CHAR_CHARSET (XINT (ch
)));
932 DEFUN ("charset-after", Fcharset_after
, Scharset_after
, 0, 1, 0,
933 "Return charset of a character in current buffer at position POS.\n\
934 If POS is nil, it defauls to the current point.")
938 register int pos_byte
, c
, charset
;
939 register unsigned char *p
;
943 else if (MARKERP (pos
))
944 pos_byte
= marker_byte_position (pos
);
947 CHECK_NUMBER (pos
, 0);
948 pos_byte
= CHAR_TO_BYTE (XINT (pos
));
950 p
= BYTE_POS_ADDR (pos_byte
);
951 c
= STRING_CHAR (p
, Z_BYTE
- pos_byte
);
952 charset
= CHAR_CHARSET (c
);
953 return CHARSET_SYMBOL (charset
);
956 DEFUN ("iso-charset", Fiso_charset
, Siso_charset
, 3, 3, 0,
957 "Return charset of ISO's specification DIMENSION, CHARS, and FINAL-CHAR.\n\
959 ISO 2022's designation sequence (escape sequence) distinguishes charsets\n\
960 by their DIMENSION, CHARS, and FINAL-CHAR,\n\
961 where as Emacs distinguishes them by charset symbol.\n\
962 See the documentation of the function `charset-info' for the meanings of\n\
963 DIMENSION, CHARS, and FINAL-CHAR.")
964 (dimension
, chars
, final_char
)
965 Lisp_Object dimension
, chars
, final_char
;
969 CHECK_NUMBER (dimension
, 0);
970 CHECK_NUMBER (chars
, 1);
971 CHECK_NUMBER (final_char
, 2);
973 if ((charset
= ISO_CHARSET_TABLE (dimension
, chars
, final_char
)) < 0)
975 return CHARSET_SYMBOL (charset
);
978 /* If GENERICP is nonzero, return nonzero iff C is a valid normal or
979 generic character. If GENERICP is zero, return nonzero iff C is a
980 valid normal character. Do not call this function directly,
981 instead use macro CHAR_VALID_P. */
983 char_valid_p (c
, genericp
)
990 if (SINGLE_BYTE_CHAR_P (c
))
992 SPLIT_NON_ASCII_CHAR (c
, charset
, c1
, c2
);
993 if (!CHARSET_DEFINED_P (charset
))
995 return (c
< MIN_CHAR_COMPOSITION
996 ? ((c
& CHAR_FIELD1_MASK
) /* i.e. dimension of C is two. */
997 ? (genericp
&& c1
== 0 && c2
== 0
998 || c1
>= 32 && c2
>= 32)
999 : (genericp
&& c1
== 0
1001 : c
< MIN_CHAR_COMPOSITION
+ n_cmpchars
);
1004 DEFUN ("char-valid-p", Fchar_valid_p
, Schar_valid_p
, 1, 2, 0,
1005 "Return t if OBJECT is a valid normal character.\n\
1006 If optional arg GENERICP is non-nil, also return t if OBJECT is\n\
1007 a valid generic character.")
1009 Lisp_Object object
, genericp
;
1011 if (! NATNUMP (object
))
1013 return (CHAR_VALID_P (XFASTINT (object
), !NILP (genericp
)) ? Qt
: Qnil
);
1016 DEFUN ("unibyte-char-to-multibyte", Funibyte_char_to_multibyte
,
1017 Sunibyte_char_to_multibyte
, 1, 1, 0,
1018 "Convert the unibyte character CH to multibyte character.\n\
1019 The conversion is done based on `nonascii-translation-table' (which see)\n\
1020 or `nonascii-insert-offset' (which see).")
1026 CHECK_NUMBER (ch
, 0);
1028 if (c
< 0 || c
>= 0400)
1029 error ("Invalid unibyte character: %d", c
);
1030 c
= unibyte_char_to_multibyte (c
);
1032 error ("Can't convert to multibyte character: %d", XINT (ch
));
1033 return make_number (c
);
1036 DEFUN ("multibyte-char-to-unibyte", Fmultibyte_char_to_unibyte
,
1037 Smultibyte_char_to_unibyte
, 1, 1, 0,
1038 "Convert the multibyte character CH to unibyte character.\n\
1039 The conversion is done based on `nonascii-translation-table' (which see)\n\
1040 or `nonascii-insert-offset' (which see).")
1046 CHECK_NUMBER (ch
, 0);
1049 error ("Invalid multibyte character: %d", c
);
1050 c
= multibyte_char_to_unibyte (c
, Qnil
);
1052 error ("Can't convert to unibyte character: %d", XINT (ch
));
1053 return make_number (c
);
1056 DEFUN ("char-bytes", Fchar_bytes
, Schar_bytes
, 1, 1, 0,
1057 "Return 1 regardless of the argument CHAR.\n\
1058 This is now an obsolete function. We keep it just for backward compatibility.")
1064 CHECK_NUMBER (ch
, 0);
1065 return make_number (1);
1068 /* Return how many bytes C will occupy in a multibyte buffer.
1069 Don't call this function directly, instead use macro CHAR_BYTES. */
1076 if (COMPOSITE_CHAR_P (c
))
1078 unsigned int id
= COMPOSITE_CHAR_ID (c
);
1080 bytes
= (id
< n_cmpchars
? cmpchar_table
[id
]->len
: 1);
1084 int charset
= CHAR_CHARSET (c
);
1086 bytes
= CHARSET_DEFINED_P (charset
) ? CHARSET_BYTES (charset
) : 1;
1092 /* Return the width of character of which multi-byte form starts with
1093 C. The width is measured by how many columns occupied on the
1094 screen when displayed in the current buffer. */
1096 #define ONE_BYTE_CHAR_WIDTH(c) \
1099 ? XFASTINT (current_buffer->tab_width) \
1100 : (c == '\n' ? 0 : (NILP (current_buffer->ctl_arrow) ? 4 : 2))) \
1104 ? (NILP (current_buffer->ctl_arrow) ? 4 : 2) \
1105 : ((! NILP (current_buffer->enable_multibyte_characters) \
1106 && BASE_LEADING_CODE_P (c)) \
1107 ? WIDTH_BY_CHAR_HEAD (c) \
1110 DEFUN ("char-width", Fchar_width
, Schar_width
, 1, 1, 0,
1111 "Return width of CHAR when displayed in the current buffer.\n\
1112 The width is measured by how many columns it occupies on the screen.")
1116 Lisp_Object val
, disp
;
1118 struct Lisp_Char_Table
*dp
= buffer_display_table ();
1120 CHECK_NUMBER (ch
, 0);
1124 /* Get the way the display table would display it. */
1125 disp
= dp
? DISP_CHAR_VECTOR (dp
, c
) : Qnil
;
1128 XSETINT (val
, XVECTOR (disp
)->size
);
1129 else if (SINGLE_BYTE_CHAR_P (c
))
1130 XSETINT (val
, ONE_BYTE_CHAR_WIDTH (c
));
1131 else if (COMPOSITE_CHAR_P (c
))
1133 int id
= COMPOSITE_CHAR_ID (XFASTINT (ch
));
1134 XSETFASTINT (val
, (id
< n_cmpchars
? cmpchar_table
[id
]->width
: 0));
1138 int charset
= CHAR_CHARSET (c
);
1140 XSETFASTINT (val
, CHARSET_WIDTH (charset
));
1145 /* Return width of string STR of length LEN when displayed in the
1146 current buffer. The width is measured by how many columns it
1147 occupies on the screen. */
1154 unsigned char *endp
= str
+ len
;
1156 struct Lisp_Char_Table
*dp
= buffer_display_table ();
1160 if (*str
== LEADING_CODE_COMPOSITION
)
1162 int id
= str_cmpchar_id (str
, endp
- str
);
1171 width
+= cmpchar_table
[id
]->width
;
1172 str
+= cmpchar_table
[id
]->len
;
1179 int c
= STRING_CHAR_AND_LENGTH (str
, endp
- str
, thislen
);
1181 /* Get the way the display table would display it. */
1183 disp
= DISP_CHAR_VECTOR (dp
, c
);
1188 width
+= XVECTOR (disp
)->size
;
1190 width
+= ONE_BYTE_CHAR_WIDTH (*str
);
1198 DEFUN ("string-width", Fstring_width
, Sstring_width
, 1, 1, 0,
1199 "Return width of STRING when displayed in the current buffer.\n\
1200 Width is measured by how many columns it occupies on the screen.\n\
1201 When calculating width of a multibyte character in STRING,\n\
1202 only the base leading-code is considered; the validity of\n\
1203 the following bytes is not checked.")
1209 CHECK_STRING (str
, 0);
1210 XSETFASTINT (val
, strwidth (XSTRING (str
)->data
,
1211 STRING_BYTES (XSTRING (str
))));
1215 DEFUN ("char-direction", Fchar_direction
, Schar_direction
, 1, 1, 0,
1216 "Return the direction of CHAR.\n\
1217 The returned value is 0 for left-to-right and 1 for right-to-left.")
1223 CHECK_NUMBER (ch
, 0);
1224 charset
= CHAR_CHARSET (XFASTINT (ch
));
1225 if (!CHARSET_DEFINED_P (charset
))
1226 invalid_character (XINT (ch
));
1227 return CHARSET_TABLE_INFO (charset
, CHARSET_DIRECTION_IDX
);
1230 DEFUN ("chars-in-region", Fchars_in_region
, Schars_in_region
, 2, 2, 0,
1231 "Return number of characters between BEG and END.")
1233 Lisp_Object beg
, end
;
1237 CHECK_NUMBER_COERCE_MARKER (beg
, 0);
1238 CHECK_NUMBER_COERCE_MARKER (end
, 1);
1240 from
= min (XFASTINT (beg
), XFASTINT (end
));
1241 to
= max (XFASTINT (beg
), XFASTINT (end
));
1243 return make_number (to
- from
);
1246 /* Return the number of characters in the NBYTES bytes at PTR.
1247 This works by looking at the contents and checking for multibyte sequences.
1248 However, if the current buffer has enable-multibyte-characters = nil,
1249 we treat each byte as a character. */
1252 chars_in_text (ptr
, nbytes
)
1256 unsigned char *endp
, c
;
1259 /* current_buffer is null at early stages of Emacs initialization. */
1260 if (current_buffer
== 0
1261 || NILP (current_buffer
->enable_multibyte_characters
))
1264 endp
= ptr
+ nbytes
;
1271 if (BASE_LEADING_CODE_P (c
))
1272 while (ptr
< endp
&& ! CHAR_HEAD_P (*ptr
)) ptr
++;
1279 /* Return the number of characters in the NBYTES bytes at PTR.
1280 This works by looking at the contents and checking for multibyte sequences.
1281 It ignores enable-multibyte-characters. */
1284 multibyte_chars_in_text (ptr
, nbytes
)
1288 unsigned char *endp
, c
;
1291 endp
= ptr
+ nbytes
;
1298 if (BASE_LEADING_CODE_P (c
))
1299 while (ptr
< endp
&& ! CHAR_HEAD_P (*ptr
)) ptr
++;
1306 DEFUN ("string", Fstring
, Sstring
, 1, MANY
, 0,
1307 "Concatenate all the argument characters and make the result a string.")
1314 = (unsigned char *) alloca (MAX_LENGTH_OF_MULTI_BYTE_FORM
* n
);
1315 unsigned char *p
= buf
;
1318 for (i
= 0; i
< n
; i
++)
1323 if (!INTEGERP (args
[i
]))
1324 CHECK_NUMBER (args
[i
], 0);
1326 len
= CHAR_STRING (c
, p
, str
);
1328 /* C is a composite character. */
1329 bcopy (str
, p
, len
);
1333 /* Here, we can't use make_string_from_bytes because of byte
1334 combining problem. */
1335 val
= make_string (buf
, p
- buf
);
1341 /*** Composite characters staffs ***/
1343 /* Each composite character is identified by CMPCHAR-ID which is
1344 assigned when Emacs needs the character code of the composite
1345 character (e.g. when displaying it on the screen). See the
1346 document "GENERAL NOTE on COMPOSITE CHARACTER" in `charset.h' how a
1347 composite character is represented in Emacs. */
1349 /* If `static' is defined, it means that it is defined to null string. */
1351 /* The following function is copied from lread.c. */
1353 hash_string (ptr
, len
)
1357 register unsigned char *p
= ptr
;
1358 register unsigned char *end
= p
+ len
;
1359 register unsigned char c
;
1360 register int hash
= 0;
1365 if (c
>= 0140) c
-= 40;
1366 hash
= ((hash
<<3) + (hash
>>28) + c
);
1368 return hash
& 07777777777;
1372 #define CMPCHAR_HASH_TABLE_SIZE 0xFFF
1374 static int *cmpchar_hash_table
[CMPCHAR_HASH_TABLE_SIZE
];
1376 /* Each element of `cmpchar_hash_table' is a pointer to an array of
1377 integer, where the 1st element is the size of the array, the 2nd
1378 element is how many elements are actually used in the array, and
1379 the remaining elements are CMPCHAR-IDs of composite characters of
1380 the same hash value. */
1381 #define CMPCHAR_HASH_SIZE(table) table[0]
1382 #define CMPCHAR_HASH_USED(table) table[1]
1383 #define CMPCHAR_HASH_CMPCHAR_ID(table, i) table[i]
1385 /* Return CMPCHAR-ID of the composite character in STR of the length
1386 LEN. If the composite character has not yet been registered,
1387 register it in `cmpchar_table' and assign new CMPCHAR-ID. This
1388 is the sole function for assigning CMPCHAR-ID. */
1390 str_cmpchar_id (str
, len
)
1391 const unsigned char *str
;
1394 int hash_idx
, *hashp
;
1396 int embedded_rule
; /* 1 if composition rule is embedded. */
1397 int chars
; /* number of components. */
1399 struct cmpchar_info
*cmpcharp
;
1401 /* The second byte 0xFF means compostion rule is embedded. */
1402 embedded_rule
= (str
[1] == 0xFF);
1404 /* At first, get the actual length of the composite character. */
1406 const unsigned char *p
, *endp
= str
+ 1, *lastp
= str
+ len
;
1409 while (endp
< lastp
&& ! CHAR_HEAD_P (*endp
)) endp
++;
1411 /* Any composite char have at least 5-byte length. */
1418 if (embedded_rule
) p
++;
1419 /* No need of checking if *P is 0xA0 because
1420 BYTES_BY_CHAR_HEAD (0x80) surely returns 2. */
1421 p
+= BYTES_BY_CHAR_HEAD (*p
- 0x20);
1424 if (p
> endp
|| chars
< 2 || chars
> MAX_COMPONENT_COUNT
)
1425 /* Invalid components. */
1429 hash_idx
= hash_string (str
, len
) % CMPCHAR_HASH_TABLE_SIZE
;
1430 hashp
= cmpchar_hash_table
[hash_idx
];
1432 /* Then, look into the hash table. */
1434 /* Find the correct one among composite characters of the same
1436 for (i
= 2; i
< CMPCHAR_HASH_USED (hashp
); i
++)
1438 cmpcharp
= cmpchar_table
[CMPCHAR_HASH_CMPCHAR_ID (hashp
, i
)];
1439 if (len
== cmpcharp
->len
1440 && ! bcmp (str
, cmpcharp
->data
, len
))
1441 return CMPCHAR_HASH_CMPCHAR_ID (hashp
, i
);
1444 /* We have to register the composite character in cmpchar_table. */
1445 if (n_cmpchars
> (CHAR_FIELD2_MASK
| CHAR_FIELD3_MASK
))
1446 /* No, we have no more room for a new composite character. */
1449 /* Make the entry in hash table. */
1452 /* Make a table for 8 composite characters initially. */
1453 hashp
= (cmpchar_hash_table
[hash_idx
]
1454 = (int *) xmalloc (sizeof (int) * (2 + 8)));
1455 CMPCHAR_HASH_SIZE (hashp
) = 10;
1456 CMPCHAR_HASH_USED (hashp
) = 2;
1458 else if (CMPCHAR_HASH_USED (hashp
) >= CMPCHAR_HASH_SIZE (hashp
))
1460 CMPCHAR_HASH_SIZE (hashp
) += 8;
1461 hashp
= (cmpchar_hash_table
[hash_idx
]
1462 = (int *) xrealloc (hashp
,
1463 sizeof (int) * CMPCHAR_HASH_SIZE (hashp
)));
1465 CMPCHAR_HASH_CMPCHAR_ID (hashp
, CMPCHAR_HASH_USED (hashp
)) = n_cmpchars
;
1466 CMPCHAR_HASH_USED (hashp
)++;
1468 /* Set information of the composite character in cmpchar_table. */
1469 if (cmpchar_table_size
== 0)
1471 /* This is the first composite character to be registered. */
1472 cmpchar_table_size
= 256;
1474 = (struct cmpchar_info
**) xmalloc (sizeof (cmpchar_table
[0])
1475 * cmpchar_table_size
);
1477 else if (cmpchar_table_size
<= n_cmpchars
)
1479 cmpchar_table_size
+= 256;
1481 = (struct cmpchar_info
**) xrealloc (cmpchar_table
,
1482 sizeof (cmpchar_table
[0])
1483 * cmpchar_table_size
);
1486 cmpcharp
= (struct cmpchar_info
*) xmalloc (sizeof (struct cmpchar_info
));
1488 cmpcharp
->len
= len
;
1489 cmpcharp
->data
= (unsigned char *) xmalloc (len
+ 1);
1490 bcopy (str
, cmpcharp
->data
, len
);
1491 cmpcharp
->data
[len
] = 0;
1492 cmpcharp
->glyph_len
= chars
;
1493 cmpcharp
->glyph
= (GLYPH
*) xmalloc (sizeof (GLYPH
) * chars
);
1496 cmpcharp
->cmp_rule
= (unsigned char *) xmalloc (chars
);
1497 cmpcharp
->col_offset
= (float *) xmalloc (sizeof (float) * chars
);
1501 cmpcharp
->cmp_rule
= NULL
;
1502 cmpcharp
->col_offset
= NULL
;
1505 /* Setup GLYPH data and composition rules (if any) so as not to make
1506 them every time on displaying. */
1508 unsigned char *bufp
;
1510 float leftmost
= 0.0, rightmost
= 1.0;
1513 /* At first, col_offset[N] is set to relative to col_offset[0]. */
1514 cmpcharp
->col_offset
[0] = 0;
1516 for (i
= 0, bufp
= cmpcharp
->data
+ 1; i
< chars
; i
++)
1519 cmpcharp
->cmp_rule
[i
] = *bufp
++;
1521 if (*bufp
== 0xA0) /* This is an ASCII character. */
1523 cmpcharp
->glyph
[i
] = FAST_MAKE_GLYPH ((*++bufp
& 0x7F), 0);
1527 else /* Multibyte character. */
1529 /* Make `bufp' point normal multi-byte form temporally. */
1532 = FAST_MAKE_GLYPH (string_to_non_ascii_char (bufp
, 4, 0, 0), 0);
1533 width
= WIDTH_BY_CHAR_HEAD (*bufp
);
1535 bufp
+= BYTES_BY_CHAR_HEAD (*bufp
- 0x20);
1538 if (embedded_rule
&& i
> 0)
1540 /* Reference points (global_ref and new_ref) are
1551 Now, we calculate the column offset of the new glyph
1552 from the left edge of the first glyph. This can avoid
1553 the same calculation everytime displaying this
1554 composite character. */
1556 /* Reference points of global glyph and new glyph. */
1557 int global_ref
= (cmpcharp
->cmp_rule
[i
] - 0xA0) / 9;
1558 int new_ref
= (cmpcharp
->cmp_rule
[i
] - 0xA0) % 9;
1559 /* Column offset relative to the first glyph. */
1560 float left
= (leftmost
1561 + (global_ref
% 3) * (rightmost
- leftmost
) / 2.0
1562 - (new_ref
% 3) * width
/ 2.0);
1564 cmpcharp
->col_offset
[i
] = left
;
1565 if (left
< leftmost
)
1567 if (left
+ width
> rightmost
)
1568 rightmost
= left
+ width
;
1572 if (width
> rightmost
)
1578 /* Now col_offset[N] are relative to the left edge of the
1579 first component. Make them relative to the left edge of
1581 for (i
= 0; i
< chars
; i
++)
1582 cmpcharp
->col_offset
[i
] -= leftmost
;
1583 /* Make rightmost holds width of overall glyph. */
1584 rightmost
-= leftmost
;
1587 cmpcharp
->width
= rightmost
;
1588 if (cmpcharp
->width
< rightmost
)
1589 /* To get a ceiling integer value. */
1593 cmpchar_table
[n_cmpchars
] = cmpcharp
;
1595 return n_cmpchars
++;
1598 /* Return the Nth element of the composite character C. */
1600 cmpchar_component (c
, n
)
1603 int id
= COMPOSITE_CHAR_ID (c
);
1605 if (id
>= n_cmpchars
/* C is not a valid composite character. */
1606 || n
>= cmpchar_table
[id
]->glyph_len
) /* No such component. */
1608 /* No face data is stored in glyph code. */
1609 return ((int) (cmpchar_table
[id
]->glyph
[n
]));
1612 DEFUN ("cmpcharp", Fcmpcharp
, Scmpcharp
, 1, 1, 0,
1613 "T if CHAR is a composite character.")
1617 CHECK_NUMBER (ch
, 0);
1618 return (COMPOSITE_CHAR_P (XINT (ch
)) ? Qt
: Qnil
);
1621 DEFUN ("composite-char-component", Fcmpchar_component
, Scmpchar_component
,
1623 "Return the IDXth component character of composite character CHARACTER.")
1625 Lisp_Object character
, idx
;
1629 CHECK_NUMBER (character
, 0);
1630 CHECK_NUMBER (idx
, 1);
1632 if ((c
= cmpchar_component (XINT (character
), XINT (idx
))) < 0)
1633 args_out_of_range (character
, idx
);
1635 return make_number (c
);
1638 DEFUN ("composite-char-composition-rule", Fcmpchar_cmp_rule
, Scmpchar_cmp_rule
,
1640 "Return the Nth composition rule embedded in composite character CHARACTER.\n\
1641 The returned rule is for composing the Nth component\n\
1642 on the (N-1)th component. If N is 0, the returned value is always 255.")
1644 Lisp_Object character
, n
;
1648 CHECK_NUMBER (character
, 0);
1649 CHECK_NUMBER (n
, 1);
1651 id
= COMPOSITE_CHAR_ID (XINT (character
));
1652 if (id
< 0 || id
>= n_cmpchars
)
1653 error ("Invalid composite character: %d", XINT (character
));
1655 if (i
> cmpchar_table
[id
]->glyph_len
)
1656 args_out_of_range (character
, n
);
1658 return make_number (cmpchar_table
[id
]->cmp_rule
[i
]);
1661 DEFUN ("composite-char-composition-rule-p", Fcmpchar_cmp_rule_p
,
1662 Scmpchar_cmp_rule_p
, 1, 1, 0,
1663 "Return non-nil if composite character CHARACTER contains a embedded rule.")
1665 Lisp_Object character
;
1669 CHECK_NUMBER (character
, 0);
1670 id
= COMPOSITE_CHAR_ID (XINT (character
));
1671 if (id
< 0 || id
>= n_cmpchars
)
1672 error ("Invalid composite character: %d", XINT (character
));
1674 return (cmpchar_table
[id
]->cmp_rule
? Qt
: Qnil
);
1677 DEFUN ("composite-char-component-count", Fcmpchar_cmp_count
,
1678 Scmpchar_cmp_count
, 1, 1, 0,
1679 "Return number of compoents of composite character CHARACTER.")
1681 Lisp_Object character
;
1685 CHECK_NUMBER (character
, 0);
1686 id
= COMPOSITE_CHAR_ID (XINT (character
));
1687 if (id
< 0 || id
>= n_cmpchars
)
1688 error ("Invalid composite character: %d", XINT (character
));
1690 return (make_number (cmpchar_table
[id
]->glyph_len
));
1693 DEFUN ("compose-string", Fcompose_string
, Scompose_string
,
1695 "Return one char string composed from all characters in STRING.")
1699 unsigned char buf
[MAX_LENGTH_OF_MULTI_BYTE_FORM
], *p
, *pend
, *ptemp
;
1702 CHECK_STRING (str
, 0);
1704 buf
[0] = LEADING_CODE_COMPOSITION
;
1705 p
= XSTRING (str
)->data
;
1706 pend
= p
+ STRING_BYTES (XSTRING (str
));
1710 if (*p
< 0x20 || *p
== 127) /* control code */
1711 error ("Invalid component character: %d", *p
);
1712 else if (*p
< 0x80) /* ASCII */
1714 if (i
+ 2 >= MAX_LENGTH_OF_MULTI_BYTE_FORM
)
1715 error ("Too long string to be composed: %s", XSTRING (str
)->data
);
1716 /* Prepend an ASCII charset indicator 0xA0, set MSB of the
1719 buf
[i
++] = *p
++ + 0x80;
1721 else if (*p
== LEADING_CODE_COMPOSITION
) /* composite char */
1723 /* Already composed. Eliminate the heading
1724 LEADING_CODE_COMPOSITION, keep the remaining bytes
1728 while (! CHAR_HEAD_P (*p
)) p
++;
1729 if (i
+ (p
- ptemp
) >= MAX_LENGTH_OF_MULTI_BYTE_FORM
)
1730 error ("Too long string to be composed: %s", XSTRING (str
)->data
);
1731 bcopy (ptemp
, buf
+ i
, p
- ptemp
);
1734 else /* multibyte char */
1736 /* Add 0x20 to the base leading-code, keep the remaining
1738 len
= BYTES_BY_CHAR_HEAD (*p
);
1739 if (i
+ len
>= MAX_LENGTH_OF_MULTI_BYTE_FORM
)
1740 error ("Too long string to be composed: %s", XSTRING (str
)->data
);
1741 bcopy (p
, buf
+ i
, len
);
1748 /* STR contains only one character, which can't be composed. */
1749 error ("Too short string to be composed: %s", XSTRING (str
)->data
);
1751 return make_string_from_bytes (buf
, 1, i
);
1756 charset_id_internal (charset_name
)
1761 val
= Fget (intern (charset_name
), Qcharset
);
1763 error ("Charset %s is not defined", charset_name
);
1765 return (XINT (XVECTOR (val
)->contents
[0]));
1768 DEFUN ("setup-special-charsets", Fsetup_special_charsets
,
1769 Ssetup_special_charsets
, 0, 0, 0, "Internal use only.")
1772 charset_latin_iso8859_1
= charset_id_internal ("latin-iso8859-1");
1773 charset_jisx0208_1978
= charset_id_internal ("japanese-jisx0208-1978");
1774 charset_jisx0208
= charset_id_internal ("japanese-jisx0208");
1775 charset_katakana_jisx0201
= charset_id_internal ("katakana-jisx0201");
1776 charset_latin_jisx0201
= charset_id_internal ("latin-jisx0201");
1777 charset_big5_1
= charset_id_internal ("chinese-big5-1");
1778 charset_big5_2
= charset_id_internal ("chinese-big5-2");
1783 init_charset_once ()
1787 staticpro (&Vcharset_table
);
1788 staticpro (&Vcharset_symbol_table
);
1789 staticpro (&Vgeneric_character_list
);
1791 /* This has to be done here, before we call Fmake_char_table. */
1792 Qcharset_table
= intern ("charset-table");
1793 staticpro (&Qcharset_table
);
1795 /* Intern this now in case it isn't already done.
1796 Setting this variable twice is harmless.
1797 But don't staticpro it here--that is done in alloc.c. */
1798 Qchar_table_extra_slots
= intern ("char-table-extra-slots");
1800 /* Now we are ready to set up this property, so we can
1801 create the charset table. */
1802 Fput (Qcharset_table
, Qchar_table_extra_slots
, make_number (0));
1803 Vcharset_table
= Fmake_char_table (Qcharset_table
, Qnil
);
1805 Vcharset_symbol_table
= Fmake_vector (make_number (MAX_CHARSET
+ 1), Qnil
);
1808 for (i
= 0; i
< 2; i
++)
1809 for (j
= 0; j
< 2; j
++)
1810 for (k
= 0; k
< 128; k
++)
1811 iso_charset_table
[i
][j
][k
] = -1;
1813 bzero (cmpchar_hash_table
, sizeof cmpchar_hash_table
);
1814 cmpchar_table_size
= n_cmpchars
= 0;
1816 for (i
= 0; i
< 256; i
++)
1817 BYTES_BY_CHAR_HEAD (i
) = 1;
1818 for (i
= MIN_CHARSET_OFFICIAL_DIMENSION1
;
1819 i
<= MAX_CHARSET_OFFICIAL_DIMENSION1
; i
++)
1820 BYTES_BY_CHAR_HEAD (i
) = 2;
1821 for (i
= MIN_CHARSET_OFFICIAL_DIMENSION2
;
1822 i
<= MAX_CHARSET_OFFICIAL_DIMENSION2
; i
++)
1823 BYTES_BY_CHAR_HEAD (i
) = 3;
1824 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_11
) = 3;
1825 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_12
) = 3;
1826 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_21
) = 4;
1827 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_22
) = 4;
1828 /* The followings don't reflect the actual bytes, but just to tell
1829 that it is a start of a multibyte character. */
1830 BYTES_BY_CHAR_HEAD (LEADING_CODE_COMPOSITION
) = 2;
1831 BYTES_BY_CHAR_HEAD (0x9E) = 2;
1832 BYTES_BY_CHAR_HEAD (0x9F) = 2;
1834 for (i
= 0; i
< 128; i
++)
1835 WIDTH_BY_CHAR_HEAD (i
) = 1;
1836 for (; i
< 256; i
++)
1837 WIDTH_BY_CHAR_HEAD (i
) = 4;
1838 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_11
) = 1;
1839 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_12
) = 2;
1840 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_21
) = 1;
1841 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_22
) = 2;
1847 for (i
= 0x81; i
< 0x90; i
++)
1848 val
= Fcons (make_number ((i
- 0x70) << 7), val
);
1849 for (; i
< 0x9A; i
++)
1850 val
= Fcons (make_number ((i
- 0x8F) << 14), val
);
1851 for (i
= 0xA0; i
< 0xF0; i
++)
1852 val
= Fcons (make_number ((i
- 0x70) << 7), val
);
1853 for (; i
< 0xFF; i
++)
1854 val
= Fcons (make_number ((i
- 0xE0) << 14), val
);
1855 val
= Fcons (make_number (GENERIC_COMPOSITION_CHAR
), val
);
1856 Vgeneric_character_list
= Fnreverse (val
);
1859 nonascii_insert_offset
= 0;
1860 Vnonascii_translation_table
= Qnil
;
1868 Qascii
= intern ("ascii");
1869 staticpro (&Qascii
);
1871 Qcharset
= intern ("charset");
1872 staticpro (&Qcharset
);
1874 /* Define ASCII charset now. */
1875 update_charset_table (make_number (CHARSET_ASCII
),
1876 make_number (1), make_number (94),
1881 build_string ("ASCII"),
1882 build_string ("ASCII"),
1883 build_string ("ASCII (ISO646 IRV)"));
1884 CHARSET_SYMBOL (CHARSET_ASCII
) = Qascii
;
1885 Fput (Qascii
, Qcharset
, CHARSET_TABLE_ENTRY (CHARSET_ASCII
));
1887 Qcomposition
= intern ("composition");
1888 staticpro (&Qcomposition
);
1889 CHARSET_SYMBOL (CHARSET_COMPOSITION
) = Qcomposition
;
1891 Qauto_fill_chars
= intern ("auto-fill-chars");
1892 staticpro (&Qauto_fill_chars
);
1893 Fput (Qauto_fill_chars
, Qchar_table_extra_slots
, make_number (0));
1895 defsubr (&Sdefine_charset
);
1896 defsubr (&Sgeneric_character_list
);
1897 defsubr (&Sget_unused_iso_final_char
);
1898 defsubr (&Sdeclare_equiv_charset
);
1899 defsubr (&Sfind_charset_region
);
1900 defsubr (&Sfind_charset_string
);
1901 defsubr (&Smake_char_internal
);
1902 defsubr (&Ssplit_char
);
1903 defsubr (&Schar_charset
);
1904 defsubr (&Scharset_after
);
1905 defsubr (&Siso_charset
);
1906 defsubr (&Schar_valid_p
);
1907 defsubr (&Sunibyte_char_to_multibyte
);
1908 defsubr (&Smultibyte_char_to_unibyte
);
1909 defsubr (&Schar_bytes
);
1910 defsubr (&Schar_width
);
1911 defsubr (&Sstring_width
);
1912 defsubr (&Schar_direction
);
1913 defsubr (&Schars_in_region
);
1915 defsubr (&Scmpcharp
);
1916 defsubr (&Scmpchar_component
);
1917 defsubr (&Scmpchar_cmp_rule
);
1918 defsubr (&Scmpchar_cmp_rule_p
);
1919 defsubr (&Scmpchar_cmp_count
);
1920 defsubr (&Scompose_string
);
1921 defsubr (&Ssetup_special_charsets
);
1923 DEFVAR_LISP ("charset-list", &Vcharset_list
,
1924 "List of charsets ever defined.");
1925 Vcharset_list
= Fcons (Qascii
, Qnil
);
1927 DEFVAR_LISP ("translation-table-vector", &Vtranslation_table_vector
,
1928 "Vector of cons cell of a symbol and translation table ever defined.\n\
1929 An ID of a translation table is an index of this vector.");
1930 Vtranslation_table_vector
= Fmake_vector (make_number (16), Qnil
);
1932 DEFVAR_INT ("leading-code-composition", &leading_code_composition
,
1933 "Leading-code of composite characters.");
1934 leading_code_composition
= LEADING_CODE_COMPOSITION
;
1936 DEFVAR_INT ("leading-code-private-11", &leading_code_private_11
,
1937 "Leading-code of private TYPE9N charset of column-width 1.");
1938 leading_code_private_11
= LEADING_CODE_PRIVATE_11
;
1940 DEFVAR_INT ("leading-code-private-12", &leading_code_private_12
,
1941 "Leading-code of private TYPE9N charset of column-width 2.");
1942 leading_code_private_12
= LEADING_CODE_PRIVATE_12
;
1944 DEFVAR_INT ("leading-code-private-21", &leading_code_private_21
,
1945 "Leading-code of private TYPE9Nx9N charset of column-width 1.");
1946 leading_code_private_21
= LEADING_CODE_PRIVATE_21
;
1948 DEFVAR_INT ("leading-code-private-22", &leading_code_private_22
,
1949 "Leading-code of private TYPE9Nx9N charset of column-width 2.");
1950 leading_code_private_22
= LEADING_CODE_PRIVATE_22
;
1952 DEFVAR_INT ("nonascii-insert-offset", &nonascii_insert_offset
,
1953 "Offset for converting non-ASCII unibyte codes 0240...0377 to multibyte.\n\
1954 This is used for converting unibyte text to multibyte,\n\
1955 and for inserting character codes specified by number.\n\n\
1956 This serves to convert a Latin-1 or similar 8-bit character code\n\
1957 to the corresponding Emacs multibyte character code.\n\
1958 Typically the value should be (- (make-char CHARSET 0) 128),\n\
1959 for your choice of character set.\n\
1960 If `nonascii-translation-table' is non-nil, it overrides this variable.");
1961 nonascii_insert_offset
= 0;
1963 DEFVAR_LISP ("nonascii-translation-table", &Vnonascii_translation_table
,
1964 "Translation table to convert non-ASCII unibyte codes to multibyte.\n\
1965 This is used for converting unibyte text to multibyte,\n\
1966 and for inserting character codes specified by number.\n\n\
1967 Conversion is performed only when multibyte characters are enabled,\n\
1968 and it serves to convert a Latin-1 or similar 8-bit character code\n\
1969 to the corresponding Emacs character code.\n\n\
1970 If this is nil, `nonascii-insert-offset' is used instead.\n\
1971 See also the docstring of `make-translation-table'.");
1972 Vnonascii_translation_table
= Qnil
;
1974 DEFVAR_INT ("min-composite-char", &min_composite_char
,
1975 "Minimum character code of a composite character.");
1976 min_composite_char
= MIN_CHAR_COMPOSITION
;
1978 DEFVAR_LISP ("auto-fill-chars", &Vauto_fill_chars
,
1979 "A char-table for characters which invoke auto-filling.\n\
1980 Such characters has value t in this table.");
1981 Vauto_fill_chars
= Fmake_char_table (Qauto_fill_chars
, Qnil
);
1982 CHAR_TABLE_SET (Vauto_fill_chars
, make_number (' '), Qt
);
1983 CHAR_TABLE_SET (Vauto_fill_chars
, make_number ('\n'), Qt
);