(VALID_CHAR_P): New macro.
[bpt/emacs.git] / src / charset.c
CommitLineData
4ed46869
KH
1/* Multilingual characters handler.
2 Ver.1.0
4ed46869
KH
3 Copyright (C) 1995 Free Software Foundation, Inc.
4 Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
5
369314dc
KH
6This file is part of GNU Emacs.
7
8GNU Emacs is free software; you can redistribute it and/or modify
9it under the terms of the GNU General Public License as published by
10the Free Software Foundation; either version 2, or (at your option)
11any later version.
4ed46869 12
369314dc
KH
13GNU Emacs is distributed in the hope that it will be useful,
14but WITHOUT ANY WARRANTY; without even the implied warranty of
15MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16GNU General Public License for more details.
4ed46869 17
369314dc
KH
18You should have received a copy of the GNU General Public License
19along with GNU Emacs; see the file COPYING. If not, write to
20the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
21Boston, MA 02111-1307, USA. */
4ed46869
KH
22
23/* At first, see the document in `charset.h' to understand the code in
24 this file. */
25
26#include <stdio.h>
27
28#ifdef emacs
29
30#include <sys/types.h>
31#include <config.h>
32#include "lisp.h"
33#include "buffer.h"
34#include "charset.h"
35#include "coding.h"
36
37#else /* not emacs */
38
39#include "mulelib.h"
40
41#endif /* emacs */
42
43Lisp_Object Qcharset, Qascii, Qcomposition;
44
45/* Declaration of special leading-codes. */
46int leading_code_composition; /* for composite characters */
47int leading_code_private_11; /* for private DIMENSION1 of 1-column */
48int leading_code_private_12; /* for private DIMENSION1 of 2-column */
49int leading_code_private_21; /* for private DIMENSION2 of 1-column */
50int leading_code_private_22; /* for private DIMENSION2 of 2-column */
51
52/* Declaration of special charsets. */
53int charset_ascii; /* ASCII */
54int charset_composition; /* for a composite character */
55int charset_latin_iso8859_1; /* ISO8859-1 (Latin-1) */
56int charset_jisx0208_1978; /* JISX0208.1978 (Japanese Kanji old set) */
57int charset_jisx0208; /* JISX0208.1983 (Japanese Kanji) */
58int charset_katakana_jisx0201; /* JISX0201.Kana (Japanese Katakana) */
59int charset_latin_jisx0201; /* JISX0201.Roman (Japanese Roman) */
60int charset_big5_1; /* Big5 Level 1 (Chinese Traditional) */
61int charset_big5_2; /* Big5 Level 2 (Chinese Traditional) */
62
63Lisp_Object Qcharset_table;
64
65/* A char-table containing information of each character set. */
66Lisp_Object Vcharset_table;
67
68/* A vector of charset symbol indexed by charset-id. This is used
69 only for returning charset symbol from C functions. */
70Lisp_Object Vcharset_symbol_table;
71
72/* A list of charset symbols ever defined. */
73Lisp_Object Vcharset_list;
74
75/* Tables used by macros BYTES_BY_CHAR_HEAD and WIDTH_BY_CHAR_HEAD. */
76int bytes_by_char_head[256];
77int width_by_char_head[256];
78
79/* Mapping table from ISO2022's charset (specified by DIMENSION,
80 CHARS, and FINAL-CHAR) to Emacs' charset. */
81int iso_charset_table[2][2][128];
82
513ee442
KH
83/* Table of pointers to the structure `cmpchar_info' indexed by
84 CMPCHAR-ID. */
85struct cmpchar_info **cmpchar_table;
86/* The current size of `cmpchar_table'. */
87static int cmpchar_table_size;
88/* Number of the current composite characters. */
89int n_cmpchars;
90
4ed46869
KH
91/* Variables used locally in the macro FETCH_MULTIBYTE_CHAR. */
92unsigned char *_fetch_multibyte_char_p;
93int _fetch_multibyte_char_len;
94
95/* Set STR a pointer to the multi-byte form of the character C. If C
96 is not a composite character, the multi-byte form is set in WORKBUF
97 and STR points WORKBUF. The caller should allocate at least 4-byte
98 area at WORKBUF in advance. Returns the length of the multi-byte
99 form.
100
101 Use macro `CHAR_STRING (C, WORKBUF, STR)' instead of calling this
102 function directly if C can be an ASCII character. */
103
104int
105non_ascii_char_to_string (c, workbuf, str)
106 int c;
107 unsigned char *workbuf, **str;
108{
6dc0722d 109 int charset, c1, c2;
4ed46869
KH
110
111 if (COMPOSITE_CHAR_P (c))
112 {
113 int cmpchar_id = COMPOSITE_CHAR_ID (c);
114
115 if (cmpchar_id < n_cmpchars)
116 {
117 *str = cmpchar_table[cmpchar_id]->data;
118 return cmpchar_table[cmpchar_id]->len;
119 }
120 else
121 {
122 *str = workbuf;
123 return 0;
124 }
125 }
126
127 SPLIT_NON_ASCII_CHAR (c, charset, c1, c2);
128
129 *str = workbuf;
130 *workbuf++ = CHARSET_LEADING_CODE_BASE (charset);
131 if (*workbuf = CHARSET_LEADING_CODE_EXT (charset))
132 workbuf++;
133 *workbuf++ = c1 | 0x80;
6dc0722d 134 if (c2 >= 0)
4ed46869
KH
135 *workbuf++ = c2 | 0x80;
136
137 return (workbuf - *str);
138}
139
140/* Return a non-ASCII character of which multi-byte form is at STR of
141 length LEN. If ACTUAL_LEN is not NULL, the actual length of the
142 character is set to the address ACTUAL_LEN.
143
144 Use macro `STRING_CHAR (STR, LEN)' instead of calling this function
145 directly if STR can hold an ASCII character. */
146
147string_to_non_ascii_char (str, len, actual_len)
148 unsigned char *str;
149 int len, *actual_len;
150{
151 int charset;
152 unsigned char c1, c2;
153 register int c;
154
155 if (SPLIT_STRING (str, len, charset, c1, c2) == CHARSET_ASCII)
156 {
157 if (actual_len)
158 *actual_len = 1;
159 return (int) *str;
160 }
161
162 c = MAKE_NON_ASCII_CHAR (charset, c1, c2);
163
164 if (actual_len)
165 *actual_len = (charset == CHARSET_COMPOSITION
166 ? cmpchar_table[COMPOSITE_CHAR_ID (c)]->len
167 : BYTES_BY_CHAR_HEAD (*str));
168 return c;
169}
170
171/* Return the length of the multi-byte form at string STR of length LEN. */
172int
173multibyte_form_length (str, len)
174 unsigned char *str;
175 int len;
176{
177 int charset;
178 unsigned char c1, c2;
179 register int c;
180
181 if (SPLIT_STRING (str, len, charset, c1, c2) == CHARSET_ASCII)
182 return 1;
183
184 return (charset == CHARSET_COMPOSITION
185 ? cmpchar_table[(c1 << 7) | c2]->len
186 : BYTES_BY_CHAR_HEAD (*str));
187}
188
189/* Check if string STR of length LEN contains valid multi-byte form of
190 a character. If valid, charset and position codes of the character
191 is set at *CHARSET, *C1, and *C2, and return 0. If not valid,
192 return -1. This should be used only in the macro SPLIT_STRING
193 which checks range of STR in advance. */
194
195split_non_ascii_string (str, len, charset, c1, c2)
196 register unsigned char *str, *c1, *c2;
197 register int len, *charset;
198{
199 register unsigned int cs = *str++;
200
201 if (cs == LEADING_CODE_COMPOSITION)
202 {
203 int cmpchar_id = str_cmpchar_id (str - 1, len);
204
205 if (cmpchar_id < 0)
206 return -1;
207 *charset = cs, *c1 = cmpchar_id >> 7, *c2 = cmpchar_id & 0x7F;
208 }
209 else if ((cs < LEADING_CODE_PRIVATE_11 || (cs = *str++) >= 0xA0)
210 && CHARSET_DEFINED_P (cs))
211 {
212 *charset = cs;
213 if (*str < 0xA0)
214 return -1;
215 *c1 = (*str++) & 0x7F;
216 if (CHARSET_DIMENSION (cs) == 2)
217 {
218 if (*str < 0xA0)
219 return -1;
220 *c2 = (*str++) & 0x7F;
221 }
222 }
223 else
224 return -1;
225 return 0;
226}
227
23d2a7f1
KH
228/* Return a character unified with C (or a character made of CHARSET,
229 C1, and C2) in unification table TABLE. If no unification is found
230 in TABLE, return C. */
231unify_char (table, c, charset, c1, c2)
232 Lisp_Object table;
233 int c, charset, c1, c2;
234{
235 Lisp_Object ch;
236 int alt_charset, alt_c1, alt_c2, dimension;
237
238 if (c < 0) c = MAKE_CHAR (charset, c1, c2);
239 if (!CHAR_TABLE_P (table)
240 || (ch = Faref (table, make_number (c)), !INTEGERP (ch))
241 || XINT (ch) < 0)
242 return c;
243
244 SPLIT_CHAR (XFASTINT (ch), alt_charset, alt_c1, alt_c2);
245 dimension = CHARSET_DIMENSION (alt_charset);
246 if (dimension == 1 && alt_c1 > 0 || dimension == 2 && alt_c2 > 0)
247 /* CH is not a generic character, just return it. */
248 return XFASTINT (ch);
249
250 /* Since CH is a generic character, we must return a specific
251 charater which has the same position codes as C from CH. */
252 if (charset < 0)
253 SPLIT_CHAR (c, charset, c1, c2);
254 if (dimension != CHARSET_DIMENSION (charset))
255 /* We can't make such a character because of dimension mismatch. */
256 return c;
257 if (!alt_c1) alt_c1 = c1;
258 if (!alt_c2) alt_c2 = c2;
259 return MAKE_CHAR (alt_charset, c1, c2);
260}
261
4ed46869
KH
262/* Update the table Vcharset_table with the given arguments (see the
263 document of `define-charset' for the meaning of each argument).
264 Several other table contents are also updated. The caller should
265 check the validity of CHARSET-ID and the remaining arguments in
266 advance. */
267
268void
269update_charset_table (charset_id, dimension, chars, width, direction,
270 iso_final_char, iso_graphic_plane,
271 short_name, long_name, description)
272 Lisp_Object charset_id, dimension, chars, width, direction;
273 Lisp_Object iso_final_char, iso_graphic_plane;
274 Lisp_Object short_name, long_name, description;
275{
276 int charset = XINT (charset_id);
277 int bytes;
278 unsigned char leading_code_base, leading_code_ext;
279
6dc0722d
KH
280 if (NILP (CHARSET_TABLE_ENTRY (charset)))
281 CHARSET_TABLE_ENTRY (charset)
282 = Fmake_vector (make_number (CHARSET_MAX_IDX), Qnil);
4ed46869
KH
283
284 /* Get byte length of multibyte form, base leading-code, and
285 extended leading-code of the charset. See the comment under the
286 title "GENERAL NOTE on CHARACTER SET (CHARSET)" in charset.h. */
287 bytes = XINT (dimension);
288 if (charset < MIN_CHARSET_PRIVATE_DIMENSION1)
289 {
290 /* Official charset, it doesn't have an extended leading-code. */
291 if (charset != CHARSET_ASCII)
292 bytes += 1; /* For a base leading-code. */
293 leading_code_base = charset;
294 leading_code_ext = 0;
295 }
296 else
297 {
298 /* Private charset. */
299 bytes += 2; /* For base and extended leading-codes. */
300 leading_code_base
301 = (charset < LEADING_CODE_EXT_12
302 ? LEADING_CODE_PRIVATE_11
303 : (charset < LEADING_CODE_EXT_21
304 ? LEADING_CODE_PRIVATE_12
305 : (charset < LEADING_CODE_EXT_22
306 ? LEADING_CODE_PRIVATE_21
307 : LEADING_CODE_PRIVATE_22)));
308 leading_code_ext = charset;
309 }
310
311 CHARSET_TABLE_INFO (charset, CHARSET_ID_IDX) = charset_id;
312 CHARSET_TABLE_INFO (charset, CHARSET_BYTES_IDX) = make_number (bytes);
313 CHARSET_TABLE_INFO (charset, CHARSET_DIMENSION_IDX) = dimension;
314 CHARSET_TABLE_INFO (charset, CHARSET_CHARS_IDX) = chars;
315 CHARSET_TABLE_INFO (charset, CHARSET_WIDTH_IDX) = width;
316 CHARSET_TABLE_INFO (charset, CHARSET_DIRECTION_IDX) = direction;
317 CHARSET_TABLE_INFO (charset, CHARSET_LEADING_CODE_BASE_IDX)
318 = make_number (leading_code_base);
319 CHARSET_TABLE_INFO (charset, CHARSET_LEADING_CODE_EXT_IDX)
320 = make_number (leading_code_ext);
321 CHARSET_TABLE_INFO (charset, CHARSET_ISO_FINAL_CHAR_IDX) = iso_final_char;
322 CHARSET_TABLE_INFO (charset, CHARSET_ISO_GRAPHIC_PLANE_IDX)
323 = iso_graphic_plane;
324 CHARSET_TABLE_INFO (charset, CHARSET_SHORT_NAME_IDX) = short_name;
325 CHARSET_TABLE_INFO (charset, CHARSET_LONG_NAME_IDX) = long_name;
326 CHARSET_TABLE_INFO (charset, CHARSET_DESCRIPTION_IDX) = description;
327 CHARSET_TABLE_INFO (charset, CHARSET_PLIST_IDX) = Qnil;
328
329 {
330 /* If we have already defined a charset which has the same
331 DIMENSION, CHARS and ISO-FINAL-CHAR but the different
332 DIRECTION, we must update the entry REVERSE-CHARSET of both
333 charsets. If there's no such charset, the value of the entry
334 is set to nil. */
335 int i;
336
513ee442 337 for (i = 0; i <= MAX_CHARSET; i++)
4ed46869
KH
338 if (!NILP (CHARSET_TABLE_ENTRY (i)))
339 {
340 if (CHARSET_DIMENSION (i) == XINT (dimension)
341 && CHARSET_CHARS (i) == XINT (chars)
342 && CHARSET_ISO_FINAL_CHAR (i) == XINT (iso_final_char)
343 && CHARSET_DIRECTION (i) != XINT (direction))
344 {
345 CHARSET_TABLE_INFO (charset, CHARSET_REVERSE_CHARSET_IDX)
346 = make_number (i);
347 CHARSET_TABLE_INFO (i, CHARSET_REVERSE_CHARSET_IDX) = charset_id;
348 break;
349 }
350 }
513ee442 351 if (i > MAX_CHARSET)
4ed46869
KH
352 /* No such a charset. */
353 CHARSET_TABLE_INFO (charset, CHARSET_REVERSE_CHARSET_IDX)
354 = make_number (-1);
355 }
356
357 if (charset != CHARSET_ASCII
358 && charset < MIN_CHARSET_PRIVATE_DIMENSION1)
359 {
360 /* Update tables bytes_by_char_head and width_by_char_head. */
361 bytes_by_char_head[leading_code_base] = bytes;
362 width_by_char_head[leading_code_base] = XINT (width);
363
364 /* Update table emacs_code_class. */
365 emacs_code_class[charset] = (bytes == 2
366 ? EMACS_leading_code_2
367 : (bytes == 3
368 ? EMACS_leading_code_3
369 : EMACS_leading_code_4));
370 }
371
372 /* Update table iso_charset_table. */
373 if (ISO_CHARSET_TABLE (dimension, chars, iso_final_char) < 0)
374 ISO_CHARSET_TABLE (dimension, chars, iso_final_char) = charset;
375}
376
377#ifdef emacs
378
379/* Return charset id of CHARSET_SYMBOL, or return -1 if CHARSET_SYMBOL
380 is invalid. */
381int
382get_charset_id (charset_symbol)
383 Lisp_Object charset_symbol;
384{
385 Lisp_Object val;
386 int charset;
387
388 return ((SYMBOLP (charset_symbol)
389 && (val = Fget (charset_symbol, Qcharset), VECTORP (val))
390 && (charset = XINT (XVECTOR (val)->contents[CHARSET_ID_IDX]),
391 CHARSET_VALID_P (charset)))
392 ? charset : -1);
393}
394
395/* Return an identification number for a new private charset of
396 DIMENSION and WIDTH. If there's no more room for the new charset,
397 return 0. */
398Lisp_Object
399get_new_private_charset_id (dimension, width)
400 int dimension, width;
401{
402 int charset, from, to;
403
404 if (dimension == 1)
405 {
406 if (width == 1)
407 from = LEADING_CODE_EXT_11, to = LEADING_CODE_EXT_12;
408 else
409 from = LEADING_CODE_EXT_12, to = LEADING_CODE_EXT_21;
410 }
411 else
412 {
413 if (width == 1)
414 from = LEADING_CODE_EXT_21, to = LEADING_CODE_EXT_22;
415 else
416 from = LEADING_CODE_EXT_22, to = LEADING_CODE_EXT_MAX - 1;
417 }
418
419 for (charset = from; charset < to; charset++)
420 if (!CHARSET_DEFINED_P (charset)) break;
421
422 return make_number (charset < to ? charset : 0);
423}
424
425DEFUN ("define-charset", Fdefine_charset, Sdefine_charset, 3, 3, 0,
426 "Define CHARSET-ID as the identification number of CHARSET with INFO-VECTOR.\n\
23d2a7f1 427If CHARSET-ID is nil, it is decided automatically, which means CHARSET is\n\
4ed46869
KH
428 treated as a private charset.\n\
429INFO-VECTOR is a vector of the format:\n\
430 [DIMENSION CHARS WIDTH DIRECTION ISO-FINAL-CHAR ISO-GRAPHIC-PLANE\n\
431 SHORT-NAME LONG-NAME DESCRIPTION]\n\
432The meanings of each elements is as follows:\n\
433DIMENSION (integer) is the number of bytes to represent a character: 1 or 2.\n\
434CHARS (integer) is the number of characters in a dimension: 94 or 96.\n\
435WIDTH (integer) is the number of columns a character in the charset\n\
436occupies on the screen: one of 0, 1, and 2.\n\
437\n\
438DIRECTION (integer) is the rendering direction of characters in the\n\
439charset when rendering. If 0, render from right to left, else\n\
440render from left to right.\n\
441\n\
442ISO-FINAL-CHAR (character) is the final character of the\n\
443corresponding ISO 2022 charset.\n\
444\n\
445ISO-GRAPHIC-PLANE (integer) is the graphic plane to be invoked\n\
446while encoding to variants of ISO 2022 coding system, one of the\n\
447following: 0/graphic-plane-left(GL), 1/graphic-plane-right(GR).\n\
448\n\
449SHORT-NAME (string) is the short name to refer to the charset.\n\
450\n\
451LONG-NAME (string) is the long name to refer to the charset.\n\
452\n\
453DESCRIPTION (string) is the description string of the charset.")
454 (charset_id, charset_symbol, info_vector)
455 Lisp_Object charset_id, charset_symbol, info_vector;
456{
457 Lisp_Object *vec;
458
459 if (!NILP (charset_id))
460 CHECK_NUMBER (charset_id, 0);
461 CHECK_SYMBOL (charset_symbol, 1);
462 CHECK_VECTOR (info_vector, 2);
463
464 if (! NILP (charset_id))
465 {
466 if (! CHARSET_VALID_P (XINT (charset_id)))
467 error ("Invalid CHARSET: %d", XINT (charset_id));
468 else if (CHARSET_DEFINED_P (XINT (charset_id)))
469 error ("Already defined charset: %d", XINT (charset_id));
470 }
471
472 vec = XVECTOR (info_vector)->contents;
473 if (XVECTOR (info_vector)->size != 9
474 || !INTEGERP (vec[0]) || !(XINT (vec[0]) == 1 || XINT (vec[0]) == 2)
475 || !INTEGERP (vec[1]) || !(XINT (vec[1]) == 94 || XINT (vec[1]) == 96)
476 || !INTEGERP (vec[2]) || !(XINT (vec[2]) == 1 || XINT (vec[2]) == 2)
477 || !INTEGERP (vec[3]) || !(XINT (vec[3]) == 0 || XINT (vec[3]) == 1)
478 || !INTEGERP (vec[4]) || !(XINT (vec[4]) >= '0' && XINT (vec[4]) <= '~')
479 || !INTEGERP (vec[5]) || !(XINT (vec[5]) == 0 || XINT (vec[5]) == 1)
480 || !STRINGP (vec[6])
481 || !STRINGP (vec[7])
482 || !STRINGP (vec[8]))
483 error ("Invalid info-vector argument for defining charset %s",
484 XSYMBOL (charset_symbol)->name->data);
485
486 if (NILP (charset_id))
487 {
488 charset_id = get_new_private_charset_id (XINT (vec[0]), XINT (vec[2]));
489 if (XINT (charset_id) == 0)
490 error ("There's no room for a new private charset %s",
491 XSYMBOL (charset_symbol)->name->data);
492 }
493
494 update_charset_table (charset_id, vec[0], vec[1], vec[2], vec[3],
495 vec[4], vec[5], vec[6], vec[7], vec[8]);
6dc0722d 496 Fput (charset_symbol, Qcharset, CHARSET_TABLE_ENTRY (XINT (charset_id)));
4ed46869
KH
497 CHARSET_SYMBOL (XINT (charset_id)) = charset_symbol;
498 Vcharset_list = Fcons (charset_symbol, Vcharset_list);
499 return Qnil;
500}
501
502DEFUN ("declare-equiv-charset", Fdeclare_equiv_charset, Sdeclare_equiv_charset,
503 4, 4, 0,
504 "Declare a charset of DIMENSION, CHARS, FINAL-CHAR is the same as CHARSET.\n\
505CHARSET should be defined by `defined-charset' in advance.")
506 (dimension, chars, final_char, charset_symbol)
507 Lisp_Object dimension, chars, final_char, charset_symbol;
508{
509 int charset;
510
511 CHECK_NUMBER (dimension, 0);
512 CHECK_NUMBER (chars, 1);
513 CHECK_NUMBER (final_char, 2);
514 CHECK_SYMBOL (charset_symbol, 3);
515
516 if (XINT (dimension) != 1 && XINT (dimension) != 2)
517 error ("Invalid DIMENSION %d, it should be 1 or 2", XINT (dimension));
518 if (XINT (chars) != 94 && XINT (chars) != 96)
519 error ("Invalid CHARS %d, it should be 94 or 96", XINT (chars));
520 if (XINT (final_char) < '0' || XFASTINT (final_char) > '~')
521 error ("Invalid FINAL-CHAR %c, it should be `0'..`~'", XINT (chars));
522 if ((charset = get_charset_id (charset_symbol)) < 0)
523 error ("Invalid charset %s", XSYMBOL (charset_symbol)->name->data);
524
525 ISO_CHARSET_TABLE (dimension, chars, final_char) = charset;
526 return Qnil;
527}
528
529/* Return number of different charsets in STR of length LEN. In
530 addition, for each found charset N, CHARSETS[N] is set 1. The
23d2a7f1
KH
531 caller should allocate CHARSETS (MAX_CHARSET + 1 bytes) in advance.
532 It may lookup a unification table TABLE if supplied. */
4ed46869
KH
533
534int
23d2a7f1 535find_charset_in_str (str, len, charsets, table)
4ed46869
KH
536 unsigned char *str, *charsets;
537 int len;
23d2a7f1 538 Lisp_Object table;
4ed46869
KH
539{
540 int num = 0;
541
23d2a7f1
KH
542 if (! CHAR_TABLE_P (table))
543 table = Qnil;
544
4ed46869
KH
545 while (len > 0)
546 {
547 int bytes = BYTES_BY_CHAR_HEAD (*str);
23d2a7f1
KH
548 int charset;
549
550 if (NILP (table))
551 charset = CHARSET_AT (str);
552 else
553 {
554 int c, charset;
555 unsigned char c1, c2;
556
557 SPLIT_STRING(str, bytes, charset, c1, c2);
558 if ((c = unify_char (table, -1, charset, c1, c2)) >= 0)
559 charset = CHAR_CHARSET (c);
560 }
4ed46869
KH
561
562 if (!charsets[charset])
563 {
564 charsets[charset] = 1;
565 num += 1;
566 }
567 str += bytes;
568 len -= bytes;
569 }
570 return num;
571}
572
573DEFUN ("find-charset-region", Ffind_charset_region, Sfind_charset_region,
23d2a7f1 574 2, 3, 0,
4ed46869 575 "Return a list of charsets in the region between BEG and END.\n\
23d2a7f1
KH
576BEG and END are buffer positions.\n\
577Optional arg TABLE if non-nil is a unification table to look up.")
578 (beg, end, table)
579 Lisp_Object beg, end, table;
4ed46869 580{
513ee442 581 char charsets[MAX_CHARSET + 1];
4ed46869
KH
582 int from, to, stop, i;
583 Lisp_Object val;
584
585 validate_region (&beg, &end);
586 from = XFASTINT (beg);
587 stop = to = XFASTINT (end);
588 if (from < GPT && GPT < to)
589 stop = GPT;
513ee442 590 bzero (charsets, MAX_CHARSET + 1);
4ed46869
KH
591 while (1)
592 {
23d2a7f1 593 find_charset_in_str (POS_ADDR (from), stop - from, charsets, table);
4ed46869
KH
594 if (stop < to)
595 from = stop, stop = to;
596 else
597 break;
598 }
599 val = Qnil;
513ee442 600 for (i = MAX_CHARSET; i >= 0; i--)
4ed46869
KH
601 if (charsets[i])
602 val = Fcons (CHARSET_SYMBOL (i), val);
603 return val;
604}
605
606DEFUN ("find-charset-string", Ffind_charset_string, Sfind_charset_string,
23d2a7f1
KH
607 1, 2, 0,
608 "Return a list of charsets in STR.\n\
609Optional arg TABLE if non-nil is a unification table to look up.")
610 (str, table)
611 Lisp_Object str, table;
4ed46869 612{
513ee442 613 char charsets[MAX_CHARSET + 1];
4ed46869
KH
614 int i;
615 Lisp_Object val;
616
617 CHECK_STRING (str, 0);
513ee442 618 bzero (charsets, MAX_CHARSET + 1);
23d2a7f1
KH
619 find_charset_in_str (XSTRING (str)->data, XSTRING (str)->size,
620 charsets, table);
4ed46869 621 val = Qnil;
513ee442 622 for (i = MAX_CHARSET; i >= 0; i--)
4ed46869
KH
623 if (charsets[i])
624 val = Fcons (CHARSET_SYMBOL (i), val);
625 return val;
626}
627\f
628DEFUN ("make-char-internal", Fmake_char_internal, Smake_char_internal, 1, 3, 0,
513ee442 629 "")
4ed46869
KH
630 (charset, code1, code2)
631 Lisp_Object charset, code1, code2;
632{
633 CHECK_NUMBER (charset, 0);
634
635 if (NILP (code1))
636 XSETFASTINT (code1, 0);
637 else
638 CHECK_NUMBER (code1, 1);
639 if (NILP (code2))
640 XSETFASTINT (code2, 0);
641 else
642 CHECK_NUMBER (code2, 2);
643
644 if (!CHARSET_DEFINED_P (XINT (charset)))
645 error ("Invalid charset: %d", XINT (charset));
646
647 return make_number (MAKE_CHAR (XINT (charset), XINT (code1), XINT (code2)));
648}
649
650DEFUN ("split-char", Fsplit_char, Ssplit_char, 1, 1, 0,
651 "Return list of charset and one or two position-codes of CHAR.")
652 (ch)
653 Lisp_Object ch;
654{
655 Lisp_Object val;
6dc0722d 656 int charset, c1, c2;
4ed46869
KH
657
658 CHECK_NUMBER (ch, 0);
659 SPLIT_CHAR (XFASTINT (ch), charset, c1, c2);
6dc0722d 660 return (c2 >= 0
4ed46869
KH
661 ? Fcons (CHARSET_SYMBOL (charset),
662 Fcons (make_number (c1), Fcons (make_number (c2), Qnil)))
663 : Fcons (CHARSET_SYMBOL (charset), Fcons (make_number (c1), Qnil)));
664}
665
666DEFUN ("char-charset", Fchar_charset, Schar_charset, 1, 1, 0,
667 "Return charset of CHAR.")
668 (ch)
669 Lisp_Object ch;
670{
671 CHECK_NUMBER (ch, 0);
672
673 return CHARSET_SYMBOL (CHAR_CHARSET (XINT (ch)));
674}
675
676DEFUN ("iso-charset", Fiso_charset, Siso_charset, 3, 3, 0,
677 "Return charset of ISO's specification DIMENSION, CHARS, and FINAL-CHAR.")
678 (dimension, chars, final_char)
679 Lisp_Object dimension, chars, final_char;
680{
681 int charset;
682
683 CHECK_NUMBER (dimension, 0);
684 CHECK_NUMBER (chars, 1);
685 CHECK_NUMBER (final_char, 2);
686
687 if ((charset = ISO_CHARSET_TABLE (dimension, chars, final_char)) < 0)
688 return Qnil;
689 return CHARSET_SYMBOL (charset);
690}
691
692DEFUN ("char-bytes", Fchar_bytes, Schar_bytes, 1, 1, 0,
693 "Return byte length of multi-byte form of CHAR.")
694 (ch)
695 Lisp_Object ch;
696{
697 Lisp_Object val;
698 int bytes;
699
700 CHECK_NUMBER (ch, 0);
701 if (COMPOSITE_CHAR_P (XFASTINT (ch)))
702 {
703 unsigned int id = COMPOSITE_CHAR_ID (XFASTINT (ch));
704
705 bytes = (id < n_cmpchars ? cmpchar_table[id]->len : 1);
706 }
707 else
708 {
709 int charset = CHAR_CHARSET (XFASTINT (ch));
710
711 bytes = CHARSET_DEFINED_P (charset) ? CHARSET_BYTES (charset) : 1;
712 }
713
714 XSETFASTINT (val, bytes);
715 return val;
716}
717
718/* Return the width of character of which multi-byte form starts with
719 C. The width is measured by how many columns occupied on the
720 screen when displayed in the current buffer. */
721
722#define ONE_BYTE_CHAR_WIDTH(c) \
723 (c < 0x20 \
724 ? (c == '\t' \
53316e55 725 ? XFASTINT (current_buffer->tab_width) \
4ed46869
KH
726 : (c == '\n' ? 0 : (NILP (current_buffer->ctl_arrow) ? 4 : 2))) \
727 : (c < 0x7f \
728 ? 1 \
729 : (c == 0x7F \
730 ? (NILP (current_buffer->ctl_arrow) ? 4 : 2) \
731 : ((! NILP (current_buffer->enable_multibyte_characters) \
732 && BASE_LEADING_CODE_P (c)) \
733 ? WIDTH_BY_CHAR_HEAD (c) \
734 : 4)))) \
735
736
737DEFUN ("char-width", Fchar_width, Schar_width, 1, 1, 0,
738 "Return width of CHAR when displayed in the current buffer.\n\
739The width is measured by how many columns it occupies on the screen.")
740 (ch)
741 Lisp_Object ch;
742{
859f2b3c 743 Lisp_Object val, disp;
4ed46869
KH
744 int c;
745
746 CHECK_NUMBER (ch, 0);
747
859f2b3c
RS
748 c = XINT (ch);
749
750 /* Get the way the display table would display it. */
751 disp = DISP_CHAR_VECTOR (buffer_display_table (current_buffer), (c));
752
753 if (VECTORP (disp))
754 XSETINT (val, XVECTOR (disp)->size);
755 else if (SINGLE_BYTE_CHAR_P (c))
756 XSETINT (val, ONE_BYTE_CHAR_WIDTH (c));
4ed46869
KH
757 else if (COMPOSITE_CHAR_P (c))
758 {
759 int id = COMPOSITE_CHAR_ID (XFASTINT (ch));
760 XSETFASTINT (val, (id < n_cmpchars ? cmpchar_table[id]->width : 0));
761 }
762 else
763 {
764 int charset = CHAR_CHARSET (c);
765
766 XSETFASTINT (val, CHARSET_WIDTH (charset));
767 }
768 return val;
769}
770
771/* Return width of string STR of length LEN when displayed in the
772 current buffer. The width is measured by how many columns it
773 occupies on the screen. */
859f2b3c 774
4ed46869
KH
775int
776strwidth (str, len)
777 unsigned char *str;
778 int len;
779{
780 unsigned char *endp = str + len;
781 int width = 0;
859f2b3c 782 struct Lisp_Char_Table *dp = buffer_display_table (current_buffer);
4ed46869 783
859f2b3c
RS
784 while (str < endp)
785 {
786 if (*str == LEADING_CODE_COMPOSITION)
787 {
788 int id = str_cmpchar_id (str, endp - str);
789
790 if (id < 0)
791 {
792 width += 4;
793 str++;
794 }
795 else
796 {
797 width += cmpchar_table[id]->width;
798 str += cmpchar_table[id]->len;
799 }
800 }
801 else
802 {
803 Lisp_Object disp;
804 int thiswidth;
805 int c = STRING_CHAR (str, endp - str);
806
807 /* Get the way the display table would display it. */
808 disp = DISP_CHAR_VECTOR (dp, c);
809
810 if (VECTORP (disp))
811 thiswidth = XVECTOR (disp)->size;
812 else
813 thiswidth = ONE_BYTE_CHAR_WIDTH (*str);
814
815 width += thiswidth;
816 str += BYTES_BY_CHAR_HEAD (*str);
817 }
818 }
4ed46869
KH
819 return width;
820}
821
822DEFUN ("string-width", Fstring_width, Sstring_width, 1, 1, 0,
823 "Return width of STRING when displayed in the current buffer.\n\
824Width is measured by how many columns it occupies on the screen.\n\
825When calculating width of a multi-byte character in STRING,\n\
826 only the base leading-code is considered and the validity of\n\
827 the following bytes are not checked.")
828 (str)
829 Lisp_Object str;
830{
831 Lisp_Object val;
832
833 CHECK_STRING (str, 0);
834 XSETFASTINT (val, strwidth (XSTRING (str)->data, XSTRING (str)->size));
835 return val;
836}
837
838DEFUN ("char-direction", Fchar_direction, Schar_direction, 1, 1, 0,
839 "Return the direction of CHAR.\n\
840The returned value is 0 for left-to-right and 1 for right-to-left.")
841 (ch)
842 Lisp_Object ch;
843{
844 int charset;
845
846 CHECK_NUMBER (ch, 0);
847 charset = CHAR_CHARSET (XFASTINT (ch));
848 if (!CHARSET_DEFINED_P (charset))
849 error ("Invalid character: %d", XINT (ch));
850 return CHARSET_TABLE_INFO (charset, CHARSET_DIRECTION_IDX);
851}
852
853DEFUN ("chars-in-string", Fchars_in_string, Schars_in_string, 1, 1, 0,
854 "Return number of characters in STRING.")
855 (str)
856 Lisp_Object str;
857{
858 Lisp_Object val;
859 unsigned char *p, *endp;
860 int chars;
861
862 CHECK_STRING (str, 0);
863
864 p = XSTRING (str)->data; endp = p + XSTRING (str)->size;
865 chars = 0;
866 while (p < endp)
867 {
868 if (*p == LEADING_CODE_COMPOSITION)
869 {
870 p++;
871 while (p < endp && ! CHAR_HEAD_P (p)) p++;
872 }
873 else
874 p += BYTES_BY_CHAR_HEAD (*p);
875 chars++;
876 }
877
878 XSETFASTINT (val, chars);
879 return val;
880}
881
882DEFUN ("char-boundary-p", Fchar_boundary_p, Schar_boundary_p, 1, 1, 0,
883 "Return non-nil value if POS is at character boundary of multibyte form.\n\
884The return value is:\n\
885 0 if POS is at an ASCII character or at the end of range,\n\
886 1 if POS is at a head of 2-byte length multi-byte form,\n\
887 2 if POS is at a head of 3-byte length multi-byte form,\n\
888 3 if POS is at a head of 4-byte length multi-byte form,\n\
889 4 if POS is at a head of multi-byte form of a composite character.\n\
890If POS is out of range or not at character boundary, return NIL.")
891 (pos)
892 Lisp_Object pos;
893{
894 Lisp_Object val;
895 int n;
896
897 CHECK_NUMBER_COERCE_MARKER (pos, 0);
898
899 n = XINT (pos);
900 if (n < BEGV || n > ZV)
901 return Qnil;
902
903 if (n == ZV || NILP (current_buffer->enable_multibyte_characters))
904 XSETFASTINT (val, 0);
905 else
906 {
907 unsigned char *p = POS_ADDR (n);
908
909 if (SINGLE_BYTE_CHAR_P (*p))
910 XSETFASTINT (val, 0);
911 else if (*p == LEADING_CODE_COMPOSITION)
912 XSETFASTINT (val, 4);
913 else if (BYTES_BY_CHAR_HEAD (*p) > 1)
914 XSETFASTINT (val, BYTES_BY_CHAR_HEAD (*p) - 1);
915 else
916 val = Qnil;
917 }
918 return val;
919}
920
921DEFUN ("concat-chars", Fconcat_chars, Sconcat_chars, 1, MANY, 0,
922 "Concatenate all the argument characters and make the result a string.")
53316e55
KH
923 (n, args)
924 int n;
4ed46869
KH
925 Lisp_Object *args;
926{
53316e55 927 int i;
4ed46869
KH
928 unsigned char *buf
929 = (unsigned char *) malloc (MAX_LENGTH_OF_MULTI_BYTE_FORM * n);
930 unsigned char *p = buf;
931 Lisp_Object val;
932
933 for (i = 0; i < n; i++)
934 {
935 int c, len;
936 unsigned char *str;
937
938 if (!INTEGERP (args[i]))
939 {
940 free (buf);
941 CHECK_NUMBER (args[i], 0);
942 }
943 c = XINT (args[i]);
944 len = CHAR_STRING (c, p, str);
945 if (p != str)
946 /* C is a composite character. */
947 bcopy (str, p, len);
948 p += len;
949 }
950
951 val = make_string (buf, p - buf);
952 free (buf);
953 return val;
954}
955
956#endif /* emacs */
957\f
958/*** Composite characters staffs ***/
959
960/* Each composite character is identified by CMPCHAR-ID which is
961 assigned when Emacs needs the character code of the composite
962 character (e.g. when displaying it on the screen). See the
963 document "GENERAL NOTE on COMPOSITE CHARACTER" in `charset.h' how a
964 composite character is represented in Emacs. */
965
966/* If `static' is defined, it means that it is defined to null string. */
967#ifndef static
968/* The following function is copied from lread.c. */
969static int
970hash_string (ptr, len)
971 unsigned char *ptr;
972 int len;
973{
974 register unsigned char *p = ptr;
975 register unsigned char *end = p + len;
976 register unsigned char c;
977 register int hash = 0;
978
979 while (p != end)
980 {
981 c = *p++;
982 if (c >= 0140) c -= 40;
983 hash = ((hash<<3) + (hash>>28) + c);
984 }
985 return hash & 07777777777;
986}
987#endif
988
4ed46869
KH
989#define CMPCHAR_HASH_TABLE_SIZE 0xFFF
990
991static int *cmpchar_hash_table[CMPCHAR_HASH_TABLE_SIZE];
992
993/* Each element of `cmpchar_hash_table' is a pointer to an array of
994 integer, where the 1st element is the size of the array, the 2nd
995 element is how many elements are actually used in the array, and
996 the remaining elements are CMPCHAR-IDs of composite characters of
997 the same hash value. */
998#define CMPCHAR_HASH_SIZE(table) table[0]
999#define CMPCHAR_HASH_USED(table) table[1]
1000#define CMPCHAR_HASH_CMPCHAR_ID(table, i) table[i]
1001
1002/* Return CMPCHAR-ID of the composite character in STR of the length
1003 LEN. If the composite character has not yet been registered,
1004 register it in `cmpchar_table' and assign new CMPCHAR-ID. This
1005 is the sole function for assigning CMPCHAR-ID. */
1006int
1007str_cmpchar_id (str, len)
1008 unsigned char *str;
1009 int len;
1010{
1011 int hash_idx, *hashp;
1012 unsigned char *buf;
1013 int embedded_rule; /* 1 if composition rule is embedded. */
1014 int chars; /* number of components. */
1015 int i;
1016 struct cmpchar_info *cmpcharp;
1017
1018 if (len < 5)
1019 /* Any composite char have at least 3-byte length. */
1020 return -1;
1021
1022 /* The second byte 0xFF means compostion rule is embedded. */
1023 embedded_rule = (str[1] == 0xFF);
1024
1025 /* At first, get the actual length of the composite character. */
1026 {
1027 unsigned char *p, *endp = str + 1, *lastp = str + len;
1028 int bytes;
1029
1030 while (endp < lastp && ! CHAR_HEAD_P (endp)) endp++;
1031 chars = 0;
1032 p = str + 1 + embedded_rule;
1033 while (p < endp)
1034 {
1035 /* No need of checking if *P is 0xA0 because
1036 BYTES_BY_CHAR_HEAD (0x80) surely returns 2. */
1037 p += (bytes = BYTES_BY_CHAR_HEAD (*p - 0x20) + embedded_rule);
1038 chars++;
1039 }
1040 len = (p -= embedded_rule) - str;
1041 if (p > endp)
1042 len -= - bytes, chars--;
1043
1044 if (chars < 2 || chars > MAX_COMPONENT_COUNT)
1045 /* Invalid number of components. */
1046 return -1;
1047 }
1048 hash_idx = hash_string (str, len) % CMPCHAR_HASH_TABLE_SIZE;
1049 hashp = cmpchar_hash_table[hash_idx];
1050
1051 /* Then, look into the hash table. */
1052 if (hashp != NULL)
1053 /* Find the correct one among composite characters of the same
1054 hash value. */
1055 for (i = 2; i < CMPCHAR_HASH_USED (hashp); i++)
1056 {
1057 cmpcharp = cmpchar_table[CMPCHAR_HASH_CMPCHAR_ID (hashp, i)];
1058 if (len == cmpcharp->len
1059 && ! bcmp (str, cmpcharp->data, len))
1060 return CMPCHAR_HASH_CMPCHAR_ID (hashp, i);
1061 }
1062
1063 /* We have to register the composite character in cmpchar_table. */
513ee442
KH
1064 if (n_cmpchars > (CHAR_FIELD2_MASK | CHAR_FIELD3_MASK))
1065 /* No, we have no more room for a new composite character. */
1066 return -1;
1067
4ed46869
KH
1068 /* Make the entry in hash table. */
1069 if (hashp == NULL)
1070 {
1071 /* Make a table for 8 composite characters initially. */
1072 hashp = (cmpchar_hash_table[hash_idx]
1073 = (int *) xmalloc (sizeof (int) * (2 + 8)));
1074 CMPCHAR_HASH_SIZE (hashp) = 10;
1075 CMPCHAR_HASH_USED (hashp) = 2;
1076 }
1077 else if (CMPCHAR_HASH_USED (hashp) >= CMPCHAR_HASH_SIZE (hashp))
1078 {
1079 CMPCHAR_HASH_SIZE (hashp) += 8;
1080 hashp = (cmpchar_hash_table[hash_idx]
1081 = (int *) xrealloc (hashp,
1082 sizeof (int) * CMPCHAR_HASH_SIZE (hashp)));
1083 }
1084 CMPCHAR_HASH_CMPCHAR_ID (hashp, CMPCHAR_HASH_USED (hashp)) = n_cmpchars;
1085 CMPCHAR_HASH_USED (hashp)++;
1086
1087 /* Set information of the composite character in cmpchar_table. */
1088 if (cmpchar_table_size == 0)
1089 {
1090 /* This is the first composite character to be registered. */
1091 cmpchar_table_size = 256;
1092 cmpchar_table
1093 = (struct cmpchar_info **) xmalloc (sizeof (cmpchar_table[0])
1094 * cmpchar_table_size);
1095 }
1096 else if (cmpchar_table_size <= n_cmpchars)
1097 {
1098 cmpchar_table_size += 256;
1099 cmpchar_table
1100 = (struct cmpchar_info **) xrealloc (cmpchar_table,
1101 sizeof (cmpchar_table[0])
1102 * cmpchar_table_size);
1103 }
1104
1105 cmpcharp = (struct cmpchar_info *) xmalloc (sizeof (struct cmpchar_info));
1106
1107 cmpcharp->len = len;
1108 cmpcharp->data = (unsigned char *) xmalloc (len + 1);
1109 bcopy (str, cmpcharp->data, len);
1110 cmpcharp->data[len] = 0;
1111 cmpcharp->glyph_len = chars;
1112 cmpcharp->glyph = (GLYPH *) xmalloc (sizeof (GLYPH) * chars);
1113 if (embedded_rule)
1114 {
1115 cmpcharp->cmp_rule = (unsigned char *) xmalloc (chars);
1116 cmpcharp->col_offset = (float *) xmalloc (sizeof (float) * chars);
1117 }
1118 else
1119 {
1120 cmpcharp->cmp_rule = NULL;
1121 cmpcharp->col_offset = NULL;
1122 }
1123
1124 /* Setup GLYPH data and composition rules (if any) so as not to make
1125 them every time on displaying. */
1126 {
1127 unsigned char *bufp;
1128 int width;
1129 float leftmost = 0.0, rightmost = 1.0;
1130
1131 if (embedded_rule)
1132 /* At first, col_offset[N] is set to relative to col_offset[0]. */
1133 cmpcharp->col_offset[0] = 0;
1134
1135 for (i = 0, bufp = cmpcharp->data + 1; i < chars; i++)
1136 {
1137 if (embedded_rule)
1138 cmpcharp->cmp_rule[i] = *bufp++;
1139
1140 if (*bufp == 0xA0) /* This is an ASCII character. */
1141 {
1142 cmpcharp->glyph[i] = FAST_MAKE_GLYPH ((*++bufp & 0x7F), 0);
1143 width = 1;
1144 bufp++;
1145 }
1146 else /* Multibyte character. */
1147 {
1148 /* Make `bufp' point normal multi-byte form temporally. */
1149 *bufp -= 0x20;
1150 cmpcharp->glyph[i]
1151 = FAST_MAKE_GLYPH (string_to_non_ascii_char (bufp, 4, 0), 0);
1152 width = WIDTH_BY_CHAR_HEAD (*bufp);
1153 *bufp += 0x20;
1154 bufp += BYTES_BY_CHAR_HEAD (*bufp - 0x20);
1155 }
1156
1157 if (embedded_rule && i > 0)
1158 {
1159 /* Reference points (global_ref and new_ref) are
1160 encoded as below:
1161
1162 0--1--2 -- ascent
1163 | |
1164 | |
1165 | 4 -+--- center
1166 -- 3 5 -- baseline
1167 | |
1168 6--7--8 -- descent
1169
1170 Now, we calculate the column offset of the new glyph
1171 from the left edge of the first glyph. This can avoid
1172 the same calculation everytime displaying this
1173 composite character. */
1174
1175 /* Reference points of global glyph and new glyph. */
1176 int global_ref = (cmpcharp->cmp_rule[i] - 0xA0) / 9;
1177 int new_ref = (cmpcharp->cmp_rule[i] - 0xA0) % 9;
1178 /* Column offset relative to the first glyph. */
1179 float left = (leftmost
1180 + (global_ref % 3) * (rightmost - leftmost) / 2.0
1181 - (new_ref % 3) * width / 2.0);
1182
1183 cmpcharp->col_offset[i] = left;
1184 if (left < leftmost)
1185 leftmost = left;
1186 if (left + width > rightmost)
1187 rightmost = left + width;
1188 }
1189 else
1190 {
1191 if (width > rightmost)
1192 rightmost = width;
1193 }
1194 }
1195 if (embedded_rule)
1196 {
1197 /* Now col_offset[N] are relative to the left edge of the
1198 first component. Make them relative to the left edge of
1199 overall glyph. */
1200 for (i = 0; i < chars; i++)
1201 cmpcharp->col_offset[i] -= leftmost;
1202 /* Make rightmost holds width of overall glyph. */
1203 rightmost -= leftmost;
1204 }
1205
1206 cmpcharp->width = rightmost;
1207 if (cmpcharp->width < rightmost)
1208 /* To get a ceiling integer value. */
1209 cmpcharp->width++;
1210 }
1211
1212 cmpchar_table[n_cmpchars] = cmpcharp;
1213
1214 return n_cmpchars++;
1215}
1216
1217/* Return the Nth element of the composite character C. */
1218int
1219cmpchar_component (c, n)
1220 unsigned int c, n;
1221{
1222 int id = COMPOSITE_CHAR_ID (c);
1223
1224 if (id >= n_cmpchars /* C is not a valid composite character. */
1225 || n >= cmpchar_table[id]->glyph_len) /* No such component. */
1226 return -1;
1227 /* No face data is stored in glyph code. */
1228 return ((int) (cmpchar_table[id]->glyph[n]));
1229}
1230
1231DEFUN ("cmpcharp", Fcmpcharp, Scmpcharp, 1, 1, 0,
1232 "T if CHAR is a composite character.")
1233 (ch)
1234 Lisp_Object ch;
1235{
1236 CHECK_NUMBER (ch, 0);
1237 return (COMPOSITE_CHAR_P (XINT (ch)) ? Qt : Qnil);
1238}
1239
1240DEFUN ("composite-char-component", Fcmpchar_component, Scmpchar_component,
1241 2, 2, 0,
1242 "Return the IDXth component character of composite character CHARACTER.")
1243 (character, idx)
1244 Lisp_Object character, idx;
1245{
1246 int c;
1247
1248 CHECK_NUMBER (character, 0);
1249 CHECK_NUMBER (idx, 1);
1250
1251 if ((c = cmpchar_component (XINT (character), XINT (idx))) < 0)
1252 args_out_of_range (character, idx);
1253
1254 return make_number (c);
1255}
1256
1257DEFUN ("composite-char-composition-rule", Fcmpchar_cmp_rule, Scmpchar_cmp_rule,
1258 2, 2, 0,
55001746
KH
1259 "Return the Nth composition rule embedded in composite character CHARACTER.\n\
1260The returned rule is for composing the Nth component\n\
1261on the (N-1)th component. If N is 0, the returned value is always 255.")
1262 (character, n)
1263 Lisp_Object character, n;
4ed46869
KH
1264{
1265 int id, i;
1266
1267 CHECK_NUMBER (character, 0);
55001746 1268 CHECK_NUMBER (n, 1);
4ed46869
KH
1269
1270 id = COMPOSITE_CHAR_ID (XINT (character));
1271 if (id < 0 || id >= n_cmpchars)
1272 error ("Invalid composite character: %d", XINT (character));
55001746 1273 i = XINT (n);
4ed46869 1274 if (i > cmpchar_table[id]->glyph_len)
55001746 1275 args_out_of_range (character, n);
4ed46869
KH
1276
1277 return make_number (cmpchar_table[id]->cmp_rule[i]);
1278}
1279
1280DEFUN ("composite-char-composition-rule-p", Fcmpchar_cmp_rule_p,
1281 Scmpchar_cmp_rule_p, 1, 1, 0,
1282 "Return non-nil if composite character CHARACTER contains a embedded rule.")
1283 (character)
1284 Lisp_Object character;
1285{
1286 int id;
1287
1288 CHECK_NUMBER (character, 0);
1289 id = COMPOSITE_CHAR_ID (XINT (character));
1290 if (id < 0 || id >= n_cmpchars)
1291 error ("Invalid composite character: %d", XINT (character));
1292
1293 return (cmpchar_table[id]->cmp_rule ? Qt : Qnil);
1294}
1295
1296DEFUN ("composite-char-component-count", Fcmpchar_cmp_count,
1297 Scmpchar_cmp_count, 1, 1, 0,
1298 "Return number of compoents of composite character CHARACTER.")
1299 (character)
1300 Lisp_Object character;
1301{
1302 int id;
1303
1304 CHECK_NUMBER (character, 0);
1305 id = COMPOSITE_CHAR_ID (XINT (character));
1306 if (id < 0 || id >= n_cmpchars)
1307 error ("Invalid composite character: %d", XINT (character));
1308
1309 return (make_number (cmpchar_table[id]->glyph_len));
1310}
1311
1312DEFUN ("compose-string", Fcompose_string, Scompose_string,
1313 1, 1, 0,
1314 "Return one char string composed from all characters in STRING.")
1315 (str)
1316 Lisp_Object str;
1317{
1318 unsigned char buf[MAX_LENGTH_OF_MULTI_BYTE_FORM], *p, *pend, *ptemp;
1319 int len, i;
1320
1321 CHECK_STRING (str, 0);
1322
1323 buf[0] = LEADING_CODE_COMPOSITION;
1324 p = XSTRING (str)->data;
1325 pend = p + XSTRING (str)->size;
1326 i = 1;
1327 while (p < pend)
1328 {
1329 if (*p < 0x20 || *p == 127) /* control code */
1330 error ("Invalid component character: %d", *p);
1331 else if (*p < 0x80) /* ASCII */
1332 {
1333 if (i + 2 >= MAX_LENGTH_OF_MULTI_BYTE_FORM)
1334 error ("Too long string to be composed: %s", XSTRING (str)->data);
1335 /* Prepend an ASCII charset indicator 0xA0, set MSB of the
1336 code itself. */
1337 buf[i++] = 0xA0;
1338 buf[i++] = *p++ + 0x80;
1339 }
1340 else if (*p == LEADING_CODE_COMPOSITION) /* composite char */
1341 {
1342 /* Already composed. Eliminate the heading
1343 LEADING_CODE_COMPOSITION, keep the remaining bytes
1344 unchanged. */
1345 p++;
1346 ptemp = p;
1347 while (! CHAR_HEAD_P (p)) p++;
1348 if (i + (p - ptemp) >= MAX_LENGTH_OF_MULTI_BYTE_FORM)
1349 error ("Too long string to be composed: %s", XSTRING (str)->data);
1350 bcopy (ptemp, buf + i, p - ptemp);
1351 i += p - ptemp;
1352 }
1353 else /* multibyte char */
1354 {
1355 /* Add 0x20 to the base leading-code, keep the remaining
1356 bytes unchanged. */
1357 len = BYTES_BY_CHAR_HEAD (*p);
1358 if (i + len >= MAX_LENGTH_OF_MULTI_BYTE_FORM)
1359 error ("Too long string to be composed: %s", XSTRING (str)->data);
1360 bcopy (p, buf + i, len);
1361 buf[i] += 0x20;
1362 p += len, i += len;
1363 }
1364 }
1365
1366 if (i < 5)
1367 /* STR contains only one character, which can't be composed. */
1368 error ("Too short string to be composed: %s", XSTRING (str)->data);
1369
1370 return make_string (buf, i);
1371}
1372
1373\f
1374charset_id_internal (charset_name)
1375 char *charset_name;
1376{
1377 Lisp_Object val = Fget (intern (charset_name), Qcharset);
1378
1379 if (!VECTORP (val))
1380 error ("Charset %s is not defined", charset_name);
1381
1382 return (XINT (XVECTOR (val)->contents[0]));
1383}
1384
1385DEFUN ("setup-special-charsets", Fsetup_special_charsets,
1386 Ssetup_special_charsets, 0, 0, 0, "Internal use only.")
1387 ()
1388{
1389 charset_latin_iso8859_1 = charset_id_internal ("latin-iso8859-1");
1390 charset_jisx0208_1978 = charset_id_internal ("japanese-jisx0208-1978");
1391 charset_jisx0208 = charset_id_internal ("japanese-jisx0208");
1392 charset_katakana_jisx0201 = charset_id_internal ("katakana-jisx0201");
1393 charset_latin_jisx0201 = charset_id_internal ("latin-jisx0201");
1394 charset_big5_1 = charset_id_internal ("chinese-big5-1");
1395 charset_big5_2 = charset_id_internal ("chinese-big5-2");
1396 return Qnil;
1397}
1398
1399init_charset_once ()
1400{
1401 int i, j, k;
1402
1403 staticpro (&Vcharset_table);
1404 staticpro (&Vcharset_symbol_table);
1405
1406 /* This has to be done here, before we call Fmake_char_table. */
1407 Qcharset_table = intern ("charset-table");
1408 staticpro (&Qcharset_table);
1409
1410 /* Intern this now in case it isn't already done.
1411 Setting this variable twice is harmless.
1412 But don't staticpro it here--that is done in alloc.c. */
1413 Qchar_table_extra_slots = intern ("char-table-extra-slots");
1414
1415 /* Now we are ready to set up this property, so we can
1416 create the charset table. */
1417 Fput (Qcharset_table, Qchar_table_extra_slots, make_number (0));
1418 Vcharset_table = Fmake_char_table (Qcharset_table, Qnil);
1419
513ee442 1420 Vcharset_symbol_table = Fmake_vector (make_number (MAX_CHARSET + 1), Qnil);
4ed46869
KH
1421
1422 /* Setup tables. */
1423 for (i = 0; i < 2; i++)
1424 for (j = 0; j < 2; j++)
1425 for (k = 0; k < 128; k++)
1426 iso_charset_table [i][j][k] = -1;
1427
1428 bzero (cmpchar_hash_table, sizeof cmpchar_hash_table);
1429 cmpchar_table_size = n_cmpchars = 0;
1430
1431 for (i = 0; i < 256; i++)
1432 BYTES_BY_CHAR_HEAD (i) = 1;
1433 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_11) = 3;
1434 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_12) = 3;
1435 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_21) = 4;
1436 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_22) = 4;
1437 /* The following doesn't reflect the actual bytes, but just to tell
1438 that it is a start of a multibyte character. */
1439 BYTES_BY_CHAR_HEAD (LEADING_CODE_COMPOSITION) = 2;
1440
1441 for (i = 0; i < 128; i++)
1442 WIDTH_BY_CHAR_HEAD (i) = 1;
1443 for (; i < 256; i++)
1444 WIDTH_BY_CHAR_HEAD (i) = 4;
1445 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_11) = 1;
1446 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_12) = 2;
1447 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_21) = 1;
1448 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_22) = 2;
1449}
1450
1451#ifdef emacs
1452
1453syms_of_charset ()
1454{
1455 Qascii = intern ("ascii");
1456 staticpro (&Qascii);
1457
1458 Qcharset = intern ("charset");
1459 staticpro (&Qcharset);
1460
1461 /* Define ASCII charset now. */
1462 update_charset_table (make_number (CHARSET_ASCII),
1463 make_number (1), make_number (94),
1464 make_number (1),
1465 make_number (0),
1466 make_number ('B'),
1467 make_number (0),
1468 build_string ("ASCII"),
1469 build_string ("ASCII"),
1470 build_string ("ASCII (ISO646 IRV)"));
1471 CHARSET_SYMBOL (CHARSET_ASCII) = Qascii;
1472 Fput (Qascii, Qcharset, CHARSET_TABLE_ENTRY (CHARSET_ASCII));
1473
1474 Qcomposition = intern ("composition");
1475 staticpro (&Qcomposition);
1476 CHARSET_SYMBOL (CHARSET_COMPOSITION) = Qcomposition;
1477
1478 defsubr (&Sdefine_charset);
1479 defsubr (&Sdeclare_equiv_charset);
1480 defsubr (&Sfind_charset_region);
1481 defsubr (&Sfind_charset_string);
1482 defsubr (&Smake_char_internal);
1483 defsubr (&Ssplit_char);
1484 defsubr (&Schar_charset);
1485 defsubr (&Siso_charset);
1486 defsubr (&Schar_bytes);
1487 defsubr (&Schar_width);
1488 defsubr (&Sstring_width);
1489 defsubr (&Schar_direction);
1490 defsubr (&Schars_in_string);
1491 defsubr (&Schar_boundary_p);
1492 defsubr (&Sconcat_chars);
1493 defsubr (&Scmpcharp);
1494 defsubr (&Scmpchar_component);
1495 defsubr (&Scmpchar_cmp_rule);
1496 defsubr (&Scmpchar_cmp_rule_p);
1497 defsubr (&Scmpchar_cmp_count);
1498 defsubr (&Scompose_string);
1499 defsubr (&Ssetup_special_charsets);
1500
1501 DEFVAR_LISP ("charset-list", &Vcharset_list,
1502 "List of charsets ever defined.");
1503 Vcharset_list = Fcons (Qascii, Qnil);
1504
1505 DEFVAR_INT ("leading-code-composition", &leading_code_composition,
1506 "Leading-code of composite characters.");
1507 leading_code_composition = LEADING_CODE_COMPOSITION;
1508
1509 DEFVAR_INT ("leading-code-private-11", &leading_code_private_11,
1510 "Leading-code of private TYPE9N charset of column-width 1.");
1511 leading_code_private_11 = LEADING_CODE_PRIVATE_11;
1512
1513 DEFVAR_INT ("leading-code-private-12", &leading_code_private_12,
1514 "Leading-code of private TYPE9N charset of column-width 2.");
1515 leading_code_private_12 = LEADING_CODE_PRIVATE_12;
1516
1517 DEFVAR_INT ("leading-code-private-21", &leading_code_private_21,
1518 "Leading-code of private TYPE9Nx9N charset of column-width 1.");
1519 leading_code_private_21 = LEADING_CODE_PRIVATE_21;
1520
1521 DEFVAR_INT ("leading-code-private-22", &leading_code_private_22,
1522 "Leading-code of private TYPE9Nx9N charset of column-width 2.");
1523 leading_code_private_22 = LEADING_CODE_PRIVATE_22;
1524}
1525
1526#endif /* emacs */