(x_set_tool_bar_lines): When clearing the frame, also
[bpt/emacs.git] / src / fontset.c
CommitLineData
4ed46869 1/* Fontset handler.
0d407d77 2 Copyright (C) 1995, 1997, 2000 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 21
0d407d77
KH
22/* #define FONTSET_DEBUG */
23
4ed46869 24#include <config.h>
0d407d77
KH
25
26#ifdef FONTSET_DEBUG
27#include <stdio.h>
28#endif
29
4ed46869 30#include "lisp.h"
1ff005e1 31#include "buffer.h"
4ed46869
KH
32#include "charset.h"
33#include "ccl.h"
2538fae4 34#include "keyboard.h"
4ed46869 35#include "frame.h"
0d407d77 36#include "dispextern.h"
3541bb8f 37#include "fontset.h"
0d407d77
KH
38#include "window.h"
39
40#ifdef FONTSET_DEBUG
41#undef xassert
42#define xassert(X) do {if (!(X)) abort ();} while (0)
43#undef INLINE
44#define INLINE
45#endif
46
47
48/* FONTSET
49
50 A fontset is a collection of font related information to give
51 similar appearance (style, size, etc) of characters. There are two
52 kinds of fontsets; base and realized. A base fontset is created by
53 new-fontset from Emacs Lisp explicitly. A realized fontset is
54 created implicitly when a face is realized for ASCII characters. A
55 face is also realized for multibyte characters based on an ASCII
56 face. All of the multibyte faces based on the same ASCII face
57 share the same realized fontset.
58
59 A fontset object is implemented by a char-table.
60
61 An element of a base fontset is:
62 (INDEX . FONTNAME) or
63 (INDEX . (FOUNDRY . REGISTRY ))
64 FONTNAME is a font name pattern for the corresponding character.
65 FOUNDRY and REGISTRY are respectively foundy and regisry fields of
66 a font name for the corresponding character. INDEX specifies for
67 which character (or generic character) the element is defined. It
68 may be different from an index to access this element. For
69 instance, if a fontset defines some font for all characters of
70 charset `japanese-jisx0208', INDEX is the generic character of this
71 charset. REGISTRY is the
72
73 An element of a realized fontset is FACE-ID which is a face to use
74 for displaying the correspnding character.
75
76 All single byte charaters (ASCII and 8bit-unibyte) share the same
11d9bd93
KH
77 element in a fontset. The element is stored in the first element
78 of the fontset.
0d407d77
KH
79
80 To access or set each element, use macros FONTSET_REF and
81 FONTSET_SET respectively for efficiency.
82
83 A fontset has 3 extra slots.
84
85 The 1st slot is an ID number of the fontset.
86
87 The 2nd slot is a name of the fontset. This is nil for a realized
88 face.
89
90 The 3rd slot is a frame that the fontset belongs to. This is nil
91 for a default face.
92
93 A parent of a base fontset is nil. A parent of a realized fontset
94 is a base fontset.
95
afe93d01 96 All fontsets are recorded in Vfontset_table.
0d407d77
KH
97
98
99 DEFAULT FONTSET
100
101 There's a special fontset named `default fontset' which defines a
afe93d01
KH
102 default fontname pattern. When a base fontset doesn't specify a
103 font for a specific character, the corresponding value in the
104 default fontset is used. The format is the same as a base fontset.
0d407d77 105
afe93d01
KH
106 The parent of a realized fontset created for such a face that has
107 no fontset is the default fontset.
0d407d77
KH
108
109
110 These structures are hidden from the other codes than this file.
111 The other codes handle fontsets only by their ID numbers. They
112 usually use variable name `fontset' for IDs. But, in this file, we
113 always use varialbe name `id' for IDs, and name `fontset' for the
114 actual fontset objects.
115
116*/
117
118/********** VARIABLES and FUNCTION PROTOTYPES **********/
119
120extern Lisp_Object Qfont;
121Lisp_Object Qfontset;
122
123/* Vector containing all fontsets. */
124static Lisp_Object Vfontset_table;
125
126/* Next possibly free fontset ID. Usually this keeps the mininum
127 fontset ID not yet used. */
128static int next_fontset_id;
129
130/* The default fontset. This gives default FAMILY and REGISTRY of
131 font for each characters. */
132static Lisp_Object Vdefault_fontset;
4ed46869 133
4ed46869 134Lisp_Object Vfont_encoding_alist;
6a7e6d80 135Lisp_Object Vuse_default_ascent;
2aeafb78 136Lisp_Object Vignore_relative_composition;
01d4b817 137Lisp_Object Valternate_fontname_alist;
1c283e35 138Lisp_Object Vfontset_alias_alist;
ec3bb068
KH
139Lisp_Object Vhighlight_wrong_size_font;
140Lisp_Object Vclip_large_size_font;
810abb87 141Lisp_Object Vvertical_centering_font_regexp;
4ed46869 142
0d407d77
KH
143/* The following six are declarations of callback functions depending
144 on window system. See the comments in src/fontset.h for more
145 detail. */
4ed46869
KH
146
147/* Return a pointer to struct font_info of font FONT_IDX of frame F. */
5771dcf4 148struct font_info *(*get_font_info_func) P_ ((FRAME_PTR f, int font_idx));
4ed46869
KH
149
150/* Return a list of font names which matches PATTERN. See the document of
151 `x-list-fonts' for more detail. */
3541bb8f
KH
152Lisp_Object (*list_fonts_func) P_ ((struct frame *f,
153 Lisp_Object pattern,
154 int size,
155 int maxnames));
4ed46869
KH
156
157/* Load a font named NAME for frame F and return a pointer to the
158 information of the loaded font. If loading is failed, return 0. */
5771dcf4 159struct font_info *(*load_font_func) P_ ((FRAME_PTR f, char *name, int));
4ed46869
KH
160
161/* Return a pointer to struct font_info of a font named NAME for frame F. */
5771dcf4 162struct font_info *(*query_font_func) P_ ((FRAME_PTR f, char *name));
4ed46869
KH
163
164/* Additional function for setting fontset or changing fontset
165 contents of frame F. */
5771dcf4
AS
166void (*set_frame_fontset_func) P_ ((FRAME_PTR f, Lisp_Object arg,
167 Lisp_Object oldval));
4ed46869 168
727fb790
KH
169/* To find a CCL program, fs_load_font calls this function.
170 The argument is a pointer to the struct font_info.
171 This function set the memer `encoder' of the structure. */
172void (*find_ccl_program_func) P_ ((struct font_info *));
173
4ed46869 174/* Check if any window system is used now. */
5771dcf4 175void (*check_window_system_func) P_ ((void));
4ed46869 176
0d407d77
KH
177
178/* Prototype declarations for static functions. */
179static Lisp_Object fontset_ref P_ ((Lisp_Object, int));
180static void fontset_set P_ ((Lisp_Object, int, Lisp_Object));
181static Lisp_Object make_fontset P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
182static int fontset_id_valid_p P_ ((int));
183static Lisp_Object fontset_pattern_regexp P_ ((Lisp_Object));
184static Lisp_Object font_family_registry P_ ((Lisp_Object));
185
186\f
187/********** MACROS AND FUNCTIONS TO HANDLE FONTSET **********/
188
0d407d77
KH
189/* Return the fontset with ID. No check of ID's validness. */
190#define FONTSET_FROM_ID(id) AREF (Vfontset_table, id)
191
afe93d01 192/* Macros to access special values of FONTSET. */
0d407d77
KH
193#define FONTSET_ID(fontset) XCHAR_TABLE (fontset)->extras[0]
194#define FONTSET_NAME(fontset) XCHAR_TABLE (fontset)->extras[1]
195#define FONTSET_FRAME(fontset) XCHAR_TABLE (fontset)->extras[2]
11d9bd93 196#define FONTSET_ASCII(fontset) XCHAR_TABLE (fontset)->contents[0]
0d407d77
KH
197#define FONTSET_BASE(fontset) XCHAR_TABLE (fontset)->parent
198
199#define BASE_FONTSET_P(fontset) NILP (FONTSET_BASE(fontset))
200
201
202/* Return the element of FONTSET (char-table) at index C (character). */
203
204#define FONTSET_REF(fontset, c) fontset_ref (fontset, c)
205
afe93d01 206static Lisp_Object
0d407d77
KH
207fontset_ref (fontset, c)
208 Lisp_Object fontset;
209 int c;
210{
211 int charset, c1, c2;
212 Lisp_Object elt, defalt;
213 int i;
214
215 if (SINGLE_BYTE_CHAR_P (c))
216 return FONTSET_ASCII (fontset);
217
f55d03b1 218 SPLIT_CHAR (c, charset, c1, c2);
0d407d77
KH
219 elt = XCHAR_TABLE (fontset)->contents[charset + 128];
220 if (!SUB_CHAR_TABLE_P (elt))
221 return elt;
222 defalt = XCHAR_TABLE (elt)->defalt;
223 if (c1 < 32
224 || (elt = XCHAR_TABLE (elt)->contents[c1],
225 NILP (elt)))
226 return defalt;
227 if (!SUB_CHAR_TABLE_P (elt))
228 return elt;
229 defalt = XCHAR_TABLE (elt)->defalt;
230 if (c2 < 32
231 || (elt = XCHAR_TABLE (elt)->contents[c2],
232 NILP (elt)))
233 return defalt;
234 return elt;
235}
236
237
238#define FONTSET_REF_VIA_BASE(fontset, c) fontset_ref_via_base (fontset, &c)
239
afe93d01 240static Lisp_Object
0d407d77
KH
241fontset_ref_via_base (fontset, c)
242 Lisp_Object fontset;
243 int *c;
244{
245 int charset, c1, c2;
246 Lisp_Object elt;
0d407d77
KH
247
248 if (SINGLE_BYTE_CHAR_P (*c))
249 return FONTSET_ASCII (fontset);
250
251 elt = FONTSET_REF (FONTSET_BASE (fontset), *c);
11d9bd93
KH
252 if (NILP (elt) && ! EQ (fontset, Vdefault_fontset))
253 elt = FONTSET_REF (Vdefault_fontset, *c);
0d407d77
KH
254 if (NILP (elt))
255 return Qnil;
256
257 *c = XINT (XCAR (elt));
f55d03b1 258 SPLIT_CHAR (*c, charset, c1, c2);
0d407d77
KH
259 elt = XCHAR_TABLE (fontset)->contents[charset + 128];
260 if (c1 < 32)
261 return (SUB_CHAR_TABLE_P (elt) ? XCHAR_TABLE (elt)->defalt : elt);
262 if (!SUB_CHAR_TABLE_P (elt))
263 return Qnil;
264 elt = XCHAR_TABLE (elt)->contents[c1];
265 if (c2 < 32)
266 return (SUB_CHAR_TABLE_P (elt) ? XCHAR_TABLE (elt)->defalt : elt);
267 if (!SUB_CHAR_TABLE_P (elt))
268 return Qnil;
269 elt = XCHAR_TABLE (elt)->contents[c2];
270 return elt;
271}
272
273
afe93d01 274/* Store into the element of FONTSET at index C the value NEWELT. */
0d407d77
KH
275#define FONTSET_SET(fontset, c, newelt) fontset_set(fontset, c, newelt)
276
277static void
278fontset_set (fontset, c, newelt)
279 Lisp_Object fontset;
280 int c;
281 Lisp_Object newelt;
282{
283 int charset, code[3];
284 Lisp_Object *elt, tmp;
285 int i, j;
286
287 if (SINGLE_BYTE_CHAR_P (c))
288 {
289 FONTSET_ASCII (fontset) = newelt;
290 return;
291 }
292
f55d03b1 293 SPLIT_CHAR (c, charset, code[0], code[1]);
0d407d77
KH
294 code[2] = 0; /* anchor */
295 elt = &XCHAR_TABLE (fontset)->contents[charset + 128];
296 for (i = 0; code[i] > 0; i++)
297 {
298 if (!SUB_CHAR_TABLE_P (*elt))
299 *elt = make_sub_char_table (*elt);
300 elt = &XCHAR_TABLE (*elt)->contents[code[i]];
301 }
302 if (SUB_CHAR_TABLE_P (*elt))
303 XCHAR_TABLE (*elt)->defalt = newelt;
304 else
305 *elt = newelt;
306}
307
308
309/* Return a newly created fontset with NAME. If BASE is nil, make a
310 base fontset. Otherwise make a realized fontset whose parent is
311 BASE. */
312
313static Lisp_Object
314make_fontset (frame, name, base)
315 Lisp_Object frame, name, base;
4ed46869 316{
0d407d77
KH
317 Lisp_Object fontset, elt, base_elt;
318 int size = ASIZE (Vfontset_table);
319 int id = next_fontset_id;
320 int i, j;
321
322 /* Find a free slot in Vfontset_table. Usually, next_fontset_id is
323 the next available fontset ID. So it is expected that this loop
324 terminates quickly. In addition, as the last element of
325 Vfotnset_table is always nil, we don't have to check the range of
326 id. */
327 while (!NILP (AREF (Vfontset_table, id))) id++;
328
329 if (id + 1 == size)
330 {
331 Lisp_Object tem;
332 int i;
4ed46869 333
0d407d77
KH
334 tem = Fmake_vector (make_number (size + 8), Qnil);
335 for (i = 0; i < size; i++)
336 AREF (tem, i) = AREF (Vfontset_table, i);
337 Vfontset_table = tem;
338 }
4ed46869 339
11d9bd93 340 fontset = Fmake_char_table (Qfontset, Qnil);
0d407d77
KH
341
342 FONTSET_ID (fontset) = make_number (id);
343 FONTSET_NAME (fontset) = name;
344 FONTSET_FRAME (fontset) = frame;
345 FONTSET_BASE (fontset) = base;
346
347 AREF (Vfontset_table, id) = fontset;
348 next_fontset_id = id + 1;
349 return fontset;
4ed46869
KH
350}
351
0d407d77
KH
352
353/* Return 1 if ID is a valid fontset id, else return 0. */
354
355static INLINE int
356fontset_id_valid_p (id)
357 int id;
358{
359 return (id >= 0 && id < ASIZE (Vfontset_table) - 1);
360}
361
362
363/* Extract `family' and `registry' string from FONTNAME and set in
364 *FAMILY and *REGISTRY respectively. Actually, `family' may also
365 contain `foundry', `registry' may also contain `encoding' of
366 FONTNAME. */
367
368static Lisp_Object
369font_family_registry (fontname)
370 Lisp_Object fontname;
371{
372 Lisp_Object family, registry;
373 char *p = XSTRING (fontname)->data;
374 char *sep[15];
375 int i = 0;
376
377 while (*p && i < 15) if (*p++ == '-') sep[i++] = p;
378 if (i != 14)
379 return fontname;
380
381 family = make_unibyte_string (sep[0], sep[2] - 1 - sep[0]);
382 registry = make_unibyte_string (sep[12], p - sep[12]);
383 return Fcons (family, registry);
384}
385
386\f
387/********** INTERFACES TO xfaces.c and dispextern.h **********/
388
389/* Return name of the fontset with ID. */
390
391Lisp_Object
392fontset_name (id)
393 int id;
394{
395 Lisp_Object fontset;
396 fontset = FONTSET_FROM_ID (id);
397 return FONTSET_NAME (fontset);
398}
399
400
401/* Return ASCII font name of the fontset with ID. */
402
403Lisp_Object
404fontset_ascii (id)
405 int id;
406{
407 Lisp_Object fontset, elt;
408 fontset= FONTSET_FROM_ID (id);
409 elt = FONTSET_ASCII (fontset);
410 return XCDR (elt);
411}
412
413
414/* Free fontset of FACE. Called from free_realized_face. */
415
4ed46869 416void
0d407d77
KH
417free_face_fontset (f, face)
418 FRAME_PTR f;
419 struct face *face;
4ed46869 420{
0d407d77 421 if (fontset_id_valid_p (face->fontset))
4ed46869 422 {
0d407d77
KH
423 AREF (Vfontset_table, face->fontset) = Qnil;
424 if (face->fontset < next_fontset_id)
425 next_fontset_id = face->fontset;
426 }
427}
18998710 428
0d407d77
KH
429
430/* Return 1 iff FACE is suitable for displaying character C.
431 Otherwise return 0. Called from the macro FACE_SUITABLE_FOR_CHAR_P
432 when C is not a single byte character.. */
433
434int
435face_suitable_for_char_p (face, c)
436 struct face *face;
437 int c;
438{
439 Lisp_Object fontset, elt;
440
441 if (SINGLE_BYTE_CHAR_P (c))
442 return (face == face->ascii_face);
443
444 xassert (fontset_id_valid_p (face->fontset));
445 fontset = FONTSET_FROM_ID (face->fontset);
446 xassert (!BASE_FONTSET_P (fontset));
447
448 elt = FONTSET_REF_VIA_BASE (fontset, c);
449 return (!NILP (elt) && face->id == XFASTINT (elt));
450}
451
452
453/* Return ID of face suitable for displaying character C on frame F.
454 The selection of face is done based on the fontset of FACE. FACE
455 should already have been realized for ASCII characters. Called
456 from the macro FACE_FOR_CHAR when C is not a single byte character. */
457
458int
459face_for_char (f, face, c)
460 FRAME_PTR f;
461 struct face *face;
462 int c;
463{
464 Lisp_Object fontset, elt;
465 int face_id;
466
467 xassert (fontset_id_valid_p (face->fontset));
468 fontset = FONTSET_FROM_ID (face->fontset);
469 xassert (!BASE_FONTSET_P (fontset));
470
471 elt = FONTSET_REF_VIA_BASE (fontset, c);
472 if (!NILP (elt))
473 return XINT (elt);
474
475 /* No face is recorded for C in the fontset of FACE. Make a new
476 realized face for C that has the same fontset. */
477 face_id = lookup_face (f, face->lface, c, face);
478
479 /* Record the face ID in FONTSET at the same index as the
480 information in the base fontset. */
481 FONTSET_SET (fontset, c, make_number (face_id));
482 return face_id;
483}
484
485
486/* Make a realized fontset for ASCII face FACE on frame F from the
487 base fontset BASE_FONTSET_ID. If BASE_FONTSET_ID is -1, use the
488 default fontset as the base. Value is the id of the new fontset.
489 Called from realize_x_face. */
490
491int
492make_fontset_for_ascii_face (f, base_fontset_id)
493 FRAME_PTR f;
494 int base_fontset_id;
495{
496 Lisp_Object base_fontset, fontset, name, frame;
497
498 XSETFRAME (frame, f);
499 if (base_fontset_id >= 0)
500 {
501 base_fontset = FONTSET_FROM_ID (base_fontset_id);
502 if (!BASE_FONTSET_P (base_fontset))
503 base_fontset = FONTSET_BASE (base_fontset);
504 xassert (BASE_FONTSET_P (base_fontset));
4ed46869 505 }
0d407d77
KH
506 else
507 base_fontset = Vdefault_fontset;
508
509 fontset = make_fontset (frame, Qnil, base_fontset);
f3231837 510 return XINT (FONTSET_ID (fontset));
0d407d77
KH
511}
512
513
514/* Return the font name pattern for C that is recorded in the fontset
515 with ID. A font is opened by that pattern to get the fullname. If
516 the fullname conform to XLFD, extract foundry-family field and
517 registry-encoding field, and return the cons of them. Otherwise
518 return the fullname. If ID is -1, or the fontset doesn't contain
519 information about C, get the registry and encoding of C from the
520 default fontset. Called from choose_face_font. */
521
522Lisp_Object
523fontset_font_pattern (f, id, c)
524 FRAME_PTR f;
525 int id, c;
526{
527 Lisp_Object fontset, elt;
528 struct font_info *fontp;
529 Lisp_Object family_registry;
530
531 elt = Qnil;
532 if (fontset_id_valid_p (id))
533 {
534 fontset = FONTSET_FROM_ID (id);
535 xassert (!BASE_FONTSET_P (fontset));
536 fontset = FONTSET_BASE (fontset);
537 elt = FONTSET_REF (fontset, c);
538 }
11d9bd93 539 if (NILP (elt))
0d407d77
KH
540 elt = FONTSET_REF (Vdefault_fontset, c);
541
542 if (!CONSP (elt))
543 return Qnil;
544 if (CONSP (XCDR (elt)))
545 return XCDR (elt);
546
547 /* The fontset specifies only a font name pattern (not cons of
548 family and registry). Try to open a font by that pattern and get
549 a registry from the full name of the opened font. We ignore
550 family name here because it should be wild card in the fontset
551 specification. */
552 elt = XCDR (elt);
553 xassert (STRINGP (elt));
554 fontp = FS_LOAD_FONT (f, c, XSTRING (elt)->data, -1);
555 if (!fontp)
556 return Qnil;
4ed46869 557
0d407d77
KH
558 family_registry = font_family_registry (build_string (fontp->full_name));
559 if (!CONSP (family_registry))
560 return family_registry;
561 XCAR (family_registry) = Qnil;
562 return family_registry;
4ed46869
KH
563}
564
d5e7d534 565
0d407d77
KH
566/* Load a font named FONTNAME to display character C on frame F.
567 Return a pointer to the struct font_info of the loaded font. If
568 loading fails, return NULL. If FACE is non-zero and a fontset is
569 assigned to it, record FACE->id in the fontset for C. If FONTNAME
570 is NULL, the name is taken from the fontset of FACE or what
571 specified by ID. */
4ed46869
KH
572
573struct font_info *
0d407d77 574fs_load_font (f, c, fontname, id, face)
4ed46869 575 FRAME_PTR f;
0d407d77 576 int c;
4ed46869 577 char *fontname;
0d407d77
KH
578 int id;
579 struct face *face;
4ed46869 580{
0d407d77 581 Lisp_Object fontset;
4ed46869
KH
582 Lisp_Object list, elt;
583 int font_idx;
584 int size = 0;
4ed46869 585 struct font_info *fontp;
0d407d77
KH
586 int charset = CHAR_CHARSET (c);
587
588 if (face)
589 id = face->fontset;
590 if (id < 0)
591 fontset = Qnil;
592 else
593 fontset = FONTSET_FROM_ID (id);
4ed46869 594
0d407d77
KH
595 if (!NILP (fontset)
596 && !BASE_FONTSET_P (fontset))
4ed46869 597 {
0d407d77
KH
598 elt = FONTSET_REF_VIA_BASE (fontset, c);
599 if (!NILP (elt))
600 {
601 /* A suitable face for C is already recorded, which means
602 that a proper font is already loaded. */
603 int face_id = XINT (elt);
4ed46869 604
0d407d77
KH
605 xassert (face_id == face->id);
606 face = FACE_FROM_ID (f, face_id);
607 return (*get_font_info_func) (f, face->font_info_id);
608 }
4ed46869 609
0d407d77 610 if (!fontname && charset == CHARSET_ASCII)
afbee0fa 611 {
0d407d77
KH
612 elt = FONTSET_ASCII (fontset);
613 fontname = XSTRING (XCDR (elt))->data;
afbee0fa 614 }
afbee0fa 615 }
4ed46869 616
0d407d77
KH
617 if (!fontname)
618 /* No way to get fontname. */
619 return 0;
4ed46869 620
0d407d77 621 fontp = (*load_font_func) (f, fontname, size);
4ed46869 622 if (!fontp)
0d407d77 623 return 0;
4ed46869 624
0d407d77
KH
625 /* Fill in members (charset, vertical_centering, encoding, etc) of
626 font_info structure that are not set by (*load_font_func). */
4ed46869
KH
627 fontp->charset = charset;
628
810abb87
KH
629 fontp->vertical_centering
630 = (STRINGP (Vvertical_centering_font_regexp)
631 && (fast_c_string_match_ignore_case
632 (Vvertical_centering_font_regexp, fontp->full_name) >= 0));
633
afbee0fa 634 if (fontp->encoding[1] != FONT_ENCODING_NOT_DECIDED)
4ed46869
KH
635 {
636 /* The font itself tells which code points to be used. Use this
637 encoding for all other charsets. */
638 int i;
639
640 fontp->encoding[0] = fontp->encoding[1];
467e7675 641 for (i = MIN_CHARSET_OFFICIAL_DIMENSION1; i <= MAX_CHARSET; i++)
4ed46869
KH
642 fontp->encoding[i] = fontp->encoding[1];
643 }
644 else
645 {
0d407d77 646 /* The font itself doesn't have information about encoding. */
4ed46869
KH
647 int i;
648
40292c8a
KH
649 fontname = fontp->full_name;
650 /* By default, encoding of ASCII chars is 0 (i.e. 0x00..0x7F),
651 others is 1 (i.e. 0x80..0xFF). */
652 fontp->encoding[0] = 0;
467e7675 653 for (i = MIN_CHARSET_OFFICIAL_DIMENSION1; i <= MAX_CHARSET; i++)
4ed46869
KH
654 fontp->encoding[i] = 1;
655 /* Then override them by a specification in Vfont_encoding_alist. */
7539e11f 656 for (list = Vfont_encoding_alist; CONSP (list); list = XCDR (list))
4ed46869 657 {
7539e11f 658 elt = XCAR (list);
4ed46869 659 if (CONSP (elt)
7539e11f
KR
660 && STRINGP (XCAR (elt)) && CONSP (XCDR (elt))
661 && (fast_c_string_match_ignore_case (XCAR (elt), fontname)
4ed46869
KH
662 >= 0))
663 {
664 Lisp_Object tmp;
665
7539e11f
KR
666 for (tmp = XCDR (elt); CONSP (tmp); tmp = XCDR (tmp))
667 if (CONSP (XCAR (tmp))
668 && ((i = get_charset_id (XCAR (XCAR (tmp))))
4ed46869 669 >= 0)
7539e11f
KR
670 && INTEGERP (XCDR (XCAR (tmp)))
671 && XFASTINT (XCDR (XCAR (tmp))) < 4)
4ed46869 672 fontp->encoding[i]
7539e11f 673 = XFASTINT (XCDR (XCAR (tmp)));
4ed46869
KH
674 }
675 }
676 }
677
678 fontp->font_encoder = (struct ccl_program *) 0;
727fb790
KH
679
680 if (find_ccl_program_func)
681 (*find_ccl_program_func) (fontp);
4ed46869 682
1ff005e1
KH
683 /* If we loaded a font for a face that has fontset, record the face
684 ID in the fontset for C. */
685 if (face
686 && !NILP (fontset)
687 && !BASE_FONTSET_P (fontset))
688 FONTSET_SET (fontset, c, make_number (face->id));
4ed46869
KH
689 return fontp;
690}
691
0d407d77 692\f
4ed46869
KH
693/* Cache data used by fontset_pattern_regexp. The car part is a
694 pattern string containing at least one wild card, the cdr part is
695 the corresponding regular expression. */
696static Lisp_Object Vcached_fontset_data;
697
7539e11f
KR
698#define CACHED_FONTSET_NAME (XSTRING (XCAR (Vcached_fontset_data))->data)
699#define CACHED_FONTSET_REGEX (XCDR (Vcached_fontset_data))
4ed46869
KH
700
701/* If fontset name PATTERN contains any wild card, return regular
702 expression corresponding to PATTERN. */
703
0d407d77 704static Lisp_Object
4ed46869
KH
705fontset_pattern_regexp (pattern)
706 Lisp_Object pattern;
707{
4ed46869
KH
708 if (!index (XSTRING (pattern)->data, '*')
709 && !index (XSTRING (pattern)->data, '?'))
710 /* PATTERN does not contain any wild cards. */
1c283e35 711 return Qnil;
4ed46869
KH
712
713 if (!CONSP (Vcached_fontset_data)
714 || strcmp (XSTRING (pattern)->data, CACHED_FONTSET_NAME))
715 {
716 /* We must at first update the cached data. */
1c283e35 717 char *regex = (char *) alloca (XSTRING (pattern)->size * 2);
4ed46869
KH
718 char *p0, *p1 = regex;
719
1c283e35
KH
720 /* Convert "*" to ".*", "?" to ".". */
721 *p1++ = '^';
ea5239ec 722 for (p0 = (char *) XSTRING (pattern)->data; *p0; p0++)
4ed46869 723 {
1c283e35 724 if (*p0 == '*')
4ed46869 725 {
1c283e35
KH
726 *p1++ = '.';
727 *p1++ = '*';
4ed46869 728 }
1c283e35 729 else if (*p0 == '?')
d96d677d 730 *p1++ = '.';
1c283e35
KH
731 else
732 *p1++ = *p0;
4ed46869
KH
733 }
734 *p1++ = '$';
735 *p1++ = 0;
736
737 Vcached_fontset_data = Fcons (build_string (XSTRING (pattern)->data),
738 build_string (regex));
739 }
740
741 return CACHED_FONTSET_REGEX;
742}
743
0d407d77
KH
744/* Return ID of the base fontset named NAME. If there's no such
745 fontset, return -1. */
746
747int
748fs_query_fontset (name, regexpp)
749 Lisp_Object name;
750 int regexpp;
751{
752 Lisp_Object fontset, tem;
753 int i;
754
755 name = Fdowncase (name);
756 if (!regexpp)
757 {
758 tem = Frassoc (name, Vfontset_alias_alist);
759 if (CONSP (tem) && STRINGP (XCAR (tem)))
760 name = XCAR (tem);
761 else
762 {
763 tem = fontset_pattern_regexp (name);
764 if (STRINGP (tem))
765 {
766 name = tem;
767 regexpp = 1;
768 }
769 }
770 }
771
772 for (i = 0; i < ASIZE (Vfontset_table); i++)
773 {
774 Lisp_Object fontset;
775 unsigned char *this_name;
776
777 fontset = FONTSET_FROM_ID (i);
778 if (NILP (fontset)
779 || !BASE_FONTSET_P (fontset))
780 continue;
781
782 this_name = XSTRING (FONTSET_NAME (fontset))->data;
783 if (regexpp
784 ? fast_c_string_match_ignore_case (name, this_name) >= 0
785 : !strcmp (XSTRING (name)->data, this_name))
786 return i;
787 }
788 return -1;
789}
790
791
727fb790 792DEFUN ("query-fontset", Fquery_fontset, Squery_fontset, 1, 2, 0,
0d407d77 793 "Return the name of a fontset that matches PATTERN.\n\
9af3dc47
RS
794The value is nil if there is no matching fontset.\n\
795PATTERN can contain `*' or `?' as a wildcard\n\
796just as X font name matching algorithm allows.\n\
797If REGEXPP is non-nil, PATTERN is a regular expression.")
727fb790
KH
798 (pattern, regexpp)
799 Lisp_Object pattern, regexpp;
4ed46869 800{
0d407d77
KH
801 Lisp_Object fontset;
802 int id;
4ed46869
KH
803
804 (*check_window_system_func) ();
805
806 CHECK_STRING (pattern, 0);
807
808 if (XSTRING (pattern)->size == 0)
809 return Qnil;
810
0d407d77
KH
811 id = fs_query_fontset (pattern, !NILP (regexpp));
812 if (id < 0)
813 return Qnil;
4ed46869 814
0d407d77
KH
815 fontset = FONTSET_FROM_ID (id);
816 return FONTSET_NAME (fontset);
4ed46869
KH
817}
818
0d407d77
KH
819/* Return a list of base fontset names matching PATTERN on frame F.
820 If SIZE is not 0, it is the size (maximum bound width) of fontsets
821 to be listed. */
4ed46869
KH
822
823Lisp_Object
824list_fontsets (f, pattern, size)
825 FRAME_PTR f;
826 Lisp_Object pattern;
827 int size;
828{
0d407d77
KH
829 Lisp_Object frame, regexp, val, tail;
830 int id;
4ed46869 831
0d407d77 832 XSETFRAME (frame, f);
4ed46869 833
0d407d77 834 regexp = fontset_pattern_regexp (pattern);
4ed46869 835 val = Qnil;
4ed46869 836
0d407d77
KH
837 for (id = 0; id < ASIZE (Vfontset_table); id++)
838 {
839 Lisp_Object fontset;
840 unsigned char *name;
841
842 fontset = FONTSET_FROM_ID (id);
843 if (NILP (fontset)
844 || !BASE_FONTSET_P (fontset)
845 || !EQ (frame, FONTSET_FRAME (fontset)))
846 continue;
847 name = XSTRING (FONTSET_NAME (fontset))->data;
848
849 if (!NILP (regexp)
850 ? (fast_c_string_match_ignore_case (regexp, name) < 0)
851 : strcmp (XSTRING (pattern)->data, name))
852 continue;
853
854 if (size)
4ed46869 855 {
0d407d77
KH
856 struct font_info *fontp;
857 fontp = FS_LOAD_FONT (f, 0, NULL, id);
858 if (!fontp || size != fontp->size)
859 continue;
4ed46869 860 }
0d407d77 861 val = Fcons (Fcopy_sequence (FONTSET_NAME (fontset)), val);
4ed46869
KH
862 }
863
864 return val;
865}
866
867DEFUN ("new-fontset", Fnew_fontset, Snew_fontset, 2, 2, 0,
0d407d77
KH
868 "Create a new fontset NAME that contains font information in FONTLIST.\n\
869FONTLIST is an alist of charsets vs corresponding font name patterns.")
4ed46869
KH
870 (name, fontlist)
871 Lisp_Object name, fontlist;
872{
0d407d77
KH
873 Lisp_Object fontset, elements, ascii_font;
874 Lisp_Object tem, tail, elt;
4ed46869
KH
875
876 (*check_window_system_func) ();
877
878 CHECK_STRING (name, 0);
879 CHECK_LIST (fontlist, 1);
880
0d407d77
KH
881 name = Fdowncase (name);
882 tem = Fquery_fontset (name, Qnil);
883 if (!NILP (tem))
9af3dc47 884 error ("Fontset `%s' matches the existing fontset `%s'",
0d407d77 885 XSTRING (name)->data, XSTRING (tem)->data);
4ed46869 886
0d407d77
KH
887 /* Check the validity of FONTLIST while creating a template for
888 fontset elements. */
889 elements = ascii_font = Qnil;
7539e11f 890 for (tail = fontlist; CONSP (tail); tail = XCDR (tail))
4ed46869 891 {
0d407d77
KH
892 Lisp_Object family, registry;
893 int c, charset;
4ed46869 894
0d407d77 895 tem = XCAR (tail);
4ed46869 896 if (!CONSP (tem)
7539e11f
KR
897 || (charset = get_charset_id (XCAR (tem))) < 0
898 || !STRINGP (XCDR (tem)))
4ed46869 899 error ("Elements of fontlist must be a cons of charset and font name");
0d407d77
KH
900
901 tem = Fdowncase (XCDR (tem));
902 if (charset == CHARSET_ASCII)
903 ascii_font = tem;
904 else
905 {
906 c = MAKE_CHAR (charset, 0, 0);
907 elements = Fcons (Fcons (make_number (c), tem), elements);
908 }
4ed46869
KH
909 }
910
0d407d77
KH
911 if (NILP (ascii_font))
912 error ("No ASCII font in the fontlist");
4ed46869 913
0d407d77
KH
914 fontset = make_fontset (Qnil, name, Qnil);
915 FONTSET_ASCII (fontset) = Fcons (make_number (0), ascii_font);
916 for (; CONSP (elements); elements = XCDR (elements))
917 {
918 elt = XCAR (elements);
919 tem = Fcons (XCAR (elt), font_family_registry (XCDR (elt)));
920 FONTSET_SET (fontset, XINT (XCAR (elt)), tem);
921 }
4ed46869
KH
922
923 return Qnil;
924}
925
4ed46869 926
0d407d77
KH
927/* Clear all elements of FONTSET for multibyte characters. */
928
929static void
930clear_fontset_elements (fontset)
931 Lisp_Object fontset;
4ed46869 932{
0d407d77 933 int i;
4ed46869 934
0d407d77
KH
935 for (i = CHAR_TABLE_SINGLE_BYTE_SLOTS; i < CHAR_TABLE_ORDINARY_SLOTS; i++)
936 XCHAR_TABLE (fontset)->contents[i] = Qnil;
937}
4ed46869 938
4ed46869 939
0d407d77
KH
940/* Check validity of NAME as a fontset name and return the
941 corresponding fontset. If not valid, signal an error.
942 If NAME is t, return Vdefault_fontset. */
943
944static Lisp_Object
945check_fontset_name (name)
946 Lisp_Object name;
947{
948 int id;
949
950 if (EQ (name, Qt))
951 return Vdefault_fontset;
4ed46869 952
0d407d77
KH
953 CHECK_STRING (name, 0);
954 id = fs_query_fontset (name, 0);
955 if (id < 0)
9af3dc47 956 error ("Fontset `%s' does not exist", XSTRING (name)->data);
0d407d77
KH
957 return FONTSET_FROM_ID (id);
958}
4ed46869 959
0d407d77 960DEFUN ("set-fontset-font", Fset_fontset_font, Sset_fontset_font, 3, 4, 0,
4ea5775b 961 "Modify fontset NAME to use FONTNAME for CHARACTER.\n\
755f47fe 962\n\
4ea5775b 963CHARACTER may be a cons; (FROM . TO), where FROM and TO are\n\
755f47fe
DL
964non-generic characters. In that case, use FONTNAME\n\
965for all characters in the range FROM and TO (inclusive).\n\
0890801b
KH
966CHARACTER may be a charset. In that case, use FONTNAME\n\
967for all character in the charsets.\n\
755f47fe 968\n\
8a9be3ac
KH
969FONTNAME may be a cons; (FAMILY . REGISTRY), where FAMILY is a family\n\
970name of a font, REGSITRY is a registry name of a font.")
4ea5775b
KH
971 (name, character, fontname, frame)
972 Lisp_Object name, character, fontname, frame;
0d407d77
KH
973{
974 Lisp_Object fontset, elt;
975 Lisp_Object realized;
976 int from, to;
977 int id;
8a9be3ac 978 Lisp_Object family, registry;
0d407d77
KH
979
980 fontset = check_fontset_name (name);
981
4ea5775b 982 if (CONSP (character))
0d407d77
KH
983 {
984 /* CH should be (FROM . TO) where FROM and TO are non-generic
985 characters. */
4ea5775b
KH
986 CHECK_NUMBER (XCAR (character), 1);
987 CHECK_NUMBER (XCDR (character), 1);
988 from = XINT (XCAR (character));
989 to = XINT (XCDR (character));
0d407d77
KH
990 if (!char_valid_p (from, 0) || !char_valid_p (to, 0))
991 error ("Character range should be by non-generic characters.");
992 if (!NILP (name)
993 && (SINGLE_BYTE_CHAR_P (from) || SINGLE_BYTE_CHAR_P (to)))
994 error ("Can't change font for a single byte character");
995 }
0890801b
KH
996 else if (SYMBOLP (character))
997 {
998 elt = Fget (character, Qcharset);
999 if (!VECTORP (elt) || ASIZE (elt) < 1 || !NATNUMP (AREF (elt, 0)))
1000 error ("Invalid charset: %s", (XSYMBOL (character)->name)->data);
1001 from = MAKE_CHAR (XINT (AREF (elt, 0)), 0, 0);
1002 to = from;
1003 }
0d407d77 1004 else
4ed46869 1005 {
4ea5775b
KH
1006 CHECK_NUMBER (character, 1);
1007 from = XINT (character);
0d407d77
KH
1008 to = from;
1009 }
1010 if (!char_valid_p (from, 1))
1011 invalid_character (from);
1012 if (SINGLE_BYTE_CHAR_P (from))
1013 error ("Can't change font for a single byte character");
1014 if (from < to)
1015 {
1016 if (!char_valid_p (to, 1))
1017 invalid_character (to);
1018 if (SINGLE_BYTE_CHAR_P (to))
1019 error ("Can't change font for a single byte character");
1020 }
4ed46869 1021
8a9be3ac 1022 if (STRINGP (fontname))
0d407d77 1023 {
8a9be3ac
KH
1024 fontname = Fdowncase (fontname);
1025 elt = Fcons (make_number (from), font_family_registry (fontname));
4ed46869 1026 }
0d407d77 1027 else
8a9be3ac
KH
1028 {
1029 CHECK_CONS (fontname, 2);
1030 family = XCAR (fontname);
1031 registry = XCDR (fontname);
1032 if (!NILP (family))
afe93d01
KH
1033 {
1034 CHECK_STRING (family, 2);
1035 family = Fdowncase (family);
1036 }
8a9be3ac 1037 if (!NILP (registry))
afe93d01
KH
1038 {
1039 CHECK_STRING (registry, 2);
1040 registry = Fdowncase (registry);
1041 }
8a9be3ac
KH
1042 elt = Fcons (make_number (from), Fcons (family, registry));
1043 }
0d407d77
KH
1044
1045 /* The arg FRAME is kept for backward compatibility. We only check
1046 the validity. */
1047 if (!NILP (frame))
1048 CHECK_LIVE_FRAME (frame, 3);
4ed46869 1049
0d407d77
KH
1050 for (; from <= to; from++)
1051 FONTSET_SET (fontset, from, elt);
1052 Foptimize_char_table (fontset);
4ed46869 1053
0d407d77
KH
1054 /* If there's a realized fontset REALIZED whose parent is FONTSET,
1055 clear all the elements of REALIZED and free all multibyte faces
1056 whose fontset is REALIZED. This way, the specified character(s)
1057 are surely redisplayed by a correct font. */
1058 for (id = 0; id < ASIZE (Vfontset_table); id++)
1059 {
1060 realized = AREF (Vfontset_table, id);
1061 if (!NILP (realized)
1062 && !BASE_FONTSET_P (realized)
1063 && EQ (FONTSET_BASE (realized), fontset))
4ed46869 1064 {
0d407d77
KH
1065 FRAME_PTR f = XFRAME (FONTSET_FRAME (realized));
1066 clear_fontset_elements (realized);
1067 free_realized_multibyte_face (f, id);
4ed46869 1068 }
0d407d77 1069 }
4ed46869
KH
1070
1071 return Qnil;
1072}
1073
1074DEFUN ("font-info", Ffont_info, Sfont_info, 1, 2, 0,
1075 "Return information about a font named NAME on frame FRAME.\n\
1076If FRAME is omitted or nil, use the selected frame.\n\
1077The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,\n\
6a7e6d80 1078 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,\n\
4ed46869
KH
1079where\n\
1080 OPENED-NAME is the name used for opening the font,\n\
1081 FULL-NAME is the full name of the font,\n\
0d407d77 1082 SIZE is the maximum bound width of the font,\n\
4ed46869
KH
1083 HEIGHT is the height of the font,\n\
1084 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,\n\
6a7e6d80
KH
1085 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling\n\
1086 how to compose characters.\n\
4ed46869
KH
1087If the named font is not yet loaded, return nil.")
1088 (name, frame)
1089 Lisp_Object name, frame;
1090{
1091 FRAME_PTR f;
1092 struct font_info *fontp;
1093 Lisp_Object info;
1094
1095 (*check_window_system_func) ();
1096
1097 CHECK_STRING (name, 0);
0d407d77 1098 name = Fdowncase (name);
4ed46869 1099 if (NILP (frame))
18f39d0e
GM
1100 frame = selected_frame;
1101 CHECK_LIVE_FRAME (frame, 1);
1102 f = XFRAME (frame);
4ed46869
KH
1103
1104 if (!query_font_func)
1105 error ("Font query function is not supported");
1106
1107 fontp = (*query_font_func) (f, XSTRING (name)->data);
1108 if (!fontp)
1109 return Qnil;
1110
0d407d77 1111 info = Fmake_vector (make_number (7), Qnil);
4ed46869
KH
1112
1113 XVECTOR (info)->contents[0] = build_string (fontp->name);
1114 XVECTOR (info)->contents[1] = build_string (fontp->full_name);
0d407d77
KH
1115 XVECTOR (info)->contents[2] = make_number (fontp->size);
1116 XVECTOR (info)->contents[3] = make_number (fontp->height);
1117 XVECTOR (info)->contents[4] = make_number (fontp->baseline_offset);
1118 XVECTOR (info)->contents[5] = make_number (fontp->relative_compose);
1119 XVECTOR (info)->contents[6] = make_number (fontp->default_ascent);
4ed46869
KH
1120
1121 return info;
1122}
1123
1ff005e1
KH
1124
1125/* Return the font name for the character at POSITION in the current
1126 buffer. This is computed from all the text properties and overlays
1127 that apply to POSITION. It returns nil in the following cases:
1128
1129 (1) The window system doesn't have a font for the character (thus
1130 it is displayed by an empty box).
1131
1132 (2) The character code is invalid.
1133
1134 (3) The current buffer is not displayed in any window.
1135
1136 In addition, the returned font name may not take into account of
1137 such redisplay engine hooks as what used in jit-lock-mode if
1138 POSITION is currently not visible. */
1139
1140
1141DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 1, 0,
1142 "For internal use only.")
1143 (position)
1144 Lisp_Object position;
1145{
1146 int pos, pos_byte, dummy;
1147 int face_id;
1148 int c;
1149 Lisp_Object window;
1150 struct window *w;
1151 struct frame *f;
1152 struct face *face;
1153
1154 CHECK_NUMBER_COERCE_MARKER (position, 0);
1155 pos = XINT (position);
1156 if (pos < BEGV || pos >= ZV)
1157 args_out_of_range_3 (position, make_number (BEGV), make_number (ZV));
1158 pos_byte = CHAR_TO_BYTE (pos);
1159 c = FETCH_CHAR (pos_byte);
1160 if (! CHAR_VALID_P (c, 0))
1161 return Qnil;
851ab85e 1162 window = Fget_buffer_window (Fcurrent_buffer (), Qnil);
1ff005e1
KH
1163 if (NILP (window))
1164 return Qnil;
1165 w = XWINDOW (window);
1166 f = XFRAME (w->frame);
1167 face_id = face_at_buffer_position (w, pos, -1, -1, &dummy, pos + 100, 0);
1168 face_id = FACE_FOR_CHAR (f, FACE_FROM_ID (f, face_id), c);
1169 face = FACE_FROM_ID (f, face_id);
1170 return (face->font && face->font_name
1171 ? build_string (face->font_name)
1172 : Qnil);
1173}
1174
1175
1176/* Called from Ffontset_info via map_char_table on each leaf of
1177 fontset. ARG is a list (LAST FONT-INFO ...), where LAST is `(last
1178 ARG)' and FONT-INFOs have this form:
1179 (CHAR FONT-SPEC) or ((FROM . TO) FONT-SPEC)
1180 The current leaf is indexed by CHARACTER and has value ELT. This
1181 function add the information of the current leaf to ARG by
1182 appending a new element or modifying the last element.. */
1183
1184static void
1185accumulate_font_info (arg, character, elt)
1186 Lisp_Object arg, character, elt;
1187{
1188 Lisp_Object last, last_char, last_elt, tmp;
1189
11d9bd93
KH
1190 if (!CONSP (elt) && !SINGLE_BYTE_CHAR_P (XINT (character)))
1191 elt = FONTSET_REF (Vdefault_fontset, XINT (character));
1ff005e1
KH
1192 if (!CONSP (elt))
1193 return;
1194 last = XCAR (arg);
1195 last_char = XCAR (XCAR (last));
1196 last_elt = XCAR (XCDR (XCAR (last)));
1197 elt = XCDR (elt);
1198 if (!NILP (Fequal (elt, last_elt)))
1199 {
1200 int this_charset = CHAR_CHARSET (XINT (character));
1201
1202 if (CONSP (last_char)) /* LAST_CHAR == (FROM . TO) */
1203 {
1204 if (this_charset == CHAR_CHARSET (XINT (XCAR (last_char))))
1205 {
1206 XCDR (last_char) = character;
1207 return;
1208 }
1209 }
11d9bd93
KH
1210 else if (XINT (last_char) == XINT (character))
1211 return;
1212 else if (this_charset == CHAR_CHARSET (XINT (last_char)))
1ff005e1 1213 {
11d9bd93
KH
1214 XCAR (XCAR (last)) = Fcons (last_char, character);
1215 return;
1ff005e1
KH
1216 }
1217 }
1218 XCDR (last) = Fcons (Fcons (character, Fcons (elt, Qnil)), Qnil);
1219 XCAR (arg) = XCDR (last);
1220}
1221
1222
4ed46869
KH
1223DEFUN ("fontset-info", Ffontset_info, Sfontset_info, 1, 2, 0,
1224 "Return information about a fontset named NAME on frame FRAME.\n\
a921395d
KH
1225The value is a vector:\n\
1226 [ SIZE HEIGHT ((CHARSET-OR-RANGE FONT-SPEC OPENED ...) ...) ],\n\
1ff005e1 1227where,\n\
a921395d
KH
1228 SIZE is the maximum bound width of ASCII font in the fontset,\n\
1229 HEIGHT is the maximum bound height of ASCII font in the fontset,\n\
63dffd51 1230 CHARSET-OR-RANGE is a charset, a character (may be a generic character)\n\
06e6aef0 1231 or a cons of two characters specifying the range of characters.\n\
1ff005e1
KH
1232 FONT-SPEC is a fontname pattern string or a cons (FAMILY . REGISTRY),\n\
1233 where FAMILY is a `FAMILY' field of a XLFD font name,\n\
1234 REGISTRY is a `CHARSET_REGISTRY' field of a XLDF font name.\n\
1235 FAMILY may contain a `FOUNDARY' field at the head.\n\
1236 REGISTRY may contain a `CHARSET_ENCODING' field at the tail.\n\
1237 OPENEDs are names of fonts actually opened.\n\
a921395d 1238If the ASCII font is not yet opened, SIZE and HEIGHT are 0.\n\
1ff005e1 1239If FRAME is omitted, it defaults to the currently selected frame.")
4ed46869
KH
1240 (name, frame)
1241 Lisp_Object name, frame;
1242{
1ff005e1 1243 Lisp_Object fontset;
4ed46869 1244 FRAME_PTR f;
1ff005e1
KH
1245 Lisp_Object indices[3];
1246 Lisp_Object val, tail, elt;
1247 Lisp_Object *realized;
a921395d 1248 struct font_info *fontp = NULL;
1ff005e1 1249 int n_realized = 0;
4ed46869
KH
1250 int i;
1251
1252 (*check_window_system_func) ();
1253
0d407d77
KH
1254 fontset = check_fontset_name (name);
1255
4ed46869 1256 if (NILP (frame))
18f39d0e
GM
1257 frame = selected_frame;
1258 CHECK_LIVE_FRAME (frame, 1);
1259 f = XFRAME (frame);
4ed46869 1260
11d9bd93 1261 /* Recode realized fontsets whose base is FONTSET in the table
1ff005e1
KH
1262 `realized'. */
1263 realized = (Lisp_Object *) alloca (sizeof (Lisp_Object)
1264 * ASIZE (Vfontset_table));
0d407d77
KH
1265 for (i = 0; i < ASIZE (Vfontset_table); i++)
1266 {
1ff005e1
KH
1267 elt = FONTSET_FROM_ID (i);
1268 if (!NILP (elt)
1269 && EQ (FONTSET_BASE (elt), fontset))
1270 realized[n_realized++] = elt;
0d407d77 1271 }
4ed46869 1272
1ff005e1
KH
1273 /* Accumulate information of the fontset in VAL. The format is
1274 (LAST FONT-INFO FONT-INFO ...), where FONT-INFO is (CHAR-OR-RANGE
1275 FONT-SPEC). See the comment for accumulate_font_info for the
1276 detail. */
1277 val = Fcons (Fcons (make_number (0),
1278 Fcons (XCDR (FONTSET_ASCII (fontset)), Qnil)),
0d407d77 1279 Qnil);
1ff005e1
KH
1280 val = Fcons (val, val);
1281 map_char_table (accumulate_font_info, Qnil, fontset, val, 0, indices);
1282 val = XCDR (val);
1283
1284 /* For each FONT-INFO, if CHAR_OR_RANGE (car part) is a generic
11d9bd93 1285 character for a charset, replace it with the charset symbol. If
1ff005e1
KH
1286 fonts are opened for FONT-SPEC, append the names of the fonts to
1287 FONT-SPEC. */
1288 for (tail = val; CONSP (tail); tail = XCDR (tail))
0d407d77 1289 {
1ff005e1
KH
1290 int c;
1291 elt = XCAR (tail);
1292 if (INTEGERP (XCAR (elt)))
0d407d77 1293 {
1ff005e1
KH
1294 int charset, c1, c2;
1295 c = XINT (XCAR (elt));
1296 SPLIT_CHAR (c, charset, c1, c2);
1297 if (c1 == 0)
1298 XCAR (elt) = CHARSET_SYMBOL (charset);
1299 }
1300 else
1301 c = XINT (XCAR (XCAR (elt)));
1302 for (i = 0; i < n_realized; i++)
1303 {
1304 Lisp_Object face_id, font;
0d407d77
KH
1305 struct face *face;
1306
1ff005e1
KH
1307 face_id = FONTSET_REF_VIA_BASE (realized[i], c);
1308 if (INTEGERP (face_id))
0d407d77 1309 {
1ff005e1
KH
1310 face = FACE_FROM_ID (f, XINT (face_id));
1311 if (face->font && face->font_name)
1312 {
1313 font = build_string (face->font_name);
1314 if (NILP (Fmember (font, XCDR (XCDR (elt)))))
1315 XCDR (XCDR (elt)) = Fcons (font, XCDR (XCDR (elt)));
1316 }
0d407d77 1317 }
0d407d77
KH
1318 }
1319 }
a921395d
KH
1320
1321 elt = Fcdr (Fcdr (Fassq (CHARSET_SYMBOL (CHARSET_ASCII), val)));
1322 if (CONSP (elt))
1323 {
1324 elt = XCAR (elt);
1325 fontp = (*query_font_func) (f, XSTRING (elt)->data);
1326 }
1327 val = Fmake_vector (make_number (3), val);
1328 AREF (val, 0) = fontp ? make_number (fontp->size) : make_number (0);
1329 AREF (val, 1) = fontp ? make_number (fontp->height) : make_number (0);
1330 return val;
4ed46869
KH
1331}
1332
0d407d77 1333DEFUN ("fontset-font", Ffontset_font, Sfontset_font, 2, 2, 0,
755f47fe 1334 "Return a font name pattern for character CH in fontset NAME.\n\
0d407d77
KH
1335If NAME is t, find a font name pattern in the default fontset.")
1336 (name, ch)
1337 Lisp_Object name, ch;
1338{
1339 int c, id;
1340 Lisp_Object fontset, elt;
1341
1342 fontset = check_fontset_name (name);
1343
1344 CHECK_NUMBER (ch, 1);
1345 c = XINT (ch);
1346 if (!char_valid_p (c, 1))
1347 invalid_character (c);
1348
1349 elt = FONTSET_REF (fontset, c);
1350 if (CONSP (elt))
1351 elt = XCDR (elt);
1352
1353 return elt;
1354}
1355
1356
1357DEFUN ("fontset-list", Ffontset_list, Sfontset_list, 0, 0, 0,
1358 "Return a list of all defined fontset names.")
1359 ()
1360{
1361 Lisp_Object fontset, list;
1362 int i;
1363
1364 list = Qnil;
1365 for (i = 0; i < ASIZE (Vfontset_table); i++)
1366 {
1367 fontset = FONTSET_FROM_ID (i);
1368 if (!NILP (fontset)
1369 && BASE_FONTSET_P (fontset))
1370 list = Fcons (FONTSET_NAME (fontset), list);
1371 }
1ff005e1 1372
0d407d77
KH
1373 return list;
1374}
1375
dfcf069d 1376void
4ed46869
KH
1377syms_of_fontset ()
1378{
1379 int i;
1380
4ed46869
KH
1381 if (!load_font_func)
1382 /* Window system initializer should have set proper functions. */
1383 abort ();
1384
6a7e6d80 1385 Qfontset = intern ("fontset");
4ed46869 1386 staticpro (&Qfontset);
0d407d77 1387 Fput (Qfontset, Qchar_table_extra_slots, make_number (3));
4ed46869
KH
1388
1389 Vcached_fontset_data = Qnil;
1390 staticpro (&Vcached_fontset_data);
1391
0d407d77
KH
1392 Vfontset_table = Fmake_vector (make_number (32), Qnil);
1393 staticpro (&Vfontset_table);
0d407d77
KH
1394
1395 Vdefault_fontset = Fmake_char_table (Qfontset, Qnil);
1396 staticpro (&Vdefault_fontset);
1ff005e1
KH
1397 FONTSET_ID (Vdefault_fontset) = make_number (0);
1398 FONTSET_NAME (Vdefault_fontset)
1399 = build_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default");
82d9a3b9 1400#if defined (macintosh)
1a578e9b
AC
1401 FONTSET_ASCII (Vdefault_fontset)
1402 = Fcons (make_number (0),
1403 build_string ("-apple-monaco-medium-r-*--*-120-*-*-*-*-mac-roman"));
82d9a3b9
JR
1404#elif defined (WINDOWSNT)
1405 FONTSET_ASCII (Vdefault_fontset)
1406 = Fcons (make_number (0),
842c80a3 1407 build_string ("-*-courier new-normal-r-*-*-*-100-*-*-*-*-iso8859-1"));
1a578e9b 1408#else
0d407d77 1409 FONTSET_ASCII (Vdefault_fontset)
afc125e1
KH
1410 = Fcons (make_number (0),
1411 build_string ("-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1"));
1a578e9b 1412#endif
1ff005e1
KH
1413 AREF (Vfontset_table, 0) = Vdefault_fontset;
1414 next_fontset_id = 1;
4ed46869
KH
1415
1416 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist,
1417 "Alist of fontname patterns vs corresponding encoding info.\n\
1418Each element looks like (REGEXP . ENCODING-INFO),\n\
1419 where ENCODING-INFO is an alist of CHARSET vs ENCODING.\n\
1420ENCODING is one of the following integer values:\n\
1421 0: code points 0x20..0x7F or 0x2020..0x7F7F are used,\n\
1422 1: code points 0xA0..0xFF or 0xA0A0..0xFFFF are used,\n\
1423 2: code points 0x20A0..0x7FFF are used,\n\
1424 3: code points 0xA020..0xFF7F are used.");
1425 Vfont_encoding_alist = Qnil;
1426
6a7e6d80 1427 DEFVAR_LISP ("use-default-ascent", &Vuse_default_ascent,
fc891591 1428 "Char table of characters whose ascent values should be ignored.\n\
6a7e6d80 1429If an entry for a character is non-nil, the ascent value of the glyph\n\
2aeafb78
KH
1430is assumed to be what specified by _MULE_DEFAULT_ASCENT property of a font.\n\
1431\n\
1432This affects how a composite character which contains\n\
1433such a character is displayed on screen.");
1434 Vuse_default_ascent = Qnil;
1435
1436 DEFVAR_LISP ("ignore-relative-composition", &Vignore_relative_composition,
1437 "Char table of characters which is not composed relatively.\n\
810abb87 1438If an entry for a character is non-nil, a composition sequence\n\
2aeafb78
KH
1439which contains that character is displayed so that\n\
1440the glyph of that character is put without considering\n\
1441an ascent and descent value of a previous character.");
810abb87 1442 Vignore_relative_composition = Qnil;
6a7e6d80 1443
01d4b817
KH
1444 DEFVAR_LISP ("alternate-fontname-alist", &Valternate_fontname_alist,
1445 "Alist of fontname vs list of the alternate fontnames.\n\
fc891591 1446When a specified font name is not found, the corresponding\n\
01d4b817
KH
1447alternate fontnames (if any) are tried instead.");
1448 Valternate_fontname_alist = Qnil;
8c83e4f9 1449
1c283e35
KH
1450 DEFVAR_LISP ("fontset-alias-alist", &Vfontset_alias_alist,
1451 "Alist of fontset names vs the aliases.");
1ff005e1
KH
1452 Vfontset_alias_alist = Fcons (Fcons (FONTSET_NAME (Vdefault_fontset),
1453 build_string ("fontset-default")),
1454 Qnil);
1c283e35 1455
ec3bb068
KH
1456 DEFVAR_LISP ("highlight-wrong-size-font", &Vhighlight_wrong_size_font,
1457 "*Non-nil means highlight characters shown in wrong size fonts somehow.\n\
1458The way to highlight them depends on window system on which Emacs runs.\n\
fc891591 1459On X11, a rectangle is shown around each such character.");
e3ee2a8a 1460 Vhighlight_wrong_size_font = Qnil;
ec3bb068
KH
1461
1462 DEFVAR_LISP ("clip-large-size-font", &Vclip_large_size_font,
fc891591 1463 "*Non-nil means characters shown in overlarge fonts are clipped.\n\
1c283e35 1464The height of clipping area is the same as that of an ASCII character.\n\
fc891591
RS
1465The width of the area is the same as that of an ASCII character,\n\
1466or twice as wide, depending on the character set's column-width.\n\
1c283e35 1467\n\
fc891591
RS
1468If the only font you have for a specific character set is too large,\n\
1469and clipping these characters makes them hard to read,\n\
1470you can set this variable to nil to display the characters without clipping.\n\
1471The drawback is that you will get some garbage left on your screen.");
ec3bb068
KH
1472 Vclip_large_size_font = Qt;
1473
810abb87
KH
1474 DEFVAR_LISP ("vertical-centering-font-regexp",
1475 &Vvertical_centering_font_regexp,
1476 "*Regexp matching font names that require vertical centering on display.\n\
1477When a character is displayed with such fonts, the character is displayed\n\
1478at the vertival center of lines.");
1479 Vvertical_centering_font_regexp = Qnil;
1480
4ed46869
KH
1481 defsubr (&Squery_fontset);
1482 defsubr (&Snew_fontset);
1483 defsubr (&Sset_fontset_font);
1484 defsubr (&Sfont_info);
1ff005e1 1485 defsubr (&Sinternal_char_font);
4ed46869 1486 defsubr (&Sfontset_info);
0d407d77
KH
1487 defsubr (&Sfontset_font);
1488 defsubr (&Sfontset_list);
4ed46869 1489}