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 (c
& ~GLYPH_MASK_CHAR
)
147 /* Move the meta bit to the right place for a string. */
151 else if (c
& CHAR_SHIFT
&& (c
& 0x7F) >= 'a' && (c
& 0x7F) <= 'z')
159 invalid_character (c
);
161 if (COMPOSITE_CHAR_P (c
))
163 int cmpchar_id
= COMPOSITE_CHAR_ID (c
);
165 if (cmpchar_id
< n_cmpchars
)
167 *str
= cmpchar_table
[cmpchar_id
]->data
;
168 return cmpchar_table
[cmpchar_id
]->len
;
172 invalid_character (c
);
176 SPLIT_NON_ASCII_CHAR (c
, charset
, c1
, c2
);
178 || ! CHARSET_DEFINED_P (charset
)
179 || c1
>= 0 && c1
< 32
180 || c2
>= 0 && c2
< 32)
181 invalid_character (c
);
184 *workbuf
++ = CHARSET_LEADING_CODE_BASE (charset
);
185 if (*workbuf
= CHARSET_LEADING_CODE_EXT (charset
))
187 *workbuf
++ = c1
| 0x80;
189 *workbuf
++ = c2
| 0x80;
191 return (workbuf
- *str
);
194 /* Return a non-ASCII character of which multi-byte form is at STR of
195 length LEN. If ACTUAL_LEN is not NULL, the actual length of the
196 multibyte form is set to the address ACTUAL_LEN.
198 If exclude_tail_garbage is nonzero, ACTUAL_LEN excludes gabage
199 bytes following the non-ASCII character.
201 Use macro `STRING_CHAR (STR, LEN)' instead of calling this function
202 directly if STR can hold an ASCII character. */
205 string_to_non_ascii_char (str
, len
, actual_len
, exclude_tail_garbage
)
206 const unsigned char *str
;
207 int len
, *actual_len
, exclude_tail_garbage
;
210 unsigned char c1
, c2
;
212 const unsigned char *begp
= str
;
217 if (BASE_LEADING_CODE_P (c
))
219 while (bytes
< len
&& ! CHAR_HEAD_P (begp
[bytes
])) bytes
++;
221 if (c
== LEADING_CODE_COMPOSITION
)
223 int cmpchar_id
= str_cmpchar_id (begp
, bytes
);
227 c
= MAKE_COMPOSITE_CHAR (cmpchar_id
);
228 str
+= cmpchar_table
[cmpchar_id
]->len
- 1;
235 const unsigned char *endp
= begp
+ bytes
;
236 int charset
= c
, c1
, c2
= 0;
238 if (str
>= endp
) break;
239 if (c
>= LEADING_CODE_PRIVATE_11
&& c
<= LEADING_CODE_PRIVATE_22
)
245 c1
= charset
, charset
= c
;
249 if (CHARSET_DEFINED_P (charset
)
250 && CHARSET_DIMENSION (charset
) == 2
253 c
= MAKE_NON_ASCII_CHAR (charset
, c1
, c2
);
258 *actual_len
= exclude_tail_garbage
? str
- begp
: bytes
;
262 /* Return the length of the multi-byte form at string STR of length LEN. */
264 multibyte_form_length (str
, len
)
265 const unsigned char *str
;
270 if (BASE_LEADING_CODE_P (*str
))
271 while (bytes
< len
&& ! CHAR_HEAD_P (str
[bytes
])) bytes
++;
276 /* Check if string STR of length LEN contains valid multi-byte form of
277 a character. If valid, charset and position codes of the character
278 is set at *CHARSET, *C1, and *C2, and return 0. If not valid,
279 return -1. This should be used only in the macro SPLIT_STRING
280 which checks range of STR in advance. */
283 split_non_ascii_string (str
, len
, charset
, c1
, c2
)
284 register const unsigned char *str
;
285 register unsigned char *c1
, *c2
;
286 register int len
, *charset
;
288 register unsigned int cs
= *str
++;
290 if (cs
== LEADING_CODE_COMPOSITION
)
292 int cmpchar_id
= str_cmpchar_id (str
- 1, len
);
296 *charset
= cs
, *c1
= cmpchar_id
>> 7, *c2
= cmpchar_id
& 0x7F;
298 else if ((cs
< LEADING_CODE_PRIVATE_11
|| (cs
= *str
++) >= 0xA0)
299 && CHARSET_DEFINED_P (cs
))
304 *c1
= (*str
++) & 0x7F;
305 if (CHARSET_DIMENSION (cs
) == 2)
309 *c2
= (*str
++) & 0x7F;
317 /* Translate character C by translation table TABLE. If C
318 is negative, translate a character specified by CHARSET, C1, and C2
319 (C1 and C2 are code points of the character). If no translation is
320 found in TABLE, return C. */
322 translate_char (table
, c
, charset
, c1
, c2
)
324 int c
, charset
, c1
, c2
;
327 int alt_charset
, alt_c1
, alt_c2
, dimension
;
329 if (c
< 0) c
= MAKE_CHAR (charset
, c1
, c2
);
330 if (!CHAR_TABLE_P (table
)
331 || (ch
= Faref (table
, make_number (c
)), !INTEGERP (ch
))
335 SPLIT_CHAR (XFASTINT (ch
), alt_charset
, alt_c1
, alt_c2
);
336 dimension
= CHARSET_DIMENSION (alt_charset
);
337 if (dimension
== 1 && alt_c1
> 0 || dimension
== 2 && alt_c2
> 0)
338 /* CH is not a generic character, just return it. */
339 return XFASTINT (ch
);
341 /* Since CH is a generic character, we must return a specific
342 charater which has the same position codes as C from CH. */
344 SPLIT_CHAR (c
, charset
, c1
, c2
);
345 if (dimension
!= CHARSET_DIMENSION (charset
))
346 /* We can't make such a character because of dimension mismatch. */
348 return MAKE_CHAR (alt_charset
, c1
, c2
);
351 /* Convert the unibyte character C to multibyte based on
352 Vnonascii_translation_table or nonascii_insert_offset. If they can't
353 convert C to a valid multibyte character, convert it based on
354 DEFAULT_NONASCII_INSERT_OFFSET which makes C a Latin-1 character. */
357 unibyte_char_to_multibyte (c
)
364 if (! NILP (Vnonascii_translation_table
))
366 c
= XINT (Faref (Vnonascii_translation_table
, make_number (c
)));
367 if (c
>= 0400 && ! VALID_MULTIBYTE_CHAR_P (c
))
368 c
= c_save
+ DEFAULT_NONASCII_INSERT_OFFSET
;
370 else if (c
>= 0240 && nonascii_insert_offset
> 0)
372 c
+= nonascii_insert_offset
;
373 if (c
< 0400 || ! VALID_MULTIBYTE_CHAR_P (c
))
374 c
= c_save
+ DEFAULT_NONASCII_INSERT_OFFSET
;
377 c
= c_save
+ DEFAULT_NONASCII_INSERT_OFFSET
;
383 /* Convert the multibyte character C to unibyte 8-bit character based
384 on Vnonascii_translation_table or nonascii_insert_offset. If
385 REV_TBL is non-nil, it should be a reverse table of
386 Vnonascii_translation_table, i.e. what given by:
387 Fchar_table_extra_slot (Vnonascii_translation_table, make_number (0)) */
390 multibyte_char_to_unibyte (c
, rev_tbl
)
394 if (!SINGLE_BYTE_CHAR_P (c
))
398 if (! CHAR_TABLE_P (rev_tbl
)
399 && CHAR_TABLE_P (Vnonascii_translation_table
))
400 rev_tbl
= Fchar_table_extra_slot (Vnonascii_translation_table
,
402 if (CHAR_TABLE_P (rev_tbl
))
405 temp
= Faref (rev_tbl
, make_number (c
));
409 c
= (c_save
& 0177) + 0200;
413 if (nonascii_insert_offset
> 0)
414 c
-= nonascii_insert_offset
;
415 if (c
< 128 || c
>= 256)
416 c
= (c_save
& 0177) + 0200;
424 /* Update the table Vcharset_table with the given arguments (see the
425 document of `define-charset' for the meaning of each argument).
426 Several other table contents are also updated. The caller should
427 check the validity of CHARSET-ID and the remaining arguments in
431 update_charset_table (charset_id
, dimension
, chars
, width
, direction
,
432 iso_final_char
, iso_graphic_plane
,
433 short_name
, long_name
, description
)
434 Lisp_Object charset_id
, dimension
, chars
, width
, direction
;
435 Lisp_Object iso_final_char
, iso_graphic_plane
;
436 Lisp_Object short_name
, long_name
, description
;
438 int charset
= XINT (charset_id
);
440 unsigned char leading_code_base
, leading_code_ext
;
442 if (NILP (CHARSET_TABLE_ENTRY (charset
)))
443 CHARSET_TABLE_ENTRY (charset
)
444 = Fmake_vector (make_number (CHARSET_MAX_IDX
), Qnil
);
446 /* Get byte length of multibyte form, base leading-code, and
447 extended leading-code of the charset. See the comment under the
448 title "GENERAL NOTE on CHARACTER SET (CHARSET)" in charset.h. */
449 bytes
= XINT (dimension
);
450 if (charset
< MIN_CHARSET_PRIVATE_DIMENSION1
)
452 /* Official charset, it doesn't have an extended leading-code. */
453 if (charset
!= CHARSET_ASCII
)
454 bytes
+= 1; /* For a base leading-code. */
455 leading_code_base
= charset
;
456 leading_code_ext
= 0;
460 /* Private charset. */
461 bytes
+= 2; /* For base and extended leading-codes. */
463 = (charset
< LEADING_CODE_EXT_12
464 ? LEADING_CODE_PRIVATE_11
465 : (charset
< LEADING_CODE_EXT_21
466 ? LEADING_CODE_PRIVATE_12
467 : (charset
< LEADING_CODE_EXT_22
468 ? LEADING_CODE_PRIVATE_21
469 : LEADING_CODE_PRIVATE_22
)));
470 leading_code_ext
= charset
;
473 if (BYTES_BY_CHAR_HEAD (leading_code_base
) != bytes
)
474 error ("Invalid dimension for the charset-ID %d", charset
);
476 CHARSET_TABLE_INFO (charset
, CHARSET_ID_IDX
) = charset_id
;
477 CHARSET_TABLE_INFO (charset
, CHARSET_BYTES_IDX
) = make_number (bytes
);
478 CHARSET_TABLE_INFO (charset
, CHARSET_DIMENSION_IDX
) = dimension
;
479 CHARSET_TABLE_INFO (charset
, CHARSET_CHARS_IDX
) = chars
;
480 CHARSET_TABLE_INFO (charset
, CHARSET_WIDTH_IDX
) = width
;
481 CHARSET_TABLE_INFO (charset
, CHARSET_DIRECTION_IDX
) = direction
;
482 CHARSET_TABLE_INFO (charset
, CHARSET_LEADING_CODE_BASE_IDX
)
483 = make_number (leading_code_base
);
484 CHARSET_TABLE_INFO (charset
, CHARSET_LEADING_CODE_EXT_IDX
)
485 = make_number (leading_code_ext
);
486 CHARSET_TABLE_INFO (charset
, CHARSET_ISO_FINAL_CHAR_IDX
) = iso_final_char
;
487 CHARSET_TABLE_INFO (charset
, CHARSET_ISO_GRAPHIC_PLANE_IDX
)
489 CHARSET_TABLE_INFO (charset
, CHARSET_SHORT_NAME_IDX
) = short_name
;
490 CHARSET_TABLE_INFO (charset
, CHARSET_LONG_NAME_IDX
) = long_name
;
491 CHARSET_TABLE_INFO (charset
, CHARSET_DESCRIPTION_IDX
) = description
;
492 CHARSET_TABLE_INFO (charset
, CHARSET_PLIST_IDX
) = Qnil
;
495 /* If we have already defined a charset which has the same
496 DIMENSION, CHARS and ISO-FINAL-CHAR but the different
497 DIRECTION, we must update the entry REVERSE-CHARSET of both
498 charsets. If there's no such charset, the value of the entry
502 for (i
= 0; i
<= MAX_CHARSET
; i
++)
503 if (!NILP (CHARSET_TABLE_ENTRY (i
)))
505 if (CHARSET_DIMENSION (i
) == XINT (dimension
)
506 && CHARSET_CHARS (i
) == XINT (chars
)
507 && CHARSET_ISO_FINAL_CHAR (i
) == XINT (iso_final_char
)
508 && CHARSET_DIRECTION (i
) != XINT (direction
))
510 CHARSET_TABLE_INFO (charset
, CHARSET_REVERSE_CHARSET_IDX
)
512 CHARSET_TABLE_INFO (i
, CHARSET_REVERSE_CHARSET_IDX
) = charset_id
;
517 /* No such a charset. */
518 CHARSET_TABLE_INFO (charset
, CHARSET_REVERSE_CHARSET_IDX
)
522 if (charset
!= CHARSET_ASCII
523 && charset
< MIN_CHARSET_PRIVATE_DIMENSION1
)
525 width_by_char_head
[leading_code_base
] = XINT (width
);
527 /* Update table emacs_code_class. */
528 emacs_code_class
[charset
] = (bytes
== 2
529 ? EMACS_leading_code_2
531 ? EMACS_leading_code_3
532 : EMACS_leading_code_4
));
535 /* Update table iso_charset_table. */
536 if (ISO_CHARSET_TABLE (dimension
, chars
, iso_final_char
) < 0)
537 ISO_CHARSET_TABLE (dimension
, chars
, iso_final_char
) = charset
;
542 /* Return charset id of CHARSET_SYMBOL, or return -1 if CHARSET_SYMBOL
545 get_charset_id (charset_symbol
)
546 Lisp_Object charset_symbol
;
551 return ((SYMBOLP (charset_symbol
)
552 && (val
= Fget (charset_symbol
, Qcharset
), VECTORP (val
))
553 && (charset
= XINT (XVECTOR (val
)->contents
[CHARSET_ID_IDX
]),
554 CHARSET_VALID_P (charset
)))
558 /* Return an identification number for a new private charset of
559 DIMENSION and WIDTH. If there's no more room for the new charset,
562 get_new_private_charset_id (dimension
, width
)
563 int dimension
, width
;
565 int charset
, from
, to
;
570 from
= LEADING_CODE_EXT_11
, to
= LEADING_CODE_EXT_12
;
572 from
= LEADING_CODE_EXT_12
, to
= LEADING_CODE_EXT_21
;
577 from
= LEADING_CODE_EXT_21
, to
= LEADING_CODE_EXT_22
;
579 from
= LEADING_CODE_EXT_22
, to
= LEADING_CODE_EXT_MAX
+ 1;
582 for (charset
= from
; charset
< to
; charset
++)
583 if (!CHARSET_DEFINED_P (charset
)) break;
585 return make_number (charset
< to
? charset
: 0);
588 DEFUN ("define-charset", Fdefine_charset
, Sdefine_charset
, 3, 3, 0,
589 "Define CHARSET-ID as the identification number of CHARSET with INFO-VECTOR.\n\
590 If CHARSET-ID is nil, it is decided automatically, which means CHARSET is\n\
591 treated as a private charset.\n\
592 INFO-VECTOR is a vector of the format:\n\
593 [DIMENSION CHARS WIDTH DIRECTION ISO-FINAL-CHAR ISO-GRAPHIC-PLANE\n\
594 SHORT-NAME LONG-NAME DESCRIPTION]\n\
595 The meanings of each elements is as follows:\n\
596 DIMENSION (integer) is the number of bytes to represent a character: 1 or 2.\n\
597 CHARS (integer) is the number of characters in a dimension: 94 or 96.\n\
598 WIDTH (integer) is the number of columns a character in the charset\n\
599 occupies on the screen: one of 0, 1, and 2.\n\
601 DIRECTION (integer) is the rendering direction of characters in the\n\
602 charset when rendering. If 0, render from left to right, else\n\
603 render from right to left.\n\
605 ISO-FINAL-CHAR (character) is the final character of the\n\
606 corresponding ISO 2022 charset.\n\
608 ISO-GRAPHIC-PLANE (integer) is the graphic plane to be invoked\n\
609 while encoding to variants of ISO 2022 coding system, one of the\n\
610 following: 0/graphic-plane-left(GL), 1/graphic-plane-right(GR).\n\
612 SHORT-NAME (string) is the short name to refer to the charset.\n\
614 LONG-NAME (string) is the long name to refer to the charset.\n\
616 DESCRIPTION (string) is the description string of the charset.")
617 (charset_id
, charset_symbol
, info_vector
)
618 Lisp_Object charset_id
, charset_symbol
, info_vector
;
622 if (!NILP (charset_id
))
623 CHECK_NUMBER (charset_id
, 0);
624 CHECK_SYMBOL (charset_symbol
, 1);
625 CHECK_VECTOR (info_vector
, 2);
627 if (! NILP (charset_id
))
629 if (! CHARSET_VALID_P (XINT (charset_id
)))
630 error ("Invalid CHARSET: %d", XINT (charset_id
));
631 else if (CHARSET_DEFINED_P (XINT (charset_id
)))
632 error ("Already defined charset: %d", XINT (charset_id
));
635 vec
= XVECTOR (info_vector
)->contents
;
636 if (XVECTOR (info_vector
)->size
!= 9
637 || !INTEGERP (vec
[0]) || !(XINT (vec
[0]) == 1 || XINT (vec
[0]) == 2)
638 || !INTEGERP (vec
[1]) || !(XINT (vec
[1]) == 94 || XINT (vec
[1]) == 96)
639 || !INTEGERP (vec
[2]) || !(XINT (vec
[2]) == 1 || XINT (vec
[2]) == 2)
640 || !INTEGERP (vec
[3]) || !(XINT (vec
[3]) == 0 || XINT (vec
[3]) == 1)
641 || !INTEGERP (vec
[4]) || !(XINT (vec
[4]) >= '0' && XINT (vec
[4]) <= '~')
642 || !INTEGERP (vec
[5]) || !(XINT (vec
[5]) == 0 || XINT (vec
[5]) == 1)
645 || !STRINGP (vec
[8]))
646 error ("Invalid info-vector argument for defining charset %s",
647 XSYMBOL (charset_symbol
)->name
->data
);
649 if (NILP (charset_id
))
651 charset_id
= get_new_private_charset_id (XINT (vec
[0]), XINT (vec
[2]));
652 if (XINT (charset_id
) == 0)
653 error ("There's no room for a new private charset %s",
654 XSYMBOL (charset_symbol
)->name
->data
);
657 update_charset_table (charset_id
, vec
[0], vec
[1], vec
[2], vec
[3],
658 vec
[4], vec
[5], vec
[6], vec
[7], vec
[8]);
659 Fput (charset_symbol
, Qcharset
, CHARSET_TABLE_ENTRY (XINT (charset_id
)));
660 CHARSET_SYMBOL (XINT (charset_id
)) = charset_symbol
;
661 Vcharset_list
= Fcons (charset_symbol
, Vcharset_list
);
665 DEFUN ("generic-character-list", Fgeneric_character_list
,
666 Sgeneric_character_list
, 0, 0, 0,
667 "Return a list of all possible generic characters.\n\
668 It includes a generic character for a charset not yet defined.")
671 return Vgeneric_character_list
;
674 DEFUN ("get-unused-iso-final-char", Fget_unused_iso_final_char
,
675 Sget_unused_iso_final_char
, 2, 2, 0,
676 "Return an unsed ISO's final char for a charset of DIMENISION and CHARS.\n\
677 DIMENSION is the number of bytes to represent a character: 1 or 2.\n\
678 CHARS is the number of characters in a dimension: 94 or 96.\n\
680 This final char is for private use, thus the range is `0' (48) .. `?' (63).\n\
681 If there's no unused final char for the specified kind of charset,\n\
684 Lisp_Object dimension
, chars
;
688 CHECK_NUMBER (dimension
, 0);
689 CHECK_NUMBER (chars
, 1);
690 if (XINT (dimension
) != 1 && XINT (dimension
) != 2)
691 error ("Invalid charset dimension %d, it should be 1 or 2",
693 if (XINT (chars
) != 94 && XINT (chars
) != 96)
694 error ("Invalid charset chars %d, it should be 94 or 96",
696 for (final_char
= '0'; final_char
<= '?'; final_char
++)
698 if (ISO_CHARSET_TABLE (dimension
, chars
, make_number (final_char
)) < 0)
701 return (final_char
<= '?' ? make_number (final_char
) : Qnil
);
704 DEFUN ("declare-equiv-charset", Fdeclare_equiv_charset
, Sdeclare_equiv_charset
,
706 "Declare a charset of DIMENSION, CHARS, FINAL-CHAR is the same as CHARSET.\n\
707 CHARSET should be defined by `defined-charset' in advance.")
708 (dimension
, chars
, final_char
, charset_symbol
)
709 Lisp_Object dimension
, chars
, final_char
, charset_symbol
;
713 CHECK_NUMBER (dimension
, 0);
714 CHECK_NUMBER (chars
, 1);
715 CHECK_NUMBER (final_char
, 2);
716 CHECK_SYMBOL (charset_symbol
, 3);
718 if (XINT (dimension
) != 1 && XINT (dimension
) != 2)
719 error ("Invalid DIMENSION %d, it should be 1 or 2", XINT (dimension
));
720 if (XINT (chars
) != 94 && XINT (chars
) != 96)
721 error ("Invalid CHARS %d, it should be 94 or 96", XINT (chars
));
722 if (XINT (final_char
) < '0' || XFASTINT (final_char
) > '~')
723 error ("Invalid FINAL-CHAR %c, it should be `0'..`~'", XINT (chars
));
724 if ((charset
= get_charset_id (charset_symbol
)) < 0)
725 error ("Invalid charset %s", XSYMBOL (charset_symbol
)->name
->data
);
727 ISO_CHARSET_TABLE (dimension
, chars
, final_char
) = charset
;
731 /* Return number of different charsets in STR of length LEN. In
732 addition, for each found charset N, CHARSETS[N] is set 1. The
733 caller should allocate CHARSETS (MAX_CHARSET + 1 elements) in advance.
734 It may lookup a translation table TABLE if supplied.
736 If CMPCHARP is nonzero and some composite character is found,
737 CHARSETS[128] is also set 1 and the returned number is incremented
741 find_charset_in_str (str
, len
, charsets
, table
, cmpcharp
)
747 register int num
= 0, c
;
749 if (! CHAR_TABLE_P (table
))
757 if (c
== LEADING_CODE_COMPOSITION
)
759 int cmpchar_id
= str_cmpchar_id (str
, len
);
764 struct cmpchar_info
*cmp_p
= cmpchar_table
[cmpchar_id
];
767 for (i
= 0; i
< cmp_p
->glyph_len
; i
++)
772 if ((c
= translate_char (table
, c
, 0, 0, 0)) < 0)
775 if ((charset
= CHAR_CHARSET (c
)) < 0)
776 charset
= CHARSET_ASCII
;
777 if (!charsets
[charset
])
779 charsets
[charset
] = 1;
785 if (cmpcharp
&& !charsets
[CHARSET_COMPOSITION
])
787 charsets
[CHARSET_COMPOSITION
] = 1;
793 charset
= CHARSET_ASCII
;
798 c
= STRING_CHAR_AND_LENGTH (str
, len
, bytes
);
801 int c1
= translate_char (table
, c
, 0, 0, 0);
805 charset
= CHAR_CHARSET (c
);
808 if (!charsets
[charset
])
810 charsets
[charset
] = 1;
819 DEFUN ("find-charset-region", Ffind_charset_region
, Sfind_charset_region
,
821 "Return a list of charsets in the region between BEG and END.\n\
822 BEG and END are buffer positions.\n\
823 If the region contains any composite character,\n\
824 `composition' is included in the returned list.\n\
825 Optional arg TABLE if non-nil is a translation table to look up.")
827 Lisp_Object beg
, end
, table
;
829 int charsets
[MAX_CHARSET
+ 1];
830 int from
, from_byte
, to
, stop
, stop_byte
, i
;
833 validate_region (&beg
, &end
);
834 from
= XFASTINT (beg
);
835 stop
= to
= XFASTINT (end
);
837 if (NILP (current_buffer
->enable_multibyte_characters
))
840 : Fcons (Qascii
, Qnil
));
842 if (from
< GPT
&& GPT
< to
)
845 stop_byte
= GPT_BYTE
;
848 stop_byte
= CHAR_TO_BYTE (stop
);
850 from_byte
= CHAR_TO_BYTE (from
);
852 bzero (charsets
, (MAX_CHARSET
+ 1) * sizeof (int));
855 find_charset_in_str (BYTE_POS_ADDR (from_byte
), stop_byte
- from_byte
,
859 from
= stop
, from_byte
= stop_byte
;
860 stop
= to
, stop_byte
= CHAR_TO_BYTE (stop
);
867 for (i
= MAX_CHARSET
; i
>= 0; i
--)
869 val
= Fcons (CHARSET_SYMBOL (i
), val
);
873 DEFUN ("find-charset-string", Ffind_charset_string
, Sfind_charset_string
,
875 "Return a list of charsets in STR.\n\
876 If the string contains any composite characters,\n\
877 `composition' is included in the returned list.\n\
878 Optional arg TABLE if non-nil is a translation table to look up.")
880 Lisp_Object str
, table
;
882 int charsets
[MAX_CHARSET
+ 1];
886 CHECK_STRING (str
, 0);
888 if (! STRING_MULTIBYTE (str
))
889 return (XSTRING (str
)->size
== 0
891 : Fcons (Qascii
, Qnil
));
893 bzero (charsets
, (MAX_CHARSET
+ 1) * sizeof (int));
894 find_charset_in_str (XSTRING (str
)->data
, STRING_BYTES (XSTRING (str
)),
897 for (i
= MAX_CHARSET
; i
>= 0; i
--)
899 val
= Fcons (CHARSET_SYMBOL (i
), val
);
903 DEFUN ("make-char-internal", Fmake_char_internal
, Smake_char_internal
, 1, 3, 0,
905 (charset
, code1
, code2
)
906 Lisp_Object charset
, code1
, code2
;
908 CHECK_NUMBER (charset
, 0);
911 XSETFASTINT (code1
, 0);
913 CHECK_NUMBER (code1
, 1);
915 XSETFASTINT (code2
, 0);
917 CHECK_NUMBER (code2
, 2);
919 if (!CHARSET_DEFINED_P (XINT (charset
)))
920 error ("Invalid charset: %d", XINT (charset
));
922 return make_number (MAKE_CHAR (XINT (charset
), XINT (code1
), XINT (code2
)));
925 DEFUN ("split-char", Fsplit_char
, Ssplit_char
, 1, 1, 0,
926 "Return list of charset and one or two position-codes of CHAR.")
933 CHECK_NUMBER (ch
, 0);
934 SPLIT_CHAR (XFASTINT (ch
), charset
, c1
, c2
);
936 ? Fcons (CHARSET_SYMBOL (charset
),
937 Fcons (make_number (c1
), Fcons (make_number (c2
), Qnil
)))
938 : Fcons (CHARSET_SYMBOL (charset
), Fcons (make_number (c1
), Qnil
)));
941 DEFUN ("char-charset", Fchar_charset
, Schar_charset
, 1, 1, 0,
942 "Return charset of CHAR.")
946 CHECK_NUMBER (ch
, 0);
948 return CHARSET_SYMBOL (CHAR_CHARSET (XINT (ch
)));
951 DEFUN ("charset-after", Fcharset_after
, Scharset_after
, 0, 1, 0,
952 "Return charset of a character in current buffer at position POS.\n\
953 If POS is nil, it defauls to the current point.")
957 register int pos_byte
, c
, charset
;
958 register unsigned char *p
;
962 else if (MARKERP (pos
))
963 pos_byte
= marker_byte_position (pos
);
966 CHECK_NUMBER (pos
, 0);
967 pos_byte
= CHAR_TO_BYTE (XINT (pos
));
969 p
= BYTE_POS_ADDR (pos_byte
);
970 c
= STRING_CHAR (p
, Z_BYTE
- pos_byte
);
971 charset
= CHAR_CHARSET (c
);
972 return CHARSET_SYMBOL (charset
);
975 DEFUN ("iso-charset", Fiso_charset
, Siso_charset
, 3, 3, 0,
976 "Return charset of ISO's specification DIMENSION, CHARS, and FINAL-CHAR.\n\
978 ISO 2022's designation sequence (escape sequence) distinguishes charsets\n\
979 by their DIMENSION, CHARS, and FINAL-CHAR,\n\
980 where as Emacs distinguishes them by charset symbol.\n\
981 See the documentation of the function `charset-info' for the meanings of\n\
982 DIMENSION, CHARS, and FINAL-CHAR.")
983 (dimension
, chars
, final_char
)
984 Lisp_Object dimension
, chars
, final_char
;
988 CHECK_NUMBER (dimension
, 0);
989 CHECK_NUMBER (chars
, 1);
990 CHECK_NUMBER (final_char
, 2);
992 if ((charset
= ISO_CHARSET_TABLE (dimension
, chars
, final_char
)) < 0)
994 return CHARSET_SYMBOL (charset
);
997 /* If GENERICP is nonzero, return nonzero iff C is a valid normal or
998 generic character. If GENERICP is zero, return nonzero iff C is a
999 valid normal character. Do not call this function directly,
1000 instead use macro CHAR_VALID_P. */
1002 char_valid_p (c
, genericp
)
1005 int charset
, c1
, c2
;
1009 if (SINGLE_BYTE_CHAR_P (c
))
1011 SPLIT_NON_ASCII_CHAR (c
, charset
, c1
, c2
);
1012 if (charset
!= CHARSET_COMPOSITION
&& !CHARSET_DEFINED_P (charset
))
1014 return (c
< MIN_CHAR_COMPOSITION
1015 ? ((c
& CHAR_FIELD1_MASK
) /* i.e. dimension of C is two. */
1016 ? (genericp
&& c1
== 0 && c2
== 0
1017 || c1
>= 32 && c2
>= 32)
1018 : (genericp
&& c1
== 0
1020 : c
< MIN_CHAR_COMPOSITION
+ n_cmpchars
);
1023 DEFUN ("char-valid-p", Fchar_valid_p
, Schar_valid_p
, 1, 2, 0,
1024 "Return t if OBJECT is a valid normal character.\n\
1025 If optional arg GENERICP is non-nil, also return t if OBJECT is\n\
1026 a valid generic character.")
1028 Lisp_Object object
, genericp
;
1030 if (! NATNUMP (object
))
1032 return (CHAR_VALID_P (XFASTINT (object
), !NILP (genericp
)) ? Qt
: Qnil
);
1035 DEFUN ("unibyte-char-to-multibyte", Funibyte_char_to_multibyte
,
1036 Sunibyte_char_to_multibyte
, 1, 1, 0,
1037 "Convert the unibyte character CH to multibyte character.\n\
1038 The conversion is done based on `nonascii-translation-table' (which see)\n\
1039 or `nonascii-insert-offset' (which see).")
1045 CHECK_NUMBER (ch
, 0);
1047 if (c
< 0 || c
>= 0400)
1048 error ("Invalid unibyte character: %d", c
);
1049 c
= unibyte_char_to_multibyte (c
);
1051 error ("Can't convert to multibyte character: %d", XINT (ch
));
1052 return make_number (c
);
1055 DEFUN ("multibyte-char-to-unibyte", Fmultibyte_char_to_unibyte
,
1056 Smultibyte_char_to_unibyte
, 1, 1, 0,
1057 "Convert the multibyte character CH to unibyte character.\n\
1058 The conversion is done based on `nonascii-translation-table' (which see)\n\
1059 or `nonascii-insert-offset' (which see).")
1065 CHECK_NUMBER (ch
, 0);
1068 error ("Invalid multibyte character: %d", c
);
1069 c
= multibyte_char_to_unibyte (c
, Qnil
);
1071 error ("Can't convert to unibyte character: %d", XINT (ch
));
1072 return make_number (c
);
1075 DEFUN ("char-bytes", Fchar_bytes
, Schar_bytes
, 1, 1, 0,
1076 "Return 1 regardless of the argument CHAR.\n\
1077 This is now an obsolete function. We keep it just for backward compatibility.")
1083 CHECK_NUMBER (ch
, 0);
1084 return make_number (1);
1087 /* Return how many bytes C will occupy in a multibyte buffer.
1088 Don't call this function directly, instead use macro CHAR_BYTES. */
1095 if (SINGLE_BYTE_CHAR_P (c
) || (c
& ~GLYPH_MASK_CHAR
))
1098 if (COMPOSITE_CHAR_P (c
))
1100 unsigned int id
= COMPOSITE_CHAR_ID (c
);
1102 bytes
= (id
< n_cmpchars
? cmpchar_table
[id
]->len
: 1);
1106 int charset
= CHAR_CHARSET (c
);
1108 bytes
= CHARSET_DEFINED_P (charset
) ? CHARSET_BYTES (charset
) : 1;
1114 /* Return the width of character of which multi-byte form starts with
1115 C. The width is measured by how many columns occupied on the
1116 screen when displayed in the current buffer. */
1118 #define ONE_BYTE_CHAR_WIDTH(c) \
1121 ? XFASTINT (current_buffer->tab_width) \
1122 : (c == '\n' ? 0 : (NILP (current_buffer->ctl_arrow) ? 4 : 2))) \
1126 ? (NILP (current_buffer->ctl_arrow) ? 4 : 2) \
1127 : ((! NILP (current_buffer->enable_multibyte_characters) \
1128 && BASE_LEADING_CODE_P (c)) \
1129 ? WIDTH_BY_CHAR_HEAD (c) \
1132 DEFUN ("char-width", Fchar_width
, Schar_width
, 1, 1, 0,
1133 "Return width of CHAR when displayed in the current buffer.\n\
1134 The width is measured by how many columns it occupies on the screen.")
1138 Lisp_Object val
, disp
;
1140 struct Lisp_Char_Table
*dp
= buffer_display_table ();
1142 CHECK_NUMBER (ch
, 0);
1146 /* Get the way the display table would display it. */
1147 disp
= dp
? DISP_CHAR_VECTOR (dp
, c
) : Qnil
;
1150 XSETINT (val
, XVECTOR (disp
)->size
);
1151 else if (SINGLE_BYTE_CHAR_P (c
))
1152 XSETINT (val
, ONE_BYTE_CHAR_WIDTH (c
));
1153 else if (COMPOSITE_CHAR_P (c
))
1155 int id
= COMPOSITE_CHAR_ID (XFASTINT (ch
));
1156 XSETFASTINT (val
, (id
< n_cmpchars
? cmpchar_table
[id
]->width
: 0));
1160 int charset
= CHAR_CHARSET (c
);
1162 XSETFASTINT (val
, CHARSET_WIDTH (charset
));
1167 /* Return width of string STR of length LEN when displayed in the
1168 current buffer. The width is measured by how many columns it
1169 occupies on the screen. */
1176 unsigned char *endp
= str
+ len
;
1178 struct Lisp_Char_Table
*dp
= buffer_display_table ();
1182 if (*str
== LEADING_CODE_COMPOSITION
)
1184 int id
= str_cmpchar_id (str
, endp
- str
);
1193 width
+= cmpchar_table
[id
]->width
;
1194 str
+= cmpchar_table
[id
]->len
;
1201 int c
= STRING_CHAR_AND_LENGTH (str
, endp
- str
, thislen
);
1203 /* Get the way the display table would display it. */
1205 disp
= DISP_CHAR_VECTOR (dp
, c
);
1210 width
+= XVECTOR (disp
)->size
;
1212 width
+= ONE_BYTE_CHAR_WIDTH (*str
);
1220 DEFUN ("string-width", Fstring_width
, Sstring_width
, 1, 1, 0,
1221 "Return width of STRING when displayed in the current buffer.\n\
1222 Width is measured by how many columns it occupies on the screen.\n\
1223 When calculating width of a multibyte character in STRING,\n\
1224 only the base leading-code is considered; the validity of\n\
1225 the following bytes is not checked.")
1231 CHECK_STRING (str
, 0);
1232 XSETFASTINT (val
, strwidth (XSTRING (str
)->data
,
1233 STRING_BYTES (XSTRING (str
))));
1237 DEFUN ("char-direction", Fchar_direction
, Schar_direction
, 1, 1, 0,
1238 "Return the direction of CHAR.\n\
1239 The returned value is 0 for left-to-right and 1 for right-to-left.")
1245 CHECK_NUMBER (ch
, 0);
1246 charset
= CHAR_CHARSET (XFASTINT (ch
));
1247 if (!CHARSET_DEFINED_P (charset
))
1248 invalid_character (XINT (ch
));
1249 return CHARSET_TABLE_INFO (charset
, CHARSET_DIRECTION_IDX
);
1252 DEFUN ("chars-in-region", Fchars_in_region
, Schars_in_region
, 2, 2, 0,
1253 "Return number of characters between BEG and END.")
1255 Lisp_Object beg
, end
;
1259 CHECK_NUMBER_COERCE_MARKER (beg
, 0);
1260 CHECK_NUMBER_COERCE_MARKER (end
, 1);
1262 from
= min (XFASTINT (beg
), XFASTINT (end
));
1263 to
= max (XFASTINT (beg
), XFASTINT (end
));
1265 return make_number (to
- from
);
1268 /* Return the number of characters in the NBYTES bytes at PTR.
1269 This works by looking at the contents and checking for multibyte sequences.
1270 However, if the current buffer has enable-multibyte-characters = nil,
1271 we treat each byte as a character. */
1274 chars_in_text (ptr
, nbytes
)
1278 unsigned char *endp
, c
;
1281 /* current_buffer is null at early stages of Emacs initialization. */
1282 if (current_buffer
== 0
1283 || NILP (current_buffer
->enable_multibyte_characters
))
1286 endp
= ptr
+ nbytes
;
1293 if (BASE_LEADING_CODE_P (c
))
1294 while (ptr
< endp
&& ! CHAR_HEAD_P (*ptr
)) ptr
++;
1301 /* Return the number of characters in the NBYTES bytes at PTR.
1302 This works by looking at the contents and checking for multibyte sequences.
1303 It ignores enable-multibyte-characters. */
1306 multibyte_chars_in_text (ptr
, nbytes
)
1310 unsigned char *endp
, c
;
1313 endp
= ptr
+ nbytes
;
1320 if (BASE_LEADING_CODE_P (c
))
1321 while (ptr
< endp
&& ! CHAR_HEAD_P (*ptr
)) ptr
++;
1328 DEFUN ("string", Fstring
, Sstring
, 1, MANY
, 0,
1329 "Concatenate all the argument characters and make the result a string.")
1336 = (unsigned char *) alloca (MAX_LENGTH_OF_MULTI_BYTE_FORM
* n
);
1337 unsigned char *p
= buf
;
1340 for (i
= 0; i
< n
; i
++)
1345 if (!INTEGERP (args
[i
]))
1346 CHECK_NUMBER (args
[i
], 0);
1348 len
= CHAR_STRING (c
, p
, str
);
1350 /* C is a composite character. */
1351 bcopy (str
, p
, len
);
1355 /* Here, we can't use make_string_from_bytes because of byte
1356 combining problem. */
1357 val
= make_string (buf
, p
- buf
);
1363 /*** Composite characters staffs ***/
1365 /* Each composite character is identified by CMPCHAR-ID which is
1366 assigned when Emacs needs the character code of the composite
1367 character (e.g. when displaying it on the screen). See the
1368 document "GENERAL NOTE on COMPOSITE CHARACTER" in `charset.h' how a
1369 composite character is represented in Emacs. */
1371 /* If `static' is defined, it means that it is defined to null string. */
1373 /* The following function is copied from lread.c. */
1375 hash_string (ptr
, len
)
1379 register unsigned char *p
= ptr
;
1380 register unsigned char *end
= p
+ len
;
1381 register unsigned char c
;
1382 register int hash
= 0;
1387 if (c
>= 0140) c
-= 40;
1388 hash
= ((hash
<<3) + (hash
>>28) + c
);
1390 return hash
& 07777777777;
1394 #define CMPCHAR_HASH_TABLE_SIZE 0xFFF
1396 static int *cmpchar_hash_table
[CMPCHAR_HASH_TABLE_SIZE
];
1398 /* Each element of `cmpchar_hash_table' is a pointer to an array of
1399 integer, where the 1st element is the size of the array, the 2nd
1400 element is how many elements are actually used in the array, and
1401 the remaining elements are CMPCHAR-IDs of composite characters of
1402 the same hash value. */
1403 #define CMPCHAR_HASH_SIZE(table) table[0]
1404 #define CMPCHAR_HASH_USED(table) table[1]
1405 #define CMPCHAR_HASH_CMPCHAR_ID(table, i) table[i]
1407 /* Return CMPCHAR-ID of the composite character in STR of the length
1408 LEN. If the composite character has not yet been registered,
1409 register it in `cmpchar_table' and assign new CMPCHAR-ID. This
1410 is the sole function for assigning CMPCHAR-ID. */
1412 str_cmpchar_id (str
, len
)
1413 const unsigned char *str
;
1416 int hash_idx
, *hashp
;
1418 int embedded_rule
; /* 1 if composition rule is embedded. */
1419 int chars
; /* number of components. */
1421 struct cmpchar_info
*cmpcharp
;
1423 /* The second byte 0xFF means compostion rule is embedded. */
1424 embedded_rule
= (str
[1] == 0xFF);
1426 /* At first, get the actual length of the composite character. */
1428 const unsigned char *p
, *endp
= str
+ 1, *lastp
= str
+ len
;
1431 while (endp
< lastp
&& ! CHAR_HEAD_P (*endp
)) endp
++;
1433 /* Any composite char have at least 5-byte length. */
1446 /* No need of checking if *P is 0xA0 because
1447 BYTES_BY_CHAR_HEAD (0x80) surely returns 2. */
1448 p
+= BYTES_BY_CHAR_HEAD (*p
- 0x20);
1451 if (p
> endp
|| chars
< 2 || chars
> MAX_COMPONENT_COUNT
)
1452 /* Invalid components. */
1456 hash_idx
= hash_string (str
, len
) % CMPCHAR_HASH_TABLE_SIZE
;
1457 hashp
= cmpchar_hash_table
[hash_idx
];
1459 /* Then, look into the hash table. */
1461 /* Find the correct one among composite characters of the same
1463 for (i
= 2; i
< CMPCHAR_HASH_USED (hashp
); i
++)
1465 cmpcharp
= cmpchar_table
[CMPCHAR_HASH_CMPCHAR_ID (hashp
, i
)];
1466 if (len
== cmpcharp
->len
1467 && ! bcmp (str
, cmpcharp
->data
, len
))
1468 return CMPCHAR_HASH_CMPCHAR_ID (hashp
, i
);
1471 /* We have to register the composite character in cmpchar_table. */
1472 if (n_cmpchars
> (CHAR_FIELD2_MASK
| CHAR_FIELD3_MASK
))
1473 /* No, we have no more room for a new composite character. */
1476 /* Make the entry in hash table. */
1479 /* Make a table for 8 composite characters initially. */
1480 hashp
= (cmpchar_hash_table
[hash_idx
]
1481 = (int *) xmalloc (sizeof (int) * (2 + 8)));
1482 CMPCHAR_HASH_SIZE (hashp
) = 10;
1483 CMPCHAR_HASH_USED (hashp
) = 2;
1485 else if (CMPCHAR_HASH_USED (hashp
) >= CMPCHAR_HASH_SIZE (hashp
))
1487 CMPCHAR_HASH_SIZE (hashp
) += 8;
1488 hashp
= (cmpchar_hash_table
[hash_idx
]
1489 = (int *) xrealloc (hashp
,
1490 sizeof (int) * CMPCHAR_HASH_SIZE (hashp
)));
1492 CMPCHAR_HASH_CMPCHAR_ID (hashp
, CMPCHAR_HASH_USED (hashp
)) = n_cmpchars
;
1493 CMPCHAR_HASH_USED (hashp
)++;
1495 /* Set information of the composite character in cmpchar_table. */
1496 if (cmpchar_table_size
== 0)
1498 /* This is the first composite character to be registered. */
1499 cmpchar_table_size
= 256;
1501 = (struct cmpchar_info
**) xmalloc (sizeof (cmpchar_table
[0])
1502 * cmpchar_table_size
);
1504 else if (cmpchar_table_size
<= n_cmpchars
)
1506 cmpchar_table_size
+= 256;
1508 = (struct cmpchar_info
**) xrealloc (cmpchar_table
,
1509 sizeof (cmpchar_table
[0])
1510 * cmpchar_table_size
);
1513 cmpcharp
= (struct cmpchar_info
*) xmalloc (sizeof (struct cmpchar_info
));
1515 cmpcharp
->len
= len
;
1516 cmpcharp
->data
= (unsigned char *) xmalloc (len
+ 1);
1517 bcopy (str
, cmpcharp
->data
, len
);
1518 cmpcharp
->data
[len
] = 0;
1519 cmpcharp
->glyph_len
= chars
;
1520 cmpcharp
->glyph
= (GLYPH
*) xmalloc (sizeof (GLYPH
) * chars
);
1523 cmpcharp
->cmp_rule
= (unsigned char *) xmalloc (chars
);
1524 cmpcharp
->col_offset
= (float *) xmalloc (sizeof (float) * chars
);
1528 cmpcharp
->cmp_rule
= NULL
;
1529 cmpcharp
->col_offset
= NULL
;
1532 /* Setup GLYPH data and composition rules (if any) so as not to make
1533 them every time on displaying. */
1535 unsigned char *bufp
;
1537 float leftmost
= 0.0, rightmost
= 1.0;
1540 /* At first, col_offset[N] is set to relative to col_offset[0]. */
1541 cmpcharp
->col_offset
[0] = 0;
1543 for (i
= 0, bufp
= cmpcharp
->data
+ 1; i
< chars
; i
++)
1546 cmpcharp
->cmp_rule
[i
] = *bufp
++;
1548 if (*bufp
== 0xA0) /* This is an ASCII character. */
1550 cmpcharp
->glyph
[i
] = FAST_MAKE_GLYPH ((*++bufp
& 0x7F), 0);
1554 else /* Multibyte character. */
1556 /* Make `bufp' point normal multi-byte form temporally. */
1559 = FAST_MAKE_GLYPH (string_to_non_ascii_char (bufp
, 4, 0, 0), 0);
1560 width
= WIDTH_BY_CHAR_HEAD (*bufp
);
1562 bufp
+= BYTES_BY_CHAR_HEAD (*bufp
- 0x20);
1565 if (embedded_rule
&& i
> 0)
1567 /* Reference points (global_ref and new_ref) are
1578 Now, we calculate the column offset of the new glyph
1579 from the left edge of the first glyph. This can avoid
1580 the same calculation everytime displaying this
1581 composite character. */
1583 /* Reference points of global glyph and new glyph. */
1584 int global_ref
= (cmpcharp
->cmp_rule
[i
] - 0xA0) / 9;
1585 int new_ref
= (cmpcharp
->cmp_rule
[i
] - 0xA0) % 9;
1586 /* Column offset relative to the first glyph. */
1587 float left
= (leftmost
1588 + (global_ref
% 3) * (rightmost
- leftmost
) / 2.0
1589 - (new_ref
% 3) * width
/ 2.0);
1591 cmpcharp
->col_offset
[i
] = left
;
1592 if (left
< leftmost
)
1594 if (left
+ width
> rightmost
)
1595 rightmost
= left
+ width
;
1599 if (width
> rightmost
)
1605 /* Now col_offset[N] are relative to the left edge of the
1606 first component. Make them relative to the left edge of
1608 for (i
= 0; i
< chars
; i
++)
1609 cmpcharp
->col_offset
[i
] -= leftmost
;
1610 /* Make rightmost holds width of overall glyph. */
1611 rightmost
-= leftmost
;
1614 cmpcharp
->width
= rightmost
;
1615 if (cmpcharp
->width
< rightmost
)
1616 /* To get a ceiling integer value. */
1620 cmpchar_table
[n_cmpchars
] = cmpcharp
;
1622 return n_cmpchars
++;
1625 /* Return the Nth element of the composite character C. If NOERROR is
1626 nonzero, return 0 on error condition (C is an invalid composite
1627 charcter, or N is out of range). */
1629 cmpchar_component (c
, n
, noerror
)
1632 int id
= COMPOSITE_CHAR_ID (c
);
1634 if (id
< 0 || id
>= n_cmpchars
)
1636 /* C is not a valid composite character. */
1637 if (noerror
) return 0;
1638 error ("Invalid composite character: %d", c
) ;
1640 if (n
>= cmpchar_table
[id
]->glyph_len
)
1642 /* No such component. */
1643 if (noerror
) return 0;
1644 args_out_of_range (make_number (c
), make_number (n
));
1646 /* No face data is stored in glyph code. */
1647 return ((int) (cmpchar_table
[id
]->glyph
[n
]));
1650 DEFUN ("cmpcharp", Fcmpcharp
, Scmpcharp
, 1, 1, 0,
1651 "T if CHAR is a composite character.")
1655 CHECK_NUMBER (ch
, 0);
1656 return (COMPOSITE_CHAR_P (XINT (ch
)) ? Qt
: Qnil
);
1659 DEFUN ("composite-char-component", Fcmpchar_component
, Scmpchar_component
,
1661 "Return the Nth component character of composite character CHARACTER.")
1663 Lisp_Object character
, n
;
1667 CHECK_NUMBER (character
, 0);
1668 CHECK_NUMBER (n
, 1);
1670 return (make_number (cmpchar_component (XINT (character
), XINT (n
), 0)));
1673 DEFUN ("composite-char-composition-rule", Fcmpchar_cmp_rule
, Scmpchar_cmp_rule
,
1675 "Return the Nth composition rule of composite character CHARACTER.\n\
1676 The returned rule is for composing the Nth component\n\
1677 on the (N-1)th component.\n\
1678 If CHARACTER should be composed relatively or N is 0, return 255.")
1680 Lisp_Object character
, n
;
1684 CHECK_NUMBER (character
, 0);
1685 CHECK_NUMBER (n
, 1);
1687 id
= COMPOSITE_CHAR_ID (XINT (character
));
1688 if (id
< 0 || id
>= n_cmpchars
)
1689 error ("Invalid composite character: %d", XINT (character
));
1690 if (XINT (n
) < 0 || XINT (n
) >= cmpchar_table
[id
]->glyph_len
)
1691 args_out_of_range (character
, n
);
1693 return make_number (cmpchar_table
[id
]->cmp_rule
1694 ? cmpchar_table
[id
]->cmp_rule
[XINT (n
)]
1698 DEFUN ("composite-char-composition-rule-p", Fcmpchar_cmp_rule_p
,
1699 Scmpchar_cmp_rule_p
, 1, 1, 0,
1700 "Return non-nil if composite character CHARACTER contains a embedded rule.")
1702 Lisp_Object character
;
1706 CHECK_NUMBER (character
, 0);
1707 id
= COMPOSITE_CHAR_ID (XINT (character
));
1708 if (id
< 0 || id
>= n_cmpchars
)
1709 error ("Invalid composite character: %d", XINT (character
));
1711 return (cmpchar_table
[id
]->cmp_rule
? Qt
: Qnil
);
1714 DEFUN ("composite-char-component-count", Fcmpchar_cmp_count
,
1715 Scmpchar_cmp_count
, 1, 1, 0,
1716 "Return number of compoents of composite character CHARACTER.")
1718 Lisp_Object character
;
1722 CHECK_NUMBER (character
, 0);
1723 id
= COMPOSITE_CHAR_ID (XINT (character
));
1724 if (id
< 0 || id
>= n_cmpchars
)
1725 error ("Invalid composite character: %d", XINT (character
));
1727 return (make_number (cmpchar_table
[id
]->glyph_len
));
1730 DEFUN ("compose-string", Fcompose_string
, Scompose_string
,
1732 "Return one char string composed from all characters in STRING.")
1736 unsigned char buf
[MAX_LENGTH_OF_MULTI_BYTE_FORM
], *p
, *pend
, *ptemp
;
1739 CHECK_STRING (str
, 0);
1741 buf
[0] = LEADING_CODE_COMPOSITION
;
1742 p
= XSTRING (str
)->data
;
1743 pend
= p
+ STRING_BYTES (XSTRING (str
));
1747 if (*p
< 0x20) /* control code */
1748 error ("Invalid component character: %d", *p
);
1749 else if (*p
< 0x80) /* ASCII */
1751 if (i
+ 2 >= MAX_LENGTH_OF_MULTI_BYTE_FORM
)
1752 error ("Too long string to be composed: %s", XSTRING (str
)->data
);
1753 /* Prepend an ASCII charset indicator 0xA0, set MSB of the
1756 buf
[i
++] = *p
++ + 0x80;
1758 else if (*p
== LEADING_CODE_COMPOSITION
) /* composite char */
1760 /* Already composed. Eliminate the heading
1761 LEADING_CODE_COMPOSITION, keep the remaining bytes
1765 error ("Can't compose a rule-based composition character");
1767 while (! CHAR_HEAD_P (*p
)) p
++;
1768 if (str_cmpchar_id (ptemp
- 1, p
- ptemp
+ 1) < 0)
1769 error ("Can't compose an invalid composition character");
1770 if (i
+ (p
- ptemp
) >= MAX_LENGTH_OF_MULTI_BYTE_FORM
)
1771 error ("Too long string to be composed: %s", XSTRING (str
)->data
);
1772 bcopy (ptemp
, buf
+ i
, p
- ptemp
);
1775 else /* multibyte char */
1777 /* Add 0x20 to the base leading-code, keep the remaining
1779 int c
= STRING_CHAR_AND_CHAR_LENGTH (p
, pend
- p
, len
);
1781 if (len
<= 1 || ! CHAR_VALID_P (c
, 0))
1782 error ("Can't compose an invalid character");
1783 if (i
+ len
>= MAX_LENGTH_OF_MULTI_BYTE_FORM
)
1784 error ("Too long string to be composed: %s", XSTRING (str
)->data
);
1785 bcopy (p
, buf
+ i
, len
);
1792 /* STR contains only one character, which can't be composed. */
1793 error ("Too short string to be composed: %s", XSTRING (str
)->data
);
1795 return make_string_from_bytes (buf
, 1, i
);
1800 charset_id_internal (charset_name
)
1805 val
= Fget (intern (charset_name
), Qcharset
);
1807 error ("Charset %s is not defined", charset_name
);
1809 return (XINT (XVECTOR (val
)->contents
[0]));
1812 DEFUN ("setup-special-charsets", Fsetup_special_charsets
,
1813 Ssetup_special_charsets
, 0, 0, 0, "Internal use only.")
1816 charset_latin_iso8859_1
= charset_id_internal ("latin-iso8859-1");
1817 charset_jisx0208_1978
= charset_id_internal ("japanese-jisx0208-1978");
1818 charset_jisx0208
= charset_id_internal ("japanese-jisx0208");
1819 charset_katakana_jisx0201
= charset_id_internal ("katakana-jisx0201");
1820 charset_latin_jisx0201
= charset_id_internal ("latin-jisx0201");
1821 charset_big5_1
= charset_id_internal ("chinese-big5-1");
1822 charset_big5_2
= charset_id_internal ("chinese-big5-2");
1827 init_charset_once ()
1831 staticpro (&Vcharset_table
);
1832 staticpro (&Vcharset_symbol_table
);
1833 staticpro (&Vgeneric_character_list
);
1835 /* This has to be done here, before we call Fmake_char_table. */
1836 Qcharset_table
= intern ("charset-table");
1837 staticpro (&Qcharset_table
);
1839 /* Intern this now in case it isn't already done.
1840 Setting this variable twice is harmless.
1841 But don't staticpro it here--that is done in alloc.c. */
1842 Qchar_table_extra_slots
= intern ("char-table-extra-slots");
1844 /* Now we are ready to set up this property, so we can
1845 create the charset table. */
1846 Fput (Qcharset_table
, Qchar_table_extra_slots
, make_number (0));
1847 Vcharset_table
= Fmake_char_table (Qcharset_table
, Qnil
);
1849 Vcharset_symbol_table
= Fmake_vector (make_number (MAX_CHARSET
+ 1), Qnil
);
1852 for (i
= 0; i
< 2; i
++)
1853 for (j
= 0; j
< 2; j
++)
1854 for (k
= 0; k
< 128; k
++)
1855 iso_charset_table
[i
][j
][k
] = -1;
1857 bzero (cmpchar_hash_table
, sizeof cmpchar_hash_table
);
1858 cmpchar_table_size
= n_cmpchars
= 0;
1860 for (i
= 0; i
< 256; i
++)
1861 BYTES_BY_CHAR_HEAD (i
) = 1;
1862 for (i
= MIN_CHARSET_OFFICIAL_DIMENSION1
;
1863 i
<= MAX_CHARSET_OFFICIAL_DIMENSION1
; i
++)
1864 BYTES_BY_CHAR_HEAD (i
) = 2;
1865 for (i
= MIN_CHARSET_OFFICIAL_DIMENSION2
;
1866 i
<= MAX_CHARSET_OFFICIAL_DIMENSION2
; i
++)
1867 BYTES_BY_CHAR_HEAD (i
) = 3;
1868 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_11
) = 3;
1869 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_12
) = 3;
1870 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_21
) = 4;
1871 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_22
) = 4;
1872 /* The followings don't reflect the actual bytes, but just to tell
1873 that it is a start of a multibyte character. */
1874 BYTES_BY_CHAR_HEAD (LEADING_CODE_COMPOSITION
) = 2;
1875 BYTES_BY_CHAR_HEAD (0x9E) = 2;
1876 BYTES_BY_CHAR_HEAD (0x9F) = 2;
1878 for (i
= 0; i
< 128; i
++)
1879 WIDTH_BY_CHAR_HEAD (i
) = 1;
1880 for (; i
< 256; i
++)
1881 WIDTH_BY_CHAR_HEAD (i
) = 4;
1882 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_11
) = 1;
1883 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_12
) = 2;
1884 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_21
) = 1;
1885 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_22
) = 2;
1891 for (i
= 0x81; i
< 0x90; i
++)
1892 val
= Fcons (make_number ((i
- 0x70) << 7), val
);
1893 for (; i
< 0x9A; i
++)
1894 val
= Fcons (make_number ((i
- 0x8F) << 14), val
);
1895 for (i
= 0xA0; i
< 0xF0; i
++)
1896 val
= Fcons (make_number ((i
- 0x70) << 7), val
);
1897 for (; i
< 0xFF; i
++)
1898 val
= Fcons (make_number ((i
- 0xE0) << 14), val
);
1899 val
= Fcons (make_number (GENERIC_COMPOSITION_CHAR
), val
);
1900 Vgeneric_character_list
= Fnreverse (val
);
1903 nonascii_insert_offset
= 0;
1904 Vnonascii_translation_table
= Qnil
;
1912 Qascii
= intern ("ascii");
1913 staticpro (&Qascii
);
1915 Qcharset
= intern ("charset");
1916 staticpro (&Qcharset
);
1918 /* Define ASCII charset now. */
1919 update_charset_table (make_number (CHARSET_ASCII
),
1920 make_number (1), make_number (94),
1925 build_string ("ASCII"),
1926 build_string ("ASCII"),
1927 build_string ("ASCII (ISO646 IRV)"));
1928 CHARSET_SYMBOL (CHARSET_ASCII
) = Qascii
;
1929 Fput (Qascii
, Qcharset
, CHARSET_TABLE_ENTRY (CHARSET_ASCII
));
1931 Qcomposition
= intern ("composition");
1932 staticpro (&Qcomposition
);
1933 CHARSET_SYMBOL (CHARSET_COMPOSITION
) = Qcomposition
;
1935 Qauto_fill_chars
= intern ("auto-fill-chars");
1936 staticpro (&Qauto_fill_chars
);
1937 Fput (Qauto_fill_chars
, Qchar_table_extra_slots
, make_number (0));
1939 defsubr (&Sdefine_charset
);
1940 defsubr (&Sgeneric_character_list
);
1941 defsubr (&Sget_unused_iso_final_char
);
1942 defsubr (&Sdeclare_equiv_charset
);
1943 defsubr (&Sfind_charset_region
);
1944 defsubr (&Sfind_charset_string
);
1945 defsubr (&Smake_char_internal
);
1946 defsubr (&Ssplit_char
);
1947 defsubr (&Schar_charset
);
1948 defsubr (&Scharset_after
);
1949 defsubr (&Siso_charset
);
1950 defsubr (&Schar_valid_p
);
1951 defsubr (&Sunibyte_char_to_multibyte
);
1952 defsubr (&Smultibyte_char_to_unibyte
);
1953 defsubr (&Schar_bytes
);
1954 defsubr (&Schar_width
);
1955 defsubr (&Sstring_width
);
1956 defsubr (&Schar_direction
);
1957 defsubr (&Schars_in_region
);
1959 defsubr (&Scmpcharp
);
1960 defsubr (&Scmpchar_component
);
1961 defsubr (&Scmpchar_cmp_rule
);
1962 defsubr (&Scmpchar_cmp_rule_p
);
1963 defsubr (&Scmpchar_cmp_count
);
1964 defsubr (&Scompose_string
);
1965 defsubr (&Ssetup_special_charsets
);
1967 DEFVAR_LISP ("charset-list", &Vcharset_list
,
1968 "List of charsets ever defined.");
1969 Vcharset_list
= Fcons (Qascii
, Qnil
);
1971 DEFVAR_LISP ("translation-table-vector", &Vtranslation_table_vector
,
1972 "Vector of cons cell of a symbol and translation table ever defined.\n\
1973 An ID of a translation table is an index of this vector.");
1974 Vtranslation_table_vector
= Fmake_vector (make_number (16), Qnil
);
1976 DEFVAR_INT ("leading-code-composition", &leading_code_composition
,
1977 "Leading-code of composite characters.");
1978 leading_code_composition
= LEADING_CODE_COMPOSITION
;
1980 DEFVAR_INT ("leading-code-private-11", &leading_code_private_11
,
1981 "Leading-code of private TYPE9N charset of column-width 1.");
1982 leading_code_private_11
= LEADING_CODE_PRIVATE_11
;
1984 DEFVAR_INT ("leading-code-private-12", &leading_code_private_12
,
1985 "Leading-code of private TYPE9N charset of column-width 2.");
1986 leading_code_private_12
= LEADING_CODE_PRIVATE_12
;
1988 DEFVAR_INT ("leading-code-private-21", &leading_code_private_21
,
1989 "Leading-code of private TYPE9Nx9N charset of column-width 1.");
1990 leading_code_private_21
= LEADING_CODE_PRIVATE_21
;
1992 DEFVAR_INT ("leading-code-private-22", &leading_code_private_22
,
1993 "Leading-code of private TYPE9Nx9N charset of column-width 2.");
1994 leading_code_private_22
= LEADING_CODE_PRIVATE_22
;
1996 DEFVAR_INT ("nonascii-insert-offset", &nonascii_insert_offset
,
1997 "Offset for converting non-ASCII unibyte codes 0240...0377 to multibyte.\n\
1998 This is used for converting unibyte text to multibyte,\n\
1999 and for inserting character codes specified by number.\n\n\
2000 This serves to convert a Latin-1 or similar 8-bit character code\n\
2001 to the corresponding Emacs multibyte character code.\n\
2002 Typically the value should be (- (make-char CHARSET 0) 128),\n\
2003 for your choice of character set.\n\
2004 If `nonascii-translation-table' is non-nil, it overrides this variable.");
2005 nonascii_insert_offset
= 0;
2007 DEFVAR_LISP ("nonascii-translation-table", &Vnonascii_translation_table
,
2008 "Translation table to convert non-ASCII unibyte codes to multibyte.\n\
2009 This is used for converting unibyte text to multibyte,\n\
2010 and for inserting character codes specified by number.\n\n\
2011 Conversion is performed only when multibyte characters are enabled,\n\
2012 and it serves to convert a Latin-1 or similar 8-bit character code\n\
2013 to the corresponding Emacs character code.\n\n\
2014 If this is nil, `nonascii-insert-offset' is used instead.\n\
2015 See also the docstring of `make-translation-table'.");
2016 Vnonascii_translation_table
= Qnil
;
2018 DEFVAR_INT ("min-composite-char", &min_composite_char
,
2019 "Minimum character code of a composite character.");
2020 min_composite_char
= MIN_CHAR_COMPOSITION
;
2022 DEFVAR_LISP ("auto-fill-chars", &Vauto_fill_chars
,
2023 "A char-table for characters which invoke auto-filling.\n\
2024 Such characters has value t in this table.");
2025 Vauto_fill_chars
= Fmake_char_table (Qauto_fill_chars
, Qnil
);
2026 CHAR_TABLE_SET (Vauto_fill_chars
, make_number (' '), Qt
);
2027 CHAR_TABLE_SET (Vauto_fill_chars
, make_number ('\n'), Qt
);