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