Tweak to Makefile rules that list *.el files
[bpt/emacs.git] / src / fontset.c
CommitLineData
4ed46869 1/* Fontset handler.
95df8112 2
ab422c4d 3Copyright (C) 2001-2013 Free Software Foundation, Inc.
95df8112
GM
4Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
5 2005, 2006, 2007, 2008, 2009, 2010, 2011
6 National Institute of Advanced Industrial Science and Technology (AIST)
7 Registration Number H14PRO021
8Copyright (C) 2003, 2006
9 National Institute of Advanced Industrial Science and Technology (AIST)
10 Registration Number H13PRO009
eb152aa9 11
369314dc
KH
12This file is part of GNU Emacs.
13
9ec0b715 14GNU Emacs is free software: you can redistribute it and/or modify
369314dc 15it under the terms of the GNU General Public License as published by
9ec0b715
GM
16the Free Software Foundation, either version 3 of the License, or
17(at your option) any later version.
4ed46869 18
369314dc
KH
19GNU Emacs is distributed in the hope that it will be useful,
20but WITHOUT ANY WARRANTY; without even the implied warranty of
21MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22GNU General Public License for more details.
4ed46869 23
369314dc 24You should have received a copy of the GNU General Public License
9ec0b715 25along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
4ed46869
KH
26
27#include <config.h>
0d407d77 28#include <stdio.h>
0d407d77 29
4ed46869 30#include "lisp.h"
06f76f0d 31#include "blockinput.h"
06f76f0d 32#include "character.h"
e5560ff7 33#include "buffer.h"
4ed46869
KH
34#include "charset.h"
35#include "ccl.h"
2538fae4 36#include "keyboard.h"
4ed46869 37#include "frame.h"
0d407d77 38#include "dispextern.h"
e1a14cdc 39#include "intervals.h"
3541bb8f 40#include "fontset.h"
0d407d77 41#include "window.h"
92c15c34
KH
42#ifdef HAVE_X_WINDOWS
43#include "xterm.h"
44#endif
0fda9b75 45#ifdef HAVE_NTGUI
92c15c34
KH
46#include "w32term.h"
47#endif
edfda783
AR
48#ifdef HAVE_NS
49#include "nsterm.h"
50#endif
fa971ac3 51#include "termhooks.h"
0d407d77 52
8aa07a8d 53#include "font.h"
8aa07a8d 54
0d407d77
KH
55/* FONTSET
56
57 A fontset is a collection of font related information to give
1d5d7200
KH
58 similar appearance (style, etc) of characters. A fontset has two
59 roles. One is to use for the frame parameter `font' as if it is an
60 ASCII font. In that case, Emacs uses the font specified for
61 `ascii' script for the frame's default font.
62
63 Another role, the more important one, is to provide information
64 about which font to use for each non-ASCII character.
65
66 There are two kinds of fontsets; base and realized. A base fontset
67 is created by `new-fontset' from Emacs Lisp explicitly. A realized
68 fontset is created implicitly when a face is realized for ASCII
69 characters. A face is also realized for non-ASCII characters based
70 on an ASCII face. All of non-ASCII faces based on the same ASCII
71 face share the same realized fontset.
8f924df7 72
06f76f0d
KH
73 A fontset object is implemented by a char-table whose default value
74 and parent are always nil.
fc8865fc 75
1d5d7200
KH
76 An element of a base fontset is a vector of FONT-DEFs which itself
77 is a vector [ FONT-SPEC ENCODING REPERTORY ].
78
f088b054
KH
79 An element of a realized fontset is nil, t, 0, or a vector of this
80 form:
7e1a1cd9 81
581f7ac7
KH
82 [ CHARSET-ORDERED-LIST-TICK PREFERRED-RFONT-DEF
83 RFONT-DEF0 RFONT-DEF1 ... ]
0d407d77 84
7e1a1cd9 85 RFONT-DEFn (i.e. Realized FONT-DEF) has this form:
0d407d77 86
581f7ac7 87 [ FACE-ID FONT-DEF FONT-OBJECT SORTING-SCORE ]
0d407d77 88
581f7ac7 89 RFONT-DEFn are automatically reordered by the current charset
1d5d7200 90 priority list.
0d407d77 91
7e1a1cd9
KH
92 The value nil means that we have not yet generated the above vector
93 from the base of the fontset.
0d407d77 94
1d5d7200
KH
95 The value t means that no font is available for the corresponding
96 range of characters.
0d407d77 97
f088b054
KH
98 The value 0 means that no font is available for the corresponding
99 range of characters in this fontset, but may be available in the
100 default fontset.
101
0d407d77 102
eb36588a 103 A fontset has 9 extra slots.
0d407d77 104
1d5d7200 105 The 1st slot: the ID number of the fontset
0d407d77 106
1d5d7200
KH
107 The 2nd slot:
108 base: the name of the fontset
109 realized: nil
0d407d77 110
1d5d7200 111 The 3rd slot:
d6aaac9e 112 base: nil
1d5d7200 113 realized: the base fontset
06f76f0d 114
1d5d7200
KH
115 The 4th slot:
116 base: nil
117 realized: the frame that the fontset belongs to
0d407d77 118
1d5d7200
KH
119 The 5th slot:
120 base: the font name for ASCII characters
121 realized: nil
0d407d77 122
1d5d7200
KH
123 The 6th slot:
124 base: nil
125 realized: the ID number of a face to use for characters that
126 has no font in a realized fontset.
0d407d77 127
1d5d7200
KH
128 The 7th slot:
129 base: nil
130 realized: Alist of font index vs the corresponding repertory
131 char-table.
eb152aa9 132
d6aaac9e
KH
133 The 8th slot:
134 base: nil
135 realized: If the base is not the default fontset, a fontset
136 realized from the default fontset, else nil.
1d5d7200 137
eb36588a 138 The 9th slot:
cc7b6145
KH
139 base: Same as element value (but for fallback fonts).
140 realized: Likewise.
eb36588a 141
1d5d7200 142 All fontsets are recorded in the vector Vfontset_table.
0d407d77
KH
143
144
145 DEFAULT FONTSET
146
1d5d7200
KH
147 There's a special base fontset named `default fontset' which
148 defines the default font specifications. When a base fontset
149 doesn't specify a font for a specific character, the corresponding
150 value in the default fontset is used.
0d407d77 151
afe93d01
KH
152 The parent of a realized fontset created for such a face that has
153 no fontset is the default fontset.
0d407d77
KH
154
155
156 These structures are hidden from the other codes than this file.
157 The other codes handle fontsets only by their ID numbers. They
06f76f0d 158 usually use the variable name `fontset' for IDs. But, in this
c80e3b4a 159 file, we always use variable name `id' for IDs, and name `fontset'
1d5d7200 160 for an actual fontset object, i.e., char-table.
0d407d77
KH
161
162*/
163
164/********** VARIABLES and FUNCTION PROTOTYPES **********/
165
d6aaac9e
KH
166static Lisp_Object Qfontset;
167static Lisp_Object Qfontset_info;
1d5d7200 168static Lisp_Object Qprepend, Qappend;
ef6e0694 169Lisp_Object Qlatin;
0d407d77
KH
170
171/* Vector containing all fontsets. */
172static Lisp_Object Vfontset_table;
173
fc8865fc 174/* Next possibly free fontset ID. Usually this keeps the minimum
0d407d77
KH
175 fontset ID not yet used. */
176static int next_fontset_id;
177
178/* The default fontset. This gives default FAMILY and REGISTRY of
06f76f0d 179 font for each character. */
0d407d77 180static Lisp_Object Vdefault_fontset;
4ed46869 181
0d407d77 182/* Prototype declarations for static functions. */
f57e2426 183static Lisp_Object make_fontset (Lisp_Object, Lisp_Object, Lisp_Object);
2449d4d0 184
a864ef14 185/* Return true if ID is a valid fontset id.
e509cfa6 186 Optimized away if ENABLE_CHECKING is not defined. */
556383ac 187
a864ef14 188static bool
ef1b0ba7 189fontset_id_valid_p (int id)
556383ac
KH
190{
191 return (id >= 0 && id < ASIZE (Vfontset_table) - 1);
192}
193
0d407d77
KH
194
195\f
196/********** MACROS AND FUNCTIONS TO HANDLE FONTSET **********/
197
0d407d77
KH
198/* Return the fontset with ID. No check of ID's validness. */
199#define FONTSET_FROM_ID(id) AREF (Vfontset_table, id)
200
d0d2d26f 201/* Access special values of FONTSET. */
6d470bdd
DA
202
203#define FONTSET_ID(fontset) XCHAR_TABLE (fontset)->extras[0]
d0d2d26f
PE
204static void
205set_fontset_id (Lisp_Object fontset, Lisp_Object id)
206{
207 set_char_table_extras (fontset, 0, id);
208}
06f76f0d 209
d0d2d26f 210/* Access special values of (base) FONTSET. */
6d470bdd
DA
211
212#define FONTSET_NAME(fontset) XCHAR_TABLE (fontset)->extras[1]
d0d2d26f
PE
213static void
214set_fontset_name (Lisp_Object fontset, Lisp_Object name)
215{
216 set_char_table_extras (fontset, 1, name);
217}
6d470bdd
DA
218
219#define FONTSET_ASCII(fontset) XCHAR_TABLE (fontset)->extras[4]
d0d2d26f
PE
220static void
221set_fontset_ascii (Lisp_Object fontset, Lisp_Object ascii)
222{
223 set_char_table_extras (fontset, 4, ascii);
224}
06f76f0d 225
d0d2d26f 226/* Access special values of (realized) FONTSET. */
6d470bdd
DA
227
228#define FONTSET_BASE(fontset) XCHAR_TABLE (fontset)->extras[2]
d0d2d26f
PE
229static void
230set_fontset_base (Lisp_Object fontset, Lisp_Object base)
231{
232 set_char_table_extras (fontset, 2, base);
233}
6d470bdd
DA
234
235#define FONTSET_FRAME(fontset) XCHAR_TABLE (fontset)->extras[3]
d0d2d26f
PE
236static void
237set_fontset_frame (Lisp_Object fontset, Lisp_Object frame)
238{
239 set_char_table_extras (fontset, 3, frame);
240}
6d470bdd
DA
241
242#define FONTSET_NOFONT_FACE(fontset) XCHAR_TABLE (fontset)->extras[5]
d0d2d26f
PE
243static void
244set_fontset_nofont_face (Lisp_Object fontset, Lisp_Object face)
245{
246 set_char_table_extras (fontset, 5, face);
247}
6d470bdd
DA
248
249#define FONTSET_DEFAULT(fontset) XCHAR_TABLE (fontset)->extras[7]
d0d2d26f
PE
250static void
251set_fontset_default (Lisp_Object fontset, Lisp_Object def)
252{
253 set_char_table_extras (fontset, 7, def);
254}
eb36588a 255
cc7b6145 256/* For both base and realized fontset. */
0d407d77 257
6d470bdd 258#define FONTSET_FALLBACK(fontset) XCHAR_TABLE (fontset)->extras[8]
d0d2d26f
PE
259static void
260set_fontset_fallback (Lisp_Object fontset, Lisp_Object fallback)
261{
262 set_char_table_extras (fontset, 8, fallback);
263}
0d407d77 264
6d470bdd 265#define BASE_FONTSET_P(fontset) (NILP (FONTSET_BASE (fontset)))
0d407d77 266
581f7ac7
KH
267/* Macros for FONT-DEF and RFONT-DEF of fontset. */
268#define FONT_DEF_NEW(font_def, font_spec, encoding, repertory) \
269 do { \
25721f5b
DA
270 (font_def) = make_uninit_vector (3); \
271 ASET ((font_def), 0, font_spec); \
581f7ac7
KH
272 ASET ((font_def), 1, encoding); \
273 ASET ((font_def), 2, repertory); \
274 } while (0)
275
276#define FONT_DEF_SPEC(font_def) AREF (font_def, 0)
277#define FONT_DEF_ENCODING(font_def) AREF (font_def, 1)
278#define FONT_DEF_REPERTORY(font_def) AREF (font_def, 2)
279
280#define RFONT_DEF_FACE(rfont_def) AREF (rfont_def, 0)
281#define RFONT_DEF_SET_FACE(rfont_def, face_id) \
282 ASET ((rfont_def), 0, make_number (face_id))
283#define RFONT_DEF_FONT_DEF(rfont_def) AREF (rfont_def, 1)
284#define RFONT_DEF_SPEC(rfont_def) FONT_DEF_SPEC (AREF (rfont_def, 1))
581f7ac7
KH
285#define RFONT_DEF_OBJECT(rfont_def) AREF (rfont_def, 2)
286#define RFONT_DEF_SET_OBJECT(rfont_def, object) \
287 ASET ((rfont_def), 2, (object))
9dfdbc0a
KH
288/* Score of RFONT_DEF is an integer value; the lowest 8 bits represent
289 the order of listing by font backends, the higher bits represents
290 the order given by charset priority list. The smaller value is
291 preferable. */
581f7ac7
KH
292#define RFONT_DEF_SCORE(rfont_def) XINT (AREF (rfont_def, 3))
293#define RFONT_DEF_SET_SCORE(rfont_def, score) \
294 ASET ((rfont_def), 3, make_number (score))
295#define RFONT_DEF_NEW(rfont_def, font_def) \
296 do { \
297 (rfont_def) = Fmake_vector (make_number (4), Qnil); \
6d470bdd 298 ASET ((rfont_def), 1, (font_def)); \
581f7ac7
KH
299 RFONT_DEF_SET_SCORE ((rfont_def), 0); \
300 } while (0)
301
302
1d5d7200
KH
303/* Return the element of FONTSET for the character C. If FONTSET is a
304 base fontset other then the default fontset and FONTSET doesn't
305 contain information for C, return the information in the default
306 fontset. */
0d407d77 307
1d5d7200
KH
308#define FONTSET_REF(fontset, c) \
309 (EQ (fontset, Vdefault_fontset) \
310 ? CHAR_TABLE_REF (fontset, c) \
311 : fontset_ref ((fontset), (c)))
0d407d77 312
afe93d01 313static Lisp_Object
971de7fb 314fontset_ref (Lisp_Object fontset, int c)
0d407d77 315{
06f76f0d
KH
316 Lisp_Object elt;
317
1d5d7200
KH
318 elt = CHAR_TABLE_REF (fontset, c);
319 if (NILP (elt) && ! EQ (fontset, Vdefault_fontset)
320 /* Don't check Vdefault_fontset for a realized fontset. */
321 && NILP (FONTSET_BASE (fontset)))
322 elt = CHAR_TABLE_REF (Vdefault_fontset, c);
0d407d77
KH
323 return elt;
324}
325
1d5d7200
KH
326/* Set elements of FONTSET for characters in RANGE to the value ELT.
327 RANGE is a cons (FROM . TO), where FROM and TO are character codes
328 specifying a range. */
329
330#define FONTSET_SET(fontset, range, elt) \
331 Fset_char_table_range ((fontset), (range), (elt))
332
0d407d77 333
1d5d7200 334/* Modify the elements of FONTSET for characters in RANGE by replacing
6bad8007 335 with ELT or adding ELT. RANGE is a cons (FROM . TO), where FROM
1d5d7200
KH
336 and TO are character codes specifying a range. If ADD is nil,
337 replace with ELT, if ADD is `prepend', prepend ELT, otherwise,
338 append ELT. */
339
6d470bdd
DA
340#define FONTSET_ADD(fontset, range, elt, add) \
341 (NILP (add) \
342 ? (NILP (range) \
d0d2d26f 343 ? (set_fontset_fallback \
6d470bdd 344 (fontset, Fmake_vector (make_number (1), (elt)))) \
d733ec6d
PE
345 : ((void) \
346 Fset_char_table_range (fontset, range, \
347 Fmake_vector (make_number (1), elt)))) \
1d5d7200 348 : fontset_add ((fontset), (range), (elt), (add)))
0d407d77 349
d733ec6d 350static void
971de7fb 351fontset_add (Lisp_Object fontset, Lisp_Object range, Lisp_Object elt, Lisp_Object add)
06f76f0d 352{
eb36588a
KH
353 Lisp_Object args[2];
354 int idx = (EQ (add, Qappend) ? 0 : 1);
355
356 args[1 - idx] = Fmake_vector (make_number (1), elt);
357
358 if (CONSP (range))
359 {
360 int from = XINT (XCAR (range));
361 int to = XINT (XCDR (range));
362 int from1, to1;
363
364 do {
5b30be1a 365 from1 = from, to1 = to;
eb36588a 366 args[idx] = char_table_ref_and_range (fontset, from, &from1, &to1);
eb36588a
KH
367 char_table_set_range (fontset, from, to1,
368 NILP (args[idx]) ? args[1 - idx]
369 : Fvconcat (2, args));
370 from = to1 + 1;
371 } while (from < to);
372 }
373 else
374 {
375 args[idx] = FONTSET_FALLBACK (fontset);
d0d2d26f 376 set_fontset_fallback
6d470bdd 377 (fontset, NILP (args[idx]) ? args[1 - idx] : Fvconcat (2, args));
eb36588a 378 }
1d5d7200
KH
379}
380
581f7ac7 381static int
971de7fb 382fontset_compare_rfontdef (const void *val1, const void *val2)
581f7ac7 383{
41ad6003
KH
384 return (RFONT_DEF_SCORE (*(Lisp_Object *) val1)
385 - RFONT_DEF_SCORE (*(Lisp_Object *) val2));
581f7ac7 386}
1d5d7200 387
ea0162a6 388/* Update FONT-GROUP which has this form:
581f7ac7
KH
389 [ CHARSET-ORDERED-LIST-TICK PREFERRED-RFONT-DEF
390 RFONT-DEF0 RFONT-DEF1 ... ]
20746fe4 391 Reorder RFONT-DEFs according to the current language, and update
581f7ac7
KH
392 CHARSET-ORDERED-LIST-TICK.
393
394 If PREFERRED_FAMILY is not nil, that family has the higher priority
395 if the encoding charsets or languages in font-specs are the same. */
396
0d407d77 397static void
971de7fb 398reorder_font_vector (Lisp_Object font_group, struct font *font)
1d5d7200 399{
41ad6003 400 Lisp_Object vec, font_object;
1d5d7200 401 int size;
581f7ac7 402 int i;
a864ef14 403 bool score_changed = 0;
1d5d7200 404
41ad6003
KH
405 if (font)
406 XSETFONT (font_object, font);
407 else
408 font_object = Qnil;
409
410 vec = XCDR (font_group);
411 size = ASIZE (vec);
412 /* Exclude the tailing nil element from the reordering. */
413 if (NILP (AREF (vec, size - 1)))
414 size--;
581f7ac7
KH
415
416 for (i = 0; i < size; i++)
6bad8007 417 {
41ad6003 418 Lisp_Object rfont_def = AREF (vec, i);
581f7ac7
KH
419 Lisp_Object font_def = RFONT_DEF_FONT_DEF (rfont_def);
420 Lisp_Object font_spec = FONT_DEF_SPEC (font_def);
41ad6003 421 int score = RFONT_DEF_SCORE (rfont_def) & 0xFF;
9dfdbc0a 422 Lisp_Object otf_spec = Ffont_get (font_spec, QCotf);
581f7ac7 423
9dfdbc0a
KH
424 if (! NILP (otf_spec))
425 /* A font-spec with :otf is preferable regardless of encoding
426 and language.. */
427 ;
428 else if (! font_match_p (font_spec, font_object))
eb152aa9 429 {
cd872f08 430 Lisp_Object encoding = FONT_DEF_ENCODING (font_def);
581f7ac7 431
cd872f08 432 if (! NILP (encoding))
41ad6003
KH
433 {
434 Lisp_Object tail;
581f7ac7 435
41ad6003
KH
436 for (tail = Vcharset_ordered_list;
437 ! EQ (tail, Vcharset_non_preferred_head) && CONSP (tail);
d311d28c 438 tail = XCDR (tail))
cd872f08 439 if (EQ (encoding, XCAR (tail)))
41ad6003 440 break;
2972b14b 441 else if (score <= min (INT_MAX, MOST_POSITIVE_FIXNUM) - 0x100)
d311d28c 442 score += 0x100;
41ad6003
KH
443 }
444 else
445 {
446 Lisp_Object lang = Ffont_get (font_spec, QClang);
447
448 if (! NILP (lang)
449 && ! EQ (lang, Vcurrent_iso639_language)
450 && (! CONSP (Vcurrent_iso639_language)
451 || NILP (Fmemq (lang, Vcurrent_iso639_language))))
452 score |= 0x100;
453 }
ea0162a6 454 }
581f7ac7 455 if (RFONT_DEF_SCORE (rfont_def) != score)
ea0162a6 456 {
581f7ac7
KH
457 RFONT_DEF_SET_SCORE (rfont_def, score);
458 score_changed = 1;
ea0162a6 459 }
6bad8007 460 }
1d5d7200 461
581f7ac7 462 if (score_changed)
663e2b3f 463 qsort (XVECTOR (vec)->contents, size, word_size,
581f7ac7 464 fontset_compare_rfontdef);
41ad6003
KH
465 XSETCAR (font_group, make_number (charset_ordered_list_tick));
466}
467
f084f942
KH
468/* Return a font-group (actually a cons (-1 . FONT-GROUP-VECTOR)) for
469 character C in FONTSET. If C is -1, return a fallback font-group.
470 If C is not -1, the value may be Qt (FONTSET doesn't have a font
ea180610 471 for C even in the fallback group), or 0 (a font for C may be found
f084f942
KH
472 only in the fallback group). */
473
41ad6003 474static Lisp_Object
3cba9369 475fontset_get_font_group (Lisp_Object fontset, int c)
41ad6003
KH
476{
477 Lisp_Object font_group;
478 Lisp_Object base_fontset;
5b30be1a 479 int from = 0, to = MAX_CHAR, i;
28e2436a 480
a54e2c05 481 eassert (! BASE_FONTSET_P (fontset));
41ad6003
KH
482 if (c >= 0)
483 font_group = CHAR_TABLE_REF (fontset, c);
484 else
485 font_group = FONTSET_FALLBACK (fontset);
486 if (! NILP (font_group))
487 return font_group;
488 base_fontset = FONTSET_BASE (fontset);
ea180610
AS
489 if (NILP (base_fontset))
490 font_group = Qnil;
491 else if (c >= 0)
41ad6003
KH
492 font_group = char_table_ref_and_range (base_fontset, c, &from, &to);
493 else
494 font_group = FONTSET_FALLBACK (base_fontset);
495 if (NILP (font_group))
f088b054 496 {
f084f942 497 font_group = make_number (0);
f088b054 498 if (c >= 0)
f084f942
KH
499 char_table_set_range (fontset, from, to, font_group);
500 return font_group;
f088b054 501 }
ea180610
AS
502 if (!VECTORP (font_group))
503 return font_group;
41ad6003
KH
504 font_group = Fcopy_sequence (font_group);
505 for (i = 0; i < ASIZE (font_group); i++)
506 if (! NILP (AREF (font_group, i)))
507 {
508 Lisp_Object rfont_def;
509
510 RFONT_DEF_NEW (rfont_def, AREF (font_group, i));
511 /* Remember the original order. */
512 RFONT_DEF_SET_SCORE (rfont_def, i);
513 ASET (font_group, i, rfont_def);
514 }
515 font_group = Fcons (make_number (-1), font_group);
516 if (c >= 0)
517 char_table_set_range (fontset, from, to, font_group);
518 else
d0d2d26f 519 set_fontset_fallback (fontset, font_group);
41ad6003 520 return font_group;
0d407d77
KH
521}
522
7e1a1cd9 523/* Return RFONT-DEF (vector) in the realized fontset FONTSET for the
d67f7f1a
KH
524 character C. If no font is found, return Qnil if there's a
525 possibility that the default fontset or the fallback font groups
526 have a proper font, and return Qt if not.
527
528 If a font is found but is not yet opened, open it (if FACE is not
529 NULL) or return Qnil (if FACE is NULL).
530
1c82b4b3
KH
531 ID is a charset-id that must be preferred, or -1 meaning no
532 preference.
d67f7f1a 533
a864ef14 534 If FALLBACK, search only fallback fonts. */
0d407d77 535
7e1a1cd9 536static Lisp_Object
a864ef14
PE
537fontset_find_font (Lisp_Object fontset, int c, struct face *face, int id,
538 bool fallback)
0d407d77 539{
162f5458 540 Lisp_Object vec, font_group;
374bf7e4 541 int i, charset_matched = 0, found_index;
a10c8269
DA
542 struct frame *f = (FRAMEP (FONTSET_FRAME (fontset))
543 ? XFRAME (FONTSET_FRAME (fontset))
544 : XFRAME (selected_frame));
a71ccf3a 545 Lisp_Object rfont_def;
0d407d77 546
41ad6003
KH
547 font_group = fontset_get_font_group (fontset, fallback ? -1 : c);
548 if (! CONSP (font_group))
bf86d09c 549 return font_group;
41ad6003
KH
550 vec = XCDR (font_group);
551 if (ASIZE (vec) == 0)
552 return Qnil;
eaa0402c 553
41ad6003 554 if (ASIZE (vec) > 1)
1d5d7200 555 {
41ad6003
KH
556 if (XINT (XCAR (font_group)) != charset_ordered_list_tick)
557 /* We have just created the font-group,
558 or the charset priorities were changed. */
559 reorder_font_vector (font_group, face->ascii_face->font);
560 if (id >= 0)
561 /* Find a spec matching with the charset ID to try at
562 first. */
563 for (i = 0; i < ASIZE (vec); i++)
564 {
0ff75233
KH
565 Lisp_Object repertory;
566
a71ccf3a 567 rfont_def = AREF (vec, i);
0ff75233
KH
568 if (NILP (rfont_def))
569 break;
570 repertory = FONT_DEF_REPERTORY (RFONT_DEF_FONT_DEF (rfont_def));
41ad6003
KH
571
572 if (XINT (repertory) == id)
eaa0402c 573 {
41ad6003 574 charset_matched = i;
581f7ac7 575 break;
41ad6003
KH
576 }
577 }
581f7ac7 578 }
1d5d7200 579
7e1a1cd9 580 /* Find the first available font in the vector of RFONT-DEF. */
41ad6003 581 for (i = 0; i < ASIZE (vec); i++)
0d407d77 582 {
a71ccf3a 583 Lisp_Object font_def;
dbf46ba6 584 Lisp_Object font_entity, font_object;
581f7ac7 585
635c75b1 586 found_index = i;
374bf7e4 587 if (i == 0)
41ad6003 588 {
374bf7e4
KH
589 if (charset_matched > 0)
590 {
635c75b1
KH
591 /* Try the element matching with the charset ID at first. */
592 found_index = charset_matched;
593 /* Make this negative so that we don't come here in the
594 next loop. */
374bf7e4 595 charset_matched = - charset_matched;
635c75b1 596 /* We must try the first element in the next loop. */
374bf7e4
KH
597 i--;
598 }
41ad6003 599 }
635c75b1 600 else if (i == - charset_matched)
374bf7e4
KH
601 {
602 /* We have already tried this element and the followings
635c75b1
KH
603 that have the same font specifications in the first
604 iteration. So, skip them all. */
374bf7e4
KH
605 rfont_def = AREF (vec, i);
606 font_def = RFONT_DEF_FONT_DEF (rfont_def);
607 for (; i + 1 < ASIZE (vec); i++)
608 {
609 rfont_def = AREF (vec, i + 1);
610 if (NILP (rfont_def))
611 break;
612 if (! EQ (RFONT_DEF_FONT_DEF (rfont_def), font_def))
613 break;
614 }
615 continue;
616 }
41ad6003 617
374bf7e4 618 rfont_def = AREF (vec, found_index);
162f5458 619 if (NILP (rfont_def))
374bf7e4 620 {
635c75b1 621 if (i < 0)
374bf7e4
KH
622 continue;
623 /* This is a sign of not to try the other fonts. */
624 return Qt;
625 }
162f5458
KH
626 if (INTEGERP (RFONT_DEF_FACE (rfont_def))
627 && XINT (RFONT_DEF_FACE (rfont_def)) < 0)
1d5d7200
KH
628 /* We couldn't open this font last time. */
629 continue;
630
162f5458 631 font_object = RFONT_DEF_OBJECT (rfont_def);
581f7ac7 632 if (NILP (font_object))
8aa07a8d 633 {
162f5458 634 font_def = RFONT_DEF_FONT_DEF (rfont_def);
d67f7f1a 635
581f7ac7
KH
636 if (! face)
637 /* We have not yet opened the font. */
638 return Qnil;
162f5458
KH
639 /* Find a font best-matching with the spec without checking
640 the support of the character C. That checking is costly,
641 and even without the checking, the found font supports C
642 in high possibility. */
581f7ac7
KH
643 font_entity = font_find_for_lface (f, face->lface,
644 FONT_DEF_SPEC (font_def), -1);
d67f7f1a 645 if (NILP (font_entity))
8b67c40a 646 {
581f7ac7 647 /* Record that no font matches the spec. */
162f5458 648 RFONT_DEF_SET_FACE (rfont_def, -1);
581f7ac7 649 continue;
d67f7f1a 650 }
ca2b2cde
KH
651 font_object = font_open_for_lface (f, font_entity, face->lface,
652 FONT_DEF_SPEC (font_def));
581f7ac7 653 if (NILP (font_object))
d67f7f1a 654 {
162f5458
KH
655 /* Something strange happened, perhaps because of a
656 Font-backend problem. Too avoid crashing, record
ee7683eb 657 that this spec is unusable. It may be better to find
162f5458
KH
658 another font of the same spec, but currently we don't
659 have such an API. */
660 RFONT_DEF_SET_FACE (rfont_def, -1);
581f7ac7 661 continue;
8aa07a8d 662 }
162f5458 663 RFONT_DEF_SET_OBJECT (rfont_def, font_object);
8aa07a8d 664 }
eb152aa9 665
581f7ac7 666 if (font_has_char (f, font_object, c))
a71ccf3a 667 goto found;
581f7ac7 668
333f9019 669 /* Find a font already opened, matching with the current spec,
162f5458
KH
670 and supporting C. */
671 font_def = RFONT_DEF_FONT_DEF (rfont_def);
374bf7e4 672 for (; found_index + 1 < ASIZE (vec); found_index++)
57e13af9 673 {
374bf7e4 674 rfont_def = AREF (vec, found_index + 1);
7d72bb82 675 if (NILP (rfont_def))
374bf7e4 676 break;
162f5458 677 if (! EQ (RFONT_DEF_FONT_DEF (rfont_def), font_def))
581f7ac7 678 break;
374bf7e4 679 font_object = RFONT_DEF_OBJECT (rfont_def);
69a8e484 680 if (! NILP (font_object) && font_has_char (f, font_object, c))
374bf7e4
KH
681 {
682 found_index++;
683 goto found;
684 }
57e13af9 685 }
162f5458
KH
686
687 /* Find a font-entity with the current spec and supporting C. */
581f7ac7
KH
688 font_entity = font_find_for_lface (f, face->lface,
689 FONT_DEF_SPEC (font_def), c);
690 if (! NILP (font_entity))
1d5d7200 691 {
162f5458
KH
692 /* We found a font. Open it and insert a new element for
693 that font in VEC. */
694 Lisp_Object new_vec;
581f7ac7 695 int j;
1d5d7200 696
581f7ac7
KH
697 font_object = font_open_for_lface (f, font_entity, face->lface,
698 Qnil);
162f5458
KH
699 if (NILP (font_object))
700 continue;
581f7ac7
KH
701 RFONT_DEF_NEW (rfont_def, font_def);
702 RFONT_DEF_SET_OBJECT (rfont_def, font_object);
162f5458 703 RFONT_DEF_SET_SCORE (rfont_def, RFONT_DEF_SCORE (rfont_def));
581f7ac7 704 new_vec = Fmake_vector (make_number (ASIZE (vec) + 1), Qnil);
374bf7e4
KH
705 found_index++;
706 for (j = 0; j < found_index; j++)
581f7ac7
KH
707 ASET (new_vec, j, AREF (vec, j));
708 ASET (new_vec, j, rfont_def);
709 for (j++; j < ASIZE (new_vec); j++)
710 ASET (new_vec, j, AREF (vec, j - 1));
162f5458 711 XSETCDR (font_group, new_vec);
a71ccf3a
KH
712 vec = new_vec;
713 goto found;
1d5d7200 714 }
374bf7e4
KH
715 if (i >= 0)
716 i = found_index;
0d407d77 717 }
d67f7f1a 718
581f7ac7 719 FONTSET_SET (fontset, make_number (c), make_number (0));
eaa0402c 720 return Qnil;
a71ccf3a
KH
721
722 found:
723 if (fallback && found_index > 0)
724 {
725 /* The order of fonts in the fallback font-group is not that
726 important, and it is better to move the found font to the
727 first of the group so that the next try will find it
728 quickly. */
729 for (i = found_index; i > 0; i--)
730 ASET (vec, i, AREF (vec, i - 1));
731 ASET (vec, 0, rfont_def);
732 }
733 return rfont_def;
1c82b4b3 734}
0d407d77 735
cc7b6145 736
1c82b4b3 737static Lisp_Object
971de7fb 738fontset_font (Lisp_Object fontset, int c, struct face *face, int id)
1c82b4b3 739{
cc6e5db1 740 Lisp_Object rfont_def, default_rfont_def IF_LINT (= Qnil);
1c82b4b3 741 Lisp_Object base_fontset;
cc7b6145 742
41ad6003 743 /* Try a font-group of FONTSET. */
b23bf85a 744 FONT_DEFERRED_LOG ("current fontset: font for", make_number (c), Qnil);
1c82b4b3 745 rfont_def = fontset_find_font (fontset, c, face, id, 0);
eaa0402c
KH
746 if (VECTORP (rfont_def))
747 return rfont_def;
f084f942
KH
748 if (NILP (rfont_def))
749 FONTSET_SET (fontset, make_number (c), make_number (0));
41ad6003
KH
750
751 /* Try a font-group of the default fontset. */
752 base_fontset = FONTSET_BASE (fontset);
753 if (! EQ (base_fontset, Vdefault_fontset))
754 {
755 if (NILP (FONTSET_DEFAULT (fontset)))
d0d2d26f 756 set_fontset_default
6d470bdd
DA
757 (fontset,
758 make_fontset (FONTSET_FRAME (fontset), Qnil, Vdefault_fontset));
b23bf85a 759 FONT_DEFERRED_LOG ("default fontset: font for", make_number (c), Qnil);
f084f942
KH
760 default_rfont_def
761 = fontset_find_font (FONTSET_DEFAULT (fontset), c, face, id, 0);
762 if (VECTORP (default_rfont_def))
763 return default_rfont_def;
764 if (NILP (default_rfont_def))
765 FONTSET_SET (FONTSET_DEFAULT (fontset), make_number (c),
766 make_number (0));
41ad6003
KH
767 }
768
769 /* Try a fallback font-group of FONTSET. */
f084f942
KH
770 if (! EQ (rfont_def, Qt))
771 {
772 FONT_DEFERRED_LOG ("current fallback: font for", make_number (c), Qnil);
773 rfont_def = fontset_find_font (fontset, c, face, id, 1);
774 if (VECTORP (rfont_def))
775 return rfont_def;
776 /* Remember that FONTSET has no font for C. */
777 FONTSET_SET (fontset, make_number (c), Qt);
778 }
d67f7f1a 779
f084f942
KH
780 /* Try a fallback font-group of the default fontset. */
781 if (! EQ (base_fontset, Vdefault_fontset)
782 && ! EQ (default_rfont_def, Qt))
41ad6003 783 {
b23bf85a 784 FONT_DEFERRED_LOG ("default fallback: font for", make_number (c), Qnil);
41ad6003
KH
785 rfont_def = fontset_find_font (FONTSET_DEFAULT (fontset), c, face, id, 1);
786 if (VECTORP (rfont_def))
787 return rfont_def;
f084f942
KH
788 /* Remember that the default fontset has no font for C. */
789 FONTSET_SET (FONTSET_DEFAULT (fontset), make_number (c), Qt);
41ad6003
KH
790 }
791
41ad6003 792 return Qnil;
0d407d77
KH
793}
794
0d407d77 795/* Return a newly created fontset with NAME. If BASE is nil, make a
06f76f0d 796 base fontset. Otherwise make a realized fontset whose base is
0d407d77
KH
797 BASE. */
798
799static Lisp_Object
971de7fb 800make_fontset (Lisp_Object frame, Lisp_Object name, Lisp_Object base)
4ed46869 801{
1337ac77 802 Lisp_Object fontset;
0d407d77
KH
803 int size = ASIZE (Vfontset_table);
804 int id = next_fontset_id;
0d407d77
KH
805
806 /* Find a free slot in Vfontset_table. Usually, next_fontset_id is
807 the next available fontset ID. So it is expected that this loop
808 terminates quickly. In addition, as the last element of
fc8865fc 809 Vfontset_table is always nil, we don't have to check the range of
0d407d77
KH
810 id. */
811 while (!NILP (AREF (Vfontset_table, id))) id++;
812
813 if (id + 1 == size)
d311d28c 814 Vfontset_table = larger_vector (Vfontset_table, 1, -1);
4ed46869 815
11d9bd93 816 fontset = Fmake_char_table (Qfontset, Qnil);
0d407d77 817
d0d2d26f 818 set_fontset_id (fontset, make_number (id));
06f76f0d 819 if (NILP (base))
d0d2d26f 820 set_fontset_name (fontset, name);
06f76f0d
KH
821 else
822 {
d0d2d26f
PE
823 set_fontset_name (fontset, Qnil);
824 set_fontset_frame (fontset, frame);
825 set_fontset_base (fontset, base);
06f76f0d 826 }
0d407d77 827
06f76f0d 828 ASET (Vfontset_table, id, fontset);
0d407d77
KH
829 next_fontset_id = id + 1;
830 return fontset;
4ed46869
KH
831}
832
0d407d77 833\f
1d5d7200 834/********** INTERFACES TO xfaces.c, xfns.c, and dispextern.h **********/
0d407d77 835
1d5d7200 836/* Return the name of the fontset who has ID. */
0d407d77
KH
837
838Lisp_Object
971de7fb 839fontset_name (int id)
0d407d77
KH
840{
841 Lisp_Object fontset;
06f76f0d 842
0d407d77
KH
843 fontset = FONTSET_FROM_ID (id);
844 return FONTSET_NAME (fontset);
845}
846
847
1d5d7200 848/* Return the ASCII font name of the fontset who has ID. */
0d407d77
KH
849
850Lisp_Object
971de7fb 851fontset_ascii (int id)
0d407d77
KH
852{
853 Lisp_Object fontset, elt;
06f76f0d 854
0d407d77
KH
855 fontset= FONTSET_FROM_ID (id);
856 elt = FONTSET_ASCII (fontset);
8aa07a8d
KH
857 if (CONSP (elt))
858 elt = XCAR (elt);
1d5d7200 859 return elt;
0d407d77
KH
860}
861
a5c0af81 862static void
a10c8269 863free_realized_fontset (struct frame *f, Lisp_Object fontset)
9459b1e9 864{
239f9db9 865#if 0
9459b1e9
KH
866 Lisp_Object tail;
867
97be3ce3
PE
868 if (0)
869 for (tail = FONTSET_OBJLIST (fontset); CONSP (tail); tail = XCDR (tail))
870 {
a54e2c05 871 eassert (FONT_OBJECT_P (XCAR (tail)));
97be3ce3
PE
872 font_close_object (f, XCAR (tail));
873 }
239f9db9 874#endif
9459b1e9 875}
0d407d77 876
06f76f0d
KH
877/* Free fontset of FACE defined on frame F. Called from
878 free_realized_face. */
0d407d77 879
4ed46869 880void
a10c8269 881free_face_fontset (struct frame *f, struct face *face)
4ed46869 882{
452a78e0
KH
883 Lisp_Object fontset;
884
ff7a2223 885 fontset = FONTSET_FROM_ID (face->fontset);
581f7ac7
KH
886 if (NILP (fontset))
887 return;
a54e2c05
DA
888 eassert (! BASE_FONTSET_P (fontset));
889 eassert (f == XFRAME (FONTSET_FRAME (fontset)));
9459b1e9 890 free_realized_fontset (f, fontset);
1d5d7200 891 ASET (Vfontset_table, face->fontset, Qnil);
06f76f0d
KH
892 if (face->fontset < next_fontset_id)
893 next_fontset_id = face->fontset;
eb36588a 894 if (! NILP (FONTSET_DEFAULT (fontset)))
452a78e0 895 {
e1a14cdc 896 int id = XINT (FONTSET_ID (FONTSET_DEFAULT (fontset)));
eb152aa9 897
452a78e0 898 fontset = AREF (Vfontset_table, id);
a54e2c05
DA
899 eassert (!NILP (fontset) && ! BASE_FONTSET_P (fontset));
900 eassert (f == XFRAME (FONTSET_FRAME (fontset)));
9459b1e9 901 free_realized_fontset (f, fontset);
452a78e0
KH
902 ASET (Vfontset_table, id, Qnil);
903 if (id < next_fontset_id)
904 next_fontset_id = face->fontset;
905 }
581f7ac7 906 face->fontset = -1;
0d407d77 907}
18998710 908
0d407d77 909
239f9db9 910#if 0
a864ef14
PE
911/* Return true if FACE is suitable for displaying character C.
912 Called from the macro FACE_SUITABLE_FOR_CHAR_P
06f76f0d 913 when C is not an ASCII character. */
0d407d77 914
a864ef14 915bool
971de7fb 916face_suitable_for_char_p (struct face *face, int c)
0d407d77 917{
7e1a1cd9 918 Lisp_Object fontset, rfont_def;
0d407d77 919
0d407d77 920 fontset = FONTSET_FROM_ID (face->fontset);
7e1a1cd9
KH
921 rfont_def = fontset_font (fontset, c, NULL, -1);
922 return (VECTORP (rfont_def)
581f7ac7
KH
923 && INTEGERP (RFONT_DEF_FACE (rfont_def))
924 && face->id == XINT (RFONT_DEF_FACE (rfont_def)));
0d407d77 925}
239f9db9 926#endif
0d407d77
KH
927
928
929/* Return ID of face suitable for displaying character C on frame F.
40ba43b4 930 FACE must be realized for ASCII characters in advance. Called from
1d5d7200 931 the macro FACE_FOR_CHAR. */
0d407d77
KH
932
933int
a10c8269 934face_for_char (struct frame *f, struct face *face, int c, int pos, Lisp_Object object)
0d407d77 935{
303d5190 936 Lisp_Object fontset, rfont_def, charset;
7e1a1cd9 937 int face_id;
6bad8007 938 int id;
1d5d7200 939
ea217c11
KH
940 /* If face->fontset is negative (that happens when no font is found
941 for face), just return face->ascii_face because we can't do
942 anything. Perhaps, we should fix the callers to assure
943 that face->fontset is always valid. */
944 if (ASCII_CHAR_P (c) || face->fontset < 0)
1d5d7200 945 return face->ascii_face->id;
0d407d77 946
a54e2c05 947 eassert (fontset_id_valid_p (face->fontset));
0d407d77 948 fontset = FONTSET_FROM_ID (face->fontset);
a54e2c05 949 eassert (!BASE_FONTSET_P (fontset));
41ad6003 950
6bad8007 951 if (pos < 0)
303d5190
KH
952 {
953 id = -1;
954 charset = Qnil;
955 }
6bad8007
KH
956 else
957 {
958 charset = Fget_char_property (make_number (pos), Qcharset, object);
b1bde622 959 if (CHARSETP (charset))
28e2436a
KH
960 {
961 Lisp_Object val;
962
a124bbb6 963 val = assq_no_quit (charset, Vfont_encoding_charset_alist);
28e2436a
KH
964 if (CONSP (val) && CHARSETP (XCDR (val)))
965 charset = XCDR (val);
966 id = XINT (CHARSET_SYMBOL_ID (charset));
967 }
b1bde622
KH
968 else
969 id = -1;
6bad8007 970 }
b59e66b3 971
7e1a1cd9
KH
972 rfont_def = fontset_font (fontset, c, face, id);
973 if (VECTORP (rfont_def))
974 {
581f7ac7
KH
975 if (INTEGERP (RFONT_DEF_FACE (rfont_def)))
976 face_id = XINT (RFONT_DEF_FACE (rfont_def));
8aa07a8d 977 else
7e1a1cd9 978 {
581f7ac7 979 Lisp_Object font_object;
7e1a1cd9 980
581f7ac7
KH
981 font_object = RFONT_DEF_OBJECT (rfont_def);
982 face_id = face_for_font (f, font_object, face);
983 RFONT_DEF_SET_FACE (rfont_def, face_id);
7e1a1cd9 984 }
7e1a1cd9 985 }
581f7ac7 986 else
7e1a1cd9 987 {
581f7ac7
KH
988 if (INTEGERP (FONTSET_NOFONT_FACE (fontset)))
989 face_id = XINT (FONTSET_NOFONT_FACE (fontset));
990 else
991 {
992 face_id = face_for_font (f, Qnil, face);
d0d2d26f 993 set_fontset_nofont_face (fontset, make_number (face_id));
581f7ac7 994 }
7e1a1cd9 995 }
a54e2c05 996 eassert (face_id >= 0);
581f7ac7 997 return face_id;
0d407d77
KH
998}
999
1000
514cf218 1001Lisp_Object
971de7fb 1002font_for_char (struct face *face, int c, int pos, Lisp_Object object)
514cf218
KH
1003{
1004 Lisp_Object fontset, rfont_def, charset;
514cf218
KH
1005 int id;
1006
1007 if (ASCII_CHAR_P (c))
1008 {
1009 Lisp_Object font_object;
1010
1011 XSETFONT (font_object, face->ascii_face->font);
1012 return font_object;
1013 }
1014
a54e2c05 1015 eassert (fontset_id_valid_p (face->fontset));
514cf218 1016 fontset = FONTSET_FROM_ID (face->fontset);
a54e2c05 1017 eassert (!BASE_FONTSET_P (fontset));
514cf218
KH
1018 if (pos < 0)
1019 {
1020 id = -1;
1021 charset = Qnil;
1022 }
1023 else
1024 {
1025 charset = Fget_char_property (make_number (pos), Qcharset, object);
b1bde622 1026 if (CHARSETP (charset))
514cf218
KH
1027 {
1028 Lisp_Object val;
1029
9fe78804 1030 val = assq_no_quit (charset, Vfont_encoding_charset_alist);
514cf218
KH
1031 if (CONSP (val) && CHARSETP (XCDR (val)))
1032 charset = XCDR (val);
1033 id = XINT (CHARSET_SYMBOL_ID (charset));
1034 }
b1bde622
KH
1035 else
1036 id = -1;
514cf218
KH
1037 }
1038
514cf218
KH
1039 rfont_def = fontset_font (fontset, c, face, id);
1040 return (VECTORP (rfont_def)
1041 ? RFONT_DEF_OBJECT (rfont_def)
1042 : Qnil);
1043}
1044
1045
0d407d77
KH
1046/* Make a realized fontset for ASCII face FACE on frame F from the
1047 base fontset BASE_FONTSET_ID. If BASE_FONTSET_ID is -1, use the
1048 default fontset as the base. Value is the id of the new fontset.
1049 Called from realize_x_face. */
1050
1051int
a10c8269 1052make_fontset_for_ascii_face (struct frame *f, int base_fontset_id, struct face *face)
0d407d77 1053{
1337ac77 1054 Lisp_Object base_fontset, fontset, frame;
0d407d77
KH
1055
1056 XSETFRAME (frame, f);
1057 if (base_fontset_id >= 0)
1058 {
1059 base_fontset = FONTSET_FROM_ID (base_fontset_id);
1060 if (!BASE_FONTSET_P (base_fontset))
1061 base_fontset = FONTSET_BASE (base_fontset);
4e6a86c6 1062 eassert (BASE_FONTSET_P (base_fontset));
4ed46869 1063 }
0d407d77
KH
1064 else
1065 base_fontset = Vdefault_fontset;
1066
1067 fontset = make_fontset (frame, Qnil, base_fontset);
f3231837 1068 return XINT (FONTSET_ID (fontset));
0d407d77
KH
1069}
1070
0d407d77 1071\f
1d5d7200 1072
4ed46869
KH
1073/* Cache data used by fontset_pattern_regexp. The car part is a
1074 pattern string containing at least one wild card, the cdr part is
1075 the corresponding regular expression. */
1076static Lisp_Object Vcached_fontset_data;
1077
51b59d79 1078#define CACHED_FONTSET_NAME SSDATA (XCAR (Vcached_fontset_data))
7539e11f 1079#define CACHED_FONTSET_REGEX (XCDR (Vcached_fontset_data))
4ed46869
KH
1080
1081/* If fontset name PATTERN contains any wild card, return regular
1082 expression corresponding to PATTERN. */
1083
0d407d77 1084static Lisp_Object
971de7fb 1085fontset_pattern_regexp (Lisp_Object pattern)
4ed46869 1086{
51b59d79
PE
1087 if (!strchr (SSDATA (pattern), '*')
1088 && !strchr (SSDATA (pattern), '?'))
4ed46869 1089 /* PATTERN does not contain any wild cards. */
1c283e35 1090 return Qnil;
4ed46869
KH
1091
1092 if (!CONSP (Vcached_fontset_data)
51b59d79 1093 || strcmp (SSDATA (pattern), CACHED_FONTSET_NAME))
4ed46869
KH
1094 {
1095 /* We must at first update the cached data. */
6cc06608 1096 unsigned char *regex, *p0, *p1;
821bc4db 1097 int ndashes = 0, nstars = 0, nescs = 0;
6cc06608 1098
fc1062f5
KH
1099 for (p0 = SDATA (pattern); *p0; p0++)
1100 {
1101 if (*p0 == '-')
1102 ndashes++;
a653f812 1103 else if (*p0 == '*')
fc1062f5 1104 nstars++;
821bc4db
KH
1105 else if (*p0 == '['
1106 || *p0 == '.' || *p0 == '\\'
8510724d 1107 || *p0 == '+' || *p0 == '^'
821bc4db
KH
1108 || *p0 == '$')
1109 nescs++;
fc1062f5
KH
1110 }
1111
da6062e6 1112 /* If PATTERN is not full XLFD we convert "*" to ".*". Otherwise
fc1062f5
KH
1113 we convert "*" to "[^-]*" which is much faster in regular
1114 expression matching. */
1115 if (ndashes < 14)
38182d90 1116 p1 = regex = alloca (SBYTES (pattern) + 2 * nstars + 2 * nescs + 1);
fc1062f5 1117 else
38182d90 1118 p1 = regex = alloca (SBYTES (pattern) + 5 * nstars + 2 * nescs + 1);
4ed46869 1119
1c283e35 1120 *p1++ = '^';
6cc06608 1121 for (p0 = SDATA (pattern); *p0; p0++)
4ed46869 1122 {
a653f812 1123 if (*p0 == '*')
4ed46869 1124 {
fc1062f5
KH
1125 if (ndashes < 14)
1126 *p1++ = '.';
1127 else
1128 *p1++ = '[', *p1++ = '^', *p1++ = '-', *p1++ = ']';
1c283e35 1129 *p1++ = '*';
4ed46869 1130 }
1c283e35 1131 else if (*p0 == '?')
d96d677d 1132 *p1++ = '.';
821bc4db
KH
1133 else if (*p0 == '['
1134 || *p0 == '.' || *p0 == '\\'
8510724d 1135 || *p0 == '+' || *p0 == '^'
821bc4db
KH
1136 || *p0 == '$')
1137 *p1++ = '\\', *p1++ = *p0;
1c283e35
KH
1138 else
1139 *p1++ = *p0;
4ed46869
KH
1140 }
1141 *p1++ = '$';
1142 *p1++ = 0;
1143
51b59d79 1144 Vcached_fontset_data = Fcons (build_string (SSDATA (pattern)),
dbf46ba6 1145 build_string ((char *) regex));
4ed46869
KH
1146 }
1147
1148 return CACHED_FONTSET_REGEX;
1149}
1150
0d407d77 1151/* Return ID of the base fontset named NAME. If there's no such
a653f812
KH
1152 fontset, return -1. NAME_PATTERN specifies how to treat NAME as this:
1153 0: pattern containing '*' and '?' as wildcards
1154 1: regular expression
1155 2: literal fontset name
1156*/
0d407d77
KH
1157
1158int
971de7fb 1159fs_query_fontset (Lisp_Object name, int name_pattern)
0d407d77 1160{
1337ac77 1161 Lisp_Object tem;
0d407d77
KH
1162 int i;
1163
1164 name = Fdowncase (name);
a653f812 1165 if (name_pattern != 1)
0d407d77
KH
1166 {
1167 tem = Frassoc (name, Vfontset_alias_alist);
6bad8007
KH
1168 if (NILP (tem))
1169 tem = Fassoc (name, Vfontset_alias_alist);
0d407d77
KH
1170 if (CONSP (tem) && STRINGP (XCAR (tem)))
1171 name = XCAR (tem);
a653f812 1172 else if (name_pattern == 0)
0d407d77
KH
1173 {
1174 tem = fontset_pattern_regexp (name);
1175 if (STRINGP (tem))
1176 {
1177 name = tem;
a653f812 1178 name_pattern = 1;
0d407d77
KH
1179 }
1180 }
1181 }
1182
1183 for (i = 0; i < ASIZE (Vfontset_table); i++)
1184 {
6e1b0d8c 1185 Lisp_Object fontset, this_name;
0d407d77
KH
1186
1187 fontset = FONTSET_FROM_ID (i);
1188 if (NILP (fontset)
1189 || !BASE_FONTSET_P (fontset))
1190 continue;
1191
6e1b0d8c 1192 this_name = FONTSET_NAME (fontset);
a653f812 1193 if (name_pattern == 1
581f7ac7 1194 ? fast_string_match_ignore_case (name, this_name) >= 0
25a48bd0 1195 : !xstrcasecmp (SSDATA (name), SSDATA (this_name)))
0d407d77
KH
1196 return i;
1197 }
1198 return -1;
1199}
1200
1201
a7ca3326 1202DEFUN ("query-fontset", Fquery_fontset, Squery_fontset, 1, 2, 0,
335c5470
PJ
1203 doc: /* Return the name of a fontset that matches PATTERN.
1204The value is nil if there is no matching fontset.
1205PATTERN can contain `*' or `?' as a wildcard
1206just as X font name matching algorithm allows.
1207If REGEXPP is non-nil, PATTERN is a regular expression. */)
5842a27b 1208 (Lisp_Object pattern, Lisp_Object regexpp)
4ed46869 1209{
0d407d77
KH
1210 Lisp_Object fontset;
1211 int id;
4ed46869 1212
7452b7bd 1213 check_window_system (NULL);
4ed46869 1214
b7826503 1215 CHECK_STRING (pattern);
4ed46869 1216
d5db4077 1217 if (SCHARS (pattern) == 0)
4ed46869
KH
1218 return Qnil;
1219
0d407d77
KH
1220 id = fs_query_fontset (pattern, !NILP (regexpp));
1221 if (id < 0)
1222 return Qnil;
4ed46869 1223
0d407d77
KH
1224 fontset = FONTSET_FROM_ID (id);
1225 return FONTSET_NAME (fontset);
4ed46869
KH
1226}
1227
06f76f0d 1228/* Return a list of base fontset names matching PATTERN on frame F. */
4ed46869
KH
1229
1230Lisp_Object
a10c8269 1231list_fontsets (struct frame *f, Lisp_Object pattern, int size)
4ed46869 1232{
1337ac77 1233 Lisp_Object frame, regexp, val;
0d407d77 1234 int id;
4ed46869 1235
0d407d77 1236 XSETFRAME (frame, f);
4ed46869 1237
0d407d77 1238 regexp = fontset_pattern_regexp (pattern);
4ed46869 1239 val = Qnil;
4ed46869 1240
0d407d77
KH
1241 for (id = 0; id < ASIZE (Vfontset_table); id++)
1242 {
6e1b0d8c 1243 Lisp_Object fontset, name;
0d407d77
KH
1244
1245 fontset = FONTSET_FROM_ID (id);
1246 if (NILP (fontset)
1247 || !BASE_FONTSET_P (fontset)
1248 || !EQ (frame, FONTSET_FRAME (fontset)))
1249 continue;
6e1b0d8c 1250 name = FONTSET_NAME (fontset);
0d407d77 1251
1d5d7200 1252 if (STRINGP (regexp)
6e1b0d8c 1253 ? (fast_string_match (regexp, name) < 0)
51b59d79 1254 : strcmp (SSDATA (pattern), SSDATA (name)))
0d407d77
KH
1255 continue;
1256
0d407d77 1257 val = Fcons (Fcopy_sequence (FONTSET_NAME (fontset)), val);
4ed46869
KH
1258 }
1259
1260 return val;
1261}
1262
4ed46869 1263
8f924df7 1264/* Free all realized fontsets whose base fontset is BASE. */
4ed46869 1265
06f76f0d 1266static void
971de7fb 1267free_realized_fontsets (Lisp_Object base)
06f76f0d
KH
1268{
1269 int id;
4ed46869 1270
2f034212 1271#if 0
27e20b2f
KH
1272 /* For the moment, this doesn't work because free_realized_face
1273 doesn't remove FACE from a cache. Until we find a solution, we
1274 suppress this code, and simply use Fclear_face_cache even though
1275 that is not efficient. */
4d7e6e51 1276 block_input ();
06f76f0d 1277 for (id = 0; id < ASIZE (Vfontset_table); id++)
4ed46869 1278 {
06f76f0d 1279 Lisp_Object this = AREF (Vfontset_table, id);
0d407d77 1280
06f76f0d 1281 if (EQ (FONTSET_BASE (this), base))
0d407d77 1282 {
06f76f0d 1283 Lisp_Object tail;
4ed46869 1284
06f76f0d
KH
1285 for (tail = FONTSET_FACE_ALIST (this); CONSP (tail);
1286 tail = XCDR (tail))
1287 {
a10c8269 1288 struct frame *f = XFRAME (FONTSET_FRAME (this));
06f76f0d
KH
1289 int face_id = XINT (XCDR (XCAR (tail)));
1290 struct face *face = FACE_FROM_ID (f, face_id);
4ed46869 1291
06f76f0d
KH
1292 /* Face THIS itself is also freed by the following call. */
1293 free_realized_face (f, face);
1294 }
1295 }
0d407d77 1296 }
4d7e6e51 1297 unblock_input ();
27e20b2f 1298#else /* not 0 */
2f034212
KH
1299 /* But, we don't have to call Fclear_face_cache if no fontset has
1300 been realized from BASE. */
1301 for (id = 0; id < ASIZE (Vfontset_table); id++)
1302 {
1303 Lisp_Object this = AREF (Vfontset_table, id);
1304
985773c9 1305 if (CHAR_TABLE_P (this) && EQ (FONTSET_BASE (this), base))
2f034212
KH
1306 {
1307 Fclear_face_cache (Qt);
1308 break;
1309 }
1310 }
27e20b2f 1311#endif /* not 0 */
0d407d77 1312}
4ed46869 1313
4ed46869 1314
0d407d77
KH
1315/* Check validity of NAME as a fontset name and return the
1316 corresponding fontset. If not valid, signal an error.
a3d16f39
KH
1317
1318 If NAME is t, return Vdefault_fontset. If NAME is nil, return the
1319 fontset of *FRAME.
1320
1321 Set *FRAME to the actual frame. */
0d407d77
KH
1322
1323static Lisp_Object
971de7fb 1324check_fontset_name (Lisp_Object name, Lisp_Object *frame)
0d407d77
KH
1325{
1326 int id;
d9f07150 1327 struct frame *f = decode_live_frame (*frame);
0d407d77 1328
d9f07150 1329 XSETFRAME (*frame, f);
a3d16f39 1330
0d407d77
KH
1331 if (EQ (name, Qt))
1332 return Vdefault_fontset;
a3d16f39 1333 if (NILP (name))
d9f07150 1334 id = FRAME_FONTSET (f);
a3d16f39
KH
1335 else
1336 {
1337 CHECK_STRING (name);
1338 /* First try NAME as literal. */
1339 id = fs_query_fontset (name, 2);
1340 if (id < 0)
1341 /* For backward compatibility, try again NAME as pattern. */
1342 id = fs_query_fontset (name, 0);
1343 if (id < 0)
1344 error ("Fontset `%s' does not exist", SDATA (name));
1345 }
0d407d77
KH
1346 return FONTSET_FROM_ID (id);
1347}
4ed46869 1348
1d5d7200 1349static void
971de7fb 1350accumulate_script_ranges (Lisp_Object arg, Lisp_Object range, Lisp_Object val)
1d5d7200
KH
1351{
1352 if (EQ (XCAR (arg), val))
1353 {
1354 if (CONSP (range))
1355 XSETCDR (arg, Fcons (Fcons (XCAR (range), XCDR (range)), XCDR (arg)));
1356 else
1357 XSETCDR (arg, Fcons (Fcons (range, range), XCDR (arg)));
1358 }
1359}
1360
1361
a3d16f39
KH
1362/* Callback function for map_charset_chars in Fset_fontset_font.
1363 ARG is a vector [ FONTSET FONT_DEF ADD ASCII SCRIPT_RANGE_LIST ].
fb78e2ed 1364
a3d16f39
KH
1365 In FONTSET, set FONT_DEF in a fashion specified by ADD for
1366 characters in RANGE and ranges in SCRIPT_RANGE_LIST before RANGE.
e1dbe924 1367 The consumed ranges are popped up from SCRIPT_RANGE_LIST, and the
a3d16f39
KH
1368 new SCRIPT_RANGE_LIST is stored in ARG.
1369
1370 If ASCII is nil, don't set FONT_DEF for ASCII characters. It is
1371 assured that SCRIPT_RANGE_LIST doesn't contain ASCII in that
1372 case. */
fb78e2ed 1373
2449d4d0 1374static void
971de7fb 1375set_fontset_font (Lisp_Object arg, Lisp_Object range)
2449d4d0 1376{
a3d16f39
KH
1377 Lisp_Object fontset, font_def, add, ascii, script_range_list;
1378 int from = XINT (XCAR (range)), to = XINT (XCDR (range));
2449d4d0 1379
a3d16f39
KH
1380 fontset = AREF (arg, 0);
1381 font_def = AREF (arg, 1);
1382 add = AREF (arg, 2);
1383 ascii = AREF (arg, 3);
1384 script_range_list = AREF (arg, 4);
fb78e2ed 1385
a3d16f39
KH
1386 if (NILP (ascii) && from < 0x80)
1387 {
1388 if (to < 0x80)
fb78e2ed 1389 return;
a3d16f39
KH
1390 from = 0x80;
1391 range = Fcons (make_number (0x80), XCDR (range));
1392 }
1393
1394#define SCRIPT_FROM XINT (XCAR (XCAR (script_range_list)))
1395#define SCRIPT_TO XINT (XCDR (XCAR (script_range_list)))
1396#define POP_SCRIPT_RANGE() script_range_list = XCDR (script_range_list)
1397
1398 for (; CONSP (script_range_list) && SCRIPT_TO < from; POP_SCRIPT_RANGE ())
1399 FONTSET_ADD (fontset, XCAR (script_range_list), font_def, add);
1400 if (CONSP (script_range_list))
1401 {
1402 if (SCRIPT_FROM < from)
1403 range = Fcons (make_number (SCRIPT_FROM), XCDR (range));
1404 while (CONSP (script_range_list) && SCRIPT_TO <= to)
1405 POP_SCRIPT_RANGE ();
1406 if (CONSP (script_range_list) && SCRIPT_FROM <= to)
1407 XSETCAR (XCAR (script_range_list), make_number (to + 1));
fb78e2ed 1408 }
a3d16f39
KH
1409
1410 FONTSET_ADD (fontset, range, font_def, add);
1411 ASET (arg, 4, script_range_list);
2449d4d0
KH
1412}
1413
f57e2426 1414static void update_auto_fontset_alist (Lisp_Object, Lisp_Object);
d6490542 1415
d6aaac9e 1416
1d5d7200 1417DEFUN ("set-fontset-font", Fset_fontset_font, Sset_fontset_font, 3, 5, 0,
8f924df7 1418 doc: /*
eb36588a 1419Modify fontset NAME to use FONT-SPEC for TARGET characters.
335c5470 1420
a3d16f39
KH
1421NAME is a fontset name string, nil for the fontset of FRAME, or t for
1422the default fontset.
1423
eb36588a
KH
1424TARGET may be a cons; (FROM . TO), where FROM and TO are characters.
1425In that case, use FONT-SPEC for all characters in the range FROM and
1426TO (inclusive).
06f76f0d 1427
eb36588a
KH
1428TARGET may be a script name symbol. In that case, use FONT-SPEC for
1429all characters that belong to the script.
06f76f0d 1430
eb36588a 1431TARGET may be a charset. In that case, use FONT-SPEC for all
95318a38 1432characters in the charset.
1d5d7200 1433
eb36588a
KH
1434TARGET may be nil. In that case, use FONT-SPEC for any characters for
1435that no FONT-SPEC is specified.
1436
0fdf26e6 1437FONT-SPEC may one of these:
581f7ac7 1438 * A font-spec object made by the function `font-spec' (which see).
3dcd48dd 1439 * A cons (FAMILY . REGISTRY), where FAMILY is a font family name and
581f7ac7
KH
1440 REGISTRY is a font registry name. FAMILY may contain foundry
1441 name, and REGISTRY may contain encoding name.
00c4da0f 1442 * A font name string.
eaa0402c 1443 * nil, which explicitly specifies that there's no font for TARGET.
1d5d7200 1444
a3d16f39
KH
1445Optional 4th argument FRAME is a frame or nil for the selected frame
1446that is concerned in the case that NAME is nil.
1d5d7200
KH
1447
1448Optional 5th argument ADD, if non-nil, specifies how to add FONT-SPEC
eb36588a 1449to the font specifications for TARGET previously set. If it is
1d5d7200
KH
1450`prepend', FONT-SPEC is prepended. If it is `append', FONT-SPEC is
1451appended. By default, FONT-SPEC overrides the previous settings. */)
5842a27b 1452 (Lisp_Object name, Lisp_Object target, Lisp_Object font_spec, Lisp_Object frame, Lisp_Object add)
0d407d77 1453{
06f76f0d 1454 Lisp_Object fontset;
9683749a 1455 Lisp_Object font_def, registry, family;
1d5d7200 1456 Lisp_Object range_list;
fb78e2ed 1457 struct charset *charset = NULL;
d6490542 1458 Lisp_Object fontname;
a864ef14 1459 bool ascii_changed = 0;
0d407d77 1460
a3d16f39 1461 fontset = check_fontset_name (name, &frame);
1d5d7200 1462
d6490542 1463 fontname = Qnil;
581f7ac7 1464 if (CONSP (font_spec))
0d407d77 1465 {
581f7ac7 1466 Lisp_Object spec = Ffont_spec (0, NULL);
1d5d7200 1467
581f7ac7
KH
1468 font_parse_family_registry (XCAR (font_spec), XCDR (font_spec), spec);
1469 font_spec = spec;
d6490542 1470 fontname = Ffont_xlfd_name (font_spec, Qnil);
0890801b 1471 }
d67f7f1a 1472 else if (STRINGP (font_spec))
4ed46869 1473 {
ea0162a6
KH
1474 Lisp_Object args[2];
1475
d6490542 1476 fontname = font_spec;
ea0162a6
KH
1477 args[0] = QCname;
1478 args[1] = font_spec;
1479 font_spec = Ffont_spec (2, args);
0d407d77 1480 }
d6490542
KH
1481 else if (FONT_SPEC_P (font_spec))
1482 fontname = Ffont_xlfd_name (font_spec, Qnil);
1483 else if (! NILP (font_spec))
581f7ac7 1484 Fsignal (Qfont, list2 (build_string ("Invalid font-spec"), font_spec));
1d5d7200 1485
d67f7f1a 1486 if (! NILP (font_spec))
57e13af9 1487 {
581f7ac7
KH
1488 Lisp_Object encoding, repertory;
1489
d67f7f1a 1490 family = AREF (font_spec, FONT_FAMILY_INDEX);
581f7ac7 1491 if (! NILP (family) )
d67f7f1a
KH
1492 family = SYMBOL_NAME (family);
1493 registry = AREF (font_spec, FONT_REGISTRY_INDEX);
581f7ac7
KH
1494 if (! NILP (registry))
1495 registry = Fdowncase (SYMBOL_NAME (registry));
1496 encoding = find_font_encoding (concat3 (family, build_string ("-"),
1497 registry));
d67f7f1a
KH
1498 if (NILP (encoding))
1499 encoding = Qascii;
1500
1501 if (SYMBOLP (encoding))
1502 {
1503 CHECK_CHARSET (encoding);
1504 encoding = repertory = CHARSET_SYMBOL_ID (encoding);
1505 }
1506 else
57e13af9 1507 {
d67f7f1a
KH
1508 repertory = XCDR (encoding);
1509 encoding = XCAR (encoding);
1510 CHECK_CHARSET (encoding);
1511 encoding = CHARSET_SYMBOL_ID (encoding);
1512 if (! NILP (repertory) && SYMBOLP (repertory))
1513 {
1514 CHECK_CHARSET (repertory);
1515 repertory = CHARSET_SYMBOL_ID (repertory);
1516 }
57e13af9 1517 }
581f7ac7 1518 FONT_DEF_NEW (font_def, font_spec, encoding, repertory);
0d407d77 1519 }
d67f7f1a
KH
1520 else
1521 font_def = Qnil;
4ed46869 1522
eb36588a 1523 if (CHARACTERP (target))
d6490542
KH
1524 {
1525 if (XFASTINT (target) < 0x80)
d7a39b51 1526 error ("Can't set a font for partial ASCII range");
6c6f1994 1527 range_list = list1 (Fcons (target, target));
d6490542 1528 }
eb36588a 1529 else if (CONSP (target))
0d407d77 1530 {
06f76f0d
KH
1531 Lisp_Object from, to;
1532
eb36588a
KH
1533 from = Fcar (target);
1534 to = Fcdr (target);
06f76f0d
KH
1535 CHECK_CHARACTER (from);
1536 CHECK_CHARACTER (to);
d6490542
KH
1537 if (XFASTINT (from) < 0x80)
1538 {
1539 if (XFASTINT (from) != 0 || XFASTINT (to) < 0x7F)
d7a39b51 1540 error ("Can't set a font for partial ASCII range");
d6490542
KH
1541 ascii_changed = 1;
1542 }
6c6f1994 1543 range_list = list1 (target);
4ed46869 1544 }
eb36588a 1545 else if (SYMBOLP (target) && !NILP (target))
8a9be3ac 1546 {
1d5d7200
KH
1547 Lisp_Object script_list;
1548 Lisp_Object val;
0d407d77 1549
1d5d7200
KH
1550 range_list = Qnil;
1551 script_list = XCHAR_TABLE (Vchar_script_table)->extras[0];
eb36588a 1552 if (! NILP (Fmemq (target, script_list)))
afe93d01 1553 {
d6490542
KH
1554 if (EQ (target, Qlatin))
1555 ascii_changed = 1;
6c6f1994 1556 val = list1 (target);
1d5d7200 1557 map_char_table (accumulate_script_ranges, Qnil, Vchar_script_table,
8f924df7 1558 val);
a3d16f39 1559 range_list = Fnreverse (XCDR (val));
afe93d01 1560 }
fb78e2ed 1561 if (CHARSETP (target))
afe93d01 1562 {
d6490542
KH
1563 CHECK_CHARSET_GET_CHARSET (target, charset);
1564 if (charset->ascii_compatible_p)
1565 ascii_changed = 1;
afe93d01 1566 }
fb78e2ed 1567 else if (NILP (range_list))
1d5d7200 1568 error ("Invalid script or charset name: %s",
eb36588a 1569 SDATA (SYMBOL_NAME (target)));
8a9be3ac 1570 }
eb36588a 1571 else if (NILP (target))
6c6f1994 1572 range_list = list1 (Qnil);
eb36588a
KH
1573 else
1574 error ("Invalid target for setting a font");
0d407d77 1575
a3d16f39
KH
1576 if (ascii_changed)
1577 {
1578 Lisp_Object val;
1579
1580 if (NILP (font_spec))
1581 error ("Can't set ASCII font to nil");
1582 val = CHAR_TABLE_REF (fontset, 0);
1583 if (! NILP (val) && EQ (add, Qappend))
1584 /* We are going to change just an additional font for ASCII. */
1585 ascii_changed = 0;
1586 }
fb78e2ed
KH
1587
1588 if (charset)
1589 {
a3d16f39
KH
1590 Lisp_Object arg;
1591
25721f5b 1592 arg = make_uninit_vector (5);
a3d16f39
KH
1593 ASET (arg, 0, fontset);
1594 ASET (arg, 1, font_def);
1595 ASET (arg, 2, add);
1596 ASET (arg, 3, ascii_changed ? Qt : Qnil);
1597 ASET (arg, 4, range_list);
fb78e2ed 1598
a3d16f39 1599 map_charset_chars (set_fontset_font, Qnil, arg, charset,
fb78e2ed
KH
1600 CHARSET_MIN_CODE (charset),
1601 CHARSET_MAX_CODE (charset));
a3d16f39 1602 range_list = AREF (arg, 4);
fb78e2ed 1603 }
1d5d7200
KH
1604 for (; CONSP (range_list); range_list = XCDR (range_list))
1605 FONTSET_ADD (fontset, XCAR (range_list), font_def, add);
4ed46869 1606
d6490542
KH
1607 if (ascii_changed)
1608 {
7519b8cd 1609 Lisp_Object tail, fr, alist;
d6490542
KH
1610 int fontset_id = XINT (FONTSET_ID (fontset));
1611
d0d2d26f 1612 set_fontset_ascii (fontset, fontname);
d6490542 1613 name = FONTSET_NAME (fontset);
7519b8cd 1614 FOR_EACH_FRAME (tail, fr)
d6490542 1615 {
a10c8269 1616 struct frame *f = XFRAME (fr);
d6490542 1617 Lisp_Object font_object;
0875632e 1618 struct face *face;
d6490542 1619
0875632e 1620 if (FRAME_INITIAL_P (f) || FRAME_TERMCAP_P (f))
d6490542
KH
1621 continue;
1622 if (fontset_id != FRAME_FONTSET (f))
1623 continue;
0875632e
KH
1624 face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
1625 if (face)
1626 font_object = font_load_for_lface (f, face->lface, font_spec);
1627 else
1628 font_object = font_open_by_spec (f, font_spec);
d6490542
KH
1629 if (! NILP (font_object))
1630 {
1631 update_auto_fontset_alist (font_object, fontset);
6c6f1994 1632 alist = list1 (Fcons (Qfont, Fcons (name, font_object)));
7519b8cd 1633 Fmodify_frame_parameters (fr, alist);
d6490542
KH
1634 }
1635 }
1636 }
1637
0875632e
KH
1638 /* Free all realized fontsets whose base is FONTSET. This way, the
1639 specified character(s) are surely redisplayed by a correct
1640 font. */
1641 free_realized_fontsets (fontset);
1642
4ed46869
KH
1643 return Qnil;
1644}
1645
06f76f0d
KH
1646
1647DEFUN ("new-fontset", Fnew_fontset, Snew_fontset, 2, 2, 0,
1648 doc: /* Create a new fontset NAME from font information in FONTLIST.
1649
1d5d7200 1650FONTLIST is an alist of scripts vs the corresponding font specification list.
d6aaac9e
KH
1651Each element of FONTLIST has the form (SCRIPT FONT-SPEC ...), where a
1652character of SCRIPT is displayed by a font that matches one of
1653FONT-SPEC.
06f76f0d 1654
d6aaac9e
KH
1655SCRIPT is a symbol that appears in the first extra slot of the
1656char-table `char-script-table'.
06f76f0d 1657
1d5d7200
KH
1658FONT-SPEC is a vector, a cons, or a string. See the documentation of
1659`set-fontset-font' for the meaning. */)
5842a27b 1660 (Lisp_Object name, Lisp_Object fontlist)
06f76f0d 1661{
1d5d7200 1662 Lisp_Object fontset;
1d5d7200 1663 int id;
06f76f0d
KH
1664
1665 CHECK_STRING (name);
1666 CHECK_LIST (fontlist);
1667
581f7ac7 1668 name = Fdowncase (name);
1d5d7200
KH
1669 id = fs_query_fontset (name, 0);
1670 if (id < 0)
0d407d77 1671 {
581f7ac7
KH
1672 Lisp_Object font_spec = Ffont_spec (0, NULL);
1673 Lisp_Object short_name;
5f2d79e0 1674 char xlfd[256];
581f7ac7
KH
1675 int len;
1676
984e7f30 1677 if (font_parse_xlfd (SSDATA (name), SBYTES (name), font_spec) < 0)
d6aaac9e 1678 error ("Fontset name must be in XLFD format");
581f7ac7 1679 short_name = AREF (font_spec, FONT_REGISTRY_INDEX);
51b59d79 1680 if (strncmp (SSDATA (SYMBOL_NAME (short_name)), "fontset-", 8)
581f7ac7
KH
1681 || SBYTES (SYMBOL_NAME (short_name)) < 9)
1682 error ("Registry field of fontset name must be \"fontset-*\"");
1683 Vfontset_alias_alist = Fcons (Fcons (name, SYMBOL_NAME (short_name)),
1684 Vfontset_alias_alist);
1685 ASET (font_spec, FONT_REGISTRY_INDEX, Qiso8859_1);
d6aaac9e 1686 fontset = make_fontset (Qnil, name, Qnil);
5f2d79e0
KH
1687 len = font_unparse_xlfd (font_spec, 0, xlfd, 256);
1688 if (len < 0)
1689 error ("Invalid fontset name (perhaps too long): %s", SDATA (name));
d0d2d26f 1690 set_fontset_ascii (fontset, make_unibyte_string (xlfd, len));
d6aaac9e 1691 }
1d5d7200
KH
1692 else
1693 {
8510724d 1694 fontset = FONTSET_FROM_ID (id);
1d5d7200
KH
1695 free_realized_fontsets (fontset);
1696 Fset_char_table_range (fontset, Qt, Qnil);
0d407d77 1697 }
4ed46869 1698
7d7bbefd 1699 for (; CONSP (fontlist); fontlist = XCDR (fontlist))
1d5d7200
KH
1700 {
1701 Lisp_Object elt, script;
1702
34348bd4 1703 elt = XCAR (fontlist);
1d5d7200 1704 script = Fcar (elt);
cc36ddbf
KH
1705 elt = Fcdr (elt);
1706 if (CONSP (elt) && (NILP (XCDR (elt)) || CONSP (XCDR (elt))))
1707 for (; CONSP (elt); elt = XCDR (elt))
1708 Fset_fontset_font (name, script, XCAR (elt), Qnil, Qappend);
1709 else
1710 Fset_fontset_font (name, script, elt, Qnil, Qappend);
1d5d7200 1711 }
06f76f0d
KH
1712 return name;
1713}
1714
1715
452a78e0 1716/* Alist of automatically created fontsets. Each element is a cons
581f7ac7 1717 (FONT-SPEC . FONTSET-ID). */
452a78e0 1718static Lisp_Object auto_fontset_alist;
d6aaac9e 1719
d6490542 1720/* Number of automatically created fontsets. */
d311d28c 1721static ptrdiff_t num_auto_fontsets;
d6490542 1722
0b381c7e 1723/* Return a fontset synthesized from FONT-OBJECT. This is called from
d8d2f142
KH
1724 x_new_font when FONT-OBJECT is used for the default ASCII font of a
1725 frame, and the returned fontset is used for the default fontset of
1726 that frame. The fontset specifies a font of the same registry as
1727 FONT-OBJECT for all characters in the repertory of the registry
1728 (see Vfont_encoding_alist). If the repertory is not known, the
1729 fontset specifies the font for all Latin characters assuming that a
1730 user intends to use FONT-OBJECT for Latin characters. */
d6490542 1731
d6aaac9e 1732int
971de7fb 1733fontset_from_font (Lisp_Object font_object)
8aa07a8d 1734{
03ef560c 1735 Lisp_Object font_name = font_get_name (font_object);
92470028 1736 Lisp_Object font_spec = copy_font_spec (font_object);
d6490542 1737 Lisp_Object registry = AREF (font_spec, FONT_REGISTRY_INDEX);
581f7ac7
KH
1738 Lisp_Object fontset_spec, alias, name, fontset;
1739 Lisp_Object val;
8aa07a8d 1740
581f7ac7
KH
1741 val = assoc_no_quit (font_spec, auto_fontset_alist);
1742 if (CONSP (val))
1743 return XINT (FONTSET_ID (XCDR (val)));
d6490542 1744 if (num_auto_fontsets++ == 0)
581f7ac7 1745 alias = intern ("fontset-startup");
03ef560c
KH
1746 else
1747 {
d311d28c 1748 char temp[sizeof "fontset-auto" + INT_STRLEN_BOUND (ptrdiff_t)];
8aa07a8d 1749
d311d28c 1750 sprintf (temp, "fontset-auto%"pD"d", num_auto_fontsets - 1);
581f7ac7 1751 alias = intern (temp);
03ef560c 1752 }
92470028 1753 fontset_spec = copy_font_spec (font_spec);
581f7ac7 1754 ASET (fontset_spec, FONT_REGISTRY_INDEX, alias);
7ae2e7f0 1755 name = Ffont_xlfd_name (fontset_spec, Qnil);
4e6a86c6 1756 eassert (!NILP (name));
03ef560c 1757 fontset = make_fontset (Qnil, name, Qnil);
581f7ac7
KH
1758 Vfontset_alias_alist = Fcons (Fcons (name, SYMBOL_NAME (alias)),
1759 Vfontset_alias_alist);
1760 alias = Fdowncase (AREF (font_object, FONT_NAME_INDEX));
1761 Vfontset_alias_alist = Fcons (Fcons (name, alias), Vfontset_alias_alist);
1762 auto_fontset_alist = Fcons (Fcons (font_spec, fontset), auto_fontset_alist);
d8d2f142
KH
1763 font_spec = Ffont_spec (0, NULL);
1764 ASET (font_spec, FONT_REGISTRY_INDEX, registry);
1765 {
1766 Lisp_Object target = find_font_encoding (SYMBOL_NAME (registry));
1767
1768 if (CONSP (target))
1769 target = XCDR (target);
1770 if (! CHARSETP (target))
1771 target = Qlatin;
1772 Fset_fontset_font (name, target, font_spec, Qnil, Qnil);
1773 Fset_fontset_font (name, Qnil, font_spec, Qnil, Qnil);
1774 }
1775
d0d2d26f 1776 set_fontset_ascii (fontset, font_name);
edfda783 1777
03ef560c 1778 return XINT (FONTSET_ID (fontset));
8aa07a8d
KH
1779}
1780
d6490542
KH
1781
1782/* Update auto_fontset_alist for FONTSET. When an ASCII font of
1783 FONTSET is changed, we delete an entry of FONTSET if any from
1784 auto_fontset_alist so that FONTSET is not re-used by
1785 fontset_from_font. */
1786
1787static void
971de7fb 1788update_auto_fontset_alist (Lisp_Object font_object, Lisp_Object fontset)
d6490542
KH
1789{
1790 Lisp_Object prev, tail;
1791
1792 for (prev = Qnil, tail = auto_fontset_alist; CONSP (tail);
1793 prev = tail, tail = XCDR (tail))
1794 if (EQ (fontset, XCDR (XCAR (tail))))
1795 {
1796 if (NILP (prev))
1797 auto_fontset_alist = XCDR (tail);
1798 else
1799 XSETCDR (prev, XCDR (tail));
1800 break;
1801 }
1802}
1803
1804
fe44f009
KH
1805/* Return a cons (FONT-OBJECT . GLYPH-CODE).
1806 FONT-OBJECT is the font for the character at POSITION in the current
1ff005e1 1807 buffer. This is computed from all the text properties and overlays
09e80d9f 1808 that apply to POSITION. POSITION may be nil, in which case,
fe44f009 1809 FONT-SPEC is the font for displaying the character CH with the
cf14fd6e
KH
1810 default face.
1811
92c15c34
KH
1812 GLYPH-CODE is the glyph code in the font to use for the character.
1813
1814 If the 2nd optional arg CH is non-nil, it is a character to check
1815 the font instead of the character at POSITION.
1816
1817 It returns nil in the following cases:
1ff005e1
KH
1818
1819 (1) The window system doesn't have a font for the character (thus
1820 it is displayed by an empty box).
1821
1822 (2) The character code is invalid.
1823
cf14fd6e
KH
1824 (3) If POSITION is not nil, and the current buffer is not displayed
1825 in any window.
1ff005e1
KH
1826
1827 In addition, the returned font name may not take into account of
1828 such redisplay engine hooks as what used in jit-lock-mode if
1829 POSITION is currently not visible. */
1830
1831
92c15c34 1832DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0,
335c5470 1833 doc: /* For internal use only. */)
5842a27b 1834 (Lisp_Object position, Lisp_Object ch)
1ff005e1 1835{
d311d28c 1836 ptrdiff_t pos, pos_byte, dummy;
1ff005e1
KH
1837 int face_id;
1838 int c;
1ff005e1
KH
1839 struct frame *f;
1840 struct face *face;
1841
cf14fd6e 1842 if (NILP (position))
92c15c34
KH
1843 {
1844 CHECK_CHARACTER (ch);
1845 c = XINT (ch);
cf14fd6e 1846 f = XFRAME (selected_frame);
f2cec7a9 1847 face_id = lookup_basic_face (f, DEFAULT_FACE_ID);
327719ee 1848 pos = -1;
cf14fd6e
KH
1849 }
1850 else
1851 {
f0397f5a 1852 Lisp_Object window;
cf14fd6e
KH
1853 struct window *w;
1854
1855 CHECK_NUMBER_COERCE_MARKER (position);
d311d28c 1856 if (! (BEGV <= XINT (position) && XINT (position) < ZV))
cf14fd6e 1857 args_out_of_range_3 (position, make_number (BEGV), make_number (ZV));
d311d28c 1858 pos = XINT (position);
cf14fd6e
KH
1859 pos_byte = CHAR_TO_BYTE (pos);
1860 if (NILP (ch))
1861 c = FETCH_CHAR (pos_byte);
1862 else
1863 {
1864 CHECK_NATNUM (ch);
1865 c = XINT (ch);
1866 }
1867 window = Fget_buffer_window (Fcurrent_buffer (), Qnil);
1868 if (NILP (window))
1869 return Qnil;
1870 w = XWINDOW (window);
d3d50620 1871 f = XFRAME (w->frame);
6970f632
CY
1872 face_id = face_at_buffer_position (w, pos, -1, -1, &dummy,
1873 pos + 100, 0, -1);
92c15c34 1874 }
2638320e 1875 if (! CHAR_VALID_P (c))
1ff005e1 1876 return Qnil;
3fa1e84d
EZ
1877 if (!FRAME_WINDOW_P (f))
1878 return Qnil;
327719ee 1879 face_id = FACE_FOR_CHAR (f, FACE_FROM_ID (f, face_id), c, pos, Qnil);
1ff005e1 1880 face = FACE_FROM_ID (f, face_id);
581f7ac7 1881 if (face->font)
8aa07a8d 1882 {
fe44f009
KH
1883 unsigned code = face->font->driver->encode_char (face->font, c);
1884 Lisp_Object font_object;
581f7ac7
KH
1885
1886 if (code == FONT_INVALID_CODE)
1887 return Qnil;
fe44f009 1888 XSETFONT (font_object, face->font);
be44ca6c 1889 return Fcons (font_object, INTEGER_TO_CONS (code));
92c15c34
KH
1890 }
1891 return Qnil;
1ff005e1
KH
1892}
1893
1894
1d5d7200
KH
1895DEFUN ("fontset-info", Ffontset_info, Sfontset_info, 1, 2, 0,
1896 doc: /* Return information about a fontset FONTSET on frame FRAME.
e2b45cf9 1897
a3d16f39
KH
1898FONTSET is a fontset name string, nil for the fontset of FRAME, or t
1899for the default fontset. FRAME nil means the selected frame.
1ff005e1 1900
a3d16f39 1901The value is a char-table whose elements have this form:
1ff005e1 1902
a3d16f39 1903 ((FONT OPENED-FONT ...) ...)
1ff005e1 1904
a3d16f39 1905FONT is a name of font specified for a range of characters.
1ff005e1 1906
d6aaac9e 1907OPENED-FONT is a name of a font actually opened.
1ff005e1 1908
a3d16f39
KH
1909The char-table has one extra slot. If FONTSET is not the default
1910fontset, the value the extra slot is a char-table containing the
1911information about the derived fonts from the default fontset. The
1912format is the same as above. */)
5842a27b 1913 (Lisp_Object fontset, Lisp_Object frame)
4ed46869 1914{
cc7b6145
KH
1915 Lisp_Object *realized[2], fontsets[2], tables[2];
1916 Lisp_Object val, elt;
1917 int c, i, j, k;
fc8865fc 1918
7452b7bd 1919 check_window_system (NULL);
a3d16f39 1920 fontset = check_fontset_name (fontset, &frame);
4ed46869 1921
1d5d7200
KH
1922 /* Recode fontsets realized on FRAME from the base fontset FONTSET
1923 in the table `realized'. */
663e2b3f 1924 realized[0] = alloca (word_size * ASIZE (Vfontset_table));
cc7b6145 1925 for (i = j = 0; i < ASIZE (Vfontset_table); i++)
0d407d77 1926 {
1ff005e1
KH
1927 elt = FONTSET_FROM_ID (i);
1928 if (!NILP (elt)
1d5d7200
KH
1929 && EQ (FONTSET_BASE (elt), fontset)
1930 && EQ (FONTSET_FRAME (elt), frame))
cc7b6145 1931 realized[0][j++] = elt;
0d407d77 1932 }
cc7b6145 1933 realized[0][j] = Qnil;
4ed46869 1934
663e2b3f 1935 realized[1] = alloca (word_size * ASIZE (Vfontset_table));
cc7b6145
KH
1936 for (i = j = 0; ! NILP (realized[0][i]); i++)
1937 {
1938 elt = FONTSET_DEFAULT (realized[0][i]);
1939 if (! NILP (elt))
1940 realized[1][j++] = elt;
1941 }
1942 realized[1][j] = Qnil;
1943
1944 tables[0] = Fmake_char_table (Qfontset_info, Qnil);
cc7b6145 1945 fontsets[0] = fontset;
348db3dd 1946 if (!EQ (fontset, Vdefault_fontset))
a3d16f39
KH
1947 {
1948 tables[1] = Fmake_char_table (Qnil, Qnil);
34dabdb7 1949 set_char_table_extras (tables[0], 0, tables[1]);
a3d16f39
KH
1950 fontsets[1] = Vdefault_fontset;
1951 }
e2b45cf9 1952
1d5d7200
KH
1953 /* Accumulate information of the fontset in TABLE. The format of
1954 each element is ((FONT-SPEC OPENED-FONT ...) ...). */
cc7b6145 1955 for (k = 0; k <= 1; k++)
0d407d77 1956 {
cc7b6145 1957 for (c = 0; c <= MAX_CHAR; )
d6aaac9e 1958 {
5b30be1a 1959 int from = c, to = MAX_5_BYTE_CHAR;
0d407d77 1960
cc7b6145
KH
1961 if (c <= MAX_5_BYTE_CHAR)
1962 {
1963 val = char_table_ref_and_range (fontsets[k], c, &from, &to);
cc7b6145
KH
1964 }
1965 else
1966 {
1967 val = FONTSET_FALLBACK (fontsets[k]);
1968 to = MAX_CHAR;
1969 }
d6aaac9e 1970 if (VECTORP (val))
0d407d77 1971 {
d6aaac9e
KH
1972 Lisp_Object alist;
1973
1974 /* At first, set ALIST to ((FONT-SPEC) ...). */
1975 for (alist = Qnil, i = 0; i < ASIZE (val); i++)
581f7ac7
KH
1976 if (! NILP (AREF (val, i)))
1977 alist = Fcons (Fcons (FONT_DEF_SPEC (AREF (val, i)), Qnil),
1978 alist);
d6aaac9e
KH
1979 alist = Fnreverse (alist);
1980
660100f3 1981 /* Then store opened font names to cdr of each elements. */
cc7b6145 1982 for (i = 0; ! NILP (realized[k][i]); i++)
1ff005e1 1983 {
cc7b6145
KH
1984 if (c <= MAX_5_BYTE_CHAR)
1985 val = FONTSET_REF (realized[k][i], c);
1986 else
1987 val = FONTSET_FALLBACK (realized[k][i]);
a3d16f39 1988 if (! CONSP (val) || ! VECTORP (XCDR (val)))
d6aaac9e 1989 continue;
a3d16f39
KH
1990 /* VAL: (int . [[FACE-ID FONT-DEF FONT-OBJECT int] ... ]) */
1991 val = XCDR (val);
1992 for (j = 0; j < ASIZE (val); j++)
3d4448a8 1993 {
581f7ac7
KH
1994 elt = AREF (val, j);
1995 if (FONT_OBJECT_P (RFONT_DEF_OBJECT (elt)))
1996 {
1997 Lisp_Object font_object = RFONT_DEF_OBJECT (elt);
1998 Lisp_Object slot, name;
1999
2000 slot = Fassq (RFONT_DEF_SPEC (elt), alist);
2001 name = AREF (font_object, FONT_NAME_INDEX);
2002 if (NILP (Fmember (name, XCDR (slot))))
6c6f1994 2003 nconc2 (slot, list1 (name));
581f7ac7 2004 }
3d4448a8 2005 }
1ff005e1 2006 }
d6aaac9e
KH
2007
2008 /* Store ALIST in TBL for characters C..TO. */
cc7b6145
KH
2009 if (c <= MAX_5_BYTE_CHAR)
2010 char_table_set_range (tables[k], c, to, alist);
2011 else
742af32f 2012 set_char_table_defalt (tables[k], alist);
581f7ac7
KH
2013
2014 /* At last, change each elements to font names. */
2015 for (; CONSP (alist); alist = XCDR (alist))
2016 {
2017 elt = XCAR (alist);
7ae2e7f0 2018 XSETCAR (elt, Ffont_xlfd_name (XCAR (elt), Qnil));
581f7ac7 2019 }
0d407d77 2020 }
d6aaac9e 2021 c = to + 1;
0d407d77 2022 }
348db3dd 2023 if (EQ (fontset, Vdefault_fontset))
a3d16f39 2024 break;
0d407d77 2025 }
a921395d 2026
cc7b6145 2027 return tables[0];
4ed46869
KH
2028}
2029
1d5d7200 2030
0fdf26e6 2031DEFUN ("fontset-font", Ffontset_font, Sfontset_font, 2, 3, 0,
335c5470 2032 doc: /* Return a font name pattern for character CH in fontset NAME.
0fdf26e6 2033If NAME is t, find a pattern in the default fontset.
5fc05db0 2034If NAME is nil, find a pattern in the fontset of the selected frame.
0fdf26e6
KH
2035
2036The value has the form (FAMILY . REGISTRY), where FAMILY is a font
2037family name and REGISTRY is a font registry name. This is actually
2038the first font name pattern for CH in the fontset or in the default
2039fontset.
2040
2041If the 2nd optional arg ALL is non-nil, return a list of all font name
2042patterns. */)
5842a27b 2043 (Lisp_Object name, Lisp_Object ch, Lisp_Object all)
0d407d77 2044{
1337ac77 2045 int c;
0fdf26e6
KH
2046 Lisp_Object fontset, elt, list, repertory, val;
2047 int i, j;
a3d16f39 2048 Lisp_Object frame;
0d407d77 2049
a3d16f39
KH
2050 frame = Qnil;
2051 fontset = check_fontset_name (name, &frame);
0d407d77 2052
06f76f0d 2053 CHECK_CHARACTER (ch);
0d407d77 2054 c = XINT (ch);
0fdf26e6
KH
2055 list = Qnil;
2056 while (1)
2057 {
2058 for (i = 0, elt = FONTSET_REF (fontset, c); i < 2;
2059 i++, elt = FONTSET_FALLBACK (fontset))
2060 if (VECTORP (elt))
2061 for (j = 0; j < ASIZE (elt); j++)
2062 {
a124bbb6
KH
2063 Lisp_Object family, registry;
2064
0fdf26e6 2065 val = AREF (elt, j);
5fc05db0 2066 if (NILP (val))
563a866e 2067 return Qnil;
0fdf26e6
KH
2068 repertory = AREF (val, 1);
2069 if (INTEGERP (repertory))
2070 {
2071 struct charset *charset = CHARSET_FROM_ID (XINT (repertory));
2072
2073 if (! CHAR_CHARSET_P (c, charset))
2074 continue;
2075 }
2076 else if (CHAR_TABLE_P (repertory))
2077 {
2078 if (NILP (CHAR_TABLE_REF (repertory, c)))
2079 continue;
2080 }
2081 val = AREF (val, 0);
a124bbb6
KH
2082 /* VAL is a FONT-SPEC */
2083 family = AREF (val, FONT_FAMILY_INDEX);
2084 if (! NILP (family))
2085 family = SYMBOL_NAME (family);
2086 registry = AREF (val, FONT_REGISTRY_INDEX);
2087 if (! NILP (registry))
2088 registry = SYMBOL_NAME (registry);
2089 val = Fcons (family, registry);
0fdf26e6
KH
2090 if (NILP (all))
2091 return val;
2092 list = Fcons (val, list);
2093 }
2094 if (EQ (fontset, Vdefault_fontset))
2095 break;
2096 fontset = Vdefault_fontset;
2097 }
2098 return (Fnreverse (list));
0d407d77 2099}
0d407d77
KH
2100
2101DEFUN ("fontset-list", Ffontset_list, Sfontset_list, 0, 0, 0,
335c5470 2102 doc: /* Return a list of all defined fontset names. */)
5842a27b 2103 (void)
0d407d77
KH
2104{
2105 Lisp_Object fontset, list;
2106 int i;
2107
2108 list = Qnil;
2109 for (i = 0; i < ASIZE (Vfontset_table); i++)
2110 {
2111 fontset = FONTSET_FROM_ID (i);
2112 if (!NILP (fontset)
2113 && BASE_FONTSET_P (fontset))
2114 list = Fcons (FONTSET_NAME (fontset), list);
2115 }
1ff005e1 2116
0d407d77
KH
2117 return list;
2118}
2119
452a78e0 2120
a54e2c05 2121#ifdef ENABLE_CHECKING
452a78e0 2122
8a10d76c
PE
2123Lisp_Object dump_fontset (Lisp_Object) EXTERNALLY_VISIBLE;
2124
452a78e0 2125Lisp_Object
ef1b0ba7 2126dump_fontset (Lisp_Object fontset)
452a78e0
KH
2127{
2128 Lisp_Object vec;
2129
2130 vec = Fmake_vector (make_number (3), Qnil);
2131 ASET (vec, 0, FONTSET_ID (fontset));
2132
2133 if (BASE_FONTSET_P (fontset))
2134 {
2135 ASET (vec, 1, FONTSET_NAME (fontset));
2136 }
2137 else
2138 {
2139 Lisp_Object frame;
2140
2141 frame = FONTSET_FRAME (fontset);
2142 if (FRAMEP (frame))
2143 {
a10c8269 2144 struct frame *f = XFRAME (frame);
452a78e0
KH
2145
2146 if (FRAME_LIVE_P (f))
1c82b4b3 2147 ASET (vec, 1,
5b20b3cc 2148 Fcons (FONTSET_NAME (FONTSET_BASE (fontset)),
e69b0960 2149 f->name));
452a78e0 2150 else
1c82b4b3
KH
2151 ASET (vec, 1,
2152 Fcons (FONTSET_NAME (FONTSET_BASE (fontset)), Qnil));
452a78e0 2153 }
eb36588a
KH
2154 if (!NILP (FONTSET_DEFAULT (fontset)))
2155 ASET (vec, 2, FONTSET_ID (FONTSET_DEFAULT (fontset)));
452a78e0
KH
2156 }
2157 return vec;
2158}
2159
a7ca3326 2160DEFUN ("fontset-list-all", Ffontset_list_all, Sfontset_list_all, 0, 0, 0,
452a78e0 2161 doc: /* Return a brief summary of all fontsets for debug use. */)
5842a27b 2162 (void)
452a78e0
KH
2163{
2164 Lisp_Object val;
2165 int i;
2166
2167 for (i = 0, val = Qnil; i < ASIZE (Vfontset_table); i++)
2168 if (! NILP (AREF (Vfontset_table, i)))
2169 val = Fcons (dump_fontset (AREF (Vfontset_table, i)), val);
2170 return (Fnreverse (val));
2171}
a54e2c05 2172#endif /* ENABLE_CHECKING */
452a78e0 2173
dfcf069d 2174void
971de7fb 2175syms_of_fontset (void)
4ed46869 2176{
1d5d7200 2177 DEFSYM (Qfontset, "fontset");
eb36588a 2178 Fput (Qfontset, Qchar_table_extra_slots, make_number (9));
d6aaac9e
KH
2179 DEFSYM (Qfontset_info, "fontset-info");
2180 Fput (Qfontset_info, Qchar_table_extra_slots, make_number (1));
4ed46869 2181
1d5d7200
KH
2182 DEFSYM (Qprepend, "prepend");
2183 DEFSYM (Qappend, "append");
c3fb88cc 2184 DEFSYM (Qlatin, "latin");
4ed46869
KH
2185
2186 Vcached_fontset_data = Qnil;
2187 staticpro (&Vcached_fontset_data);
2188
0d407d77
KH
2189 Vfontset_table = Fmake_vector (make_number (32), Qnil);
2190 staticpro (&Vfontset_table);
0d407d77
KH
2191
2192 Vdefault_fontset = Fmake_char_table (Qfontset, Qnil);
2193 staticpro (&Vdefault_fontset);
d0d2d26f
PE
2194 set_fontset_id (Vdefault_fontset, make_number (0));
2195 set_fontset_name
6d470bdd
DA
2196 (Vdefault_fontset,
2197 build_pure_c_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default"));
ff7a2223 2198 ASET (Vfontset_table, 0, Vdefault_fontset);
1ff005e1 2199 next_fontset_id = 1;
4ed46869 2200
452a78e0
KH
2201 auto_fontset_alist = Qnil;
2202 staticpro (&auto_fontset_alist);
2203
29208e82 2204 DEFVAR_LISP ("font-encoding-charset-alist", Vfont_encoding_charset_alist,
28e2436a
KH
2205 doc: /*
2206Alist of charsets vs the charsets to determine the preferred font encoding.
eb152aa9 2207Each element looks like (CHARSET . ENCODING-CHARSET),
28e2436a
KH
2208where ENCODING-CHARSET is a charset registered in the variable
2209`font-encoding-alist' as ENCODING.
2210
2211When a text has a property `charset' and the value is CHARSET, a font
2212whose encoding corresponds to ENCODING-CHARSET is preferred. */);
2213 Vfont_encoding_charset_alist = Qnil;
2214
29208e82 2215 DEFVAR_LISP ("use-default-ascent", Vuse_default_ascent,
1d5d7200
KH
2216 doc: /*
2217Char table of characters whose ascent values should be ignored.
335c5470 2218If an entry for a character is non-nil, the ascent value of the glyph
eb152aa9 2219is assumed to be specified by _MULE_DEFAULT_ASCENT property of a font.
335c5470
PJ
2220
2221This affects how a composite character which contains
2222such a character is displayed on screen. */);
2aeafb78
KH
2223 Vuse_default_ascent = Qnil;
2224
29208e82 2225 DEFVAR_LISP ("ignore-relative-composition", Vignore_relative_composition,
1d5d7200 2226 doc: /*
eb152aa9 2227Char table of characters which are not composed relatively.
335c5470
PJ
2228If an entry for a character is non-nil, a composition sequence
2229which contains that character is displayed so that
2230the glyph of that character is put without considering
2231an ascent and descent value of a previous character. */);
810abb87 2232 Vignore_relative_composition = Qnil;
6a7e6d80 2233
29208e82 2234 DEFVAR_LISP ("alternate-fontname-alist", Valternate_fontname_alist,
335c5470
PJ
2235 doc: /* Alist of fontname vs list of the alternate fontnames.
2236When a specified font name is not found, the corresponding
2237alternate fontnames (if any) are tried instead. */);
01d4b817 2238 Valternate_fontname_alist = Qnil;
8c83e4f9 2239
29208e82 2240 DEFVAR_LISP ("fontset-alias-alist", Vfontset_alias_alist,
335c5470 2241 doc: /* Alist of fontset names vs the aliases. */);
6c6f1994
PE
2242 Vfontset_alias_alist
2243 = list1 (Fcons (FONTSET_NAME (Vdefault_fontset),
2244 build_pure_c_string ("fontset-default")));
1c283e35 2245
810abb87 2246 DEFVAR_LISP ("vertical-centering-font-regexp",
29208e82 2247 Vvertical_centering_font_regexp,
fb7ada5f 2248 doc: /* Regexp matching font names that require vertical centering on display.
335c5470 2249When a character is displayed with such fonts, the character is displayed
fc8865fc 2250at the vertical center of lines. */);
810abb87
KH
2251 Vvertical_centering_font_regexp = Qnil;
2252
29208e82 2253 DEFVAR_LISP ("otf-script-alist", Votf_script_alist,
21ff5ed6
KH
2254 doc: /* Alist of OpenType script tags vs the corresponding script names. */);
2255 Votf_script_alist = Qnil;
2256
4ed46869
KH
2257 defsubr (&Squery_fontset);
2258 defsubr (&Snew_fontset);
2259 defsubr (&Sset_fontset_font);
1ff005e1 2260 defsubr (&Sinternal_char_font);
4ed46869 2261 defsubr (&Sfontset_info);
0d407d77
KH
2262 defsubr (&Sfontset_font);
2263 defsubr (&Sfontset_list);
a54e2c05 2264#ifdef ENABLE_CHECKING
452a78e0
KH
2265 defsubr (&Sfontset_list_all);
2266#endif
e3400864 2267}