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