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