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