1 /* Basic multilingual character support.
2 Copyright (C) 1995, 1997 Electrotechnical Laboratory, JAPAN.
3 Licensed to the Free Software Foundation.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
22 /* At first, see the document in `charset.h' to understand the code in
29 #include <sys/types.h>
43 Lisp_Object Qcharset
, Qascii
, Qcomposition
;
45 /* Declaration of special leading-codes. */
46 int leading_code_composition
; /* for composite characters */
47 int leading_code_private_11
; /* for private DIMENSION1 of 1-column */
48 int leading_code_private_12
; /* for private DIMENSION1 of 2-column */
49 int leading_code_private_21
; /* for private DIMENSION2 of 1-column */
50 int leading_code_private_22
; /* for private DIMENSION2 of 2-column */
52 /* Declaration of special charsets. */
53 int charset_ascii
; /* ASCII */
54 int charset_composition
; /* for a composite character */
55 int charset_latin_iso8859_1
; /* ISO8859-1 (Latin-1) */
56 int charset_jisx0208_1978
; /* JISX0208.1978 (Japanese Kanji old set) */
57 int charset_jisx0208
; /* JISX0208.1983 (Japanese Kanji) */
58 int charset_katakana_jisx0201
; /* JISX0201.Kana (Japanese Katakana) */
59 int charset_latin_jisx0201
; /* JISX0201.Roman (Japanese Roman) */
60 int charset_big5_1
; /* Big5 Level 1 (Chinese Traditional) */
61 int charset_big5_2
; /* Big5 Level 2 (Chinese Traditional) */
63 Lisp_Object Qcharset_table
;
65 /* A char-table containing information of each character set. */
66 Lisp_Object Vcharset_table
;
68 /* A vector of charset symbol indexed by charset-id. This is used
69 only for returning charset symbol from C functions. */
70 Lisp_Object Vcharset_symbol_table
;
72 /* A list of charset symbols ever defined. */
73 Lisp_Object Vcharset_list
;
75 /* Tables used by macros BYTES_BY_CHAR_HEAD and WIDTH_BY_CHAR_HEAD. */
76 int bytes_by_char_head
[256];
77 int width_by_char_head
[256];
79 /* Mapping table from ISO2022's charset (specified by DIMENSION,
80 CHARS, and FINAL-CHAR) to Emacs' charset. */
81 int iso_charset_table
[2][2][128];
83 /* Table of pointers to the structure `cmpchar_info' indexed by
85 struct cmpchar_info
**cmpchar_table
;
86 /* The current size of `cmpchar_table'. */
87 static int cmpchar_table_size
;
88 /* Number of the current composite characters. */
91 /* Variables used locally in the macro FETCH_MULTIBYTE_CHAR. */
92 unsigned char *_fetch_multibyte_char_p
;
93 int _fetch_multibyte_char_len
;
95 #define min(X, Y) ((X) < (Y) ? (X) : (Y))
96 #define max(X, Y) ((X) > (Y) ? (X) : (Y))
98 /* Set STR a pointer to the multi-byte form of the character C. If C
99 is not a composite character, the multi-byte form is set in WORKBUF
100 and STR points WORKBUF. The caller should allocate at least 4-byte
101 area at WORKBUF in advance. Returns the length of the multi-byte
102 form. If C is an invalid character to have a multi-byte form,
105 Use macro `CHAR_STRING (C, WORKBUF, STR)' instead of calling this
106 function directly if C can be an ASCII character. */
109 non_ascii_char_to_string (c
, workbuf
, str
)
111 unsigned char *workbuf
, **str
;
115 if (COMPOSITE_CHAR_P (c
))
117 int cmpchar_id
= COMPOSITE_CHAR_ID (c
);
119 if (cmpchar_id
< n_cmpchars
)
121 *str
= cmpchar_table
[cmpchar_id
]->data
;
122 return cmpchar_table
[cmpchar_id
]->len
;
126 error ("Invalid character: %d", c
);
130 SPLIT_NON_ASCII_CHAR (c
, charset
, c1
, c2
);
132 || ! CHARSET_DEFINED_P (charset
)
133 || c1
>= 0 && c1
< 32
134 || c2
>= 0 && c2
< 32)
135 error ("Invalid character: %d", c
);
138 *workbuf
++ = CHARSET_LEADING_CODE_BASE (charset
);
139 if (*workbuf
= CHARSET_LEADING_CODE_EXT (charset
))
141 *workbuf
++ = c1
| 0x80;
143 *workbuf
++ = c2
| 0x80;
145 return (workbuf
- *str
);
148 /* Return a non-ASCII character of which multi-byte form is at STR of
149 length LEN. If ACTUAL_LEN is not NULL, the actual length of the
150 character is set to the address ACTUAL_LEN.
152 Use macro `STRING_CHAR (STR, LEN)' instead of calling this function
153 directly if STR can hold an ASCII character. */
155 string_to_non_ascii_char (str
, len
, actual_len
)
157 int len
, *actual_len
;
160 unsigned char c1
, c2
;
163 if (SPLIT_STRING (str
, len
, charset
, c1
, c2
) == CHARSET_ASCII
)
170 c
= MAKE_NON_ASCII_CHAR (charset
, c1
, c2
);
173 *actual_len
= (charset
== CHARSET_COMPOSITION
174 ? cmpchar_table
[COMPOSITE_CHAR_ID (c
)]->len
175 : BYTES_BY_CHAR_HEAD (*str
));
179 /* Return the length of the multi-byte form at string STR of length LEN. */
181 multibyte_form_length (str
, len
)
186 unsigned char c1
, c2
;
189 if (SPLIT_STRING (str
, len
, charset
, c1
, c2
) == CHARSET_ASCII
)
192 return (charset
== CHARSET_COMPOSITION
193 ? cmpchar_table
[(c1
<< 7) | c2
]->len
194 : BYTES_BY_CHAR_HEAD (*str
));
197 /* Check if string STR of length LEN contains valid multi-byte form of
198 a character. If valid, charset and position codes of the character
199 is set at *CHARSET, *C1, and *C2, and return 0. If not valid,
200 return -1. This should be used only in the macro SPLIT_STRING
201 which checks range of STR in advance. */
203 split_non_ascii_string (str
, len
, charset
, c1
, c2
)
204 register unsigned char *str
, *c1
, *c2
;
205 register int len
, *charset
;
207 register unsigned int cs
= *str
++;
209 if (cs
== LEADING_CODE_COMPOSITION
)
211 int cmpchar_id
= str_cmpchar_id (str
- 1, len
);
215 *charset
= cs
, *c1
= cmpchar_id
>> 7, *c2
= cmpchar_id
& 0x7F;
217 else if ((cs
< LEADING_CODE_PRIVATE_11
|| (cs
= *str
++) >= 0xA0)
218 && CHARSET_DEFINED_P (cs
))
223 *c1
= (*str
++) & 0x7F;
224 if (CHARSET_DIMENSION (cs
) == 2)
228 *c2
= (*str
++) & 0x7F;
236 /* Return a character unified with C (or a character made of CHARSET,
237 C1, and C2) in unification table TABLE. If no unification is found
238 in TABLE, return C. */
239 unify_char (table
, c
, charset
, c1
, c2
)
241 int c
, charset
, c1
, c2
;
244 int alt_charset
, alt_c1
, alt_c2
, dimension
;
246 if (c
< 0) c
= MAKE_CHAR (charset
, c1
, c2
);
247 if (!CHAR_TABLE_P (table
)
248 || (ch
= Faref (table
, make_number (c
)), !INTEGERP (ch
))
252 SPLIT_CHAR (XFASTINT (ch
), alt_charset
, alt_c1
, alt_c2
);
253 dimension
= CHARSET_DIMENSION (alt_charset
);
254 if (dimension
== 1 && alt_c1
> 0 || dimension
== 2 && alt_c2
> 0)
255 /* CH is not a generic character, just return it. */
256 return XFASTINT (ch
);
258 /* Since CH is a generic character, we must return a specific
259 charater which has the same position codes as C from CH. */
261 SPLIT_CHAR (c
, charset
, c1
, c2
);
262 if (dimension
!= CHARSET_DIMENSION (charset
))
263 /* We can't make such a character because of dimension mismatch. */
265 if (!alt_c1
) alt_c1
= c1
;
266 if (!alt_c2
) alt_c2
= c2
;
267 return MAKE_CHAR (alt_charset
, c1
, c2
);
270 /* Update the table Vcharset_table with the given arguments (see the
271 document of `define-charset' for the meaning of each argument).
272 Several other table contents are also updated. The caller should
273 check the validity of CHARSET-ID and the remaining arguments in
277 update_charset_table (charset_id
, dimension
, chars
, width
, direction
,
278 iso_final_char
, iso_graphic_plane
,
279 short_name
, long_name
, description
)
280 Lisp_Object charset_id
, dimension
, chars
, width
, direction
;
281 Lisp_Object iso_final_char
, iso_graphic_plane
;
282 Lisp_Object short_name
, long_name
, description
;
284 int charset
= XINT (charset_id
);
286 unsigned char leading_code_base
, leading_code_ext
;
288 if (NILP (CHARSET_TABLE_ENTRY (charset
)))
289 CHARSET_TABLE_ENTRY (charset
)
290 = Fmake_vector (make_number (CHARSET_MAX_IDX
), Qnil
);
292 /* Get byte length of multibyte form, base leading-code, and
293 extended leading-code of the charset. See the comment under the
294 title "GENERAL NOTE on CHARACTER SET (CHARSET)" in charset.h. */
295 bytes
= XINT (dimension
);
296 if (charset
< MIN_CHARSET_PRIVATE_DIMENSION1
)
298 /* Official charset, it doesn't have an extended leading-code. */
299 if (charset
!= CHARSET_ASCII
)
300 bytes
+= 1; /* For a base leading-code. */
301 leading_code_base
= charset
;
302 leading_code_ext
= 0;
306 /* Private charset. */
307 bytes
+= 2; /* For base and extended leading-codes. */
309 = (charset
< LEADING_CODE_EXT_12
310 ? LEADING_CODE_PRIVATE_11
311 : (charset
< LEADING_CODE_EXT_21
312 ? LEADING_CODE_PRIVATE_12
313 : (charset
< LEADING_CODE_EXT_22
314 ? LEADING_CODE_PRIVATE_21
315 : LEADING_CODE_PRIVATE_22
)));
316 leading_code_ext
= charset
;
319 CHARSET_TABLE_INFO (charset
, CHARSET_ID_IDX
) = charset_id
;
320 CHARSET_TABLE_INFO (charset
, CHARSET_BYTES_IDX
) = make_number (bytes
);
321 CHARSET_TABLE_INFO (charset
, CHARSET_DIMENSION_IDX
) = dimension
;
322 CHARSET_TABLE_INFO (charset
, CHARSET_CHARS_IDX
) = chars
;
323 CHARSET_TABLE_INFO (charset
, CHARSET_WIDTH_IDX
) = width
;
324 CHARSET_TABLE_INFO (charset
, CHARSET_DIRECTION_IDX
) = direction
;
325 CHARSET_TABLE_INFO (charset
, CHARSET_LEADING_CODE_BASE_IDX
)
326 = make_number (leading_code_base
);
327 CHARSET_TABLE_INFO (charset
, CHARSET_LEADING_CODE_EXT_IDX
)
328 = make_number (leading_code_ext
);
329 CHARSET_TABLE_INFO (charset
, CHARSET_ISO_FINAL_CHAR_IDX
) = iso_final_char
;
330 CHARSET_TABLE_INFO (charset
, CHARSET_ISO_GRAPHIC_PLANE_IDX
)
332 CHARSET_TABLE_INFO (charset
, CHARSET_SHORT_NAME_IDX
) = short_name
;
333 CHARSET_TABLE_INFO (charset
, CHARSET_LONG_NAME_IDX
) = long_name
;
334 CHARSET_TABLE_INFO (charset
, CHARSET_DESCRIPTION_IDX
) = description
;
335 CHARSET_TABLE_INFO (charset
, CHARSET_PLIST_IDX
) = Qnil
;
338 /* If we have already defined a charset which has the same
339 DIMENSION, CHARS and ISO-FINAL-CHAR but the different
340 DIRECTION, we must update the entry REVERSE-CHARSET of both
341 charsets. If there's no such charset, the value of the entry
345 for (i
= 0; i
<= MAX_CHARSET
; i
++)
346 if (!NILP (CHARSET_TABLE_ENTRY (i
)))
348 if (CHARSET_DIMENSION (i
) == XINT (dimension
)
349 && CHARSET_CHARS (i
) == XINT (chars
)
350 && CHARSET_ISO_FINAL_CHAR (i
) == XINT (iso_final_char
)
351 && CHARSET_DIRECTION (i
) != XINT (direction
))
353 CHARSET_TABLE_INFO (charset
, CHARSET_REVERSE_CHARSET_IDX
)
355 CHARSET_TABLE_INFO (i
, CHARSET_REVERSE_CHARSET_IDX
) = charset_id
;
360 /* No such a charset. */
361 CHARSET_TABLE_INFO (charset
, CHARSET_REVERSE_CHARSET_IDX
)
365 if (charset
!= CHARSET_ASCII
366 && charset
< MIN_CHARSET_PRIVATE_DIMENSION1
)
368 /* Update tables bytes_by_char_head and width_by_char_head. */
369 bytes_by_char_head
[leading_code_base
] = bytes
;
370 width_by_char_head
[leading_code_base
] = XINT (width
);
372 /* Update table emacs_code_class. */
373 emacs_code_class
[charset
] = (bytes
== 2
374 ? EMACS_leading_code_2
376 ? EMACS_leading_code_3
377 : EMACS_leading_code_4
));
380 /* Update table iso_charset_table. */
381 if (ISO_CHARSET_TABLE (dimension
, chars
, iso_final_char
) < 0)
382 ISO_CHARSET_TABLE (dimension
, chars
, iso_final_char
) = charset
;
387 /* Return charset id of CHARSET_SYMBOL, or return -1 if CHARSET_SYMBOL
390 get_charset_id (charset_symbol
)
391 Lisp_Object charset_symbol
;
396 return ((SYMBOLP (charset_symbol
)
397 && (val
= Fget (charset_symbol
, Qcharset
), VECTORP (val
))
398 && (charset
= XINT (XVECTOR (val
)->contents
[CHARSET_ID_IDX
]),
399 CHARSET_VALID_P (charset
)))
403 /* Return an identification number for a new private charset of
404 DIMENSION and WIDTH. If there's no more room for the new charset,
407 get_new_private_charset_id (dimension
, width
)
408 int dimension
, width
;
410 int charset
, from
, to
;
415 from
= LEADING_CODE_EXT_11
, to
= LEADING_CODE_EXT_12
;
417 from
= LEADING_CODE_EXT_12
, to
= LEADING_CODE_EXT_21
;
422 from
= LEADING_CODE_EXT_21
, to
= LEADING_CODE_EXT_22
;
424 from
= LEADING_CODE_EXT_22
, to
= LEADING_CODE_EXT_MAX
- 1;
427 for (charset
= from
; charset
< to
; charset
++)
428 if (!CHARSET_DEFINED_P (charset
)) break;
430 return make_number (charset
< to
? charset
: 0);
433 DEFUN ("define-charset", Fdefine_charset
, Sdefine_charset
, 3, 3, 0,
434 "Define CHARSET-ID as the identification number of CHARSET with INFO-VECTOR.\n\
435 If CHARSET-ID is nil, it is decided automatically, which means CHARSET is\n\
436 treated as a private charset.\n\
437 INFO-VECTOR is a vector of the format:\n\
438 [DIMENSION CHARS WIDTH DIRECTION ISO-FINAL-CHAR ISO-GRAPHIC-PLANE\n\
439 SHORT-NAME LONG-NAME DESCRIPTION]\n\
440 The meanings of each elements is as follows:\n\
441 DIMENSION (integer) is the number of bytes to represent a character: 1 or 2.\n\
442 CHARS (integer) is the number of characters in a dimension: 94 or 96.\n\
443 WIDTH (integer) is the number of columns a character in the charset\n\
444 occupies on the screen: one of 0, 1, and 2.\n\
446 DIRECTION (integer) is the rendering direction of characters in the\n\
447 charset when rendering. If 0, render from right to left, else\n\
448 render from left to right.\n\
450 ISO-FINAL-CHAR (character) is the final character of the\n\
451 corresponding ISO 2022 charset.\n\
453 ISO-GRAPHIC-PLANE (integer) is the graphic plane to be invoked\n\
454 while encoding to variants of ISO 2022 coding system, one of the\n\
455 following: 0/graphic-plane-left(GL), 1/graphic-plane-right(GR).\n\
457 SHORT-NAME (string) is the short name to refer to the charset.\n\
459 LONG-NAME (string) is the long name to refer to the charset.\n\
461 DESCRIPTION (string) is the description string of the charset.")
462 (charset_id
, charset_symbol
, info_vector
)
463 Lisp_Object charset_id
, charset_symbol
, info_vector
;
467 if (!NILP (charset_id
))
468 CHECK_NUMBER (charset_id
, 0);
469 CHECK_SYMBOL (charset_symbol
, 1);
470 CHECK_VECTOR (info_vector
, 2);
472 if (! NILP (charset_id
))
474 if (! CHARSET_VALID_P (XINT (charset_id
)))
475 error ("Invalid CHARSET: %d", XINT (charset_id
));
476 else if (CHARSET_DEFINED_P (XINT (charset_id
)))
477 error ("Already defined charset: %d", XINT (charset_id
));
480 vec
= XVECTOR (info_vector
)->contents
;
481 if (XVECTOR (info_vector
)->size
!= 9
482 || !INTEGERP (vec
[0]) || !(XINT (vec
[0]) == 1 || XINT (vec
[0]) == 2)
483 || !INTEGERP (vec
[1]) || !(XINT (vec
[1]) == 94 || XINT (vec
[1]) == 96)
484 || !INTEGERP (vec
[2]) || !(XINT (vec
[2]) == 1 || XINT (vec
[2]) == 2)
485 || !INTEGERP (vec
[3]) || !(XINT (vec
[3]) == 0 || XINT (vec
[3]) == 1)
486 || !INTEGERP (vec
[4]) || !(XINT (vec
[4]) >= '0' && XINT (vec
[4]) <= '~')
487 || !INTEGERP (vec
[5]) || !(XINT (vec
[5]) == 0 || XINT (vec
[5]) == 1)
490 || !STRINGP (vec
[8]))
491 error ("Invalid info-vector argument for defining charset %s",
492 XSYMBOL (charset_symbol
)->name
->data
);
494 if (NILP (charset_id
))
496 charset_id
= get_new_private_charset_id (XINT (vec
[0]), XINT (vec
[2]));
497 if (XINT (charset_id
) == 0)
498 error ("There's no room for a new private charset %s",
499 XSYMBOL (charset_symbol
)->name
->data
);
502 update_charset_table (charset_id
, vec
[0], vec
[1], vec
[2], vec
[3],
503 vec
[4], vec
[5], vec
[6], vec
[7], vec
[8]);
504 Fput (charset_symbol
, Qcharset
, CHARSET_TABLE_ENTRY (XINT (charset_id
)));
505 CHARSET_SYMBOL (XINT (charset_id
)) = charset_symbol
;
506 Vcharset_list
= Fcons (charset_symbol
, Vcharset_list
);
510 DEFUN ("declare-equiv-charset", Fdeclare_equiv_charset
, Sdeclare_equiv_charset
,
512 "Declare a charset of DIMENSION, CHARS, FINAL-CHAR is the same as CHARSET.\n\
513 CHARSET should be defined by `defined-charset' in advance.")
514 (dimension
, chars
, final_char
, charset_symbol
)
515 Lisp_Object dimension
, chars
, final_char
, charset_symbol
;
519 CHECK_NUMBER (dimension
, 0);
520 CHECK_NUMBER (chars
, 1);
521 CHECK_NUMBER (final_char
, 2);
522 CHECK_SYMBOL (charset_symbol
, 3);
524 if (XINT (dimension
) != 1 && XINT (dimension
) != 2)
525 error ("Invalid DIMENSION %d, it should be 1 or 2", XINT (dimension
));
526 if (XINT (chars
) != 94 && XINT (chars
) != 96)
527 error ("Invalid CHARS %d, it should be 94 or 96", XINT (chars
));
528 if (XINT (final_char
) < '0' || XFASTINT (final_char
) > '~')
529 error ("Invalid FINAL-CHAR %c, it should be `0'..`~'", XINT (chars
));
530 if ((charset
= get_charset_id (charset_symbol
)) < 0)
531 error ("Invalid charset %s", XSYMBOL (charset_symbol
)->name
->data
);
533 ISO_CHARSET_TABLE (dimension
, chars
, final_char
) = charset
;
537 /* Return number of different charsets in STR of length LEN. In
538 addition, for each found charset N, CHARSETS[N] is set 1. The
539 caller should allocate CHARSETS (MAX_CHARSET + 1 elements) in advance.
540 It may lookup a unification table TABLE if supplied. */
543 find_charset_in_str (str
, len
, charsets
, table
)
550 if (! CHAR_TABLE_P (table
))
555 int bytes
= BYTES_BY_CHAR_HEAD (*str
);
559 charset
= CHARSET_AT (str
);
563 unsigned char c1
, c2
;
565 SPLIT_STRING(str
, bytes
, charset
, c1
, c2
);
566 if ((c
= unify_char (table
, -1, charset
, c1
, c2
)) >= 0)
567 charset
= CHAR_CHARSET (c
);
570 if (!charsets
[charset
])
572 charsets
[charset
] = 1;
581 DEFUN ("find-charset-region", Ffind_charset_region
, Sfind_charset_region
,
583 "Return a list of charsets in the region between BEG and END.\n\
584 BEG and END are buffer positions.\n\
585 Optional arg TABLE if non-nil is a unification table to look up.")
587 Lisp_Object beg
, end
, table
;
589 int charsets
[MAX_CHARSET
+ 1];
590 int from
, to
, stop
, i
;
593 validate_region (&beg
, &end
);
594 from
= XFASTINT (beg
);
595 stop
= to
= XFASTINT (end
);
596 if (from
< GPT
&& GPT
< to
)
598 bzero (charsets
, (MAX_CHARSET
+ 1) * sizeof (int));
601 find_charset_in_str (POS_ADDR (from
), stop
- from
, charsets
, table
);
603 from
= stop
, stop
= to
;
608 for (i
= MAX_CHARSET
; i
>= 0; i
--)
610 val
= Fcons (CHARSET_SYMBOL (i
), val
);
614 DEFUN ("find-charset-string", Ffind_charset_string
, Sfind_charset_string
,
616 "Return a list of charsets in STR.\n\
617 Optional arg TABLE if non-nil is a unification table to look up.")
619 Lisp_Object str
, table
;
621 int charsets
[MAX_CHARSET
+ 1];
625 CHECK_STRING (str
, 0);
626 bzero (charsets
, (MAX_CHARSET
+ 1) * sizeof (int));
627 find_charset_in_str (XSTRING (str
)->data
, XSTRING (str
)->size
,
630 for (i
= MAX_CHARSET
; i
>= 0; i
--)
632 val
= Fcons (CHARSET_SYMBOL (i
), val
);
636 DEFUN ("make-char-internal", Fmake_char_internal
, Smake_char_internal
, 1, 3, 0,
638 (charset
, code1
, code2
)
639 Lisp_Object charset
, code1
, code2
;
641 CHECK_NUMBER (charset
, 0);
644 XSETFASTINT (code1
, 0);
646 CHECK_NUMBER (code1
, 1);
648 XSETFASTINT (code2
, 0);
650 CHECK_NUMBER (code2
, 2);
652 if (!CHARSET_DEFINED_P (XINT (charset
)))
653 error ("Invalid charset: %d", XINT (charset
));
655 return make_number (MAKE_CHAR (XINT (charset
), XINT (code1
), XINT (code2
)));
658 DEFUN ("split-char", Fsplit_char
, Ssplit_char
, 1, 1, 0,
659 "Return list of charset and one or two position-codes of CHAR.")
666 CHECK_NUMBER (ch
, 0);
667 SPLIT_CHAR (XFASTINT (ch
), charset
, c1
, c2
);
669 ? Fcons (CHARSET_SYMBOL (charset
),
670 Fcons (make_number (c1
), Fcons (make_number (c2
), Qnil
)))
671 : Fcons (CHARSET_SYMBOL (charset
), Fcons (make_number (c1
), Qnil
)));
674 DEFUN ("char-charset", Fchar_charset
, Schar_charset
, 1, 1, 0,
675 "Return charset of CHAR.")
679 CHECK_NUMBER (ch
, 0);
681 return CHARSET_SYMBOL (CHAR_CHARSET (XINT (ch
)));
684 DEFUN ("iso-charset", Fiso_charset
, Siso_charset
, 3, 3, 0,
685 "Return charset of ISO's specification DIMENSION, CHARS, and FINAL-CHAR.")
686 (dimension
, chars
, final_char
)
687 Lisp_Object dimension
, chars
, final_char
;
691 CHECK_NUMBER (dimension
, 0);
692 CHECK_NUMBER (chars
, 1);
693 CHECK_NUMBER (final_char
, 2);
695 if ((charset
= ISO_CHARSET_TABLE (dimension
, chars
, final_char
)) < 0)
697 return CHARSET_SYMBOL (charset
);
700 DEFUN ("char-bytes", Fchar_bytes
, Schar_bytes
, 1, 1, 0,
701 "Return byte length of multi-byte form of CHAR.")
708 CHECK_NUMBER (ch
, 0);
709 if (COMPOSITE_CHAR_P (XFASTINT (ch
)))
711 unsigned int id
= COMPOSITE_CHAR_ID (XFASTINT (ch
));
713 bytes
= (id
< n_cmpchars
? cmpchar_table
[id
]->len
: 1);
717 int charset
= CHAR_CHARSET (XFASTINT (ch
));
719 bytes
= CHARSET_DEFINED_P (charset
) ? CHARSET_BYTES (charset
) : 1;
722 XSETFASTINT (val
, bytes
);
726 /* Return the width of character of which multi-byte form starts with
727 C. The width is measured by how many columns occupied on the
728 screen when displayed in the current buffer. */
730 #define ONE_BYTE_CHAR_WIDTH(c) \
733 ? XFASTINT (current_buffer->tab_width) \
734 : (c == '\n' ? 0 : (NILP (current_buffer->ctl_arrow) ? 4 : 2))) \
738 ? (NILP (current_buffer->ctl_arrow) ? 4 : 2) \
739 : ((! NILP (current_buffer->enable_multibyte_characters) \
740 && BASE_LEADING_CODE_P (c)) \
741 ? WIDTH_BY_CHAR_HEAD (c) \
745 DEFUN ("char-width", Fchar_width, Schar_width, 1, 1, 0,
746 "Return width of CHAR when displayed in the current buffer.\n\
747 The width is measured by how many columns it occupies on the screen.")
751 Lisp_Object val
, disp
;
753 struct Lisp_Char_Table
*dp
= buffer_display_table ();
755 CHECK_NUMBER (ch
, 0);
759 /* Get the way the display table would display it. */
760 disp
= dp
? DISP_CHAR_VECTOR (dp
, c
) : Qnil
;
763 XSETINT (val
, XVECTOR (disp
)->size
);
764 else if (SINGLE_BYTE_CHAR_P (c
))
765 XSETINT (val
, ONE_BYTE_CHAR_WIDTH (c
));
766 else if (COMPOSITE_CHAR_P (c
))
768 int id
= COMPOSITE_CHAR_ID (XFASTINT (ch
));
769 XSETFASTINT (val
, (id
< n_cmpchars
? cmpchar_table
[id
]->width
: 0));
773 int charset
= CHAR_CHARSET (c
);
775 XSETFASTINT (val
, CHARSET_WIDTH (charset
));
780 /* Return width of string STR of length LEN when displayed in the
781 current buffer. The width is measured by how many columns it
782 occupies on the screen. */
789 unsigned char *endp
= str
+ len
;
791 struct Lisp_Char_Table
*dp
= buffer_display_table (current_buffer
);
795 if (*str
== LEADING_CODE_COMPOSITION
)
797 int id
= str_cmpchar_id (str
, endp
- str
);
806 width
+= cmpchar_table
[id
]->width
;
807 str
+= cmpchar_table
[id
]->len
;
814 int c
= STRING_CHAR (str
, endp
- str
);
816 /* Get the way the display table would display it. */
818 disp
= DISP_CHAR_VECTOR (dp
, c
);
823 thiswidth
= XVECTOR (disp
)->size
;
825 thiswidth
= ONE_BYTE_CHAR_WIDTH (*str
);
828 str
+= BYTES_BY_CHAR_HEAD (*str
);
834 DEFUN ("string-width", Fstring_width
, Sstring_width
, 1, 1, 0,
835 "Return width of STRING when displayed in the current buffer.\n\
836 Width is measured by how many columns it occupies on the screen.\n\
837 When calculating width of a multibyte character in STRING,\n\
838 only the base leading-code is considered; the validity of\n\
839 the following bytes is not checked.")
845 CHECK_STRING (str
, 0);
846 XSETFASTINT (val
, strwidth (XSTRING (str
)->data
, XSTRING (str
)->size
));
850 DEFUN ("char-direction", Fchar_direction
, Schar_direction
, 1, 1, 0,
851 "Return the direction of CHAR.\n\
852 The returned value is 0 for left-to-right and 1 for right-to-left.")
858 CHECK_NUMBER (ch
, 0);
859 charset
= CHAR_CHARSET (XFASTINT (ch
));
860 if (!CHARSET_DEFINED_P (charset
))
861 error ("Invalid character: %d", XINT (ch
));
862 return CHARSET_TABLE_INFO (charset
, CHARSET_DIRECTION_IDX
);
865 DEFUN ("chars-in-string", Fchars_in_string
, Schars_in_string
, 1, 1, 0,
866 "Return number of characters in STRING.\n\
867 When using multibyte characters, this is not the necessarily same as\n\
868 the length of STRING; the length counts a multibyte characters as\n\
869 several bytes, but this function counts a multibyte character as one\n\
875 unsigned char *p
, *endp
;
878 CHECK_STRING (str
, 0);
880 p
= XSTRING (str
)->data
; endp
= p
+ XSTRING (str
)->size
;
884 if (*p
== LEADING_CODE_COMPOSITION
)
887 while (p
< endp
&& ! CHAR_HEAD_P (p
)) p
++;
890 p
+= BYTES_BY_CHAR_HEAD (*p
);
894 XSETFASTINT (val
, chars
);
898 DEFUN ("count-chars-region", Fcount_chars_region
, Scount_chars_region
, 2, 2, 0,
899 "Return number of characters between BEG and END.\n\
900 When using multibyte characters, this is not the necessarily same as\n\
901 (- END BEG); that subtraction gives you the number of bytes, which\n\
902 may be more than the number of characters.")
904 Lisp_Object beg
, end
;
909 unsigned char *p
, *endp
;
911 validate_region (&beg
, &end
);
913 from
= min (XFASTINT (beg
), XFASTINT (end
));
914 stop
= to
= max (XFASTINT (beg
), XFASTINT (end
));
916 endp
= POS_ADDR (stop
);
918 if (from
< GPT
&& GPT
< to
)
929 endp
= POS_ADDR (stop
);
935 if (*p
== LEADING_CODE_COMPOSITION
)
938 while (p
< endp
&& ! CHAR_HEAD_P (p
)) p
++;
941 p
+= BYTES_BY_CHAR_HEAD (*p
);
946 return make_number (chars
);
949 DEFUN ("char-boundary-p", Fchar_boundary_p
, Schar_boundary_p
, 1, 1, 0,
950 "Return non-nil value if POS is at character boundary of multibyte form.\n\
951 When the value is non-nil, it contains some additional information:\n\
952 0 if POS is at an ASCII character or at the end of range,\n\
953 1 if POS is before a 2-byte length multi-byte form,\n\
954 2 if POS is before a 3-byte length multi-byte form,\n\
955 3 if POS is before a 4-byte length multi-byte form,\n\
956 4 if POS is before a composite character.\n\
957 If POS is out of range or not at character boundary, return NIL.")
964 CHECK_NUMBER_COERCE_MARKER (pos
, 0);
967 if (n
< BEGV
|| n
> ZV
)
970 if (n
== ZV
|| NILP (current_buffer
->enable_multibyte_characters
))
971 XSETFASTINT (val
, 0);
974 unsigned char *p
= POS_ADDR (n
);
976 if (SINGLE_BYTE_CHAR_P (*p
))
977 XSETFASTINT (val
, 0);
978 else if (*p
== LEADING_CODE_COMPOSITION
)
979 XSETFASTINT (val
, 4);
980 else if (BYTES_BY_CHAR_HEAD (*p
) > 1)
981 XSETFASTINT (val
, BYTES_BY_CHAR_HEAD (*p
) - 1);
988 DEFUN ("concat-chars", Fconcat_chars
, Sconcat_chars
, 1, MANY
, 0,
989 "Concatenate all the argument characters and make the result a string.")
996 = (unsigned char *) alloca (MAX_LENGTH_OF_MULTI_BYTE_FORM
* n
);
997 unsigned char *p
= buf
;
1000 for (i
= 0; i
< n
; i
++)
1005 if (!INTEGERP (args
[i
]))
1008 CHECK_NUMBER (args
[i
], 0);
1011 len
= CHAR_STRING (c
, p
, str
);
1013 /* C is a composite character. */
1014 bcopy (str
, p
, len
);
1018 val
= make_string (buf
, p
- buf
);
1024 /*** Composite characters staffs ***/
1026 /* Each composite character is identified by CMPCHAR-ID which is
1027 assigned when Emacs needs the character code of the composite
1028 character (e.g. when displaying it on the screen). See the
1029 document "GENERAL NOTE on COMPOSITE CHARACTER" in `charset.h' how a
1030 composite character is represented in Emacs. */
1032 /* If `static' is defined, it means that it is defined to null string. */
1034 /* The following function is copied from lread.c. */
1036 hash_string (ptr
, len
)
1040 register unsigned char *p
= ptr
;
1041 register unsigned char *end
= p
+ len
;
1042 register unsigned char c
;
1043 register int hash
= 0;
1048 if (c
>= 0140) c
-= 40;
1049 hash
= ((hash
<<3) + (hash
>>28) + c
);
1051 return hash
& 07777777777;
1055 #define CMPCHAR_HASH_TABLE_SIZE 0xFFF
1057 static int *cmpchar_hash_table
[CMPCHAR_HASH_TABLE_SIZE
];
1059 /* Each element of `cmpchar_hash_table' is a pointer to an array of
1060 integer, where the 1st element is the size of the array, the 2nd
1061 element is how many elements are actually used in the array, and
1062 the remaining elements are CMPCHAR-IDs of composite characters of
1063 the same hash value. */
1064 #define CMPCHAR_HASH_SIZE(table) table[0]
1065 #define CMPCHAR_HASH_USED(table) table[1]
1066 #define CMPCHAR_HASH_CMPCHAR_ID(table, i) table[i]
1068 /* Return CMPCHAR-ID of the composite character in STR of the length
1069 LEN. If the composite character has not yet been registered,
1070 register it in `cmpchar_table' and assign new CMPCHAR-ID. This
1071 is the sole function for assigning CMPCHAR-ID. */
1073 str_cmpchar_id (str
, len
)
1077 int hash_idx
, *hashp
;
1079 int embedded_rule
; /* 1 if composition rule is embedded. */
1080 int chars
; /* number of components. */
1082 struct cmpchar_info
*cmpcharp
;
1085 /* Any composite char have at least 3-byte length. */
1088 /* The second byte 0xFF means compostion rule is embedded. */
1089 embedded_rule
= (str
[1] == 0xFF);
1091 /* At first, get the actual length of the composite character. */
1093 unsigned char *p
, *endp
= str
+ 1, *lastp
= str
+ len
;
1096 while (endp
< lastp
&& ! CHAR_HEAD_P (endp
)) endp
++;
1098 p
= str
+ 1 + embedded_rule
;
1101 /* No need of checking if *P is 0xA0 because
1102 BYTES_BY_CHAR_HEAD (0x80) surely returns 2. */
1103 p
+= (bytes
= BYTES_BY_CHAR_HEAD (*p
- 0x20) + embedded_rule
);
1106 len
= (p
-= embedded_rule
) - str
;
1108 len
-= - bytes
, chars
--;
1110 if (chars
< 2 || chars
> MAX_COMPONENT_COUNT
)
1111 /* Invalid number of components. */
1114 hash_idx
= hash_string (str
, len
) % CMPCHAR_HASH_TABLE_SIZE
;
1115 hashp
= cmpchar_hash_table
[hash_idx
];
1117 /* Then, look into the hash table. */
1119 /* Find the correct one among composite characters of the same
1121 for (i
= 2; i
< CMPCHAR_HASH_USED (hashp
); i
++)
1123 cmpcharp
= cmpchar_table
[CMPCHAR_HASH_CMPCHAR_ID (hashp
, i
)];
1124 if (len
== cmpcharp
->len
1125 && ! bcmp (str
, cmpcharp
->data
, len
))
1126 return CMPCHAR_HASH_CMPCHAR_ID (hashp
, i
);
1129 /* We have to register the composite character in cmpchar_table. */
1130 if (n_cmpchars
> (CHAR_FIELD2_MASK
| CHAR_FIELD3_MASK
))
1131 /* No, we have no more room for a new composite character. */
1134 /* Make the entry in hash table. */
1137 /* Make a table for 8 composite characters initially. */
1138 hashp
= (cmpchar_hash_table
[hash_idx
]
1139 = (int *) xmalloc (sizeof (int) * (2 + 8)));
1140 CMPCHAR_HASH_SIZE (hashp
) = 10;
1141 CMPCHAR_HASH_USED (hashp
) = 2;
1143 else if (CMPCHAR_HASH_USED (hashp
) >= CMPCHAR_HASH_SIZE (hashp
))
1145 CMPCHAR_HASH_SIZE (hashp
) += 8;
1146 hashp
= (cmpchar_hash_table
[hash_idx
]
1147 = (int *) xrealloc (hashp
,
1148 sizeof (int) * CMPCHAR_HASH_SIZE (hashp
)));
1150 CMPCHAR_HASH_CMPCHAR_ID (hashp
, CMPCHAR_HASH_USED (hashp
)) = n_cmpchars
;
1151 CMPCHAR_HASH_USED (hashp
)++;
1153 /* Set information of the composite character in cmpchar_table. */
1154 if (cmpchar_table_size
== 0)
1156 /* This is the first composite character to be registered. */
1157 cmpchar_table_size
= 256;
1159 = (struct cmpchar_info
**) xmalloc (sizeof (cmpchar_table
[0])
1160 * cmpchar_table_size
);
1162 else if (cmpchar_table_size
<= n_cmpchars
)
1164 cmpchar_table_size
+= 256;
1166 = (struct cmpchar_info
**) xrealloc (cmpchar_table
,
1167 sizeof (cmpchar_table
[0])
1168 * cmpchar_table_size
);
1171 cmpcharp
= (struct cmpchar_info
*) xmalloc (sizeof (struct cmpchar_info
));
1173 cmpcharp
->len
= len
;
1174 cmpcharp
->data
= (unsigned char *) xmalloc (len
+ 1);
1175 bcopy (str
, cmpcharp
->data
, len
);
1176 cmpcharp
->data
[len
] = 0;
1177 cmpcharp
->glyph_len
= chars
;
1178 cmpcharp
->glyph
= (GLYPH
*) xmalloc (sizeof (GLYPH
) * chars
);
1181 cmpcharp
->cmp_rule
= (unsigned char *) xmalloc (chars
);
1182 cmpcharp
->col_offset
= (float *) xmalloc (sizeof (float) * chars
);
1186 cmpcharp
->cmp_rule
= NULL
;
1187 cmpcharp
->col_offset
= NULL
;
1190 /* Setup GLYPH data and composition rules (if any) so as not to make
1191 them every time on displaying. */
1193 unsigned char *bufp
;
1195 float leftmost
= 0.0, rightmost
= 1.0;
1198 /* At first, col_offset[N] is set to relative to col_offset[0]. */
1199 cmpcharp
->col_offset
[0] = 0;
1201 for (i
= 0, bufp
= cmpcharp
->data
+ 1; i
< chars
; i
++)
1204 cmpcharp
->cmp_rule
[i
] = *bufp
++;
1206 if (*bufp
== 0xA0) /* This is an ASCII character. */
1208 cmpcharp
->glyph
[i
] = FAST_MAKE_GLYPH ((*++bufp
& 0x7F), 0);
1212 else /* Multibyte character. */
1214 /* Make `bufp' point normal multi-byte form temporally. */
1217 = FAST_MAKE_GLYPH (string_to_non_ascii_char (bufp
, 4, 0), 0);
1218 width
= WIDTH_BY_CHAR_HEAD (*bufp
);
1220 bufp
+= BYTES_BY_CHAR_HEAD (*bufp
- 0x20);
1223 if (embedded_rule
&& i
> 0)
1225 /* Reference points (global_ref and new_ref) are
1236 Now, we calculate the column offset of the new glyph
1237 from the left edge of the first glyph. This can avoid
1238 the same calculation everytime displaying this
1239 composite character. */
1241 /* Reference points of global glyph and new glyph. */
1242 int global_ref
= (cmpcharp
->cmp_rule
[i
] - 0xA0) / 9;
1243 int new_ref
= (cmpcharp
->cmp_rule
[i
] - 0xA0) % 9;
1244 /* Column offset relative to the first glyph. */
1245 float left
= (leftmost
1246 + (global_ref
% 3) * (rightmost
- leftmost
) / 2.0
1247 - (new_ref
% 3) * width
/ 2.0);
1249 cmpcharp
->col_offset
[i
] = left
;
1250 if (left
< leftmost
)
1252 if (left
+ width
> rightmost
)
1253 rightmost
= left
+ width
;
1257 if (width
> rightmost
)
1263 /* Now col_offset[N] are relative to the left edge of the
1264 first component. Make them relative to the left edge of
1266 for (i
= 0; i
< chars
; i
++)
1267 cmpcharp
->col_offset
[i
] -= leftmost
;
1268 /* Make rightmost holds width of overall glyph. */
1269 rightmost
-= leftmost
;
1272 cmpcharp
->width
= rightmost
;
1273 if (cmpcharp
->width
< rightmost
)
1274 /* To get a ceiling integer value. */
1278 cmpchar_table
[n_cmpchars
] = cmpcharp
;
1280 return n_cmpchars
++;
1283 /* Return the Nth element of the composite character C. */
1285 cmpchar_component (c
, n
)
1288 int id
= COMPOSITE_CHAR_ID (c
);
1290 if (id
>= n_cmpchars
/* C is not a valid composite character. */
1291 || n
>= cmpchar_table
[id
]->glyph_len
) /* No such component. */
1293 /* No face data is stored in glyph code. */
1294 return ((int) (cmpchar_table
[id
]->glyph
[n
]));
1297 DEFUN ("cmpcharp", Fcmpcharp
, Scmpcharp
, 1, 1, 0,
1298 "T if CHAR is a composite character.")
1302 CHECK_NUMBER (ch
, 0);
1303 return (COMPOSITE_CHAR_P (XINT (ch
)) ? Qt
: Qnil
);
1306 DEFUN ("composite-char-component", Fcmpchar_component
, Scmpchar_component
,
1308 "Return the IDXth component character of composite character CHARACTER.")
1310 Lisp_Object character
, idx
;
1314 CHECK_NUMBER (character
, 0);
1315 CHECK_NUMBER (idx
, 1);
1317 if ((c
= cmpchar_component (XINT (character
), XINT (idx
))) < 0)
1318 args_out_of_range (character
, idx
);
1320 return make_number (c
);
1323 DEFUN ("composite-char-composition-rule", Fcmpchar_cmp_rule
, Scmpchar_cmp_rule
,
1325 "Return the Nth composition rule embedded in composite character CHARACTER.\n\
1326 The returned rule is for composing the Nth component\n\
1327 on the (N-1)th component. If N is 0, the returned value is always 255.")
1329 Lisp_Object character
, n
;
1333 CHECK_NUMBER (character
, 0);
1334 CHECK_NUMBER (n
, 1);
1336 id
= COMPOSITE_CHAR_ID (XINT (character
));
1337 if (id
< 0 || id
>= n_cmpchars
)
1338 error ("Invalid composite character: %d", XINT (character
));
1340 if (i
> cmpchar_table
[id
]->glyph_len
)
1341 args_out_of_range (character
, n
);
1343 return make_number (cmpchar_table
[id
]->cmp_rule
[i
]);
1346 DEFUN ("composite-char-composition-rule-p", Fcmpchar_cmp_rule_p
,
1347 Scmpchar_cmp_rule_p
, 1, 1, 0,
1348 "Return non-nil if composite character CHARACTER contains a embedded rule.")
1350 Lisp_Object character
;
1354 CHECK_NUMBER (character
, 0);
1355 id
= COMPOSITE_CHAR_ID (XINT (character
));
1356 if (id
< 0 || id
>= n_cmpchars
)
1357 error ("Invalid composite character: %d", XINT (character
));
1359 return (cmpchar_table
[id
]->cmp_rule
? Qt
: Qnil
);
1362 DEFUN ("composite-char-component-count", Fcmpchar_cmp_count
,
1363 Scmpchar_cmp_count
, 1, 1, 0,
1364 "Return number of compoents of composite character CHARACTER.")
1366 Lisp_Object character
;
1370 CHECK_NUMBER (character
, 0);
1371 id
= COMPOSITE_CHAR_ID (XINT (character
));
1372 if (id
< 0 || id
>= n_cmpchars
)
1373 error ("Invalid composite character: %d", XINT (character
));
1375 return (make_number (cmpchar_table
[id
]->glyph_len
));
1378 DEFUN ("compose-string", Fcompose_string
, Scompose_string
,
1380 "Return one char string composed from all characters in STRING.")
1384 unsigned char buf
[MAX_LENGTH_OF_MULTI_BYTE_FORM
], *p
, *pend
, *ptemp
;
1387 CHECK_STRING (str
, 0);
1389 buf
[0] = LEADING_CODE_COMPOSITION
;
1390 p
= XSTRING (str
)->data
;
1391 pend
= p
+ XSTRING (str
)->size
;
1395 if (*p
< 0x20 || *p
== 127) /* control code */
1396 error ("Invalid component character: %d", *p
);
1397 else if (*p
< 0x80) /* ASCII */
1399 if (i
+ 2 >= MAX_LENGTH_OF_MULTI_BYTE_FORM
)
1400 error ("Too long string to be composed: %s", XSTRING (str
)->data
);
1401 /* Prepend an ASCII charset indicator 0xA0, set MSB of the
1404 buf
[i
++] = *p
++ + 0x80;
1406 else if (*p
== LEADING_CODE_COMPOSITION
) /* composite char */
1408 /* Already composed. Eliminate the heading
1409 LEADING_CODE_COMPOSITION, keep the remaining bytes
1413 while (! CHAR_HEAD_P (p
)) p
++;
1414 if (i
+ (p
- ptemp
) >= MAX_LENGTH_OF_MULTI_BYTE_FORM
)
1415 error ("Too long string to be composed: %s", XSTRING (str
)->data
);
1416 bcopy (ptemp
, buf
+ i
, p
- ptemp
);
1419 else /* multibyte char */
1421 /* Add 0x20 to the base leading-code, keep the remaining
1423 len
= BYTES_BY_CHAR_HEAD (*p
);
1424 if (i
+ len
>= MAX_LENGTH_OF_MULTI_BYTE_FORM
)
1425 error ("Too long string to be composed: %s", XSTRING (str
)->data
);
1426 bcopy (p
, buf
+ i
, len
);
1433 /* STR contains only one character, which can't be composed. */
1434 error ("Too short string to be composed: %s", XSTRING (str
)->data
);
1436 return make_string (buf
, i
);
1440 charset_id_internal (charset_name
)
1443 Lisp_Object val
= Fget (intern (charset_name
), Qcharset
);
1446 error ("Charset %s is not defined", charset_name
);
1448 return (XINT (XVECTOR (val
)->contents
[0]));
1451 DEFUN ("setup-special-charsets", Fsetup_special_charsets
,
1452 Ssetup_special_charsets
, 0, 0, 0, "Internal use only.")
1455 charset_latin_iso8859_1
= charset_id_internal ("latin-iso8859-1");
1456 charset_jisx0208_1978
= charset_id_internal ("japanese-jisx0208-1978");
1457 charset_jisx0208
= charset_id_internal ("japanese-jisx0208");
1458 charset_katakana_jisx0201
= charset_id_internal ("katakana-jisx0201");
1459 charset_latin_jisx0201
= charset_id_internal ("latin-jisx0201");
1460 charset_big5_1
= charset_id_internal ("chinese-big5-1");
1461 charset_big5_2
= charset_id_internal ("chinese-big5-2");
1465 init_charset_once ()
1469 staticpro (&Vcharset_table
);
1470 staticpro (&Vcharset_symbol_table
);
1472 /* This has to be done here, before we call Fmake_char_table. */
1473 Qcharset_table
= intern ("charset-table");
1474 staticpro (&Qcharset_table
);
1476 /* Intern this now in case it isn't already done.
1477 Setting this variable twice is harmless.
1478 But don't staticpro it here--that is done in alloc.c. */
1479 Qchar_table_extra_slots
= intern ("char-table-extra-slots");
1481 /* Now we are ready to set up this property, so we can
1482 create the charset table. */
1483 Fput (Qcharset_table
, Qchar_table_extra_slots
, make_number (0));
1484 Vcharset_table
= Fmake_char_table (Qcharset_table
, Qnil
);
1486 Vcharset_symbol_table
= Fmake_vector (make_number (MAX_CHARSET
+ 1), Qnil
);
1489 for (i
= 0; i
< 2; i
++)
1490 for (j
= 0; j
< 2; j
++)
1491 for (k
= 0; k
< 128; k
++)
1492 iso_charset_table
[i
][j
][k
] = -1;
1494 bzero (cmpchar_hash_table
, sizeof cmpchar_hash_table
);
1495 cmpchar_table_size
= n_cmpchars
= 0;
1497 for (i
= 0; i
< 256; i
++)
1498 BYTES_BY_CHAR_HEAD (i
) = 1;
1499 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_11
) = 3;
1500 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_12
) = 3;
1501 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_21
) = 4;
1502 BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_22
) = 4;
1503 /* The following doesn't reflect the actual bytes, but just to tell
1504 that it is a start of a multibyte character. */
1505 BYTES_BY_CHAR_HEAD (LEADING_CODE_COMPOSITION
) = 2;
1507 for (i
= 0; i
< 128; i
++)
1508 WIDTH_BY_CHAR_HEAD (i
) = 1;
1509 for (; i
< 256; i
++)
1510 WIDTH_BY_CHAR_HEAD (i
) = 4;
1511 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_11
) = 1;
1512 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_12
) = 2;
1513 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_21
) = 1;
1514 WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_22
) = 2;
1521 Qascii
= intern ("ascii");
1522 staticpro (&Qascii
);
1524 Qcharset
= intern ("charset");
1525 staticpro (&Qcharset
);
1527 /* Define ASCII charset now. */
1528 update_charset_table (make_number (CHARSET_ASCII
),
1529 make_number (1), make_number (94),
1534 build_string ("ASCII"),
1535 build_string ("ASCII"),
1536 build_string ("ASCII (ISO646 IRV)"));
1537 CHARSET_SYMBOL (CHARSET_ASCII
) = Qascii
;
1538 Fput (Qascii
, Qcharset
, CHARSET_TABLE_ENTRY (CHARSET_ASCII
));
1540 Qcomposition
= intern ("composition");
1541 staticpro (&Qcomposition
);
1542 CHARSET_SYMBOL (CHARSET_COMPOSITION
) = Qcomposition
;
1544 defsubr (&Sdefine_charset
);
1545 defsubr (&Sdeclare_equiv_charset
);
1546 defsubr (&Sfind_charset_region
);
1547 defsubr (&Sfind_charset_string
);
1548 defsubr (&Smake_char_internal
);
1549 defsubr (&Ssplit_char
);
1550 defsubr (&Schar_charset
);
1551 defsubr (&Siso_charset
);
1552 defsubr (&Schar_bytes
);
1553 defsubr (&Schar_width
);
1554 defsubr (&Sstring_width
);
1555 defsubr (&Schar_direction
);
1556 defsubr (&Schars_in_string
);
1557 defsubr (&Scount_chars_region
);
1558 defsubr (&Schar_boundary_p
);
1559 defsubr (&Sconcat_chars
);
1560 defsubr (&Scmpcharp
);
1561 defsubr (&Scmpchar_component
);
1562 defsubr (&Scmpchar_cmp_rule
);
1563 defsubr (&Scmpchar_cmp_rule_p
);
1564 defsubr (&Scmpchar_cmp_count
);
1565 defsubr (&Scompose_string
);
1566 defsubr (&Ssetup_special_charsets
);
1568 DEFVAR_LISP ("charset-list", &Vcharset_list
,
1569 "List of charsets ever defined.");
1570 Vcharset_list
= Fcons (Qascii
, Qnil
);
1572 DEFVAR_INT ("leading-code-composition", &leading_code_composition
,
1573 "Leading-code of composite characters.");
1574 leading_code_composition
= LEADING_CODE_COMPOSITION
;
1576 DEFVAR_INT ("leading-code-private-11", &leading_code_private_11
,
1577 "Leading-code of private TYPE9N charset of column-width 1.");
1578 leading_code_private_11
= LEADING_CODE_PRIVATE_11
;
1580 DEFVAR_INT ("leading-code-private-12", &leading_code_private_12
,
1581 "Leading-code of private TYPE9N charset of column-width 2.");
1582 leading_code_private_12
= LEADING_CODE_PRIVATE_12
;
1584 DEFVAR_INT ("leading-code-private-21", &leading_code_private_21
,
1585 "Leading-code of private TYPE9Nx9N charset of column-width 1.");
1586 leading_code_private_21
= LEADING_CODE_PRIVATE_21
;
1588 DEFVAR_INT ("leading-code-private-22", &leading_code_private_22
,
1589 "Leading-code of private TYPE9Nx9N charset of column-width 2.");
1590 leading_code_private_22
= LEADING_CODE_PRIVATE_22
;