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