(unwind_redisplay): New. Resets flag redisplaying_p.
[bpt/emacs.git] / src / charset.c
CommitLineData
75c8c592 1/* Basic multilingual character support.
35e623fb 2 Copyright (C) 1995, 1997, 1998 Electrotechnical Laboratory, JAPAN.
75c8c592 3 Licensed to the Free Software Foundation.
4ed46869 4
369314dc
KH
5This file is part of GNU Emacs.
6
7GNU Emacs is free software; you can redistribute it and/or modify
8it under the terms of the GNU General Public License as published by
9the Free Software Foundation; either version 2, or (at your option)
10any later version.
4ed46869 11
369314dc
KH
12GNU Emacs is distributed in the hope that it will be useful,
13but WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15GNU General Public License for more details.
4ed46869 16
369314dc
KH
17You should have received a copy of the GNU General Public License
18along with GNU Emacs; see the file COPYING. If not, write to
19the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20Boston, MA 02111-1307, USA. */
4ed46869
KH
21
22/* At first, see the document in `charset.h' to understand the code in
23 this file. */
24
25#include <stdio.h>
26
27#ifdef emacs
28
29#include <sys/types.h>
30#include <config.h>
31#include "lisp.h"
32#include "buffer.h"
33#include "charset.h"
34#include "coding.h"
fc6b09bf 35#include "disptab.h"
4ed46869
KH
36
37#else /* not emacs */
38
39#include "mulelib.h"
40
41#endif /* emacs */
42
43Lisp_Object Qcharset, Qascii, Qcomposition;
0282eb69 44Lisp_Object Qunknown;
4ed46869
KH
45
46/* Declaration of special leading-codes. */
47int leading_code_composition; /* for composite characters */
48int leading_code_private_11; /* for private DIMENSION1 of 1-column */
49int leading_code_private_12; /* for private DIMENSION1 of 2-column */
50int leading_code_private_21; /* for private DIMENSION2 of 1-column */
51int leading_code_private_22; /* for private DIMENSION2 of 2-column */
52
53/* Declaration of special charsets. */
54int charset_ascii; /* ASCII */
55int charset_composition; /* for a composite character */
56int charset_latin_iso8859_1; /* ISO8859-1 (Latin-1) */
57int charset_jisx0208_1978; /* JISX0208.1978 (Japanese Kanji old set) */
58int charset_jisx0208; /* JISX0208.1983 (Japanese Kanji) */
59int charset_katakana_jisx0201; /* JISX0201.Kana (Japanese Katakana) */
60int charset_latin_jisx0201; /* JISX0201.Roman (Japanese Roman) */
61int charset_big5_1; /* Big5 Level 1 (Chinese Traditional) */
62int charset_big5_2; /* Big5 Level 2 (Chinese Traditional) */
63
b0e3cf2b
KH
64int min_composite_char;
65
4ed46869
KH
66Lisp_Object Qcharset_table;
67
68/* A char-table containing information of each character set. */
69Lisp_Object Vcharset_table;
70
71/* A vector of charset symbol indexed by charset-id. This is used
72 only for returning charset symbol from C functions. */
73Lisp_Object Vcharset_symbol_table;
74
75/* A list of charset symbols ever defined. */
76Lisp_Object Vcharset_list;
77
537efd8d
KH
78/* Vector of translation table ever defined.
79 ID of a translation table is used to index this vector. */
80Lisp_Object Vtranslation_table_vector;
b0e3cf2b 81
c1a08b4c
KH
82/* A char-table for characters which may invoke auto-filling. */
83Lisp_Object Vauto_fill_chars;
84
85Lisp_Object Qauto_fill_chars;
86
4ed46869
KH
87/* Tables used by macros BYTES_BY_CHAR_HEAD and WIDTH_BY_CHAR_HEAD. */
88int bytes_by_char_head[256];
89int width_by_char_head[256];
90
91/* Mapping table from ISO2022's charset (specified by DIMENSION,
92 CHARS, and FINAL-CHAR) to Emacs' charset. */
93int iso_charset_table[2][2][128];
94
513ee442
KH
95/* Table of pointers to the structure `cmpchar_info' indexed by
96 CMPCHAR-ID. */
97struct cmpchar_info **cmpchar_table;
98/* The current size of `cmpchar_table'. */
99static int cmpchar_table_size;
100/* Number of the current composite characters. */
101int n_cmpchars;
102
4ed46869
KH
103/* Variables used locally in the macro FETCH_MULTIBYTE_CHAR. */
104unsigned char *_fetch_multibyte_char_p;
105int _fetch_multibyte_char_len;
106
35e623fb
RS
107/* Offset to add to a non-ASCII value when inserting it. */
108int nonascii_insert_offset;
109
4cf9710d
RS
110/* Translation table for converting non-ASCII unibyte characters
111 to multibyte codes, or nil. */
b4e9dd77 112Lisp_Object Vnonascii_translation_table;
4cf9710d 113
8a73a704
KH
114/* List of all possible generic characters. */
115Lisp_Object Vgeneric_character_list;
116
046b1f03
RS
117#define min(X, Y) ((X) < (Y) ? (X) : (Y))
118#define max(X, Y) ((X) > (Y) ? (X) : (Y))
119\f
93bcb785
KH
120void
121invalid_character (c)
122 int c;
123{
ba7434e5 124 error ("Invalid character: 0%o, %d, 0x%x", c, c, c);
93bcb785
KH
125}
126
127
4ed46869
KH
128/* Set STR a pointer to the multi-byte form of the character C. If C
129 is not a composite character, the multi-byte form is set in WORKBUF
130 and STR points WORKBUF. The caller should allocate at least 4-byte
131 area at WORKBUF in advance. Returns the length of the multi-byte
bd4c6dd0
KH
132 form. If C is an invalid character to have a multi-byte form,
133 signal an error.
4ed46869
KH
134
135 Use macro `CHAR_STRING (C, WORKBUF, STR)' instead of calling this
136 function directly if C can be an ASCII character. */
137
138int
139non_ascii_char_to_string (c, workbuf, str)
140 int c;
141 unsigned char *workbuf, **str;
142{
6dc0722d 143 int charset, c1, c2;
4ed46869 144
6662e69b 145 if (c & CHAR_MODIFIER_MASK) /* This includes the case C is negative. */
8ac5a9cc 146 {
6662e69b
KH
147 /* Multibyte character can't have a modifier bit. */
148 if (! SINGLE_BYTE_CHAR_P ((c & ~CHAR_MODIFIER_MASK)))
149 invalid_character (c);
150
151 /* For Meta, Shift, and Control modifiers, we need special care. */
8ac5a9cc 152 if (c & CHAR_META)
6662e69b
KH
153 {
154 /* Move the meta bit to the right place for a string. */
155 c = (c & ~CHAR_META) | 0x80;
156 }
157 if (c & CHAR_SHIFT)
158 {
159 /* Shift modifier is valid only with [A-Za-z]. */
160 if ((c & 0377) >= 'A' && (c & 0377) <= 'Z')
161 c &= ~CHAR_SHIFT;
162 else if ((c & 0377) >= 'a' && (c & 0377) <= 'z')
163 c = (c & ~CHAR_SHIFT) - ('a' - 'A');
164 }
8ac5a9cc 165 if (c & CHAR_CTL)
6662e69b
KH
166 {
167 /* Simulate the code in lread.c. */
168 /* Allow `\C- ' and `\C-?'. */
169 if (c == (CHAR_CTL | ' '))
170 c = 0;
171 else if (c == (CHAR_CTL | '?'))
172 c = 127;
173 /* ASCII control chars are made from letters (both cases),
174 as well as the non-letters within 0100...0137. */
175 else if ((c & 0137) >= 0101 && (c & 0137) <= 0132)
176 c &= (037 | (~0177 & ~CHAR_CTL));
177 else if ((c & 0177) >= 0100 && (c & 0177) <= 0137)
178 c &= (037 | (~0177 & ~CHAR_CTL));
179 }
180
181 /* If C still has any modifier bits, it is an invalid character. */
182 if (c & CHAR_MODIFIER_MASK)
183 invalid_character (c);
184
8ac5a9cc
KH
185 *str = workbuf;
186 *workbuf = c;
187 return 1;
188 }
189
da63a5fe
KH
190 if (c < 0)
191 invalid_character (c);
192
4ed46869
KH
193 if (COMPOSITE_CHAR_P (c))
194 {
195 int cmpchar_id = COMPOSITE_CHAR_ID (c);
196
197 if (cmpchar_id < n_cmpchars)
198 {
199 *str = cmpchar_table[cmpchar_id]->data;
200 return cmpchar_table[cmpchar_id]->len;
201 }
202 else
203 {
93bcb785 204 invalid_character (c);
4ed46869
KH
205 }
206 }
207
208 SPLIT_NON_ASCII_CHAR (c, charset, c1, c2);
bd4c6dd0
KH
209 if (!charset
210 || ! CHARSET_DEFINED_P (charset)
211 || c1 >= 0 && c1 < 32
212 || c2 >= 0 && c2 < 32)
93bcb785 213 invalid_character (c);
4ed46869
KH
214
215 *str = workbuf;
216 *workbuf++ = CHARSET_LEADING_CODE_BASE (charset);
217 if (*workbuf = CHARSET_LEADING_CODE_EXT (charset))
218 workbuf++;
219 *workbuf++ = c1 | 0x80;
6dc0722d 220 if (c2 >= 0)
4ed46869
KH
221 *workbuf++ = c2 | 0x80;
222
223 return (workbuf - *str);
224}
225
226/* Return a non-ASCII character of which multi-byte form is at STR of
227 length LEN. If ACTUAL_LEN is not NULL, the actual length of the
537efd8d
KH
228 multibyte form is set to the address ACTUAL_LEN.
229
230 If exclude_tail_garbage is nonzero, ACTUAL_LEN excludes gabage
231 bytes following the non-ASCII character.
4ed46869
KH
232
233 Use macro `STRING_CHAR (STR, LEN)' instead of calling this function
234 directly if STR can hold an ASCII character. */
235
dfcf069d 236int
537efd8d 237string_to_non_ascii_char (str, len, actual_len, exclude_tail_garbage)
8867de67 238 const unsigned char *str;
537efd8d 239 int len, *actual_len, exclude_tail_garbage;
4ed46869
KH
240{
241 int charset;
242 unsigned char c1, c2;
bb63e573
KH
243 int c, bytes;
244 const unsigned char *begp = str;
4ed46869 245
bb63e573 246 c = *str++;
90d7b74e
KH
247 bytes = 1;
248
249 if (BASE_LEADING_CODE_P (c))
bb63e573
KH
250 do {
251 while (bytes < len && ! CHAR_HEAD_P (begp[bytes])) bytes++;
90d7b74e
KH
252
253 if (c == LEADING_CODE_COMPOSITION)
254 {
bb63e573 255 int cmpchar_id = str_cmpchar_id (begp, bytes);
90d7b74e
KH
256
257 if (cmpchar_id >= 0)
5d76bc89
KH
258 {
259 c = MAKE_COMPOSITE_CHAR (cmpchar_id);
1dca54f6 260 str += cmpchar_table[cmpchar_id]->len - 1;
5d76bc89 261 }
1dca54f6
KH
262 else
263 str += bytes - 1;
90d7b74e
KH
264 }
265 else
266 {
bb63e573 267 const unsigned char *endp = begp + bytes;
90d7b74e 268 int charset = c, c1, c2 = 0;
4ed46869 269
bb63e573 270 if (str >= endp) break;
a6c25326 271 if (c >= LEADING_CODE_PRIVATE_11 && c <= LEADING_CODE_PRIVATE_22)
90d7b74e 272 {
bb63e573
KH
273 charset = *str++;
274 if (str < endp)
275 c1 = *str++ & 0x7F;
276 else
277 c1 = charset, charset = c;
90d7b74e 278 }
bb63e573
KH
279 else
280 c1 = *str++ & 0x7f;
281 if (CHARSET_DEFINED_P (charset)
282 && CHARSET_DIMENSION (charset) == 2
283 && str < endp)
1dca54f6 284 c2 = *str++ & 0x7F;
bb63e573 285 c = MAKE_NON_ASCII_CHAR (charset, c1, c2);
90d7b74e 286 }
bb63e573 287 } while (0);
4ed46869
KH
288
289 if (actual_len)
bb63e573 290 *actual_len = exclude_tail_garbage ? str - begp : bytes;
4ed46869
KH
291 return c;
292}
293
294/* Return the length of the multi-byte form at string STR of length LEN. */
295int
296multibyte_form_length (str, len)
8867de67 297 const unsigned char *str;
4ed46869
KH
298 int len;
299{
90d7b74e 300 int bytes = 1;
4ed46869 301
90d7b74e
KH
302 if (BASE_LEADING_CODE_P (*str))
303 while (bytes < len && ! CHAR_HEAD_P (str[bytes])) bytes++;
4ed46869 304
90d7b74e 305 return bytes;
4ed46869
KH
306}
307
308/* Check if string STR of length LEN contains valid multi-byte form of
309 a character. If valid, charset and position codes of the character
310 is set at *CHARSET, *C1, and *C2, and return 0. If not valid,
311 return -1. This should be used only in the macro SPLIT_STRING
312 which checks range of STR in advance. */
313
dfcf069d 314int
4ed46869 315split_non_ascii_string (str, len, charset, c1, c2)
8867de67
KH
316 register const unsigned char *str;
317 register unsigned char *c1, *c2;
4ed46869
KH
318 register int len, *charset;
319{
320 register unsigned int cs = *str++;
321
322 if (cs == LEADING_CODE_COMPOSITION)
323 {
324 int cmpchar_id = str_cmpchar_id (str - 1, len);
325
326 if (cmpchar_id < 0)
327 return -1;
328 *charset = cs, *c1 = cmpchar_id >> 7, *c2 = cmpchar_id & 0x7F;
329 }
330 else if ((cs < LEADING_CODE_PRIVATE_11 || (cs = *str++) >= 0xA0)
331 && CHARSET_DEFINED_P (cs))
332 {
333 *charset = cs;
334 if (*str < 0xA0)
335 return -1;
336 *c1 = (*str++) & 0x7F;
337 if (CHARSET_DIMENSION (cs) == 2)
338 {
339 if (*str < 0xA0)
340 return -1;
341 *c2 = (*str++) & 0x7F;
342 }
343 }
344 else
345 return -1;
346 return 0;
347}
348
537efd8d 349/* Translate character C by translation table TABLE. If C
b4e9dd77
KH
350 is negative, translate a character specified by CHARSET, C1, and C2
351 (C1 and C2 are code points of the character). If no translation is
352 found in TABLE, return C. */
dfcf069d 353int
b4e9dd77 354translate_char (table, c, charset, c1, c2)
23d2a7f1
KH
355 Lisp_Object table;
356 int c, charset, c1, c2;
357{
358 Lisp_Object ch;
359 int alt_charset, alt_c1, alt_c2, dimension;
360
361 if (c < 0) c = MAKE_CHAR (charset, c1, c2);
362 if (!CHAR_TABLE_P (table)
363 || (ch = Faref (table, make_number (c)), !INTEGERP (ch))
364 || XINT (ch) < 0)
365 return c;
366
367 SPLIT_CHAR (XFASTINT (ch), alt_charset, alt_c1, alt_c2);
368 dimension = CHARSET_DIMENSION (alt_charset);
369 if (dimension == 1 && alt_c1 > 0 || dimension == 2 && alt_c2 > 0)
370 /* CH is not a generic character, just return it. */
371 return XFASTINT (ch);
372
373 /* Since CH is a generic character, we must return a specific
374 charater which has the same position codes as C from CH. */
375 if (charset < 0)
376 SPLIT_CHAR (c, charset, c1, c2);
377 if (dimension != CHARSET_DIMENSION (charset))
378 /* We can't make such a character because of dimension mismatch. */
379 return c;
23d2a7f1
KH
380 return MAKE_CHAR (alt_charset, c1, c2);
381}
382
d2665018 383/* Convert the unibyte character C to multibyte based on
b4e9dd77 384 Vnonascii_translation_table or nonascii_insert_offset. If they can't
d2665018
KH
385 convert C to a valid multibyte character, convert it based on
386 DEFAULT_NONASCII_INSERT_OFFSET which makes C a Latin-1 character. */
35e623fb 387
dfcf069d 388int
35e623fb
RS
389unibyte_char_to_multibyte (c)
390 int c;
391{
543b4f61 392 if (c < 0400 && c >= 0200)
35e623fb 393 {
d2665018
KH
394 int c_save = c;
395
b4e9dd77 396 if (! NILP (Vnonascii_translation_table))
bbf12bb3
KH
397 {
398 c = XINT (Faref (Vnonascii_translation_table, make_number (c)));
399 if (c >= 0400 && ! VALID_MULTIBYTE_CHAR_P (c))
400 c = c_save + DEFAULT_NONASCII_INSERT_OFFSET;
401 }
402 else if (c >= 0240 && nonascii_insert_offset > 0)
403 {
404 c += nonascii_insert_offset;
405 if (c < 0400 || ! VALID_MULTIBYTE_CHAR_P (c))
406 c = c_save + DEFAULT_NONASCII_INSERT_OFFSET;
407 }
408 else if (c >= 0240)
d2665018 409 c = c_save + DEFAULT_NONASCII_INSERT_OFFSET;
35e623fb
RS
410 }
411 return c;
412}
76d7b829
KH
413
414
415/* Convert the multibyte character C to unibyte 8-bit character based
416 on Vnonascii_translation_table or nonascii_insert_offset. If
417 REV_TBL is non-nil, it should be a reverse table of
418 Vnonascii_translation_table, i.e. what given by:
419 Fchar_table_extra_slot (Vnonascii_translation_table, make_number (0)) */
420
421int
422multibyte_char_to_unibyte (c, rev_tbl)
423 int c;
424 Lisp_Object rev_tbl;
425{
426 if (!SINGLE_BYTE_CHAR_P (c))
427 {
428 int c_save = c;
429
430 if (! CHAR_TABLE_P (rev_tbl)
431 && CHAR_TABLE_P (Vnonascii_translation_table))
432 rev_tbl = Fchar_table_extra_slot (Vnonascii_translation_table,
433 make_number (0));
434 if (CHAR_TABLE_P (rev_tbl))
435 {
436 Lisp_Object temp;
437 temp = Faref (rev_tbl, make_number (c));
438 if (INTEGERP (temp))
439 c = XINT (temp);
bbf12bb3
KH
440 if (c >= 256)
441 c = (c_save & 0177) + 0200;
442 }
443 else
444 {
445 if (nonascii_insert_offset > 0)
446 c -= nonascii_insert_offset;
447 if (c < 128 || c >= 256)
448 c = (c_save & 0177) + 0200;
76d7b829 449 }
76d7b829
KH
450 }
451
452 return c;
453}
454
35e623fb 455\f
4ed46869
KH
456/* Update the table Vcharset_table with the given arguments (see the
457 document of `define-charset' for the meaning of each argument).
458 Several other table contents are also updated. The caller should
459 check the validity of CHARSET-ID and the remaining arguments in
460 advance. */
461
462void
463update_charset_table (charset_id, dimension, chars, width, direction,
464 iso_final_char, iso_graphic_plane,
465 short_name, long_name, description)
466 Lisp_Object charset_id, dimension, chars, width, direction;
467 Lisp_Object iso_final_char, iso_graphic_plane;
468 Lisp_Object short_name, long_name, description;
469{
470 int charset = XINT (charset_id);
471 int bytes;
472 unsigned char leading_code_base, leading_code_ext;
473
6dc0722d
KH
474 if (NILP (CHARSET_TABLE_ENTRY (charset)))
475 CHARSET_TABLE_ENTRY (charset)
476 = Fmake_vector (make_number (CHARSET_MAX_IDX), Qnil);
4ed46869
KH
477
478 /* Get byte length of multibyte form, base leading-code, and
479 extended leading-code of the charset. See the comment under the
480 title "GENERAL NOTE on CHARACTER SET (CHARSET)" in charset.h. */
481 bytes = XINT (dimension);
482 if (charset < MIN_CHARSET_PRIVATE_DIMENSION1)
483 {
484 /* Official charset, it doesn't have an extended leading-code. */
485 if (charset != CHARSET_ASCII)
486 bytes += 1; /* For a base leading-code. */
487 leading_code_base = charset;
488 leading_code_ext = 0;
489 }
490 else
491 {
492 /* Private charset. */
493 bytes += 2; /* For base and extended leading-codes. */
494 leading_code_base
495 = (charset < LEADING_CODE_EXT_12
496 ? LEADING_CODE_PRIVATE_11
497 : (charset < LEADING_CODE_EXT_21
498 ? LEADING_CODE_PRIVATE_12
499 : (charset < LEADING_CODE_EXT_22
500 ? LEADING_CODE_PRIVATE_21
501 : LEADING_CODE_PRIVATE_22)));
502 leading_code_ext = charset;
503 }
504
6ef23ebb
KH
505 if (BYTES_BY_CHAR_HEAD (leading_code_base) != bytes)
506 error ("Invalid dimension for the charset-ID %d", charset);
507
4ed46869
KH
508 CHARSET_TABLE_INFO (charset, CHARSET_ID_IDX) = charset_id;
509 CHARSET_TABLE_INFO (charset, CHARSET_BYTES_IDX) = make_number (bytes);
510 CHARSET_TABLE_INFO (charset, CHARSET_DIMENSION_IDX) = dimension;
511 CHARSET_TABLE_INFO (charset, CHARSET_CHARS_IDX) = chars;
512 CHARSET_TABLE_INFO (charset, CHARSET_WIDTH_IDX) = width;
513 CHARSET_TABLE_INFO (charset, CHARSET_DIRECTION_IDX) = direction;
514 CHARSET_TABLE_INFO (charset, CHARSET_LEADING_CODE_BASE_IDX)
515 = make_number (leading_code_base);
516 CHARSET_TABLE_INFO (charset, CHARSET_LEADING_CODE_EXT_IDX)
517 = make_number (leading_code_ext);
518 CHARSET_TABLE_INFO (charset, CHARSET_ISO_FINAL_CHAR_IDX) = iso_final_char;
519 CHARSET_TABLE_INFO (charset, CHARSET_ISO_GRAPHIC_PLANE_IDX)
520 = iso_graphic_plane;
521 CHARSET_TABLE_INFO (charset, CHARSET_SHORT_NAME_IDX) = short_name;
522 CHARSET_TABLE_INFO (charset, CHARSET_LONG_NAME_IDX) = long_name;
523 CHARSET_TABLE_INFO (charset, CHARSET_DESCRIPTION_IDX) = description;
524 CHARSET_TABLE_INFO (charset, CHARSET_PLIST_IDX) = Qnil;
525
526 {
527 /* If we have already defined a charset which has the same
528 DIMENSION, CHARS and ISO-FINAL-CHAR but the different
529 DIRECTION, we must update the entry REVERSE-CHARSET of both
530 charsets. If there's no such charset, the value of the entry
531 is set to nil. */
532 int i;
533
513ee442 534 for (i = 0; i <= MAX_CHARSET; i++)
4ed46869
KH
535 if (!NILP (CHARSET_TABLE_ENTRY (i)))
536 {
537 if (CHARSET_DIMENSION (i) == XINT (dimension)
538 && CHARSET_CHARS (i) == XINT (chars)
539 && CHARSET_ISO_FINAL_CHAR (i) == XINT (iso_final_char)
540 && CHARSET_DIRECTION (i) != XINT (direction))
541 {
542 CHARSET_TABLE_INFO (charset, CHARSET_REVERSE_CHARSET_IDX)
543 = make_number (i);
544 CHARSET_TABLE_INFO (i, CHARSET_REVERSE_CHARSET_IDX) = charset_id;
545 break;
546 }
547 }
513ee442 548 if (i > MAX_CHARSET)
4ed46869
KH
549 /* No such a charset. */
550 CHARSET_TABLE_INFO (charset, CHARSET_REVERSE_CHARSET_IDX)
551 = make_number (-1);
552 }
553
554 if (charset != CHARSET_ASCII
555 && charset < MIN_CHARSET_PRIVATE_DIMENSION1)
556 {
4ed46869
KH
557 width_by_char_head[leading_code_base] = XINT (width);
558
559 /* Update table emacs_code_class. */
560 emacs_code_class[charset] = (bytes == 2
561 ? EMACS_leading_code_2
562 : (bytes == 3
563 ? EMACS_leading_code_3
564 : EMACS_leading_code_4));
565 }
566
567 /* Update table iso_charset_table. */
568 if (ISO_CHARSET_TABLE (dimension, chars, iso_final_char) < 0)
569 ISO_CHARSET_TABLE (dimension, chars, iso_final_char) = charset;
570}
571
572#ifdef emacs
573
574/* Return charset id of CHARSET_SYMBOL, or return -1 if CHARSET_SYMBOL
575 is invalid. */
576int
577get_charset_id (charset_symbol)
578 Lisp_Object charset_symbol;
579{
580 Lisp_Object val;
581 int charset;
582
583 return ((SYMBOLP (charset_symbol)
584 && (val = Fget (charset_symbol, Qcharset), VECTORP (val))
585 && (charset = XINT (XVECTOR (val)->contents[CHARSET_ID_IDX]),
586 CHARSET_VALID_P (charset)))
587 ? charset : -1);
588}
589
590/* Return an identification number for a new private charset of
591 DIMENSION and WIDTH. If there's no more room for the new charset,
592 return 0. */
593Lisp_Object
594get_new_private_charset_id (dimension, width)
595 int dimension, width;
596{
597 int charset, from, to;
598
599 if (dimension == 1)
600 {
601 if (width == 1)
602 from = LEADING_CODE_EXT_11, to = LEADING_CODE_EXT_12;
603 else
604 from = LEADING_CODE_EXT_12, to = LEADING_CODE_EXT_21;
605 }
606 else
607 {
608 if (width == 1)
609 from = LEADING_CODE_EXT_21, to = LEADING_CODE_EXT_22;
610 else
b0e3cf2b 611 from = LEADING_CODE_EXT_22, to = LEADING_CODE_EXT_MAX + 1;
4ed46869
KH
612 }
613
614 for (charset = from; charset < to; charset++)
615 if (!CHARSET_DEFINED_P (charset)) break;
616
617 return make_number (charset < to ? charset : 0);
618}
619
620DEFUN ("define-charset", Fdefine_charset, Sdefine_charset, 3, 3, 0,
621 "Define CHARSET-ID as the identification number of CHARSET with INFO-VECTOR.\n\
23d2a7f1 622If CHARSET-ID is nil, it is decided automatically, which means CHARSET is\n\
4ed46869
KH
623 treated as a private charset.\n\
624INFO-VECTOR is a vector of the format:\n\
625 [DIMENSION CHARS WIDTH DIRECTION ISO-FINAL-CHAR ISO-GRAPHIC-PLANE\n\
626 SHORT-NAME LONG-NAME DESCRIPTION]\n\
627The meanings of each elements is as follows:\n\
628DIMENSION (integer) is the number of bytes to represent a character: 1 or 2.\n\
629CHARS (integer) is the number of characters in a dimension: 94 or 96.\n\
630WIDTH (integer) is the number of columns a character in the charset\n\
631occupies on the screen: one of 0, 1, and 2.\n\
632\n\
633DIRECTION (integer) is the rendering direction of characters in the\n\
277576f6
KH
634charset when rendering. If 0, render from left to right, else\n\
635render from right to left.\n\
4ed46869
KH
636\n\
637ISO-FINAL-CHAR (character) is the final character of the\n\
638corresponding ISO 2022 charset.\n\
639\n\
640ISO-GRAPHIC-PLANE (integer) is the graphic plane to be invoked\n\
641while encoding to variants of ISO 2022 coding system, one of the\n\
642following: 0/graphic-plane-left(GL), 1/graphic-plane-right(GR).\n\
643\n\
644SHORT-NAME (string) is the short name to refer to the charset.\n\
645\n\
646LONG-NAME (string) is the long name to refer to the charset.\n\
647\n\
648DESCRIPTION (string) is the description string of the charset.")
649 (charset_id, charset_symbol, info_vector)
650 Lisp_Object charset_id, charset_symbol, info_vector;
651{
652 Lisp_Object *vec;
653
654 if (!NILP (charset_id))
655 CHECK_NUMBER (charset_id, 0);
656 CHECK_SYMBOL (charset_symbol, 1);
657 CHECK_VECTOR (info_vector, 2);
658
659 if (! NILP (charset_id))
660 {
661 if (! CHARSET_VALID_P (XINT (charset_id)))
662 error ("Invalid CHARSET: %d", XINT (charset_id));
663 else if (CHARSET_DEFINED_P (XINT (charset_id)))
664 error ("Already defined charset: %d", XINT (charset_id));
665 }
666
667 vec = XVECTOR (info_vector)->contents;
668 if (XVECTOR (info_vector)->size != 9
669 || !INTEGERP (vec[0]) || !(XINT (vec[0]) == 1 || XINT (vec[0]) == 2)
670 || !INTEGERP (vec[1]) || !(XINT (vec[1]) == 94 || XINT (vec[1]) == 96)
671 || !INTEGERP (vec[2]) || !(XINT (vec[2]) == 1 || XINT (vec[2]) == 2)
672 || !INTEGERP (vec[3]) || !(XINT (vec[3]) == 0 || XINT (vec[3]) == 1)
673 || !INTEGERP (vec[4]) || !(XINT (vec[4]) >= '0' && XINT (vec[4]) <= '~')
674 || !INTEGERP (vec[5]) || !(XINT (vec[5]) == 0 || XINT (vec[5]) == 1)
675 || !STRINGP (vec[6])
676 || !STRINGP (vec[7])
677 || !STRINGP (vec[8]))
678 error ("Invalid info-vector argument for defining charset %s",
679 XSYMBOL (charset_symbol)->name->data);
680
681 if (NILP (charset_id))
682 {
683 charset_id = get_new_private_charset_id (XINT (vec[0]), XINT (vec[2]));
684 if (XINT (charset_id) == 0)
685 error ("There's no room for a new private charset %s",
686 XSYMBOL (charset_symbol)->name->data);
687 }
688
689 update_charset_table (charset_id, vec[0], vec[1], vec[2], vec[3],
690 vec[4], vec[5], vec[6], vec[7], vec[8]);
6dc0722d 691 Fput (charset_symbol, Qcharset, CHARSET_TABLE_ENTRY (XINT (charset_id)));
4ed46869
KH
692 CHARSET_SYMBOL (XINT (charset_id)) = charset_symbol;
693 Vcharset_list = Fcons (charset_symbol, Vcharset_list);
694 return Qnil;
695}
696
8a73a704
KH
697DEFUN ("generic-character-list", Fgeneric_character_list,
698 Sgeneric_character_list, 0, 0, 0,
699 "Return a list of all possible generic characters.\n\
700It includes a generic character for a charset not yet defined.")
701 ()
702{
703 return Vgeneric_character_list;
704}
705
3fac5a51
KH
706DEFUN ("get-unused-iso-final-char", Fget_unused_iso_final_char,
707 Sget_unused_iso_final_char, 2, 2, 0,
708 "Return an unsed ISO's final char for a charset of DIMENISION and CHARS.\n\
709DIMENSION is the number of bytes to represent a character: 1 or 2.\n\
710CHARS is the number of characters in a dimension: 94 or 96.\n\
711\n\
712This final char is for private use, thus the range is `0' (48) .. `?' (63).\n\
713If there's no unused final char for the specified kind of charset,\n\
714return nil.")
715 (dimension, chars)
716 Lisp_Object dimension, chars;
717{
718 int final_char;
719
720 CHECK_NUMBER (dimension, 0);
721 CHECK_NUMBER (chars, 1);
722 if (XINT (dimension) != 1 && XINT (dimension) != 2)
723 error ("Invalid charset dimension %d, it should be 1 or 2",
724 XINT (dimension));
725 if (XINT (chars) != 94 && XINT (chars) != 96)
726 error ("Invalid charset chars %d, it should be 94 or 96",
727 XINT (chars));
728 for (final_char = '0'; final_char <= '?'; final_char++)
729 {
730 if (ISO_CHARSET_TABLE (dimension, chars, make_number (final_char)) < 0)
731 break;
732 }
733 return (final_char <= '?' ? make_number (final_char) : Qnil);
734}
735
4ed46869
KH
736DEFUN ("declare-equiv-charset", Fdeclare_equiv_charset, Sdeclare_equiv_charset,
737 4, 4, 0,
738 "Declare a charset of DIMENSION, CHARS, FINAL-CHAR is the same as CHARSET.\n\
739CHARSET should be defined by `defined-charset' in advance.")
740 (dimension, chars, final_char, charset_symbol)
741 Lisp_Object dimension, chars, final_char, charset_symbol;
742{
743 int charset;
744
745 CHECK_NUMBER (dimension, 0);
746 CHECK_NUMBER (chars, 1);
747 CHECK_NUMBER (final_char, 2);
748 CHECK_SYMBOL (charset_symbol, 3);
749
750 if (XINT (dimension) != 1 && XINT (dimension) != 2)
751 error ("Invalid DIMENSION %d, it should be 1 or 2", XINT (dimension));
752 if (XINT (chars) != 94 && XINT (chars) != 96)
753 error ("Invalid CHARS %d, it should be 94 or 96", XINT (chars));
754 if (XINT (final_char) < '0' || XFASTINT (final_char) > '~')
755 error ("Invalid FINAL-CHAR %c, it should be `0'..`~'", XINT (chars));
756 if ((charset = get_charset_id (charset_symbol)) < 0)
757 error ("Invalid charset %s", XSYMBOL (charset_symbol)->name->data);
758
759 ISO_CHARSET_TABLE (dimension, chars, final_char) = charset;
760 return Qnil;
761}
762
763/* Return number of different charsets in STR of length LEN. In
764 addition, for each found charset N, CHARSETS[N] is set 1. The
a29e3b1b 765 caller should allocate CHARSETS (MAX_CHARSET + 1 elements) in advance.
1d67c29b
KH
766 It may lookup a translation table TABLE if supplied.
767
768 If CMPCHARP is nonzero and some composite character is found,
769 CHARSETS[128] is also set 1 and the returned number is incremented
0282eb69
KH
770 by 1.
771
772 If MULTIBYTE is zero, do not check multibyte characters, i.e. if
773 any ASCII codes (7-bit) are found, CHARSET[0] is set to 1, if any
774 8-bit codes are found CHARSET[1] is set to 1. */
4ed46869
KH
775
776int
0282eb69 777find_charset_in_str (str, len, charsets, table, cmpcharp, multibyte)
028d516b
KH
778 unsigned char *str;
779 int len, *charsets;
23d2a7f1 780 Lisp_Object table;
1d67c29b 781 int cmpcharp;
0282eb69 782 int multibyte;
4ed46869 783{
733eafd8 784 register int num = 0, c;
4ed46869 785
0282eb69
KH
786 if (! multibyte)
787 {
788 unsigned char *endp = str + len;
789 int maskbits = 0;
790
791 while (str < endp && maskbits != 3)
792 maskbits |= (*str++ < 0x80 ? 1 : 2);
793 if (maskbits & 1)
794 {
795 charsets[0] = 1;
796 num++;
797 }
798 if (maskbits & 2)
799 {
800 charsets[1] = 1;
801 num++;
802 }
803 return num;
804 }
805
23d2a7f1
KH
806 if (! CHAR_TABLE_P (table))
807 table = Qnil;
808
4ed46869
KH
809 while (len > 0)
810 {
05505664 811 int bytes, charset;
733eafd8 812 c = *str;
23d2a7f1 813
733eafd8 814 if (c == LEADING_CODE_COMPOSITION)
05505664 815 {
733eafd8
KH
816 int cmpchar_id = str_cmpchar_id (str, len);
817 GLYPH *glyph;
05505664 818
1d67c29b 819 if (cmpchar_id >= 0)
05505664 820 {
020da460 821 struct cmpchar_info *cmp_p = cmpchar_table[cmpchar_id];
733eafd8
KH
822 int i;
823
020da460 824 for (i = 0; i < cmp_p->glyph_len; i++)
733eafd8 825 {
020da460 826 c = cmp_p->glyph[i];
733eafd8
KH
827 if (!NILP (table))
828 {
b4e9dd77 829 if ((c = translate_char (table, c, 0, 0, 0)) < 0)
020da460 830 c = cmp_p->glyph[i];
733eafd8
KH
831 }
832 if ((charset = CHAR_CHARSET (c)) < 0)
833 charset = CHARSET_ASCII;
834 if (!charsets[charset])
835 {
836 charsets[charset] = 1;
837 num += 1;
838 }
839 }
020da460
KH
840 str += cmp_p->len;
841 len -= cmp_p->len;
842 if (cmpcharp && !charsets[CHARSET_COMPOSITION])
843 {
844 charsets[CHARSET_COMPOSITION] = 1;
845 num += 1;
846 }
733eafd8 847 continue;
05505664 848 }
05505664 849
0282eb69 850 charset = 1; /* This leads to `unknown' charset. */
733eafd8
KH
851 bytes = 1;
852 }
23d2a7f1
KH
853 else
854 {
733eafd8
KH
855 c = STRING_CHAR_AND_LENGTH (str, len, bytes);
856 if (! NILP (table))
857 {
b4e9dd77 858 int c1 = translate_char (table, c, 0, 0, 0);
733eafd8
KH
859 if (c1 >= 0)
860 c = c1;
861 }
862 charset = CHAR_CHARSET (c);
23d2a7f1 863 }
4ed46869
KH
864
865 if (!charsets[charset])
866 {
867 charsets[charset] = 1;
868 num += 1;
869 }
870 str += bytes;
871 len -= bytes;
872 }
873 return num;
874}
875
876DEFUN ("find-charset-region", Ffind_charset_region, Sfind_charset_region,
23d2a7f1 877 2, 3, 0,
4ed46869 878 "Return a list of charsets in the region between BEG and END.\n\
23d2a7f1 879BEG and END are buffer positions.\n\
020da460
KH
880If the region contains any composite character,\n\
881`composition' is included in the returned list.\n\
0282eb69
KH
882Optional arg TABLE if non-nil is a translation table to look up.\n\
883\n\
884If the region contains invalid multiybte characters,\n\
38f02ede 885`unknown' is included in the returned list.\n\
0282eb69
KH
886\n\
887If the current buffer is unibyte, the returned list contains\n\
888`ascii' if any 7-bit characters are found,\n\
889and `unknown' if any 8-bit characters are found.")
23d2a7f1
KH
890 (beg, end, table)
891 Lisp_Object beg, end, table;
4ed46869 892{
028d516b 893 int charsets[MAX_CHARSET + 1];
6ae1f27e 894 int from, from_byte, to, stop, stop_byte, i;
4ed46869 895 Lisp_Object val;
0282eb69
KH
896 int undefined;
897 int multibyte = !NILP (current_buffer->enable_multibyte_characters);
4ed46869
KH
898
899 validate_region (&beg, &end);
900 from = XFASTINT (beg);
901 stop = to = XFASTINT (end);
6ae1f27e 902
4ed46869 903 if (from < GPT && GPT < to)
6ae1f27e
RS
904 {
905 stop = GPT;
906 stop_byte = GPT_BYTE;
907 }
908 else
909 stop_byte = CHAR_TO_BYTE (stop);
910
911 from_byte = CHAR_TO_BYTE (from);
912
028d516b 913 bzero (charsets, (MAX_CHARSET + 1) * sizeof (int));
4ed46869
KH
914 while (1)
915 {
6ae1f27e 916 find_charset_in_str (BYTE_POS_ADDR (from_byte), stop_byte - from_byte,
0282eb69 917 charsets, table, 1, multibyte);
4ed46869 918 if (stop < to)
6ae1f27e
RS
919 {
920 from = stop, from_byte = stop_byte;
921 stop = to, stop_byte = CHAR_TO_BYTE (stop);
922 }
4ed46869
KH
923 else
924 break;
925 }
6ae1f27e 926
4ed46869 927 val = Qnil;
0282eb69
KH
928 undefined = 0;
929 for (i = (multibyte ? MAX_CHARSET : 1); i >= 0; i--)
4ed46869 930 if (charsets[i])
0282eb69
KH
931 {
932 if (CHARSET_DEFINED_P (i) || i == CHARSET_COMPOSITION)
933 val = Fcons (CHARSET_SYMBOL (i), val);
934 else
935 undefined = 1;
936 }
937 if (undefined)
938 val = Fcons (Qunknown, val);
4ed46869
KH
939 return val;
940}
941
942DEFUN ("find-charset-string", Ffind_charset_string, Sfind_charset_string,
23d2a7f1
KH
943 1, 2, 0,
944 "Return a list of charsets in STR.\n\
020da460
KH
945If the string contains any composite characters,\n\
946`composition' is included in the returned list.\n\
0282eb69
KH
947Optional arg TABLE if non-nil is a translation table to look up.\n\
948\n\
949If the region contains invalid multiybte characters,\n\
950`unknown' is included in the returned list.\n\
951\n\
952If STR is unibyte, the returned list contains\n\
953`ascii' if any 7-bit characters are found,\n\
954and `unknown' if any 8-bit characters are found.")
23d2a7f1
KH
955 (str, table)
956 Lisp_Object str, table;
4ed46869 957{
a29e3b1b 958 int charsets[MAX_CHARSET + 1];
4ed46869
KH
959 int i;
960 Lisp_Object val;
0282eb69
KH
961 int undefined;
962 int multibyte;
4ed46869
KH
963
964 CHECK_STRING (str, 0);
0282eb69 965 multibyte = STRING_MULTIBYTE (str);
87b089ad 966
a29e3b1b 967 bzero (charsets, (MAX_CHARSET + 1) * sizeof (int));
fc932ac6 968 find_charset_in_str (XSTRING (str)->data, STRING_BYTES (XSTRING (str)),
0282eb69 969 charsets, table, 1, multibyte);
4ed46869 970 val = Qnil;
0282eb69
KH
971 undefined = 0;
972 for (i = (multibyte ? MAX_CHARSET : 1); i >= 0; i--)
4ed46869 973 if (charsets[i])
0282eb69
KH
974 {
975 if (CHARSET_DEFINED_P (i) || i == CHARSET_COMPOSITION)
976 val = Fcons (CHARSET_SYMBOL (i), val);
977 else
978 undefined = 1;
979 }
980 if (undefined)
981 val = Fcons (Qunknown, val);
4ed46869
KH
982 return val;
983}
984\f
985DEFUN ("make-char-internal", Fmake_char_internal, Smake_char_internal, 1, 3, 0,
513ee442 986 "")
4ed46869
KH
987 (charset, code1, code2)
988 Lisp_Object charset, code1, code2;
989{
990 CHECK_NUMBER (charset, 0);
991
992 if (NILP (code1))
993 XSETFASTINT (code1, 0);
994 else
995 CHECK_NUMBER (code1, 1);
996 if (NILP (code2))
997 XSETFASTINT (code2, 0);
998 else
999 CHECK_NUMBER (code2, 2);
1000
1001 if (!CHARSET_DEFINED_P (XINT (charset)))
1002 error ("Invalid charset: %d", XINT (charset));
1003
1004 return make_number (MAKE_CHAR (XINT (charset), XINT (code1), XINT (code2)));
1005}
1006
1007DEFUN ("split-char", Fsplit_char, Ssplit_char, 1, 1, 0,
0282eb69
KH
1008 "Return list of charset and one or two position-codes of CHAR.\n\
1009If CHAR is invalid as a character code,\n\
1010return a list of symbol `unknown' and CHAR.")
4ed46869
KH
1011 (ch)
1012 Lisp_Object ch;
1013{
1014 Lisp_Object val;
0282eb69 1015 int c, charset, c1, c2;
4ed46869
KH
1016
1017 CHECK_NUMBER (ch, 0);
0282eb69
KH
1018 c = XFASTINT (ch);
1019 if (!CHAR_VALID_P (c, 1))
1020 return Fcons (Qunknown, Fcons (ch, Qnil));
4ed46869 1021 SPLIT_CHAR (XFASTINT (ch), charset, c1, c2);
6dc0722d 1022 return (c2 >= 0
4ed46869
KH
1023 ? Fcons (CHARSET_SYMBOL (charset),
1024 Fcons (make_number (c1), Fcons (make_number (c2), Qnil)))
1025 : Fcons (CHARSET_SYMBOL (charset), Fcons (make_number (c1), Qnil)));
1026}
1027
1028DEFUN ("char-charset", Fchar_charset, Schar_charset, 1, 1, 0,
1029 "Return charset of CHAR.")
1030 (ch)
1031 Lisp_Object ch;
1032{
1033 CHECK_NUMBER (ch, 0);
1034
1035 return CHARSET_SYMBOL (CHAR_CHARSET (XINT (ch)));
1036}
1037
90d7b74e
KH
1038DEFUN ("charset-after", Fcharset_after, Scharset_after, 0, 1, 0,
1039 "Return charset of a character in current buffer at position POS.\n\
e6e114f2
KH
1040If POS is nil, it defauls to the current point.\n\
1041If POS is out of range, the value is nil.")
90d7b74e
KH
1042 (pos)
1043 Lisp_Object pos;
1044{
1045 register int pos_byte, c, charset;
1046 register unsigned char *p;
1047
1048 if (NILP (pos))
1049 pos_byte = PT_BYTE;
1050 else if (MARKERP (pos))
e6e114f2
KH
1051 {
1052 pos_byte = marker_byte_position (pos);
1053 if (pos_byte < BEGV_BYTE || pos_byte >= ZV_BYTE)
1054 return Qnil;
1055 }
90d7b74e
KH
1056 else
1057 {
1058 CHECK_NUMBER (pos, 0);
e6e114f2
KH
1059 if (XINT (pos) < BEGV || XINT (pos) >= ZV)
1060 return Qnil;
90d7b74e
KH
1061 pos_byte = CHAR_TO_BYTE (XINT (pos));
1062 }
1063 p = BYTE_POS_ADDR (pos_byte);
1064 c = STRING_CHAR (p, Z_BYTE - pos_byte);
1065 charset = CHAR_CHARSET (c);
1066 return CHARSET_SYMBOL (charset);
1067}
1068
4ed46869 1069DEFUN ("iso-charset", Fiso_charset, Siso_charset, 3, 3, 0,
2b71bb78
KH
1070 "Return charset of ISO's specification DIMENSION, CHARS, and FINAL-CHAR.\n\
1071\n\
1072ISO 2022's designation sequence (escape sequence) distinguishes charsets\n\
1073by their DIMENSION, CHARS, and FINAL-CHAR,\n\
1074where as Emacs distinguishes them by charset symbol.\n\
1075See the documentation of the function `charset-info' for the meanings of\n\
1076DIMENSION, CHARS, and FINAL-CHAR.")
4ed46869
KH
1077 (dimension, chars, final_char)
1078 Lisp_Object dimension, chars, final_char;
1079{
1080 int charset;
1081
1082 CHECK_NUMBER (dimension, 0);
1083 CHECK_NUMBER (chars, 1);
1084 CHECK_NUMBER (final_char, 2);
1085
1086 if ((charset = ISO_CHARSET_TABLE (dimension, chars, final_char)) < 0)
1087 return Qnil;
1088 return CHARSET_SYMBOL (charset);
1089}
1090
9d3d8cba
KH
1091/* If GENERICP is nonzero, return nonzero iff C is a valid normal or
1092 generic character. If GENERICP is zero, return nonzero iff C is a
1093 valid normal character. Do not call this function directly,
1094 instead use macro CHAR_VALID_P. */
1095int
1096char_valid_p (c, genericp)
1097 int c, genericp;
1098{
1099 int charset, c1, c2;
1100
1101 if (c < 0)
1102 return 0;
1103 if (SINGLE_BYTE_CHAR_P (c))
1104 return 1;
1105 SPLIT_NON_ASCII_CHAR (c, charset, c1, c2);
32278fd5 1106 if (charset != CHARSET_COMPOSITION && !CHARSET_DEFINED_P (charset))
9d3d8cba
KH
1107 return 0;
1108 return (c < MIN_CHAR_COMPOSITION
1109 ? ((c & CHAR_FIELD1_MASK) /* i.e. dimension of C is two. */
1110 ? (genericp && c1 == 0 && c2 == 0
1111 || c1 >= 32 && c2 >= 32)
1112 : (genericp && c1 == 0
1113 || c1 >= 32))
1114 : c < MIN_CHAR_COMPOSITION + n_cmpchars);
1115}
1116
1117DEFUN ("char-valid-p", Fchar_valid_p, Schar_valid_p, 1, 2, 0,
a9d02884
DL
1118 "Return t if OBJECT is a valid normal character.\n\
1119If optional arg GENERICP is non-nil, also return t if OBJECT is\n\
9d3d8cba
KH
1120a valid generic character.")
1121 (object, genericp)
1122 Lisp_Object object, genericp;
1123{
1124 if (! NATNUMP (object))
1125 return Qnil;
1126 return (CHAR_VALID_P (XFASTINT (object), !NILP (genericp)) ? Qt : Qnil);
1127}
1128
d2665018
KH
1129DEFUN ("unibyte-char-to-multibyte", Funibyte_char_to_multibyte,
1130 Sunibyte_char_to_multibyte, 1, 1, 0,
1131 "Convert the unibyte character CH to multibyte character.\n\
537efd8d 1132The conversion is done based on `nonascii-translation-table' (which see)\n\
340b8d58 1133 or `nonascii-insert-offset' (which see).")
d2665018
KH
1134 (ch)
1135 Lisp_Object ch;
1136{
1137 int c;
1138
1139 CHECK_NUMBER (ch, 0);
1140 c = XINT (ch);
1141 if (c < 0 || c >= 0400)
1142 error ("Invalid unibyte character: %d", c);
1143 c = unibyte_char_to_multibyte (c);
1144 if (c < 0)
1145 error ("Can't convert to multibyte character: %d", XINT (ch));
1146 return make_number (c);
1147}
1148
1bcc1567
RS
1149DEFUN ("multibyte-char-to-unibyte", Fmultibyte_char_to_unibyte,
1150 Smultibyte_char_to_unibyte, 1, 1, 0,
1151 "Convert the multibyte character CH to unibyte character.\n\
1152The conversion is done based on `nonascii-translation-table' (which see)\n\
1153 or `nonascii-insert-offset' (which see).")
1154 (ch)
1155 Lisp_Object ch;
1156{
1157 int c;
1158
1159 CHECK_NUMBER (ch, 0);
1160 c = XINT (ch);
1161 if (c < 0)
1162 error ("Invalid multibyte character: %d", c);
1163 c = multibyte_char_to_unibyte (c, Qnil);
1164 if (c < 0)
1165 error ("Can't convert to unibyte character: %d", XINT (ch));
1166 return make_number (c);
1167}
1168
4ed46869 1169DEFUN ("char-bytes", Fchar_bytes, Schar_bytes, 1, 1, 0,
f78643ef 1170 "Return 1 regardless of the argument CHAR.\n\
60022cb7 1171This is now an obsolete function. We keep it just for backward compatibility.")
4ed46869
KH
1172 (ch)
1173 Lisp_Object ch;
1174{
1175 Lisp_Object val;
4ed46869
KH
1176
1177 CHECK_NUMBER (ch, 0);
9b6a601f
KH
1178 return make_number (1);
1179}
1180
1181/* Return how many bytes C will occupy in a multibyte buffer.
1182 Don't call this function directly, instead use macro CHAR_BYTES. */
1183int
1184char_bytes (c)
1185 int c;
1186{
1187 int bytes;
1188
8ac5a9cc
KH
1189 if (SINGLE_BYTE_CHAR_P (c) || (c & ~GLYPH_MASK_CHAR))
1190 return 1;
1191
9b6a601f 1192 if (COMPOSITE_CHAR_P (c))
4ed46869 1193 {
9b6a601f 1194 unsigned int id = COMPOSITE_CHAR_ID (c);
4ed46869
KH
1195
1196 bytes = (id < n_cmpchars ? cmpchar_table[id]->len : 1);
1197 }
1198 else
1199 {
9b6a601f 1200 int charset = CHAR_CHARSET (c);
4ed46869
KH
1201
1202 bytes = CHARSET_DEFINED_P (charset) ? CHARSET_BYTES (charset) : 1;
1203 }
1204
60022cb7 1205 return bytes;
4ed46869
KH
1206}
1207
1208/* Return the width of character of which multi-byte form starts with
1209 C. The width is measured by how many columns occupied on the
1210 screen when displayed in the current buffer. */
1211
1212#define ONE_BYTE_CHAR_WIDTH(c) \
1213 (c < 0x20 \
1214 ? (c == '\t' \
53316e55 1215 ? XFASTINT (current_buffer->tab_width) \
4ed46869
KH
1216 : (c == '\n' ? 0 : (NILP (current_buffer->ctl_arrow) ? 4 : 2))) \
1217 : (c < 0x7f \
1218 ? 1 \
1219 : (c == 0x7F \
1220 ? (NILP (current_buffer->ctl_arrow) ? 4 : 2) \
1221 : ((! NILP (current_buffer->enable_multibyte_characters) \
1222 && BASE_LEADING_CODE_P (c)) \
1223 ? WIDTH_BY_CHAR_HEAD (c) \
b4e9dd77 1224 : 4))))
4ed46869
KH
1225
1226DEFUN ("char-width", Fchar_width, Schar_width, 1, 1, 0,
1227 "Return width of CHAR when displayed in the current buffer.\n\
1228The width is measured by how many columns it occupies on the screen.")
1229 (ch)
1230 Lisp_Object ch;
1231{
859f2b3c 1232 Lisp_Object val, disp;
4ed46869 1233 int c;
51c4025f 1234 struct Lisp_Char_Table *dp = buffer_display_table ();
4ed46869
KH
1235
1236 CHECK_NUMBER (ch, 0);
1237
859f2b3c
RS
1238 c = XINT (ch);
1239
1240 /* Get the way the display table would display it. */
51c4025f 1241 disp = dp ? DISP_CHAR_VECTOR (dp, c) : Qnil;
859f2b3c
RS
1242
1243 if (VECTORP (disp))
1244 XSETINT (val, XVECTOR (disp)->size);
1245 else if (SINGLE_BYTE_CHAR_P (c))
1246 XSETINT (val, ONE_BYTE_CHAR_WIDTH (c));
4ed46869
KH
1247 else if (COMPOSITE_CHAR_P (c))
1248 {
1249 int id = COMPOSITE_CHAR_ID (XFASTINT (ch));
0282eb69 1250 XSETFASTINT (val, (id < n_cmpchars ? cmpchar_table[id]->width : 1));
4ed46869
KH
1251 }
1252 else
1253 {
1254 int charset = CHAR_CHARSET (c);
1255
1256 XSETFASTINT (val, CHARSET_WIDTH (charset));
1257 }
1258 return val;
1259}
1260
1261/* Return width of string STR of length LEN when displayed in the
1262 current buffer. The width is measured by how many columns it
1263 occupies on the screen. */
859f2b3c 1264
4ed46869
KH
1265int
1266strwidth (str, len)
1267 unsigned char *str;
1268 int len;
1269{
1270 unsigned char *endp = str + len;
1271 int width = 0;
c4a4e28f 1272 struct Lisp_Char_Table *dp = buffer_display_table ();
4ed46869 1273
859f2b3c
RS
1274 while (str < endp)
1275 {
1276 if (*str == LEADING_CODE_COMPOSITION)
1277 {
1278 int id = str_cmpchar_id (str, endp - str);
1279
1280 if (id < 0)
1281 {
1282 width += 4;
1283 str++;
1284 }
1285 else
1286 {
1287 width += cmpchar_table[id]->width;
1288 str += cmpchar_table[id]->len;
1289 }
1290 }
1291 else
1292 {
1293 Lisp_Object disp;
e515b0a9
KH
1294 int thislen;
1295 int c = STRING_CHAR_AND_LENGTH (str, endp - str, thislen);
859f2b3c
RS
1296
1297 /* Get the way the display table would display it. */
acc35c36
RS
1298 if (dp)
1299 disp = DISP_CHAR_VECTOR (dp, c);
1300 else
1301 disp = Qnil;
859f2b3c
RS
1302
1303 if (VECTORP (disp))
e515b0a9 1304 width += XVECTOR (disp)->size;
859f2b3c 1305 else
e515b0a9 1306 width += ONE_BYTE_CHAR_WIDTH (*str);
859f2b3c 1307
e515b0a9 1308 str += thislen;
859f2b3c
RS
1309 }
1310 }
4ed46869
KH
1311 return width;
1312}
1313
1314DEFUN ("string-width", Fstring_width, Sstring_width, 1, 1, 0,
1315 "Return width of STRING when displayed in the current buffer.\n\
1316Width is measured by how many columns it occupies on the screen.\n\
046b1f03
RS
1317When calculating width of a multibyte character in STRING,\n\
1318only the base leading-code is considered; the validity of\n\
1319the following bytes is not checked.")
4ed46869
KH
1320 (str)
1321 Lisp_Object str;
1322{
1323 Lisp_Object val;
1324
1325 CHECK_STRING (str, 0);
fc932ac6
RS
1326 XSETFASTINT (val, strwidth (XSTRING (str)->data,
1327 STRING_BYTES (XSTRING (str))));
4ed46869
KH
1328 return val;
1329}
1330
1331DEFUN ("char-direction", Fchar_direction, Schar_direction, 1, 1, 0,
1332 "Return the direction of CHAR.\n\
1333The returned value is 0 for left-to-right and 1 for right-to-left.")
1334 (ch)
1335 Lisp_Object ch;
1336{
1337 int charset;
1338
1339 CHECK_NUMBER (ch, 0);
1340 charset = CHAR_CHARSET (XFASTINT (ch));
1341 if (!CHARSET_DEFINED_P (charset))
93bcb785 1342 invalid_character (XINT (ch));
4ed46869
KH
1343 return CHARSET_TABLE_INFO (charset, CHARSET_DIRECTION_IDX);
1344}
1345
af4fecb4 1346DEFUN ("chars-in-region", Fchars_in_region, Schars_in_region, 2, 2, 0,
6ae1f27e 1347 "Return number of characters between BEG and END.")
046b1f03
RS
1348 (beg, end)
1349 Lisp_Object beg, end;
1350{
6ae1f27e 1351 int from, to;
046b1f03 1352
17e7ef1b
RS
1353 CHECK_NUMBER_COERCE_MARKER (beg, 0);
1354 CHECK_NUMBER_COERCE_MARKER (end, 1);
1355
046b1f03 1356 from = min (XFASTINT (beg), XFASTINT (end));
a8a35e61 1357 to = max (XFASTINT (beg), XFASTINT (end));
046b1f03 1358
a8c21066 1359 return make_number (to - from);
6ae1f27e 1360}
9036eb45 1361
87b089ad
RS
1362/* Return the number of characters in the NBYTES bytes at PTR.
1363 This works by looking at the contents and checking for multibyte sequences.
1364 However, if the current buffer has enable-multibyte-characters = nil,
1365 we treat each byte as a character. */
1366
6ae1f27e
RS
1367int
1368chars_in_text (ptr, nbytes)
1369 unsigned char *ptr;
1370 int nbytes;
1371{
93bcb785 1372 unsigned char *endp, c;
6ae1f27e 1373 int chars;
046b1f03 1374
87b089ad
RS
1375 /* current_buffer is null at early stages of Emacs initialization. */
1376 if (current_buffer == 0
1377 || NILP (current_buffer->enable_multibyte_characters))
6ae1f27e 1378 return nbytes;
a8a35e61 1379
6ae1f27e
RS
1380 endp = ptr + nbytes;
1381 chars = 0;
046b1f03 1382
6ae1f27e
RS
1383 while (ptr < endp)
1384 {
93bcb785
KH
1385 c = *ptr++;
1386
1387 if (BASE_LEADING_CODE_P (c))
1388 while (ptr < endp && ! CHAR_HEAD_P (*ptr)) ptr++;
046b1f03
RS
1389 chars++;
1390 }
1391
6ae1f27e 1392 return chars;
046b1f03
RS
1393}
1394
87b089ad
RS
1395/* Return the number of characters in the NBYTES bytes at PTR.
1396 This works by looking at the contents and checking for multibyte sequences.
1397 It ignores enable-multibyte-characters. */
1398
1399int
1400multibyte_chars_in_text (ptr, nbytes)
1401 unsigned char *ptr;
1402 int nbytes;
1403{
93bcb785 1404 unsigned char *endp, c;
87b089ad
RS
1405 int chars;
1406
1407 endp = ptr + nbytes;
1408 chars = 0;
1409
1410 while (ptr < endp)
1411 {
93bcb785
KH
1412 c = *ptr++;
1413
1414 if (BASE_LEADING_CODE_P (c))
1415 while (ptr < endp && ! CHAR_HEAD_P (*ptr)) ptr++;
87b089ad
RS
1416 chars++;
1417 }
1418
1419 return chars;
1420}
1421
1422DEFUN ("string", Fstring, Sstring, 1, MANY, 0,
4ed46869 1423 "Concatenate all the argument characters and make the result a string.")
53316e55
KH
1424 (n, args)
1425 int n;
4ed46869
KH
1426 Lisp_Object *args;
1427{
53316e55 1428 int i;
4ed46869 1429 unsigned char *buf
bd4c6dd0 1430 = (unsigned char *) alloca (MAX_LENGTH_OF_MULTI_BYTE_FORM * n);
4ed46869
KH
1431 unsigned char *p = buf;
1432 Lisp_Object val;
1433
1434 for (i = 0; i < n; i++)
1435 {
1436 int c, len;
1437 unsigned char *str;
1438
1439 if (!INTEGERP (args[i]))
b0e3cf2b 1440 CHECK_NUMBER (args[i], 0);
4ed46869
KH
1441 c = XINT (args[i]);
1442 len = CHAR_STRING (c, p, str);
1443 if (p != str)
1444 /* C is a composite character. */
1445 bcopy (str, p, len);
1446 p += len;
1447 }
1448
020da460
KH
1449 /* Here, we can't use make_string_from_bytes because of byte
1450 combining problem. */
1451 val = make_string (buf, p - buf);
4ed46869
KH
1452 return val;
1453}
1454
1455#endif /* emacs */
1456\f
1457/*** Composite characters staffs ***/
1458
1459/* Each composite character is identified by CMPCHAR-ID which is
1460 assigned when Emacs needs the character code of the composite
1461 character (e.g. when displaying it on the screen). See the
1462 document "GENERAL NOTE on COMPOSITE CHARACTER" in `charset.h' how a
1463 composite character is represented in Emacs. */
1464
1465/* If `static' is defined, it means that it is defined to null string. */
1466#ifndef static
1467/* The following function is copied from lread.c. */
1468static int
1469hash_string (ptr, len)
1470 unsigned char *ptr;
1471 int len;
1472{
1473 register unsigned char *p = ptr;
1474 register unsigned char *end = p + len;
1475 register unsigned char c;
1476 register int hash = 0;
1477
1478 while (p != end)
1479 {
1480 c = *p++;
1481 if (c >= 0140) c -= 40;
1482 hash = ((hash<<3) + (hash>>28) + c);
1483 }
1484 return hash & 07777777777;
1485}
1486#endif
1487
4ed46869
KH
1488#define CMPCHAR_HASH_TABLE_SIZE 0xFFF
1489
1490static int *cmpchar_hash_table[CMPCHAR_HASH_TABLE_SIZE];
1491
1492/* Each element of `cmpchar_hash_table' is a pointer to an array of
1493 integer, where the 1st element is the size of the array, the 2nd
1494 element is how many elements are actually used in the array, and
1495 the remaining elements are CMPCHAR-IDs of composite characters of
1496 the same hash value. */
1497#define CMPCHAR_HASH_SIZE(table) table[0]
1498#define CMPCHAR_HASH_USED(table) table[1]
1499#define CMPCHAR_HASH_CMPCHAR_ID(table, i) table[i]
1500
1501/* Return CMPCHAR-ID of the composite character in STR of the length
1502 LEN. If the composite character has not yet been registered,
1503 register it in `cmpchar_table' and assign new CMPCHAR-ID. This
1504 is the sole function for assigning CMPCHAR-ID. */
1505int
1506str_cmpchar_id (str, len)
8867de67 1507 const unsigned char *str;
4ed46869
KH
1508 int len;
1509{
1510 int hash_idx, *hashp;
1511 unsigned char *buf;
1512 int embedded_rule; /* 1 if composition rule is embedded. */
1513 int chars; /* number of components. */
1514 int i;
1515 struct cmpchar_info *cmpcharp;
1516
4ed46869
KH
1517 /* The second byte 0xFF means compostion rule is embedded. */
1518 embedded_rule = (str[1] == 0xFF);
1519
1520 /* At first, get the actual length of the composite character. */
1521 {
8867de67 1522 const unsigned char *p, *endp = str + 1, *lastp = str + len;
4ed46869
KH
1523 int bytes;
1524
6ae1f27e 1525 while (endp < lastp && ! CHAR_HEAD_P (*endp)) endp++;
93bcb785
KH
1526 if (endp - str < 5)
1527 /* Any composite char have at least 5-byte length. */
1528 return -1;
1529
4ed46869 1530 chars = 0;
93bcb785 1531 p = str + 1;
4ed46869
KH
1532 while (p < endp)
1533 {
9b4d1fe6
KH
1534 if (embedded_rule)
1535 {
1536 p++;
1537 if (p >= endp)
1538 return -1;
1539 }
4ed46869 1540 /* No need of checking if *P is 0xA0 because
93bcb785
KH
1541 BYTES_BY_CHAR_HEAD (0x80) surely returns 2. */
1542 p += BYTES_BY_CHAR_HEAD (*p - 0x20);
4ed46869
KH
1543 chars++;
1544 }
93bcb785
KH
1545 if (p > endp || chars < 2 || chars > MAX_COMPONENT_COUNT)
1546 /* Invalid components. */
4ed46869 1547 return -1;
93bcb785 1548 len = p - str;
4ed46869
KH
1549 }
1550 hash_idx = hash_string (str, len) % CMPCHAR_HASH_TABLE_SIZE;
1551 hashp = cmpchar_hash_table[hash_idx];
1552
1553 /* Then, look into the hash table. */
1554 if (hashp != NULL)
1555 /* Find the correct one among composite characters of the same
1556 hash value. */
1557 for (i = 2; i < CMPCHAR_HASH_USED (hashp); i++)
1558 {
1559 cmpcharp = cmpchar_table[CMPCHAR_HASH_CMPCHAR_ID (hashp, i)];
1560 if (len == cmpcharp->len
1561 && ! bcmp (str, cmpcharp->data, len))
1562 return CMPCHAR_HASH_CMPCHAR_ID (hashp, i);
1563 }
1564
1565 /* We have to register the composite character in cmpchar_table. */
0282eb69 1566 if (n_cmpchars >= (CHAR_FIELD2_MASK | CHAR_FIELD3_MASK))
513ee442
KH
1567 /* No, we have no more room for a new composite character. */
1568 return -1;
1569
4ed46869
KH
1570 /* Make the entry in hash table. */
1571 if (hashp == NULL)
1572 {
1573 /* Make a table for 8 composite characters initially. */
1574 hashp = (cmpchar_hash_table[hash_idx]
1575 = (int *) xmalloc (sizeof (int) * (2 + 8)));
1576 CMPCHAR_HASH_SIZE (hashp) = 10;
1577 CMPCHAR_HASH_USED (hashp) = 2;
1578 }
1579 else if (CMPCHAR_HASH_USED (hashp) >= CMPCHAR_HASH_SIZE (hashp))
1580 {
1581 CMPCHAR_HASH_SIZE (hashp) += 8;
1582 hashp = (cmpchar_hash_table[hash_idx]
1583 = (int *) xrealloc (hashp,
1584 sizeof (int) * CMPCHAR_HASH_SIZE (hashp)));
1585 }
1586 CMPCHAR_HASH_CMPCHAR_ID (hashp, CMPCHAR_HASH_USED (hashp)) = n_cmpchars;
1587 CMPCHAR_HASH_USED (hashp)++;
1588
1589 /* Set information of the composite character in cmpchar_table. */
1590 if (cmpchar_table_size == 0)
1591 {
1592 /* This is the first composite character to be registered. */
1593 cmpchar_table_size = 256;
1594 cmpchar_table
1595 = (struct cmpchar_info **) xmalloc (sizeof (cmpchar_table[0])
1596 * cmpchar_table_size);
1597 }
1598 else if (cmpchar_table_size <= n_cmpchars)
1599 {
1600 cmpchar_table_size += 256;
1601 cmpchar_table
1602 = (struct cmpchar_info **) xrealloc (cmpchar_table,
1603 sizeof (cmpchar_table[0])
1604 * cmpchar_table_size);
1605 }
1606
1607 cmpcharp = (struct cmpchar_info *) xmalloc (sizeof (struct cmpchar_info));
1608
1609 cmpcharp->len = len;
1610 cmpcharp->data = (unsigned char *) xmalloc (len + 1);
1611 bcopy (str, cmpcharp->data, len);
1612 cmpcharp->data[len] = 0;
1613 cmpcharp->glyph_len = chars;
1614 cmpcharp->glyph = (GLYPH *) xmalloc (sizeof (GLYPH) * chars);
1615 if (embedded_rule)
1616 {
1617 cmpcharp->cmp_rule = (unsigned char *) xmalloc (chars);
1618 cmpcharp->col_offset = (float *) xmalloc (sizeof (float) * chars);
1619 }
1620 else
1621 {
1622 cmpcharp->cmp_rule = NULL;
1623 cmpcharp->col_offset = NULL;
1624 }
1625
1626 /* Setup GLYPH data and composition rules (if any) so as not to make
1627 them every time on displaying. */
1628 {
1629 unsigned char *bufp;
1630 int width;
1631 float leftmost = 0.0, rightmost = 1.0;
1632
1633 if (embedded_rule)
1634 /* At first, col_offset[N] is set to relative to col_offset[0]. */
1635 cmpcharp->col_offset[0] = 0;
1636
1637 for (i = 0, bufp = cmpcharp->data + 1; i < chars; i++)
1638 {
1639 if (embedded_rule)
1640 cmpcharp->cmp_rule[i] = *bufp++;
1641
1642 if (*bufp == 0xA0) /* This is an ASCII character. */
1643 {
1644 cmpcharp->glyph[i] = FAST_MAKE_GLYPH ((*++bufp & 0x7F), 0);
1645 width = 1;
1646 bufp++;
1647 }
1648 else /* Multibyte character. */
1649 {
1650 /* Make `bufp' point normal multi-byte form temporally. */
1651 *bufp -= 0x20;
1652 cmpcharp->glyph[i]
537efd8d 1653 = FAST_MAKE_GLYPH (string_to_non_ascii_char (bufp, 4, 0, 0), 0);
4ed46869
KH
1654 width = WIDTH_BY_CHAR_HEAD (*bufp);
1655 *bufp += 0x20;
1656 bufp += BYTES_BY_CHAR_HEAD (*bufp - 0x20);
1657 }
1658
1659 if (embedded_rule && i > 0)
1660 {
1661 /* Reference points (global_ref and new_ref) are
1662 encoded as below:
1663
1664 0--1--2 -- ascent
1665 | |
1666 | |
1667 | 4 -+--- center
1668 -- 3 5 -- baseline
1669 | |
1670 6--7--8 -- descent
1671
1672 Now, we calculate the column offset of the new glyph
1673 from the left edge of the first glyph. This can avoid
1674 the same calculation everytime displaying this
1675 composite character. */
1676
1677 /* Reference points of global glyph and new glyph. */
1678 int global_ref = (cmpcharp->cmp_rule[i] - 0xA0) / 9;
1679 int new_ref = (cmpcharp->cmp_rule[i] - 0xA0) % 9;
1680 /* Column offset relative to the first glyph. */
1681 float left = (leftmost
1682 + (global_ref % 3) * (rightmost - leftmost) / 2.0
1683 - (new_ref % 3) * width / 2.0);
1684
1685 cmpcharp->col_offset[i] = left;
1686 if (left < leftmost)
1687 leftmost = left;
1688 if (left + width > rightmost)
1689 rightmost = left + width;
1690 }
1691 else
1692 {
1693 if (width > rightmost)
1694 rightmost = width;
1695 }
1696 }
1697 if (embedded_rule)
1698 {
1699 /* Now col_offset[N] are relative to the left edge of the
1700 first component. Make them relative to the left edge of
1701 overall glyph. */
1702 for (i = 0; i < chars; i++)
1703 cmpcharp->col_offset[i] -= leftmost;
1704 /* Make rightmost holds width of overall glyph. */
1705 rightmost -= leftmost;
1706 }
1707
1708 cmpcharp->width = rightmost;
1709 if (cmpcharp->width < rightmost)
1710 /* To get a ceiling integer value. */
1711 cmpcharp->width++;
1712 }
1713
1714 cmpchar_table[n_cmpchars] = cmpcharp;
1715
1716 return n_cmpchars++;
1717}
1718
de54b0d5
KH
1719/* Return the Nth element of the composite character C. If NOERROR is
1720 nonzero, return 0 on error condition (C is an invalid composite
1721 charcter, or N is out of range). */
4ed46869 1722int
de54b0d5
KH
1723cmpchar_component (c, n, noerror)
1724 int c, n, noerror;
4ed46869
KH
1725{
1726 int id = COMPOSITE_CHAR_ID (c);
1727
de54b0d5
KH
1728 if (id < 0 || id >= n_cmpchars)
1729 {
1730 /* C is not a valid composite character. */
1731 if (noerror) return 0;
1732 error ("Invalid composite character: %d", c) ;
1733 }
1734 if (n >= cmpchar_table[id]->glyph_len)
1735 {
1736 /* No such component. */
1737 if (noerror) return 0;
1738 args_out_of_range (make_number (c), make_number (n));
1739 }
4ed46869
KH
1740 /* No face data is stored in glyph code. */
1741 return ((int) (cmpchar_table[id]->glyph[n]));
1742}
1743
1744DEFUN ("cmpcharp", Fcmpcharp, Scmpcharp, 1, 1, 0,
1745 "T if CHAR is a composite character.")
1746 (ch)
1747 Lisp_Object ch;
1748{
1749 CHECK_NUMBER (ch, 0);
1750 return (COMPOSITE_CHAR_P (XINT (ch)) ? Qt : Qnil);
1751}
1752
1753DEFUN ("composite-char-component", Fcmpchar_component, Scmpchar_component,
1754 2, 2, 0,
de54b0d5
KH
1755 "Return the Nth component character of composite character CHARACTER.")
1756 (character, n)
1757 Lisp_Object character, n;
4ed46869 1758{
de54b0d5 1759 int id;
4ed46869
KH
1760
1761 CHECK_NUMBER (character, 0);
de54b0d5 1762 CHECK_NUMBER (n, 1);
4ed46869 1763
de54b0d5 1764 return (make_number (cmpchar_component (XINT (character), XINT (n), 0)));
4ed46869
KH
1765}
1766
1767DEFUN ("composite-char-composition-rule", Fcmpchar_cmp_rule, Scmpchar_cmp_rule,
1768 2, 2, 0,
de54b0d5 1769 "Return the Nth composition rule of composite character CHARACTER.\n\
55001746 1770The returned rule is for composing the Nth component\n\
de54b0d5
KH
1771on the (N-1)th component.\n\
1772If CHARACTER should be composed relatively or N is 0, return 255.")
55001746
KH
1773 (character, n)
1774 Lisp_Object character, n;
4ed46869 1775{
de54b0d5 1776 int id;
4ed46869
KH
1777
1778 CHECK_NUMBER (character, 0);
55001746 1779 CHECK_NUMBER (n, 1);
4ed46869
KH
1780
1781 id = COMPOSITE_CHAR_ID (XINT (character));
1782 if (id < 0 || id >= n_cmpchars)
1783 error ("Invalid composite character: %d", XINT (character));
de54b0d5 1784 if (XINT (n) < 0 || XINT (n) >= cmpchar_table[id]->glyph_len)
55001746 1785 args_out_of_range (character, n);
4ed46869 1786
de54b0d5
KH
1787 return make_number (cmpchar_table[id]->cmp_rule
1788 ? cmpchar_table[id]->cmp_rule[XINT (n)]
1789 : 255);
4ed46869
KH
1790}
1791
1792DEFUN ("composite-char-composition-rule-p", Fcmpchar_cmp_rule_p,
1793 Scmpchar_cmp_rule_p, 1, 1, 0,
1794 "Return non-nil if composite character CHARACTER contains a embedded rule.")
1795 (character)
1796 Lisp_Object character;
1797{
1798 int id;
1799
1800 CHECK_NUMBER (character, 0);
1801 id = COMPOSITE_CHAR_ID (XINT (character));
1802 if (id < 0 || id >= n_cmpchars)
1803 error ("Invalid composite character: %d", XINT (character));
1804
1805 return (cmpchar_table[id]->cmp_rule ? Qt : Qnil);
1806}
1807
1808DEFUN ("composite-char-component-count", Fcmpchar_cmp_count,
1809 Scmpchar_cmp_count, 1, 1, 0,
1810 "Return number of compoents of composite character CHARACTER.")
1811 (character)
1812 Lisp_Object character;
1813{
1814 int id;
1815
1816 CHECK_NUMBER (character, 0);
1817 id = COMPOSITE_CHAR_ID (XINT (character));
1818 if (id < 0 || id >= n_cmpchars)
1819 error ("Invalid composite character: %d", XINT (character));
1820
1821 return (make_number (cmpchar_table[id]->glyph_len));
1822}
1823
1824DEFUN ("compose-string", Fcompose_string, Scompose_string,
1825 1, 1, 0,
1826 "Return one char string composed from all characters in STRING.")
1827 (str)
1828 Lisp_Object str;
1829{
1830 unsigned char buf[MAX_LENGTH_OF_MULTI_BYTE_FORM], *p, *pend, *ptemp;
1831 int len, i;
1832
1833 CHECK_STRING (str, 0);
1834
1835 buf[0] = LEADING_CODE_COMPOSITION;
1836 p = XSTRING (str)->data;
fc932ac6 1837 pend = p + STRING_BYTES (XSTRING (str));
4ed46869
KH
1838 i = 1;
1839 while (p < pend)
1840 {
9b4d1fe6 1841 if (*p < 0x20) /* control code */
4ed46869
KH
1842 error ("Invalid component character: %d", *p);
1843 else if (*p < 0x80) /* ASCII */
1844 {
1845 if (i + 2 >= MAX_LENGTH_OF_MULTI_BYTE_FORM)
1846 error ("Too long string to be composed: %s", XSTRING (str)->data);
1847 /* Prepend an ASCII charset indicator 0xA0, set MSB of the
1848 code itself. */
1849 buf[i++] = 0xA0;
1850 buf[i++] = *p++ + 0x80;
1851 }
1852 else if (*p == LEADING_CODE_COMPOSITION) /* composite char */
1853 {
1854 /* Already composed. Eliminate the heading
1855 LEADING_CODE_COMPOSITION, keep the remaining bytes
1856 unchanged. */
1857 p++;
de54b0d5
KH
1858 if (*p == 255)
1859 error ("Can't compose a rule-based composition character");
4ed46869 1860 ptemp = p;
6ae1f27e 1861 while (! CHAR_HEAD_P (*p)) p++;
9b4d1fe6
KH
1862 if (str_cmpchar_id (ptemp - 1, p - ptemp + 1) < 0)
1863 error ("Can't compose an invalid composition character");
4ed46869
KH
1864 if (i + (p - ptemp) >= MAX_LENGTH_OF_MULTI_BYTE_FORM)
1865 error ("Too long string to be composed: %s", XSTRING (str)->data);
1866 bcopy (ptemp, buf + i, p - ptemp);
1867 i += p - ptemp;
1868 }
1869 else /* multibyte char */
1870 {
1871 /* Add 0x20 to the base leading-code, keep the remaining
1872 bytes unchanged. */
9b4d1fe6
KH
1873 int c = STRING_CHAR_AND_CHAR_LENGTH (p, pend - p, len);
1874
1875 if (len <= 1 || ! CHAR_VALID_P (c, 0))
1876 error ("Can't compose an invalid character");
4ed46869
KH
1877 if (i + len >= MAX_LENGTH_OF_MULTI_BYTE_FORM)
1878 error ("Too long string to be composed: %s", XSTRING (str)->data);
1879 bcopy (p, buf + i, len);
1880 buf[i] += 0x20;
1881 p += len, i += len;
1882 }
1883 }
1884
1885 if (i < 5)
1886 /* STR contains only one character, which can't be composed. */
1887 error ("Too short string to be composed: %s", XSTRING (str)->data);
1888
27802600 1889 return make_string_from_bytes (buf, 1, i);
4ed46869
KH
1890}
1891
1892\f
dfcf069d 1893int
4ed46869
KH
1894charset_id_internal (charset_name)
1895 char *charset_name;
1896{
76d7b829 1897 Lisp_Object val;
4ed46869 1898
76d7b829 1899 val= Fget (intern (charset_name), Qcharset);
4ed46869
KH
1900 if (!VECTORP (val))
1901 error ("Charset %s is not defined", charset_name);
1902
1903 return (XINT (XVECTOR (val)->contents[0]));
1904}
1905
1906DEFUN ("setup-special-charsets", Fsetup_special_charsets,
1907 Ssetup_special_charsets, 0, 0, 0, "Internal use only.")
1908 ()
1909{
1910 charset_latin_iso8859_1 = charset_id_internal ("latin-iso8859-1");
1911 charset_jisx0208_1978 = charset_id_internal ("japanese-jisx0208-1978");
1912 charset_jisx0208 = charset_id_internal ("japanese-jisx0208");
1913 charset_katakana_jisx0201 = charset_id_internal ("katakana-jisx0201");
1914 charset_latin_jisx0201 = charset_id_internal ("latin-jisx0201");
1915 charset_big5_1 = charset_id_internal ("chinese-big5-1");
1916 charset_big5_2 = charset_id_internal ("chinese-big5-2");
1917 return Qnil;
1918}
1919
dfcf069d 1920void
4ed46869
KH
1921init_charset_once ()
1922{
1923 int i, j, k;
1924
1925 staticpro (&Vcharset_table);
1926 staticpro (&Vcharset_symbol_table);
8a73a704 1927 staticpro (&Vgeneric_character_list);
4ed46869
KH
1928
1929 /* This has to be done here, before we call Fmake_char_table. */
1930 Qcharset_table = intern ("charset-table");
1931 staticpro (&Qcharset_table);
1932
1933 /* Intern this now in case it isn't already done.
1934 Setting this variable twice is harmless.
1935 But don't staticpro it here--that is done in alloc.c. */
1936 Qchar_table_extra_slots = intern ("char-table-extra-slots");
1937
1938 /* Now we are ready to set up this property, so we can
1939 create the charset table. */
1940 Fput (Qcharset_table, Qchar_table_extra_slots, make_number (0));
1941 Vcharset_table = Fmake_char_table (Qcharset_table, Qnil);
1942
0282eb69
KH
1943 Qunknown = intern ("unknown");
1944 staticpro (&Qunknown);
1945 Vcharset_symbol_table = Fmake_vector (make_number (MAX_CHARSET + 1),
1946 Qunknown);
4ed46869
KH
1947
1948 /* Setup tables. */
1949 for (i = 0; i < 2; i++)
1950 for (j = 0; j < 2; j++)
1951 for (k = 0; k < 128; k++)
1952 iso_charset_table [i][j][k] = -1;
1953
1954 bzero (cmpchar_hash_table, sizeof cmpchar_hash_table);
1955 cmpchar_table_size = n_cmpchars = 0;
1956
60383934 1957 for (i = 0; i < 256; i++)
4ed46869 1958 BYTES_BY_CHAR_HEAD (i) = 1;
6ef23ebb
KH
1959 for (i = MIN_CHARSET_OFFICIAL_DIMENSION1;
1960 i <= MAX_CHARSET_OFFICIAL_DIMENSION1; i++)
1961 BYTES_BY_CHAR_HEAD (i) = 2;
1962 for (i = MIN_CHARSET_OFFICIAL_DIMENSION2;
1963 i <= MAX_CHARSET_OFFICIAL_DIMENSION2; i++)
1964 BYTES_BY_CHAR_HEAD (i) = 3;
4ed46869
KH
1965 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_11) = 3;
1966 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_12) = 3;
1967 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_21) = 4;
1968 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_22) = 4;
6ef23ebb 1969 /* The followings don't reflect the actual bytes, but just to tell
4ed46869
KH
1970 that it is a start of a multibyte character. */
1971 BYTES_BY_CHAR_HEAD (LEADING_CODE_COMPOSITION) = 2;
6ef23ebb
KH
1972 BYTES_BY_CHAR_HEAD (0x9E) = 2;
1973 BYTES_BY_CHAR_HEAD (0x9F) = 2;
4ed46869
KH
1974
1975 for (i = 0; i < 128; i++)
1976 WIDTH_BY_CHAR_HEAD (i) = 1;
1977 for (; i < 256; i++)
1978 WIDTH_BY_CHAR_HEAD (i) = 4;
1979 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_11) = 1;
1980 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_12) = 2;
1981 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_21) = 1;
1982 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_22) = 2;
8a73a704
KH
1983
1984 {
76d7b829 1985 Lisp_Object val;
8a73a704 1986
76d7b829 1987 val = Qnil;
8a73a704
KH
1988 for (i = 0x81; i < 0x90; i++)
1989 val = Fcons (make_number ((i - 0x70) << 7), val);
1990 for (; i < 0x9A; i++)
1991 val = Fcons (make_number ((i - 0x8F) << 14), val);
1992 for (i = 0xA0; i < 0xF0; i++)
1993 val = Fcons (make_number ((i - 0x70) << 7), val);
1994 for (; i < 0xFF; i++)
1995 val = Fcons (make_number ((i - 0xE0) << 14), val);
1996 val = Fcons (make_number (GENERIC_COMPOSITION_CHAR), val);
1997 Vgeneric_character_list = Fnreverse (val);
1998 }
bbf12bb3
KH
1999
2000 nonascii_insert_offset = 0;
2001 Vnonascii_translation_table = Qnil;
4ed46869
KH
2002}
2003
2004#ifdef emacs
2005
dfcf069d 2006void
4ed46869
KH
2007syms_of_charset ()
2008{
2009 Qascii = intern ("ascii");
2010 staticpro (&Qascii);
2011
2012 Qcharset = intern ("charset");
2013 staticpro (&Qcharset);
2014
2015 /* Define ASCII charset now. */
2016 update_charset_table (make_number (CHARSET_ASCII),
2017 make_number (1), make_number (94),
2018 make_number (1),
2019 make_number (0),
2020 make_number ('B'),
2021 make_number (0),
2022 build_string ("ASCII"),
2023 build_string ("ASCII"),
2024 build_string ("ASCII (ISO646 IRV)"));
2025 CHARSET_SYMBOL (CHARSET_ASCII) = Qascii;
2026 Fput (Qascii, Qcharset, CHARSET_TABLE_ENTRY (CHARSET_ASCII));
2027
2028 Qcomposition = intern ("composition");
2029 staticpro (&Qcomposition);
2030 CHARSET_SYMBOL (CHARSET_COMPOSITION) = Qcomposition;
2031
c1a08b4c
KH
2032 Qauto_fill_chars = intern ("auto-fill-chars");
2033 staticpro (&Qauto_fill_chars);
2034 Fput (Qauto_fill_chars, Qchar_table_extra_slots, make_number (0));
2035
4ed46869 2036 defsubr (&Sdefine_charset);
8a73a704 2037 defsubr (&Sgeneric_character_list);
3fac5a51 2038 defsubr (&Sget_unused_iso_final_char);
4ed46869
KH
2039 defsubr (&Sdeclare_equiv_charset);
2040 defsubr (&Sfind_charset_region);
2041 defsubr (&Sfind_charset_string);
2042 defsubr (&Smake_char_internal);
2043 defsubr (&Ssplit_char);
2044 defsubr (&Schar_charset);
90d7b74e 2045 defsubr (&Scharset_after);
4ed46869 2046 defsubr (&Siso_charset);
9d3d8cba 2047 defsubr (&Schar_valid_p);
d2665018 2048 defsubr (&Sunibyte_char_to_multibyte);
1bcc1567 2049 defsubr (&Smultibyte_char_to_unibyte);
4ed46869
KH
2050 defsubr (&Schar_bytes);
2051 defsubr (&Schar_width);
2052 defsubr (&Sstring_width);
2053 defsubr (&Schar_direction);
af4fecb4 2054 defsubr (&Schars_in_region);
87b089ad 2055 defsubr (&Sstring);
4ed46869
KH
2056 defsubr (&Scmpcharp);
2057 defsubr (&Scmpchar_component);
2058 defsubr (&Scmpchar_cmp_rule);
2059 defsubr (&Scmpchar_cmp_rule_p);
2060 defsubr (&Scmpchar_cmp_count);
2061 defsubr (&Scompose_string);
2062 defsubr (&Ssetup_special_charsets);
2063
2064 DEFVAR_LISP ("charset-list", &Vcharset_list,
2065 "List of charsets ever defined.");
2066 Vcharset_list = Fcons (Qascii, Qnil);
2067
537efd8d 2068 DEFVAR_LISP ("translation-table-vector", &Vtranslation_table_vector,
b4e9dd77
KH
2069 "Vector of cons cell of a symbol and translation table ever defined.\n\
2070An ID of a translation table is an index of this vector.");
537efd8d 2071 Vtranslation_table_vector = Fmake_vector (make_number (16), Qnil);
b0e3cf2b 2072
4ed46869
KH
2073 DEFVAR_INT ("leading-code-composition", &leading_code_composition,
2074 "Leading-code of composite characters.");
2075 leading_code_composition = LEADING_CODE_COMPOSITION;
2076
2077 DEFVAR_INT ("leading-code-private-11", &leading_code_private_11,
2078 "Leading-code of private TYPE9N charset of column-width 1.");
2079 leading_code_private_11 = LEADING_CODE_PRIVATE_11;
2080
2081 DEFVAR_INT ("leading-code-private-12", &leading_code_private_12,
2082 "Leading-code of private TYPE9N charset of column-width 2.");
2083 leading_code_private_12 = LEADING_CODE_PRIVATE_12;
2084
2085 DEFVAR_INT ("leading-code-private-21", &leading_code_private_21,
2086 "Leading-code of private TYPE9Nx9N charset of column-width 1.");
2087 leading_code_private_21 = LEADING_CODE_PRIVATE_21;
2088
2089 DEFVAR_INT ("leading-code-private-22", &leading_code_private_22,
2090 "Leading-code of private TYPE9Nx9N charset of column-width 2.");
2091 leading_code_private_22 = LEADING_CODE_PRIVATE_22;
35e623fb
RS
2092
2093 DEFVAR_INT ("nonascii-insert-offset", &nonascii_insert_offset,
d2665018 2094 "Offset for converting non-ASCII unibyte codes 0240...0377 to multibyte.\n\
4cf9710d
RS
2095This is used for converting unibyte text to multibyte,\n\
2096and for inserting character codes specified by number.\n\n\
3e8ceaac
RS
2097This serves to convert a Latin-1 or similar 8-bit character code\n\
2098to the corresponding Emacs multibyte character code.\n\
2099Typically the value should be (- (make-char CHARSET 0) 128),\n\
2100for your choice of character set.\n\
537efd8d 2101If `nonascii-translation-table' is non-nil, it overrides this variable.");
35e623fb 2102 nonascii_insert_offset = 0;
b0e3cf2b 2103
b4e9dd77 2104 DEFVAR_LISP ("nonascii-translation-table", &Vnonascii_translation_table,
537efd8d 2105 "Translation table to convert non-ASCII unibyte codes to multibyte.\n\
4cf9710d
RS
2106This is used for converting unibyte text to multibyte,\n\
2107and for inserting character codes specified by number.\n\n\
2108Conversion is performed only when multibyte characters are enabled,\n\
2109and it serves to convert a Latin-1 or similar 8-bit character code\n\
2110to the corresponding Emacs character code.\n\n\
da4d65af 2111If this is nil, `nonascii-insert-offset' is used instead.\n\
b4e9dd77
KH
2112See also the docstring of `make-translation-table'.");
2113 Vnonascii_translation_table = Qnil;
4cf9710d 2114
b0e3cf2b
KH
2115 DEFVAR_INT ("min-composite-char", &min_composite_char,
2116 "Minimum character code of a composite character.");
2117 min_composite_char = MIN_CHAR_COMPOSITION;
c1a08b4c
KH
2118
2119 DEFVAR_LISP ("auto-fill-chars", &Vauto_fill_chars,
2120 "A char-table for characters which invoke auto-filling.\n\
2121Such characters has value t in this table.");
2122 Vauto_fill_chars = Fmake_char_table (Qauto_fill_chars, Qnil);
60022cb7
AS
2123 CHAR_TABLE_SET (Vauto_fill_chars, make_number (' '), Qt);
2124 CHAR_TABLE_SET (Vauto_fill_chars, make_number ('\n'), Qt);
4ed46869
KH
2125}
2126
2127#endif /* emacs */