1 /* Basic multilingual character support.
2 Copyright (C) 1995, 1997 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 Lisp_Object Qcharset_table
;
65 /* A char-table containing information of each character set. */
66 Lisp_Object Vcharset_table
;
68 /* A vector of charset symbol indexed by charset-id. This is used
69 only for returning charset symbol from C functions. */
70 Lisp_Object Vcharset_symbol_table
;
72 /* A list of charset symbols ever defined. */
73 Lisp_Object Vcharset_list
;
75 /* Tables used by macros BYTES_BY_CHAR_HEAD and WIDTH_BY_CHAR_HEAD. */
76 int bytes_by_char_head
[256];
77 int width_by_char_head
[256];
79 /* Mapping table from ISO2022's charset (specified by DIMENSION,
80 CHARS, and FINAL-CHAR) to Emacs' charset. */
81 int iso_charset_table
[2][2][128];
83 /* Table of pointers to the structure `cmpchar_info' indexed by
85 struct cmpchar_info
**cmpchar_table
;
86 /* The current size of `cmpchar_table'. */
87 static int cmpchar_table_size
;
88 /* Number of the current composite characters. */
91 /* Variables used locally in the macro FETCH_MULTIBYTE_CHAR. */
92 unsigned char *_fetch_multibyte_char_p
;
93 int _fetch_multibyte_char_len
;
95 #define min(X, Y) ((X) < (Y) ? (X) : (Y))
96 #define max(X, Y) ((X) > (Y) ? (X) : (Y))
98 /* Set STR a pointer to the multi-byte form of the character C. If C
99 is not a composite character, the multi-byte form is set in WORKBUF
100 and STR points WORKBUF. The caller should allocate at least 4-byte
101 area at WORKBUF in advance. Returns the length of the multi-byte
102 form. If C is an invalid character to have a multi-byte form,
105 Use macro `CHAR_STRING (C, WORKBUF, STR)' instead of calling this
106 function directly if C can be an ASCII character. */
109 non_ascii_char_to_string (c
, workbuf
, str
)
111 unsigned char *workbuf
, **str
;
115 if (COMPOSITE_CHAR_P (c
))
117 int cmpchar_id
= COMPOSITE_CHAR_ID (c
);
119 if (cmpchar_id
< n_cmpchars
)
121 *str
= cmpchar_table
[cmpchar_id
]->data
;
122 return cmpchar_table
[cmpchar_id
]->len
;
126 error ("Invalid character: %d", c
);
130 SPLIT_NON_ASCII_CHAR (c
, charset
, c1
, c2
);
132 || ! CHARSET_DEFINED_P (charset
)
133 || c1
>= 0 && c1
< 32
134 || c2
>= 0 && c2
< 32)
135 error ("Invalid character: %d", c
);
138 *workbuf
++ = CHARSET_LEADING_CODE_BASE (charset
);
139 if (*workbuf
= CHARSET_LEADING_CODE_EXT (charset
))
141 *workbuf
++ = c1
| 0x80;
143 *workbuf
++ = c2
| 0x80;
145 return (workbuf
- *str
);
148 /* Return a non-ASCII character of which multi-byte form is at STR of
149 length LEN. If ACTUAL_LEN is not NULL, the actual length of the
150 character is set to the address ACTUAL_LEN.
152 Use macro `STRING_CHAR (STR, LEN)' instead of calling this function
153 directly if STR can hold an ASCII character. */
155 string_to_non_ascii_char (str
, len
, actual_len
)
157 int len
, *actual_len
;
160 unsigned char c1
, c2
;
163 if (SPLIT_STRING (str
, len
, charset
, c1
, c2
) == CHARSET_ASCII
)
170 c
= MAKE_NON_ASCII_CHAR (charset
, c1
, c2
);
173 *actual_len
= (charset
== CHARSET_COMPOSITION
174 ? cmpchar_table
[COMPOSITE_CHAR_ID (c
)]->len
175 : BYTES_BY_CHAR_HEAD (*str
));
179 /* Return the length of the multi-byte form at string STR of length LEN. */
181 multibyte_form_length (str
, len
)
186 unsigned char c1
, c2
;
189 if (SPLIT_STRING (str
, len
, charset
, c1
, c2
) == CHARSET_ASCII
)
192 return (charset
== CHARSET_COMPOSITION
193 ? cmpchar_table
[(c1
<< 7) | c2
]->len
194 : BYTES_BY_CHAR_HEAD (*str
));
197 /* Check if string STR of length LEN contains valid multi-byte form of
198 a character. If valid, charset and position codes of the character
199 is set at *CHARSET, *C1, and *C2, and return 0. If not valid,
200 return -1. This should be used only in the macro SPLIT_STRING
201 which checks range of STR in advance. */
203 split_non_ascii_string (str
, len
, charset
, c1
, c2
)
204 register unsigned char *str
, *c1
, *c2
;
205 register int len
, *charset
;
207 register unsigned int cs
= *str
++;
209 if (cs
== LEADING_CODE_COMPOSITION
)
211 int cmpchar_id
= str_cmpchar_id (str
- 1, len
);
215 *charset
= cs
, *c1
= cmpchar_id
>> 7, *c2
= cmpchar_id
& 0x7F;
217 else if ((cs
< LEADING_CODE_PRIVATE_11
|| (cs
= *str
++) >= 0xA0)
218 && CHARSET_DEFINED_P (cs
))
223 *c1
= (*str
++) & 0x7F;
224 if (CHARSET_DIMENSION (cs
) == 2)
228 *c2
= (*str
++) & 0x7F;
236 /* Return a character unified with C (or a character made of CHARSET,
237 C1, and C2) in unification table TABLE. If no unification is found
238 in TABLE, return C. */
239 unify_char (table
, c
, charset
, c1
, c2
)
241 int c
, charset
, c1
, c2
;
244 int alt_charset
, alt_c1
, alt_c2
, dimension
;
246 if (c
< 0) c
= MAKE_CHAR (charset
, c1
, c2
);
247 if (!CHAR_TABLE_P (table
)
248 || (ch
= Faref (table
, make_number (c
)), !INTEGERP (ch
))
252 SPLIT_CHAR (XFASTINT (ch
), alt_charset
, alt_c1
, alt_c2
);
253 dimension
= CHARSET_DIMENSION (alt_charset
);
254 if (dimension
== 1 && alt_c1
> 0 || dimension
== 2 && alt_c2
> 0)
255 /* CH is not a generic character, just return it. */
256 return XFASTINT (ch
);
258 /* Since CH is a generic character, we must return a specific
259 charater which has the same position codes as C from CH. */
261 SPLIT_CHAR (c
, charset
, c1
, c2
);
262 if (dimension
!= CHARSET_DIMENSION (charset
))
263 /* We can't make such a character because of dimension mismatch. */
265 if (!alt_c1
) alt_c1
= c1
;
266 if (!alt_c2
) alt_c2
= c2
;
267 return MAKE_CHAR (alt_charset
, c1
, c2
);
270 /* Update the table Vcharset_table with the given arguments (see the
271 document of `define-charset' for the meaning of each argument).
272 Several other table contents are also updated. The caller should
273 check the validity of CHARSET-ID and the remaining arguments in
277 update_charset_table (charset_id
, dimension
, chars
, width
, direction
,
278 iso_final_char
, iso_graphic_plane
,
279 short_name
, long_name
, description
)
280 Lisp_Object charset_id
, dimension
, chars
, width
, direction
;
281 Lisp_Object iso_final_char
, iso_graphic_plane
;
282 Lisp_Object short_name
, long_name
, description
;
284 int charset
= XINT (charset_id
);
286 unsigned char leading_code_base
, leading_code_ext
;
288 if (NILP (CHARSET_TABLE_ENTRY (charset
)))
289 CHARSET_TABLE_ENTRY (charset
)
290 = Fmake_vector (make_number (CHARSET_MAX_IDX
), Qnil
);
292 /* Get byte length of multibyte form, base leading-code, and
293 extended leading-code of the charset. See the comment under the
294 title "GENERAL NOTE on CHARACTER SET (CHARSET)" in charset.h. */
295 bytes
= XINT (dimension
);
296 if (charset
< MIN_CHARSET_PRIVATE_DIMENSION1
)
298 /* Official charset, it doesn't have an extended leading-code. */
299 if (charset
!= CHARSET_ASCII
)
300 bytes
+= 1; /* For a base leading-code. */
301 leading_code_base
= charset
;
302 leading_code_ext
= 0;
306 /* Private charset. */
307 bytes
+= 2; /* For base and extended leading-codes. */
309 = (charset
< LEADING_CODE_EXT_12
310 ? LEADING_CODE_PRIVATE_11
311 : (charset
< LEADING_CODE_EXT_21
312 ? LEADING_CODE_PRIVATE_12
313 : (charset
< LEADING_CODE_EXT_22
314 ? LEADING_CODE_PRIVATE_21
315 : LEADING_CODE_PRIVATE_22
)));
316 leading_code_ext
= charset
;
319 CHARSET_TABLE_INFO (charset
, CHARSET_ID_IDX
) = charset_id
;
320 CHARSET_TABLE_INFO (charset
, CHARSET_BYTES_IDX
) = make_number (bytes
);
321 CHARSET_TABLE_INFO (charset
, CHARSET_DIMENSION_IDX
) = dimension
;
322 CHARSET_TABLE_INFO (charset
, CHARSET_CHARS_IDX
) = chars
;
323 CHARSET_TABLE_INFO (charset
, CHARSET_WIDTH_IDX
) = width
;
324 CHARSET_TABLE_INFO (charset
, CHARSET_DIRECTION_IDX
) = direction
;
325 CHARSET_TABLE_INFO (charset
, CHARSET_LEADING_CODE_BASE_IDX
)
326 = make_number (leading_code_base
);
327 CHARSET_TABLE_INFO (charset
, CHARSET_LEADING_CODE_EXT_IDX
)
328 = make_number (leading_code_ext
);
329 CHARSET_TABLE_INFO (charset
, CHARSET_ISO_FINAL_CHAR_IDX
) = iso_final_char
;
330 CHARSET_TABLE_INFO (charset
, CHARSET_ISO_GRAPHIC_PLANE_IDX
)
332 CHARSET_TABLE_INFO (charset
, CHARSET_SHORT_NAME_IDX
) = short_name
;
333 CHARSET_TABLE_INFO (charset
, CHARSET_LONG_NAME_IDX
) = long_name
;
334 CHARSET_TABLE_INFO (charset
, CHARSET_DESCRIPTION_IDX
) = description
;
335 CHARSET_TABLE_INFO (charset
, CHARSET_PLIST_IDX
) = Qnil
;
338 /* If we have already defined a charset which has the same
339 DIMENSION, CHARS and ISO-FINAL-CHAR but the different
340 DIRECTION, we must update the entry REVERSE-CHARSET of both
341 charsets. If there's no such charset, the value of the entry
345 for (i
= 0; i
<= MAX_CHARSET
; i
++)
346 if (!NILP (CHARSET_TABLE_ENTRY (i
)))
348 if (CHARSET_DIMENSION (i
) == XINT (dimension
)
349 && CHARSET_CHARS (i
) == XINT (chars
)
350 && CHARSET_ISO_FINAL_CHAR (i
) == XINT (iso_final_char
)
351 && CHARSET_DIRECTION (i
) != XINT (direction
))
353 CHARSET_TABLE_INFO (charset
, CHARSET_REVERSE_CHARSET_IDX
)
355 CHARSET_TABLE_INFO (i
, CHARSET_REVERSE_CHARSET_IDX
) = charset_id
;
360 /* No such a charset. */
361 CHARSET_TABLE_INFO (charset
, CHARSET_REVERSE_CHARSET_IDX
)
365 if (charset
!= CHARSET_ASCII
366 && charset
< MIN_CHARSET_PRIVATE_DIMENSION1
)
368 /* Update tables bytes_by_char_head and width_by_char_head. */
369 bytes_by_char_head
[leading_code_base
] = bytes
;
370 width_by_char_head
[leading_code_base
] = XINT (width
);
372 /* Update table emacs_code_class. */
373 emacs_code_class
[charset
] = (bytes
== 2
374 ? EMACS_leading_code_2
376 ? EMACS_leading_code_3
377 : EMACS_leading_code_4
));
380 /* Update table iso_charset_table. */
381 if (ISO_CHARSET_TABLE (dimension
, chars
, iso_final_char
) < 0)
382 ISO_CHARSET_TABLE (dimension
, chars
, iso_final_char
) = charset
;
387 /* Return charset id of CHARSET_SYMBOL, or return -1 if CHARSET_SYMBOL
390 get_charset_id (charset_symbol
)
391 Lisp_Object charset_symbol
;
396 return ((SYMBOLP (charset_symbol
)
397 && (val
= Fget (charset_symbol
, Qcharset
), VECTORP (val
))
398 && (charset
= XINT (XVECTOR (val
)->contents
[CHARSET_ID_IDX
]),
399 CHARSET_VALID_P (charset
)))
403 /* Return an identification number for a new private charset of
404 DIMENSION and WIDTH. If there's no more room for the new charset,
407 get_new_private_charset_id (dimension
, width
)
408 int dimension
, width
;
410 int charset
, from
, to
;
415 from
= LEADING_CODE_EXT_11
, to
= LEADING_CODE_EXT_12
;
417 from
= LEADING_CODE_EXT_12
, to
= LEADING_CODE_EXT_21
;
422 from
= LEADING_CODE_EXT_21
, to
= LEADING_CODE_EXT_22
;
424 from
= LEADING_CODE_EXT_22
, to
= LEADING_CODE_EXT_MAX
- 1;
427 for (charset
= from
; charset
< to
; charset
++)
428 if (!CHARSET_DEFINED_P (charset
)) break;
430 return make_number (charset
< to
? charset
: 0);
433 DEFUN ("define-charset", Fdefine_charset
, Sdefine_charset
, 3, 3, 0,
434 "Define CHARSET-ID as the identification number of CHARSET with INFO-VECTOR.\n\
435 If CHARSET-ID is nil, it is decided automatically, which means CHARSET is\n\
436 treated as a private charset.\n\
437 INFO-VECTOR is a vector of the format:\n\
438 [DIMENSION CHARS WIDTH DIRECTION ISO-FINAL-CHAR ISO-GRAPHIC-PLANE\n\
439 SHORT-NAME LONG-NAME DESCRIPTION]\n\
440 The meanings of each elements is as follows:\n\
441 DIMENSION (integer) is the number of bytes to represent a character: 1 or 2.\n\
442 CHARS (integer) is the number of characters in a dimension: 94 or 96.\n\
443 WIDTH (integer) is the number of columns a character in the charset\n\
444 occupies on the screen: one of 0, 1, and 2.\n\
446 DIRECTION (integer) is the rendering direction of characters in the\n\
447 charset when rendering. If 0, render from right to left, else\n\
448 render from left to right.\n\
450 ISO-FINAL-CHAR (character) is the final character of the\n\
451 corresponding ISO 2022 charset.\n\
453 ISO-GRAPHIC-PLANE (integer) is the graphic plane to be invoked\n\
454 while encoding to variants of ISO 2022 coding system, one of the\n\
455 following: 0/graphic-plane-left(GL), 1/graphic-plane-right(GR).\n\
457 SHORT-NAME (string) is the short name to refer to the charset.\n\
459 LONG-NAME (string) is the long name to refer to the charset.\n\
461 DESCRIPTION (string) is the description string of the charset.")
462 (charset_id
, charset_symbol
, info_vector
)
463 Lisp_Object charset_id
, charset_symbol
, info_vector
;
467 if (!NILP (charset_id
))
468 CHECK_NUMBER (charset_id
, 0);
469 CHECK_SYMBOL (charset_symbol
, 1);
470 CHECK_VECTOR (info_vector
, 2);
472 if (! NILP (charset_id
))
474 if (! CHARSET_VALID_P (XINT (charset_id
)))
475 error ("Invalid CHARSET: %d", XINT (charset_id
));
476 else if (CHARSET_DEFINED_P (XINT (charset_id
)))
477 error ("Already defined charset: %d", XINT (charset_id
));
480 vec
= XVECTOR (info_vector
)->contents
;
481 if (XVECTOR (info_vector
)->size
!= 9
482 || !INTEGERP (vec
[0]) || !(XINT (vec
[0]) == 1 || XINT (vec
[0]) == 2)
483 || !INTEGERP (vec
[1]) || !(XINT (vec
[1]) == 94 || XINT (vec
[1]) == 96)
484 || !INTEGERP (vec
[2]) || !(XINT (vec
[2]) == 1 || XINT (vec
[2]) == 2)
485 || !INTEGERP (vec
[3]) || !(XINT (vec
[3]) == 0 || XINT (vec
[3]) == 1)
486 || !INTEGERP (vec
[4]) || !(XINT (vec
[4]) >= '0' && XINT (vec
[4]) <= '~')
487 || !INTEGERP (vec
[5]) || !(XINT (vec
[5]) == 0 || XINT (vec
[5]) == 1)
490 || !STRINGP (vec
[8]))
491 error ("Invalid info-vector argument for defining charset %s",
492 XSYMBOL (charset_symbol
)->name
->data
);
494 if (NILP (charset_id
))
496 charset_id
= get_new_private_charset_id (XINT (vec
[0]), XINT (vec
[2]));
497 if (XINT (charset_id
) == 0)
498 error ("There's no room for a new private charset %s",
499 XSYMBOL (charset_symbol
)->name
->data
);
502 update_charset_table (charset_id
, vec
[0], vec
[1], vec
[2], vec
[3],
503 vec
[4], vec
[5], vec
[6], vec
[7], vec
[8]);
504 Fput (charset_symbol
, Qcharset
, CHARSET_TABLE_ENTRY (XINT (charset_id
)));
505 CHARSET_SYMBOL (XINT (charset_id
)) = charset_symbol
;
506 Vcharset_list
= Fcons (charset_symbol
, Vcharset_list
);
510 DEFUN ("get-unused-iso-final-char", Fget_unused_iso_final_char
,
511 Sget_unused_iso_final_char
, 2, 2, 0,
512 "Return an unsed ISO's final char for a charset of DIMENISION and CHARS.\n\
513 DIMENSION is the number of bytes to represent a character: 1 or 2.\n\
514 CHARS is the number of characters in a dimension: 94 or 96.\n\
516 This final char is for private use, thus the range is `0' (48) .. `?' (63).\n\
517 If there's no unused final char for the specified kind of charset,\n\
520 Lisp_Object dimension
, chars
;
524 CHECK_NUMBER (dimension
, 0);
525 CHECK_NUMBER (chars
, 1);
526 if (XINT (dimension
) != 1 && XINT (dimension
) != 2)
527 error ("Invalid charset dimension %d, it should be 1 or 2",
529 if (XINT (chars
) != 94 && XINT (chars
) != 96)
530 error ("Invalid charset chars %d, it should be 94 or 96",
532 for (final_char
= '0'; final_char
<= '?'; final_char
++)
534 if (ISO_CHARSET_TABLE (dimension
, chars
, make_number (final_char
)) < 0)
537 return (final_char
<= '?' ? make_number (final_char
) : Qnil
);
540 DEFUN ("declare-equiv-charset", Fdeclare_equiv_charset
, Sdeclare_equiv_charset
,
542 "Declare a charset of DIMENSION, CHARS, FINAL-CHAR is the same as CHARSET.\n\
543 CHARSET should be defined by `defined-charset' in advance.")
544 (dimension
, chars
, final_char
, charset_symbol
)
545 Lisp_Object dimension
, chars
, final_char
, charset_symbol
;
549 CHECK_NUMBER (dimension
, 0);
550 CHECK_NUMBER (chars
, 1);
551 CHECK_NUMBER (final_char
, 2);
552 CHECK_SYMBOL (charset_symbol
, 3);
554 if (XINT (dimension
) != 1 && XINT (dimension
) != 2)
555 error ("Invalid DIMENSION %d, it should be 1 or 2", XINT (dimension
));
556 if (XINT (chars
) != 94 && XINT (chars
) != 96)
557 error ("Invalid CHARS %d, it should be 94 or 96", XINT (chars
));
558 if (XINT (final_char
) < '0' || XFASTINT (final_char
) > '~')
559 error ("Invalid FINAL-CHAR %c, it should be `0'..`~'", XINT (chars
));
560 if ((charset
= get_charset_id (charset_symbol
)) < 0)
561 error ("Invalid charset %s", XSYMBOL (charset_symbol
)->name
->data
);
563 ISO_CHARSET_TABLE (dimension
, chars
, final_char
) = charset
;
567 /* Return number of different charsets in STR of length LEN. In
568 addition, for each found charset N, CHARSETS[N] is set 1. The
569 caller should allocate CHARSETS (MAX_CHARSET + 1 elements) in advance.
570 It may lookup a unification table TABLE if supplied. */
573 find_charset_in_str (str
, len
, charsets
, table
)
578 register int num
= 0, c
;
580 if (! CHAR_TABLE_P (table
))
588 if (c
== LEADING_CODE_COMPOSITION
)
590 int cmpchar_id
= str_cmpchar_id (str
, len
);
595 struct cmpchar_info
*cmpcharp
= cmpchar_table
[cmpchar_id
];
598 for (i
= 0; i
< cmpcharp
->glyph_len
; i
++)
600 c
= cmpcharp
->glyph
[i
];
603 if ((c
= unify_char (table
, c
, 0, 0, 0)) < 0)
604 c
= cmpcharp
->glyph
[i
];
606 if ((charset
= CHAR_CHARSET (c
)) < 0)
607 charset
= CHARSET_ASCII
;
608 if (!charsets
[charset
])
610 charsets
[charset
] = 1;
614 str
+= cmpcharp
->len
;
615 len
-= cmpcharp
->len
;
619 charset
= CHARSET_ASCII
;
624 c
= STRING_CHAR_AND_LENGTH (str
, len
, bytes
);
627 int c1
= unify_char (table
, c
, 0, 0, 0);
631 charset
= CHAR_CHARSET (c
);
634 if (!charsets
[charset
])
636 charsets
[charset
] = 1;
645 DEFUN ("find-charset-region", Ffind_charset_region
, Sfind_charset_region
,
647 "Return a list of charsets in the region between BEG and END.\n\
648 BEG and END are buffer positions.\n\
649 Optional arg TABLE if non-nil is a unification table to look up.")
651 Lisp_Object beg
, end
, table
;
653 int charsets
[MAX_CHARSET
+ 1];
654 int from
, from_byte
, to
, stop
, stop_byte
, i
;
657 validate_region (&beg
, &end
);
658 from
= XFASTINT (beg
);
659 stop
= to
= XFASTINT (end
);
661 if (from
< GPT
&& GPT
< to
)
664 stop_byte
= GPT_BYTE
;
667 stop_byte
= CHAR_TO_BYTE (stop
);
669 from_byte
= CHAR_TO_BYTE (from
);
671 bzero (charsets
, (MAX_CHARSET
+ 1) * sizeof (int));
674 find_charset_in_str (BYTE_POS_ADDR (from_byte
), stop_byte
- from_byte
,
678 from
= stop
, from_byte
= stop_byte
;
679 stop
= to
, stop_byte
= CHAR_TO_BYTE (stop
);
686 for (i
= MAX_CHARSET
; i
>= 0; i
--)
688 val
= Fcons (CHARSET_SYMBOL (i
), val
);
692 DEFUN ("find-charset-string", Ffind_charset_string
, Sfind_charset_string
,
694 "Return a list of charsets in STR.\n\
695 Optional arg TABLE if non-nil is a unification table to look up.")
697 Lisp_Object str
, table
;
699 int charsets
[MAX_CHARSET
+ 1];
703 CHECK_STRING (str
, 0);
704 bzero (charsets
, (MAX_CHARSET
+ 1) * sizeof (int));
705 find_charset_in_str (XSTRING (str
)->data
, XSTRING (str
)->size
,
708 for (i
= MAX_CHARSET
; i
>= 0; i
--)
710 val
= Fcons (CHARSET_SYMBOL (i
), val
);
714 DEFUN ("make-char-internal", Fmake_char_internal
, Smake_char_internal
, 1, 3, 0,
716 (charset
, code1
, code2
)
717 Lisp_Object charset
, code1
, code2
;
719 CHECK_NUMBER (charset
, 0);
722 XSETFASTINT (code1
, 0);
724 CHECK_NUMBER (code1
, 1);
726 XSETFASTINT (code2
, 0);
728 CHECK_NUMBER (code2
, 2);
730 if (!CHARSET_DEFINED_P (XINT (charset
)))
731 error ("Invalid charset: %d", XINT (charset
));
733 return make_number (MAKE_CHAR (XINT (charset
), XINT (code1
), XINT (code2
)));
736 DEFUN ("split-char", Fsplit_char
, Ssplit_char
, 1, 1, 0,
737 "Return list of charset and one or two position-codes of CHAR.")
744 CHECK_NUMBER (ch
, 0);
745 SPLIT_CHAR (XFASTINT (ch
), charset
, c1
, c2
);
747 ? Fcons (CHARSET_SYMBOL (charset
),
748 Fcons (make_number (c1
), Fcons (make_number (c2
), Qnil
)))
749 : Fcons (CHARSET_SYMBOL (charset
), Fcons (make_number (c1
), Qnil
)));
752 DEFUN ("char-charset", Fchar_charset
, Schar_charset
, 1, 1, 0,
753 "Return charset of CHAR.")
757 CHECK_NUMBER (ch
, 0);
759 return CHARSET_SYMBOL (CHAR_CHARSET (XINT (ch
)));
762 DEFUN ("iso-charset", Fiso_charset
, Siso_charset
, 3, 3, 0,
763 "Return charset of ISO's specification DIMENSION, CHARS, and FINAL-CHAR.")
764 (dimension
, chars
, final_char
)
765 Lisp_Object dimension
, chars
, final_char
;
769 CHECK_NUMBER (dimension
, 0);
770 CHECK_NUMBER (chars
, 1);
771 CHECK_NUMBER (final_char
, 2);
773 if ((charset
= ISO_CHARSET_TABLE (dimension
, chars
, final_char
)) < 0)
775 return CHARSET_SYMBOL (charset
);
778 /* If GENERICP is nonzero, return nonzero iff C is a valid normal or
779 generic character. If GENERICP is zero, return nonzero iff C is a
780 valid normal character. Do not call this function directly,
781 instead use macro CHAR_VALID_P. */
783 char_valid_p (c
, genericp
)
790 if (SINGLE_BYTE_CHAR_P (c
))
792 SPLIT_NON_ASCII_CHAR (c
, charset
, c1
, c2
);
793 if (!CHARSET_VALID_P (charset
))
795 return (c
< MIN_CHAR_COMPOSITION
796 ? ((c
& CHAR_FIELD1_MASK
) /* i.e. dimension of C is two. */
797 ? (genericp
&& c1
== 0 && c2
== 0
798 || c1
>= 32 && c2
>= 32)
799 : (genericp
&& c1
== 0
801 : c
< MIN_CHAR_COMPOSITION
+ n_cmpchars
);
804 DEFUN ("char-valid-p", Fchar_valid_p
, Schar_valid_p
, 1, 2, 0,
805 "Return t if OBJECT is a valid normal character.
806 If optional arg GENERICP is non-nil, also return t if OBJECT is
807 a valid generic character.")
809 Lisp_Object object
, genericp
;
811 if (! NATNUMP (object
))
813 return (CHAR_VALID_P (XFASTINT (object
), !NILP (genericp
)) ? Qt
: Qnil
);
816 DEFUN ("char-bytes", Fchar_bytes
, Schar_bytes
, 1, 1, 0,
817 "Return byte length of multi-byte form of CHAR.")
824 CHECK_NUMBER (ch
, 0);
825 if (COMPOSITE_CHAR_P (XFASTINT (ch
)))
827 unsigned int id
= COMPOSITE_CHAR_ID (XFASTINT (ch
));
829 bytes
= (id
< n_cmpchars
? cmpchar_table
[id
]->len
: 1);
833 int charset
= CHAR_CHARSET (XFASTINT (ch
));
835 bytes
= CHARSET_DEFINED_P (charset
) ? CHARSET_BYTES (charset
) : 1;
838 XSETFASTINT (val
, bytes
);
842 /* Return the width of character of which multi-byte form starts with
843 C. The width is measured by how many columns occupied on the
844 screen when displayed in the current buffer. */
846 #define ONE_BYTE_CHAR_WIDTH(c) \
849 ? XFASTINT (current_buffer->tab_width) \
850 : (c == '\n' ? 0 : (NILP (current_buffer->ctl_arrow) ? 4 : 2))) \
854 ? (NILP (current_buffer->ctl_arrow) ? 4 : 2) \
855 : ((! NILP (current_buffer->enable_multibyte_characters) \
856 && BASE_LEADING_CODE_P (c)) \
857 ? WIDTH_BY_CHAR_HEAD (c) \
861 DEFUN ("char-width", Fchar_width, Schar_width, 1, 1, 0,
862 "Return width of CHAR when displayed in the current buffer.\n\
863 The width is measured by how many columns it occupies on the screen.")
867 Lisp_Object val
, disp
;
869 struct Lisp_Char_Table
*dp
= buffer_display_table ();
871 CHECK_NUMBER (ch
, 0);
875 /* Get the way the display table would display it. */
876 disp
= dp
? DISP_CHAR_VECTOR (dp
, c
) : Qnil
;
879 XSETINT (val
, XVECTOR (disp
)->size
);
880 else if (SINGLE_BYTE_CHAR_P (c
))
881 XSETINT (val
, ONE_BYTE_CHAR_WIDTH (c
));
882 else if (COMPOSITE_CHAR_P (c
))
884 int id
= COMPOSITE_CHAR_ID (XFASTINT (ch
));
885 XSETFASTINT (val
, (id
< n_cmpchars
? cmpchar_table
[id
]->width
: 0));
889 int charset
= CHAR_CHARSET (c
);
891 XSETFASTINT (val
, CHARSET_WIDTH (charset
));
896 /* Return width of string STR of length LEN when displayed in the
897 current buffer. The width is measured by how many columns it
898 occupies on the screen. */
905 unsigned char *endp
= str
+ len
;
907 struct Lisp_Char_Table
*dp
= buffer_display_table ();
911 if (*str
== LEADING_CODE_COMPOSITION
)
913 int id
= str_cmpchar_id (str
, endp
- str
);
922 width
+= cmpchar_table
[id
]->width
;
923 str
+= cmpchar_table
[id
]->len
;
930 int c
= STRING_CHAR (str
, endp
- str
);
932 /* Get the way the display table would display it. */
934 disp
= DISP_CHAR_VECTOR (dp
, c
);
939 thiswidth
= XVECTOR (disp
)->size
;
941 thiswidth
= ONE_BYTE_CHAR_WIDTH (*str
);
944 str
+= BYTES_BY_CHAR_HEAD (*str
);
950 DEFUN ("string-width", Fstring_width
, Sstring_width
, 1, 1, 0,
951 "Return width of STRING when displayed in the current buffer.\n\
952 Width is measured by how many columns it occupies on the screen.\n\
953 When calculating width of a multibyte character in STRING,\n\
954 only the base leading-code is considered; the validity of\n\
955 the following bytes is not checked.")
961 CHECK_STRING (str
, 0);
962 XSETFASTINT (val
, strwidth (XSTRING (str
)->data
, XSTRING (str
)->size
));
966 DEFUN ("char-direction", Fchar_direction
, Schar_direction
, 1, 1, 0,
967 "Return the direction of CHAR.\n\
968 The returned value is 0 for left-to-right and 1 for right-to-left.")
974 CHECK_NUMBER (ch
, 0);
975 charset
= CHAR_CHARSET (XFASTINT (ch
));
976 if (!CHARSET_DEFINED_P (charset
))
977 error ("Invalid character: %d", XINT (ch
));
978 return CHARSET_TABLE_INFO (charset
, CHARSET_DIRECTION_IDX
);
981 DEFUN ("chars-in-string", Fchars_in_string
, Schars_in_string
, 1, 1, 0,
982 "Return number of characters in STRING.\n\
983 When using multibyte characters, this is not the necessarily same as\n\
984 the length of STRING; the length counts a multibyte characters as\n\
985 several bytes, but this function counts a multibyte character as one\n\
991 unsigned char *p
, *endp
;
994 CHECK_STRING (str
, 0);
996 if (NILP (current_buffer
->enable_multibyte_characters
))
997 return make_number (XSTRING (str
)->size
);
999 p
= XSTRING (str
)->data
; endp
= p
+ XSTRING (str
)->size
;
1003 if (*p
== LEADING_CODE_COMPOSITION
)
1006 while (p
< endp
&& ! CHAR_HEAD_P (*p
)) p
++;
1009 p
+= BYTES_BY_CHAR_HEAD (*p
);
1013 XSETFASTINT (val
, chars
);
1017 DEFUN ("chars-in-region", Fchars_in_region
, Schars_in_region
, 2, 2, 0,
1018 "Return number of characters between BEG and END.")
1020 Lisp_Object beg
, end
;
1024 from
= min (XFASTINT (beg
), XFASTINT (end
));
1025 to
= max (XFASTINT (beg
), XFASTINT (end
));
1031 chars_in_text (ptr
, nbytes
)
1035 unsigned char *endp
;
1038 if (NILP (current_buffer
->enable_multibyte_characters
))
1041 endp
= ptr
+ nbytes
;
1046 if (*ptr
== LEADING_CODE_COMPOSITION
)
1049 while (ptr
< endp
&& ! CHAR_HEAD_P (*ptr
)) ptr
++;
1052 ptr
+= BYTES_BY_CHAR_HEAD (*ptr
);
1059 DEFUN ("concat-chars", Fconcat_chars
, Sconcat_chars
, 1, MANY
, 0,
1060 "Concatenate all the argument characters and make the result a string.")
1067 = (unsigned char *) alloca (MAX_LENGTH_OF_MULTI_BYTE_FORM
* n
);
1068 unsigned char *p
= buf
;
1071 for (i
= 0; i
< n
; i
++)
1076 if (!INTEGERP (args
[i
]))
1079 CHECK_NUMBER (args
[i
], 0);
1082 len
= CHAR_STRING (c
, p
, str
);
1084 /* C is a composite character. */
1085 bcopy (str
, p
, len
);
1089 val
= make_string (buf
, p
- buf
);
1095 /*** Composite characters staffs ***/
1097 /* Each composite character is identified by CMPCHAR-ID which is
1098 assigned when Emacs needs the character code of the composite
1099 character (e.g. when displaying it on the screen). See the
1100 document "GENERAL NOTE on COMPOSITE CHARACTER" in `charset.h' how a
1101 composite character is represented in Emacs. */
1103 /* If `static' is defined, it means that it is defined to null string. */
1105 /* The following function is copied from lread.c. */
1107 hash_string (ptr
, len
)
1111 register unsigned char *p
= ptr
;
1112 register unsigned char *end
= p
+ len
;
1113 register unsigned char c
;
1114 register int hash
= 0;
1119 if (c
>= 0140) c
-= 40;
1120 hash
= ((hash
<<3) + (hash
>>28) + c
);
1122 return hash
& 07777777777;
1126 #define CMPCHAR_HASH_TABLE_SIZE 0xFFF
1128 static int *cmpchar_hash_table
[CMPCHAR_HASH_TABLE_SIZE
];
1130 /* Each element of `cmpchar_hash_table' is a pointer to an array of
1131 integer, where the 1st element is the size of the array, the 2nd
1132 element is how many elements are actually used in the array, and
1133 the remaining elements are CMPCHAR-IDs of composite characters of
1134 the same hash value. */
1135 #define CMPCHAR_HASH_SIZE(table) table[0]
1136 #define CMPCHAR_HASH_USED(table) table[1]
1137 #define CMPCHAR_HASH_CMPCHAR_ID(table, i) table[i]
1139 /* Return CMPCHAR-ID of the composite character in STR of the length
1140 LEN. If the composite character has not yet been registered,
1141 register it in `cmpchar_table' and assign new CMPCHAR-ID. This
1142 is the sole function for assigning CMPCHAR-ID. */
1144 str_cmpchar_id (str
, len
)
1148 int hash_idx
, *hashp
;
1150 int embedded_rule
; /* 1 if composition rule is embedded. */
1151 int chars
; /* number of components. */
1153 struct cmpchar_info
*cmpcharp
;
1156 /* Any composite char have at least 3-byte length. */
1159 /* The second byte 0xFF means compostion rule is embedded. */
1160 embedded_rule
= (str
[1] == 0xFF);
1162 /* At first, get the actual length of the composite character. */
1164 unsigned char *p
, *endp
= str
+ 1, *lastp
= str
+ len
;
1167 while (endp
< lastp
&& ! CHAR_HEAD_P (*endp
)) endp
++;
1169 p
= str
+ 1 + embedded_rule
;
1172 /* No need of checking if *P is 0xA0 because
1173 BYTES_BY_CHAR_HEAD (0x80) surely returns 2. */
1174 p
+= (bytes
= BYTES_BY_CHAR_HEAD (*p
- 0x20) + embedded_rule
);
1177 len
= (p
-= embedded_rule
) - str
;
1179 len
-= - bytes
, chars
--;
1181 if (chars
< 2 || chars
> MAX_COMPONENT_COUNT
)
1182 /* Invalid number of components. */
1185 hash_idx
= hash_string (str
, len
) % CMPCHAR_HASH_TABLE_SIZE
;
1186 hashp
= cmpchar_hash_table
[hash_idx
];
1188 /* Then, look into the hash table. */
1190 /* Find the correct one among composite characters of the same
1192 for (i
= 2; i
< CMPCHAR_HASH_USED (hashp
); i
++)
1194 cmpcharp
= cmpchar_table
[CMPCHAR_HASH_CMPCHAR_ID (hashp
, i
)];
1195 if (len
== cmpcharp
->len
1196 && ! bcmp (str
, cmpcharp
->data
, len
))
1197 return CMPCHAR_HASH_CMPCHAR_ID (hashp
, i
);
1200 /* We have to register the composite character in cmpchar_table. */
1201 if (n_cmpchars
> (CHAR_FIELD2_MASK
| CHAR_FIELD3_MASK
))
1202 /* No, we have no more room for a new composite character. */
1205 /* Make the entry in hash table. */
1208 /* Make a table for 8 composite characters initially. */
1209 hashp
= (cmpchar_hash_table
[hash_idx
]
1210 = (int *) xmalloc (sizeof (int) * (2 + 8)));
1211 CMPCHAR_HASH_SIZE (hashp
) = 10;
1212 CMPCHAR_HASH_USED (hashp
) = 2;
1214 else if (CMPCHAR_HASH_USED (hashp
) >= CMPCHAR_HASH_SIZE (hashp
))
1216 CMPCHAR_HASH_SIZE (hashp
) += 8;
1217 hashp
= (cmpchar_hash_table
[hash_idx
]
1218 = (int *) xrealloc (hashp
,
1219 sizeof (int) * CMPCHAR_HASH_SIZE (hashp
)));
1221 CMPCHAR_HASH_CMPCHAR_ID (hashp
, CMPCHAR_HASH_USED (hashp
)) = n_cmpchars
;
1222 CMPCHAR_HASH_USED (hashp
)++;
1224 /* Set information of the composite character in cmpchar_table. */
1225 if (cmpchar_table_size
== 0)
1227 /* This is the first composite character to be registered. */
1228 cmpchar_table_size
= 256;
1230 = (struct cmpchar_info
**) xmalloc (sizeof (cmpchar_table
[0])
1231 * cmpchar_table_size
);
1233 else if (cmpchar_table_size
<= n_cmpchars
)
1235 cmpchar_table_size
+= 256;
1237 = (struct cmpchar_info
**) xrealloc (cmpchar_table
,
1238 sizeof (cmpchar_table
[0])
1239 * cmpchar_table_size
);
1242 cmpcharp
= (struct cmpchar_info
*) xmalloc (sizeof (struct cmpchar_info
));
1244 cmpcharp
->len
= len
;
1245 cmpcharp
->data
= (unsigned char *) xmalloc (len
+ 1);
1246 bcopy (str
, cmpcharp
->data
, len
);
1247 cmpcharp
->data
[len
] = 0;
1248 cmpcharp
->glyph_len
= chars
;
1249 cmpcharp
->glyph
= (GLYPH
*) xmalloc (sizeof (GLYPH
) * chars
);
1252 cmpcharp
->cmp_rule
= (unsigned char *) xmalloc (chars
);
1253 cmpcharp
->col_offset
= (float *) xmalloc (sizeof (float) * chars
);
1257 cmpcharp
->cmp_rule
= NULL
;
1258 cmpcharp
->col_offset
= NULL
;
1261 /* Setup GLYPH data and composition rules (if any) so as not to make
1262 them every time on displaying. */
1264 unsigned char *bufp
;
1266 float leftmost
= 0.0, rightmost
= 1.0;
1269 /* At first, col_offset[N] is set to relative to col_offset[0]. */
1270 cmpcharp
->col_offset
[0] = 0;
1272 for (i
= 0, bufp
= cmpcharp
->data
+ 1; i
< chars
; i
++)
1275 cmpcharp
->cmp_rule
[i
] = *bufp
++;
1277 if (*bufp
== 0xA0) /* This is an ASCII character. */
1279 cmpcharp
->glyph
[i
] = FAST_MAKE_GLYPH ((*++bufp
& 0x7F), 0);
1283 else /* Multibyte character. */
1285 /* Make `bufp' point normal multi-byte form temporally. */
1288 = FAST_MAKE_GLYPH (string_to_non_ascii_char (bufp
, 4, 0), 0);
1289 width
= WIDTH_BY_CHAR_HEAD (*bufp
);
1291 bufp
+= BYTES_BY_CHAR_HEAD (*bufp
- 0x20);
1294 if (embedded_rule
&& i
> 0)
1296 /* Reference points (global_ref and new_ref) are
1307 Now, we calculate the column offset of the new glyph
1308 from the left edge of the first glyph. This can avoid
1309 the same calculation everytime displaying this
1310 composite character. */
1312 /* Reference points of global glyph and new glyph. */
1313 int global_ref
= (cmpcharp
->cmp_rule
[i
] - 0xA0) / 9;
1314 int new_ref
= (cmpcharp
->cmp_rule
[i
] - 0xA0) % 9;
1315 /* Column offset relative to the first glyph. */
1316 float left
= (leftmost
1317 + (global_ref
% 3) * (rightmost
- leftmost
) / 2.0
1318 - (new_ref
% 3) * width
/ 2.0);
1320 cmpcharp
->col_offset
[i
] = left
;
1321 if (left
< leftmost
)
1323 if (left
+ width
> rightmost
)
1324 rightmost
= left
+ width
;
1328 if (width
> rightmost
)
1334 /* Now col_offset[N] are relative to the left edge of the
1335 first component. Make them relative to the left edge of
1337 for (i
= 0; i
< chars
; i
++)
1338 cmpcharp
->col_offset
[i
] -= leftmost
;
1339 /* Make rightmost holds width of overall glyph. */
1340 rightmost
-= leftmost
;
1343 cmpcharp
->width
= rightmost
;
1344 if (cmpcharp
->width
< rightmost
)
1345 /* To get a ceiling integer value. */
1349 cmpchar_table
[n_cmpchars
] = cmpcharp
;
1351 return n_cmpchars
++;
1354 /* Return the Nth element of the composite character C. */
1356 cmpchar_component (c
, n
)
1359 int id
= COMPOSITE_CHAR_ID (c
);
1361 if (id
>= n_cmpchars
/* C is not a valid composite character. */
1362 || n
>= cmpchar_table
[id
]->glyph_len
) /* No such component. */
1364 /* No face data is stored in glyph code. */
1365 return ((int) (cmpchar_table
[id
]->glyph
[n
]));
1368 DEFUN ("cmpcharp", Fcmpcharp
, Scmpcharp
, 1, 1, 0,
1369 "T if CHAR is a composite character.")
1373 CHECK_NUMBER (ch
, 0);
1374 return (COMPOSITE_CHAR_P (XINT (ch
)) ? Qt
: Qnil
);
1377 DEFUN ("composite-char-component", Fcmpchar_component
, Scmpchar_component
,
1379 "Return the IDXth component character of composite character CHARACTER.")
1381 Lisp_Object character
, idx
;
1385 CHECK_NUMBER (character
, 0);
1386 CHECK_NUMBER (idx
, 1);
1388 if ((c
= cmpchar_component (XINT (character
), XINT (idx
))) < 0)
1389 args_out_of_range (character
, idx
);
1391 return make_number (c
);
1394 DEFUN ("composite-char-composition-rule", Fcmpchar_cmp_rule
, Scmpchar_cmp_rule
,
1396 "Return the Nth composition rule embedded in composite character CHARACTER.\n\
1397 The returned rule is for composing the Nth component\n\
1398 on the (N-1)th component. If N is 0, the returned value is always 255.")
1400 Lisp_Object character
, n
;
1404 CHECK_NUMBER (character
, 0);
1405 CHECK_NUMBER (n
, 1);
1407 id
= COMPOSITE_CHAR_ID (XINT (character
));
1408 if (id
< 0 || id
>= n_cmpchars
)
1409 error ("Invalid composite character: %d", XINT (character
));
1411 if (i
> cmpchar_table
[id
]->glyph_len
)
1412 args_out_of_range (character
, n
);
1414 return make_number (cmpchar_table
[id
]->cmp_rule
[i
]);
1417 DEFUN ("composite-char-composition-rule-p", Fcmpchar_cmp_rule_p
,
1418 Scmpchar_cmp_rule_p
, 1, 1, 0,
1419 "Return non-nil if composite character CHARACTER contains a embedded rule.")
1421 Lisp_Object character
;
1425 CHECK_NUMBER (character
, 0);
1426 id
= COMPOSITE_CHAR_ID (XINT (character
));
1427 if (id
< 0 || id
>= n_cmpchars
)
1428 error ("Invalid composite character: %d", XINT (character
));
1430 return (cmpchar_table
[id
]->cmp_rule
? Qt
: Qnil
);
1433 DEFUN ("composite-char-component-count", Fcmpchar_cmp_count
,
1434 Scmpchar_cmp_count
, 1, 1, 0,
1435 "Return number of compoents of composite character CHARACTER.")
1437 Lisp_Object character
;
1441 CHECK_NUMBER (character
, 0);
1442 id
= COMPOSITE_CHAR_ID (XINT (character
));
1443 if (id
< 0 || id
>= n_cmpchars
)
1444 error ("Invalid composite character: %d", XINT (character
));
1446 return (make_number (cmpchar_table
[id
]->glyph_len
));
1449 DEFUN ("compose-string", Fcompose_string
, Scompose_string
,
1451 "Return one char string composed from all characters in STRING.")
1455 unsigned char buf
[MAX_LENGTH_OF_MULTI_BYTE_FORM
], *p
, *pend
, *ptemp
;
1458 CHECK_STRING (str
, 0);
1460 buf
[0] = LEADING_CODE_COMPOSITION
;
1461 p
= XSTRING (str
)->data
;
1462 pend
= p
+ XSTRING (str
)->size
;
1466 if (*p
< 0x20 || *p
== 127) /* control code */
1467 error ("Invalid component character: %d", *p
);
1468 else if (*p
< 0x80) /* ASCII */
1470 if (i
+ 2 >= MAX_LENGTH_OF_MULTI_BYTE_FORM
)
1471 error ("Too long string to be composed: %s", XSTRING (str
)->data
);
1472 /* Prepend an ASCII charset indicator 0xA0, set MSB of the
1475 buf
[i
++] = *p
++ + 0x80;
1477 else if (*p
== LEADING_CODE_COMPOSITION
) /* composite char */
1479 /* Already composed. Eliminate the heading
1480 LEADING_CODE_COMPOSITION, keep the remaining bytes
1484 while (! CHAR_HEAD_P (*p
)) p
++;
1485 if (i
+ (p
- ptemp
) >= MAX_LENGTH_OF_MULTI_BYTE_FORM
)
1486 error ("Too long string to be composed: %s", XSTRING (str
)->data
);
1487 bcopy (ptemp
, buf
+ i
, p
- ptemp
);
1490 else /* multibyte char */
1492 /* Add 0x20 to the base leading-code, keep the remaining
1494 len
= BYTES_BY_CHAR_HEAD (*p
);
1495 if (i
+ len
>= MAX_LENGTH_OF_MULTI_BYTE_FORM
)
1496 error ("Too long string to be composed: %s", XSTRING (str
)->data
);
1497 bcopy (p
, buf
+ i
, len
);
1504 /* STR contains only one character, which can't be composed. */
1505 error ("Too short string to be composed: %s", XSTRING (str
)->data
);
1507 return make_string (buf
, i
);
1511 charset_id_internal (charset_name
)
1514 Lisp_Object val
= Fget (intern (charset_name
), Qcharset
);
1517 error ("Charset %s is not defined", charset_name
);
1519 return (XINT (XVECTOR (val
)->contents
[0]));
1522 DEFUN ("setup-special-charsets", Fsetup_special_charsets
,
1523 Ssetup_special_charsets
, 0, 0, 0, "Internal use only.")
1526 charset_latin_iso8859_1
= charset_id_internal ("latin-iso8859-1");
1527 charset_jisx0208_1978
= charset_id_internal ("japanese-jisx0208-1978");
1528 charset_jisx0208
= charset_id_internal ("japanese-jisx0208");
1529 charset_katakana_jisx0201
= charset_id_internal ("katakana-jisx0201");
1530 charset_latin_jisx0201
= charset_id_internal ("latin-jisx0201");
1531 charset_big5_1
= charset_id_internal ("chinese-big5-1");
1532 charset_big5_2
= charset_id_internal ("chinese-big5-2");
1536 init_charset_once ()
1540 staticpro (&Vcharset_table
);
1541 staticpro (&Vcharset_symbol_table
);
1543 /* This has to be done here, before we call Fmake_char_table. */
1544 Qcharset_table
= intern ("charset-table");
1545 staticpro (&Qcharset_table
);
1547 /* Intern this now in case it isn't already done.
1548 Setting this variable twice is harmless.
1549 But don't staticpro it here--that is done in alloc.c. */
1550 Qchar_table_extra_slots
= intern ("char-table-extra-slots");
1552 /* Now we are ready to set up this property, so we can
1553 create the charset table. */
1554 Fput (Qcharset_table
, Qchar_table_extra_slots
, make_number (0));
1555 Vcharset_table
= Fmake_char_table (Qcharset_table
, Qnil
);
1557 Vcharset_symbol_table
= Fmake_vector (make_number (MAX_CHARSET
+ 1), Qnil
);
1560 for (i
= 0; i
< 2; i
++)
1561 for (j
= 0; j
< 2; j
++)
1562 for (k
= 0; k
< 128; k
++)
1563 iso_charset_table
[i
][j
][k
] = -1;
1565 bzero (cmpchar_hash_table
, sizeof cmpchar_hash_table
);
1566 cmpchar_table_size
= n_cmpchars
= 0;
1568 for (i
= 0; i
< 256; i
++)
1569 BYTES_BY_CHAR_HEAD (i
) = 1;
1570 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_11
) = 3;
1571 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_12
) = 3;
1572 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_21
) = 4;
1573 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_22
) = 4;
1574 /* The following doesn't reflect the actual bytes, but just to tell
1575 that it is a start of a multibyte character. */
1576 BYTES_BY_CHAR_HEAD (LEADING_CODE_COMPOSITION
) = 2;
1578 for (i
= 0; i
< 128; i
++)
1579 WIDTH_BY_CHAR_HEAD (i
) = 1;
1580 for (; i
< 256; i
++)
1581 WIDTH_BY_CHAR_HEAD (i
) = 4;
1582 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_11
) = 1;
1583 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_12
) = 2;
1584 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_21
) = 1;
1585 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_22
) = 2;
1592 Qascii
= intern ("ascii");
1593 staticpro (&Qascii
);
1595 Qcharset
= intern ("charset");
1596 staticpro (&Qcharset
);
1598 /* Define ASCII charset now. */
1599 update_charset_table (make_number (CHARSET_ASCII
),
1600 make_number (1), make_number (94),
1605 build_string ("ASCII"),
1606 build_string ("ASCII"),
1607 build_string ("ASCII (ISO646 IRV)"));
1608 CHARSET_SYMBOL (CHARSET_ASCII
) = Qascii
;
1609 Fput (Qascii
, Qcharset
, CHARSET_TABLE_ENTRY (CHARSET_ASCII
));
1611 Qcomposition
= intern ("composition");
1612 staticpro (&Qcomposition
);
1613 CHARSET_SYMBOL (CHARSET_COMPOSITION
) = Qcomposition
;
1615 defsubr (&Sdefine_charset
);
1616 defsubr (&Sget_unused_iso_final_char
);
1617 defsubr (&Sdeclare_equiv_charset
);
1618 defsubr (&Sfind_charset_region
);
1619 defsubr (&Sfind_charset_string
);
1620 defsubr (&Smake_char_internal
);
1621 defsubr (&Ssplit_char
);
1622 defsubr (&Schar_charset
);
1623 defsubr (&Siso_charset
);
1624 defsubr (&Schar_valid_p
);
1625 defsubr (&Schar_bytes
);
1626 defsubr (&Schar_width
);
1627 defsubr (&Sstring_width
);
1628 defsubr (&Schar_direction
);
1629 defsubr (&Schars_in_string
);
1630 defsubr (&Schars_in_region
);
1631 defsubr (&Sconcat_chars
);
1632 defsubr (&Scmpcharp
);
1633 defsubr (&Scmpchar_component
);
1634 defsubr (&Scmpchar_cmp_rule
);
1635 defsubr (&Scmpchar_cmp_rule_p
);
1636 defsubr (&Scmpchar_cmp_count
);
1637 defsubr (&Scompose_string
);
1638 defsubr (&Ssetup_special_charsets
);
1640 DEFVAR_LISP ("charset-list", &Vcharset_list
,
1641 "List of charsets ever defined.");
1642 Vcharset_list
= Fcons (Qascii
, Qnil
);
1644 DEFVAR_INT ("leading-code-composition", &leading_code_composition
,
1645 "Leading-code of composite characters.");
1646 leading_code_composition
= LEADING_CODE_COMPOSITION
;
1648 DEFVAR_INT ("leading-code-private-11", &leading_code_private_11
,
1649 "Leading-code of private TYPE9N charset of column-width 1.");
1650 leading_code_private_11
= LEADING_CODE_PRIVATE_11
;
1652 DEFVAR_INT ("leading-code-private-12", &leading_code_private_12
,
1653 "Leading-code of private TYPE9N charset of column-width 2.");
1654 leading_code_private_12
= LEADING_CODE_PRIVATE_12
;
1656 DEFVAR_INT ("leading-code-private-21", &leading_code_private_21
,
1657 "Leading-code of private TYPE9Nx9N charset of column-width 1.");
1658 leading_code_private_21
= LEADING_CODE_PRIVATE_21
;
1660 DEFVAR_INT ("leading-code-private-22", &leading_code_private_22
,
1661 "Leading-code of private TYPE9Nx9N charset of column-width 2.");
1662 leading_code_private_22
= LEADING_CODE_PRIVATE_22
;