Move old compatiblity to cl.el. Remove cl-macroexpand-all.
[emacs.git] / src / fontset.c
blobb2c7249625e22ee414feb0f4e1b98a4cd9a9aa7d
1 /* Fontset handler.
3 Copyright (C) 2001-2012 Free Software Foundation, Inc.
4 Copyright (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
8 Copyright (C) 2003, 2006
9 National Institute of Advanced Industrial Science and Technology (AIST)
10 Registration Number H13PRO009
12 This file is part of GNU Emacs.
14 GNU Emacs is free software: you can redistribute it and/or modify
15 it under the terms of the GNU General Public License as published by
16 the Free Software Foundation, either version 3 of the License, or
17 (at your option) any later version.
19 GNU Emacs is distributed in the hope that it will be useful,
20 but WITHOUT ANY WARRANTY; without even the implied warranty of
21 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 GNU General Public License for more details.
24 You should have received a copy of the GNU General Public License
25 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
27 /* #define FONTSET_DEBUG */
29 #include <config.h>
30 #include <stdio.h>
31 #include <setjmp.h>
33 #include "lisp.h"
34 #include "blockinput.h"
35 #include "buffer.h"
36 #include "character.h"
37 #include "charset.h"
38 #include "ccl.h"
39 #include "keyboard.h"
40 #include "frame.h"
41 #include "dispextern.h"
42 #include "intervals.h"
43 #include "fontset.h"
44 #include "window.h"
45 #ifdef HAVE_X_WINDOWS
46 #include "xterm.h"
47 #endif
48 #ifdef WINDOWSNT
49 #include "w32term.h"
50 #endif
51 #ifdef HAVE_NS
52 #include "nsterm.h"
53 #endif
54 #include "termhooks.h"
56 #include "font.h"
58 #undef xassert
59 #ifdef FONTSET_DEBUG
60 #define xassert(X) do {if (!(X)) abort ();} while (0)
61 #else /* not FONTSET_DEBUG */
62 #define xassert(X) (void) 0
63 #endif /* not FONTSET_DEBUG */
65 /* FONTSET
67 A fontset is a collection of font related information to give
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.
73 Another role, the more important one, is to provide information
74 about which font to use for each non-ASCII character.
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.
83 A fontset object is implemented by a char-table whose default value
84 and parent are always nil.
86 An element of a base fontset is a vector of FONT-DEFs which itself
87 is a vector [ FONT-SPEC ENCODING REPERTORY ].
89 An element of a realized fontset is nil, t, 0, or a vector of this
90 form:
92 [ CHARSET-ORDERED-LIST-TICK PREFERRED-RFONT-DEF
93 RFONT-DEF0 RFONT-DEF1 ... ]
95 RFONT-DEFn (i.e. Realized FONT-DEF) has this form:
97 [ FACE-ID FONT-DEF FONT-OBJECT SORTING-SCORE ]
99 RFONT-DEFn are automatically reordered by the current charset
100 priority list.
102 The value nil means that we have not yet generated the above vector
103 from the base of the fontset.
105 The value t means that no font is available for the corresponding
106 range of characters.
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.
113 A fontset has 9 extra slots.
115 The 1st slot: the ID number of the fontset
117 The 2nd slot:
118 base: the name of the fontset
119 realized: nil
121 The 3rd slot:
122 base: nil
123 realized: the base fontset
125 The 4th slot:
126 base: nil
127 realized: the frame that the fontset belongs to
129 The 5th slot:
130 base: the font name for ASCII characters
131 realized: nil
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.
138 The 7th slot:
139 base: nil
140 realized: Alist of font index vs the corresponding repertory
141 char-table.
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.
148 The 9th slot:
149 base: Same as element value (but for fallback fonts).
150 realized: Likewise.
152 All fontsets are recorded in the vector Vfontset_table.
155 DEFAULT FONTSET
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.
162 The parent of a realized fontset created for such a face that has
163 no fontset is the default fontset.
166 These structures are hidden from the other codes than this file.
167 The other codes handle fontsets only by their ID numbers. They
168 usually use the variable name `fontset' for IDs. But, in this
169 file, we always use variable name `id' for IDs, and name `fontset'
170 for an actual fontset object, i.e., char-table.
174 /********** VARIABLES and FUNCTION PROTOTYPES **********/
176 static Lisp_Object Qfontset;
177 static Lisp_Object Qfontset_info;
178 static Lisp_Object Qprepend, Qappend;
179 Lisp_Object Qlatin;
181 /* Vector containing all fontsets. */
182 static Lisp_Object Vfontset_table;
184 /* Next possibly free fontset ID. Usually this keeps the minimum
185 fontset ID not yet used. */
186 static int next_fontset_id;
188 /* The default fontset. This gives default FAMILY and REGISTRY of
189 font for each character. */
190 static Lisp_Object Vdefault_fontset;
192 /* Check if any window system is used now. */
193 void (*check_window_system_func) (void);
196 /* Prototype declarations for static functions. */
197 static Lisp_Object fontset_add (Lisp_Object, Lisp_Object, Lisp_Object,
198 Lisp_Object);
199 static Lisp_Object fontset_find_font (Lisp_Object, int, struct face *,
200 int, int);
201 static void reorder_font_vector (Lisp_Object, struct font *);
202 static Lisp_Object fontset_font (Lisp_Object, int, struct face *, int);
203 static Lisp_Object make_fontset (Lisp_Object, Lisp_Object, Lisp_Object);
204 static Lisp_Object fontset_pattern_regexp (Lisp_Object);
205 static void accumulate_script_ranges (Lisp_Object, Lisp_Object,
206 Lisp_Object);
207 static void set_fontset_font (Lisp_Object, Lisp_Object);
209 #ifdef FONTSET_DEBUG
211 /* Return 1 if ID is a valid fontset id, else return 0. */
213 static int
214 fontset_id_valid_p (int id)
216 return (id >= 0 && id < ASIZE (Vfontset_table) - 1);
219 #endif
223 /********** MACROS AND FUNCTIONS TO HANDLE FONTSET **********/
225 /* Return the fontset with ID. No check of ID's validness. */
226 #define FONTSET_FROM_ID(id) AREF (Vfontset_table, id)
228 /* Macros to access special values of FONTSET. */
229 #define FONTSET_ID(fontset) XCHAR_TABLE (fontset)->extras[0]
231 /* Macros to access special values of (base) FONTSET. */
232 #define FONTSET_NAME(fontset) XCHAR_TABLE (fontset)->extras[1]
233 #define FONTSET_ASCII(fontset) XCHAR_TABLE (fontset)->extras[4]
234 /* #define FONTSET_SPEC(fontset) XCHAR_TABLE (fontset)->extras[5] */
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]
239 /* #define FONTSET_OBJLIST(fontset) XCHAR_TABLE (fontset)->extras[4] */
240 #define FONTSET_NOFONT_FACE(fontset) XCHAR_TABLE (fontset)->extras[5]
241 /* #define FONTSET_REPERTORY(fontset) XCHAR_TABLE (fontset)->extras[6] */
242 #define FONTSET_DEFAULT(fontset) XCHAR_TABLE (fontset)->extras[7]
244 /* For both base and realized fontset. */
245 #define FONTSET_FALLBACK(fontset) XCHAR_TABLE (fontset)->extras[8]
247 #define BASE_FONTSET_P(fontset) (NILP (FONTSET_BASE (fontset)))
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)
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)
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))
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))
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. */
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)
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. */
290 #define FONTSET_REF(fontset, c) \
291 (EQ (fontset, Vdefault_fontset) \
292 ? CHAR_TABLE_REF (fontset, c) \
293 : fontset_ref ((fontset), (c)))
295 static Lisp_Object
296 fontset_ref (Lisp_Object fontset, int c)
298 Lisp_Object elt;
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);
305 return elt;
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. */
312 #define FONTSET_SET(fontset, range, elt) \
313 Fset_char_table_range ((fontset), (range), (elt))
316 /* Modify the elements of FONTSET for characters in RANGE by replacing
317 with ELT or adding ELT. RANGE is a cons (FROM . TO), where FROM
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. */
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)))) \
328 : fontset_add ((fontset), (range), (elt), (add)))
330 static Lisp_Object
331 fontset_add (Lisp_Object fontset, Lisp_Object range, Lisp_Object elt, Lisp_Object add)
333 Lisp_Object args[2];
334 int idx = (EQ (add, Qappend) ? 0 : 1);
336 args[1 - idx] = Fmake_vector (make_number (1), elt);
338 if (CONSP (range))
340 int from = XINT (XCAR (range));
341 int to = XINT (XCDR (range));
342 int from1, to1;
344 do {
345 from1 = from, to1 = to;
346 args[idx] = char_table_ref_and_range (fontset, from, &from1, &to1);
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);
353 else
355 args[idx] = FONTSET_FALLBACK (fontset);
356 FONTSET_FALLBACK (fontset)
357 = NILP (args[idx]) ? args[1 - idx] : Fvconcat (2, args);
359 return Qnil;
362 static int
363 fontset_compare_rfontdef (const void *val1, const void *val2)
365 return (RFONT_DEF_SCORE (*(Lisp_Object *) val1)
366 - RFONT_DEF_SCORE (*(Lisp_Object *) val2));
369 /* Update FONT-GROUP which has this form:
370 [ CHARSET-ORDERED-LIST-TICK PREFERRED-RFONT-DEF
371 RFONT-DEF0 RFONT-DEF1 ... ]
372 Reorder RFONT-DEFs according to the current language, and update
373 CHARSET-ORDERED-LIST-TICK.
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. */
378 static void
379 reorder_font_vector (Lisp_Object font_group, struct font *font)
381 Lisp_Object vec, font_object;
382 int size;
383 int i;
384 int score_changed = 0;
386 if (font)
387 XSETFONT (font_object, font);
388 else
389 font_object = Qnil;
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--;
397 for (i = 0; i < size; i++)
399 Lisp_Object rfont_def = AREF (vec, i);
400 Lisp_Object font_def = RFONT_DEF_FONT_DEF (rfont_def);
401 Lisp_Object font_spec = FONT_DEF_SPEC (font_def);
402 int score = RFONT_DEF_SCORE (rfont_def) & 0xFF;
403 Lisp_Object otf_spec = Ffont_get (font_spec, QCotf);
405 if (! NILP (otf_spec))
406 /* A font-spec with :otf is preferable regardless of encoding
407 and language.. */
409 else if (! font_match_p (font_spec, font_object))
411 Lisp_Object encoding = FONT_DEF_ENCODING (font_def);
413 if (! NILP (encoding))
415 Lisp_Object tail;
417 for (tail = Vcharset_ordered_list;
418 ! EQ (tail, Vcharset_non_preferred_head) && CONSP (tail);
419 tail = XCDR (tail))
420 if (EQ (encoding, XCAR (tail)))
421 break;
422 else if (score <= min (INT_MAX, MOST_POSITIVE_FIXNUM) - 0x100)
423 score += 0x100;
425 else
427 Lisp_Object lang = Ffont_get (font_spec, QClang);
429 if (! NILP (lang)
430 && ! EQ (lang, Vcurrent_iso639_language)
431 && (! CONSP (Vcurrent_iso639_language)
432 || NILP (Fmemq (lang, Vcurrent_iso639_language))))
433 score |= 0x100;
436 if (RFONT_DEF_SCORE (rfont_def) != score)
438 RFONT_DEF_SET_SCORE (rfont_def, score);
439 score_changed = 1;
443 if (score_changed)
444 qsort (XVECTOR (vec)->contents, size, sizeof (Lisp_Object),
445 fontset_compare_rfontdef);
446 XSETCAR (font_group, make_number (charset_ordered_list_tick));
449 /* Return a font-group (actually a cons (-1 . FONT-GROUP-VECTOR)) for
450 character C in FONTSET. If C is -1, return a fallback font-group.
451 If C is not -1, the value may be Qt (FONTSET doesn't have a font
452 for C even in the fallback group), or 0 (a font for C may be found
453 only in the fallback group). */
455 static Lisp_Object
456 fontset_get_font_group (Lisp_Object fontset, int c)
458 Lisp_Object font_group;
459 Lisp_Object base_fontset;
460 int from = 0, to = MAX_CHAR, i;
462 xassert (! BASE_FONTSET_P (fontset));
463 if (c >= 0)
464 font_group = CHAR_TABLE_REF (fontset, c);
465 else
466 font_group = FONTSET_FALLBACK (fontset);
467 if (! NILP (font_group))
468 return font_group;
469 base_fontset = FONTSET_BASE (fontset);
470 if (NILP (base_fontset))
471 font_group = Qnil;
472 else if (c >= 0)
473 font_group = char_table_ref_and_range (base_fontset, c, &from, &to);
474 else
475 font_group = FONTSET_FALLBACK (base_fontset);
476 if (NILP (font_group))
478 font_group = make_number (0);
479 if (c >= 0)
480 char_table_set_range (fontset, from, to, font_group);
481 return font_group;
483 if (!VECTORP (font_group))
484 return font_group;
485 font_group = Fcopy_sequence (font_group);
486 for (i = 0; i < ASIZE (font_group); i++)
487 if (! NILP (AREF (font_group, i)))
489 Lisp_Object rfont_def;
491 RFONT_DEF_NEW (rfont_def, AREF (font_group, i));
492 /* Remember the original order. */
493 RFONT_DEF_SET_SCORE (rfont_def, i);
494 ASET (font_group, i, rfont_def);
496 font_group = Fcons (make_number (-1), font_group);
497 if (c >= 0)
498 char_table_set_range (fontset, from, to, font_group);
499 else
500 FONTSET_FALLBACK (fontset) = font_group;
501 return font_group;
504 /* Return RFONT-DEF (vector) in the realized fontset FONTSET for the
505 character C. If no font is found, return Qnil if there's a
506 possibility that the default fontset or the fallback font groups
507 have a proper font, and return Qt if not.
509 If a font is found but is not yet opened, open it (if FACE is not
510 NULL) or return Qnil (if FACE is NULL).
512 ID is a charset-id that must be preferred, or -1 meaning no
513 preference.
515 If FALLBACK is nonzero, search only fallback fonts. */
517 static Lisp_Object
518 fontset_find_font (Lisp_Object fontset, int c, struct face *face, int id, int fallback)
520 Lisp_Object vec, font_group;
521 int i, charset_matched = 0, found_index;
522 FRAME_PTR f = (FRAMEP (FONTSET_FRAME (fontset))
523 ? XFRAME (FONTSET_FRAME (fontset)) : XFRAME (selected_frame));
524 Lisp_Object rfont_def;
526 font_group = fontset_get_font_group (fontset, fallback ? -1 : c);
527 if (! CONSP (font_group))
528 return font_group;
529 vec = XCDR (font_group);
530 if (ASIZE (vec) == 0)
531 return Qnil;
533 if (ASIZE (vec) > 1)
535 if (XINT (XCAR (font_group)) != charset_ordered_list_tick)
536 /* We have just created the font-group,
537 or the charset priorities were changed. */
538 reorder_font_vector (font_group, face->ascii_face->font);
539 if (id >= 0)
540 /* Find a spec matching with the charset ID to try at
541 first. */
542 for (i = 0; i < ASIZE (vec); i++)
544 Lisp_Object repertory;
546 rfont_def = AREF (vec, i);
547 if (NILP (rfont_def))
548 break;
549 repertory = FONT_DEF_REPERTORY (RFONT_DEF_FONT_DEF (rfont_def));
551 if (XINT (repertory) == id)
553 charset_matched = i;
554 break;
559 /* Find the first available font in the vector of RFONT-DEF. */
560 for (i = 0; i < ASIZE (vec); i++)
562 Lisp_Object font_def;
563 Lisp_Object font_entity, font_object;
565 found_index = i;
566 if (i == 0)
568 if (charset_matched > 0)
570 /* Try the element matching with the charset ID at first. */
571 found_index = charset_matched;
572 /* Make this negative so that we don't come here in the
573 next loop. */
574 charset_matched = - charset_matched;
575 /* We must try the first element in the next loop. */
576 i--;
579 else if (i == - charset_matched)
581 /* We have already tried this element and the followings
582 that have the same font specifications in the first
583 iteration. So, skip them all. */
584 rfont_def = AREF (vec, i);
585 font_def = RFONT_DEF_FONT_DEF (rfont_def);
586 for (; i + 1 < ASIZE (vec); i++)
588 rfont_def = AREF (vec, i + 1);
589 if (NILP (rfont_def))
590 break;
591 if (! EQ (RFONT_DEF_FONT_DEF (rfont_def), font_def))
592 break;
594 continue;
597 rfont_def = AREF (vec, found_index);
598 if (NILP (rfont_def))
600 if (i < 0)
601 continue;
602 /* This is a sign of not to try the other fonts. */
603 return Qt;
605 if (INTEGERP (RFONT_DEF_FACE (rfont_def))
606 && XINT (RFONT_DEF_FACE (rfont_def)) < 0)
607 /* We couldn't open this font last time. */
608 continue;
610 font_object = RFONT_DEF_OBJECT (rfont_def);
611 if (NILP (font_object))
613 font_def = RFONT_DEF_FONT_DEF (rfont_def);
615 if (! face)
616 /* We have not yet opened the font. */
617 return Qnil;
618 /* Find a font best-matching with the spec without checking
619 the support of the character C. That checking is costly,
620 and even without the checking, the found font supports C
621 in high possibility. */
622 font_entity = font_find_for_lface (f, face->lface,
623 FONT_DEF_SPEC (font_def), -1);
624 if (NILP (font_entity))
626 /* Record that no font matches the spec. */
627 RFONT_DEF_SET_FACE (rfont_def, -1);
628 continue;
630 font_object = font_open_for_lface (f, font_entity, face->lface,
631 FONT_DEF_SPEC (font_def));
632 if (NILP (font_object))
634 /* Something strange happened, perhaps because of a
635 Font-backend problem. Too avoid crashing, record
636 that this spec is unusable. It may be better to find
637 another font of the same spec, but currently we don't
638 have such an API. */
639 RFONT_DEF_SET_FACE (rfont_def, -1);
640 continue;
642 RFONT_DEF_SET_OBJECT (rfont_def, font_object);
645 if (font_has_char (f, font_object, c))
646 goto found;
648 /* Find a font already opened, matching with the current spec,
649 and supporting C. */
650 font_def = RFONT_DEF_FONT_DEF (rfont_def);
651 for (; found_index + 1 < ASIZE (vec); found_index++)
653 rfont_def = AREF (vec, found_index + 1);
654 if (NILP (rfont_def))
655 break;
656 if (! EQ (RFONT_DEF_FONT_DEF (rfont_def), font_def))
657 break;
658 font_object = RFONT_DEF_OBJECT (rfont_def);
659 if (! NILP (font_object) && font_has_char (f, font_object, c))
661 found_index++;
662 goto found;
666 /* Find a font-entity with the current spec and supporting C. */
667 font_entity = font_find_for_lface (f, face->lface,
668 FONT_DEF_SPEC (font_def), c);
669 if (! NILP (font_entity))
671 /* We found a font. Open it and insert a new element for
672 that font in VEC. */
673 Lisp_Object new_vec;
674 int j;
676 font_object = font_open_for_lface (f, font_entity, face->lface,
677 Qnil);
678 if (NILP (font_object))
679 continue;
680 RFONT_DEF_NEW (rfont_def, font_def);
681 RFONT_DEF_SET_OBJECT (rfont_def, font_object);
682 RFONT_DEF_SET_SCORE (rfont_def, RFONT_DEF_SCORE (rfont_def));
683 new_vec = Fmake_vector (make_number (ASIZE (vec) + 1), Qnil);
684 found_index++;
685 for (j = 0; j < found_index; j++)
686 ASET (new_vec, j, AREF (vec, j));
687 ASET (new_vec, j, rfont_def);
688 for (j++; j < ASIZE (new_vec); j++)
689 ASET (new_vec, j, AREF (vec, j - 1));
690 XSETCDR (font_group, new_vec);
691 vec = new_vec;
692 goto found;
694 if (i >= 0)
695 i = found_index;
698 FONTSET_SET (fontset, make_number (c), make_number (0));
699 return Qnil;
701 found:
702 if (fallback && found_index > 0)
704 /* The order of fonts in the fallback font-group is not that
705 important, and it is better to move the found font to the
706 first of the group so that the next try will find it
707 quickly. */
708 for (i = found_index; i > 0; i--)
709 ASET (vec, i, AREF (vec, i - 1));
710 ASET (vec, 0, rfont_def);
712 return rfont_def;
716 static Lisp_Object
717 fontset_font (Lisp_Object fontset, int c, struct face *face, int id)
719 Lisp_Object rfont_def, default_rfont_def IF_LINT (= Qnil);
720 Lisp_Object base_fontset;
722 /* Try a font-group of FONTSET. */
723 FONT_DEFERRED_LOG ("current fontset: font for", make_number (c), Qnil);
724 rfont_def = fontset_find_font (fontset, c, face, id, 0);
725 if (VECTORP (rfont_def))
726 return rfont_def;
727 if (NILP (rfont_def))
728 FONTSET_SET (fontset, make_number (c), make_number (0));
730 /* Try a font-group of the default fontset. */
731 base_fontset = FONTSET_BASE (fontset);
732 if (! EQ (base_fontset, Vdefault_fontset))
734 if (NILP (FONTSET_DEFAULT (fontset)))
735 FONTSET_DEFAULT (fontset)
736 = make_fontset (FONTSET_FRAME (fontset), Qnil, Vdefault_fontset);
737 FONT_DEFERRED_LOG ("default fontset: font for", make_number (c), Qnil);
738 default_rfont_def
739 = fontset_find_font (FONTSET_DEFAULT (fontset), c, face, id, 0);
740 if (VECTORP (default_rfont_def))
741 return default_rfont_def;
742 if (NILP (default_rfont_def))
743 FONTSET_SET (FONTSET_DEFAULT (fontset), make_number (c),
744 make_number (0));
747 /* Try a fallback font-group of FONTSET. */
748 if (! EQ (rfont_def, Qt))
750 FONT_DEFERRED_LOG ("current fallback: font for", make_number (c), Qnil);
751 rfont_def = fontset_find_font (fontset, c, face, id, 1);
752 if (VECTORP (rfont_def))
753 return rfont_def;
754 /* Remember that FONTSET has no font for C. */
755 FONTSET_SET (fontset, make_number (c), Qt);
758 /* Try a fallback font-group of the default fontset. */
759 if (! EQ (base_fontset, Vdefault_fontset)
760 && ! EQ (default_rfont_def, Qt))
762 FONT_DEFERRED_LOG ("default fallback: font for", make_number (c), Qnil);
763 rfont_def = fontset_find_font (FONTSET_DEFAULT (fontset), c, face, id, 1);
764 if (VECTORP (rfont_def))
765 return rfont_def;
766 /* Remember that the default fontset has no font for C. */
767 FONTSET_SET (FONTSET_DEFAULT (fontset), make_number (c), Qt);
770 return Qnil;
773 /* Return a newly created fontset with NAME. If BASE is nil, make a
774 base fontset. Otherwise make a realized fontset whose base is
775 BASE. */
777 static Lisp_Object
778 make_fontset (Lisp_Object frame, Lisp_Object name, Lisp_Object base)
780 Lisp_Object fontset;
781 int size = ASIZE (Vfontset_table);
782 int id = next_fontset_id;
784 /* Find a free slot in Vfontset_table. Usually, next_fontset_id is
785 the next available fontset ID. So it is expected that this loop
786 terminates quickly. In addition, as the last element of
787 Vfontset_table is always nil, we don't have to check the range of
788 id. */
789 while (!NILP (AREF (Vfontset_table, id))) id++;
791 if (id + 1 == size)
792 Vfontset_table = larger_vector (Vfontset_table, 1, -1);
794 fontset = Fmake_char_table (Qfontset, Qnil);
796 FONTSET_ID (fontset) = make_number (id);
797 if (NILP (base))
799 FONTSET_NAME (fontset) = name;
801 else
803 FONTSET_NAME (fontset) = Qnil;
804 FONTSET_FRAME (fontset) = frame;
805 FONTSET_BASE (fontset) = base;
808 ASET (Vfontset_table, id, fontset);
809 next_fontset_id = id + 1;
810 return fontset;
814 /********** INTERFACES TO xfaces.c, xfns.c, and dispextern.h **********/
816 /* Return the name of the fontset who has ID. */
818 Lisp_Object
819 fontset_name (int id)
821 Lisp_Object fontset;
823 fontset = FONTSET_FROM_ID (id);
824 return FONTSET_NAME (fontset);
828 /* Return the ASCII font name of the fontset who has ID. */
830 Lisp_Object
831 fontset_ascii (int id)
833 Lisp_Object fontset, elt;
835 fontset= FONTSET_FROM_ID (id);
836 elt = FONTSET_ASCII (fontset);
837 if (CONSP (elt))
838 elt = XCAR (elt);
839 return elt;
842 static void
843 free_realized_fontset (FRAME_PTR f, Lisp_Object fontset)
845 #if 0
846 Lisp_Object tail;
848 if (0)
849 for (tail = FONTSET_OBJLIST (fontset); CONSP (tail); tail = XCDR (tail))
851 xassert (FONT_OBJECT_P (XCAR (tail)));
852 font_close_object (f, XCAR (tail));
854 #endif
857 /* Free fontset of FACE defined on frame F. Called from
858 free_realized_face. */
860 void
861 free_face_fontset (FRAME_PTR f, struct face *face)
863 Lisp_Object fontset;
865 fontset = FONTSET_FROM_ID (face->fontset);
866 if (NILP (fontset))
867 return;
868 xassert (! BASE_FONTSET_P (fontset));
869 xassert (f == XFRAME (FONTSET_FRAME (fontset)));
870 free_realized_fontset (f, fontset);
871 ASET (Vfontset_table, face->fontset, Qnil);
872 if (face->fontset < next_fontset_id)
873 next_fontset_id = face->fontset;
874 if (! NILP (FONTSET_DEFAULT (fontset)))
876 int id = XINT (FONTSET_ID (FONTSET_DEFAULT (fontset)));
878 fontset = AREF (Vfontset_table, id);
879 xassert (!NILP (fontset) && ! BASE_FONTSET_P (fontset));
880 xassert (f == XFRAME (FONTSET_FRAME (fontset)));
881 free_realized_fontset (f, fontset);
882 ASET (Vfontset_table, id, Qnil);
883 if (id < next_fontset_id)
884 next_fontset_id = face->fontset;
886 face->fontset = -1;
890 #if 0
891 /* Return 1 if FACE is suitable for displaying character C.
892 Otherwise return 0. Called from the macro FACE_SUITABLE_FOR_CHAR_P
893 when C is not an ASCII character. */
896 face_suitable_for_char_p (struct face *face, int c)
898 Lisp_Object fontset, rfont_def;
900 fontset = FONTSET_FROM_ID (face->fontset);
901 rfont_def = fontset_font (fontset, c, NULL, -1);
902 return (VECTORP (rfont_def)
903 && INTEGERP (RFONT_DEF_FACE (rfont_def))
904 && face->id == XINT (RFONT_DEF_FACE (rfont_def)));
906 #endif
909 /* Return ID of face suitable for displaying character C on frame F.
910 FACE must be realized for ASCII characters in advance. Called from
911 the macro FACE_FOR_CHAR. */
914 face_for_char (FRAME_PTR f, struct face *face, int c, int pos, Lisp_Object object)
916 Lisp_Object fontset, rfont_def, charset;
917 int face_id;
918 int id;
920 /* If face->fontset is negative (that happens when no font is found
921 for face), just return face->ascii_face because we can't do
922 anything. Perhaps, we should fix the callers to assure
923 that face->fontset is always valid. */
924 if (ASCII_CHAR_P (c) || face->fontset < 0)
925 return face->ascii_face->id;
927 xassert (fontset_id_valid_p (face->fontset));
928 fontset = FONTSET_FROM_ID (face->fontset);
929 xassert (!BASE_FONTSET_P (fontset));
931 if (pos < 0)
933 id = -1;
934 charset = Qnil;
936 else
938 charset = Fget_char_property (make_number (pos), Qcharset, object);
939 if (CHARSETP (charset))
941 Lisp_Object val;
943 val = assq_no_quit (charset, Vfont_encoding_charset_alist);
944 if (CONSP (val) && CHARSETP (XCDR (val)))
945 charset = XCDR (val);
946 id = XINT (CHARSET_SYMBOL_ID (charset));
948 else
949 id = -1;
952 rfont_def = fontset_font (fontset, c, face, id);
953 if (VECTORP (rfont_def))
955 if (INTEGERP (RFONT_DEF_FACE (rfont_def)))
956 face_id = XINT (RFONT_DEF_FACE (rfont_def));
957 else
959 Lisp_Object font_object;
961 font_object = RFONT_DEF_OBJECT (rfont_def);
962 face_id = face_for_font (f, font_object, face);
963 RFONT_DEF_SET_FACE (rfont_def, face_id);
966 else
968 if (INTEGERP (FONTSET_NOFONT_FACE (fontset)))
969 face_id = XINT (FONTSET_NOFONT_FACE (fontset));
970 else
972 face_id = face_for_font (f, Qnil, face);
973 FONTSET_NOFONT_FACE (fontset) = make_number (face_id);
976 xassert (face_id >= 0);
977 return face_id;
981 Lisp_Object
982 font_for_char (struct face *face, int c, int pos, Lisp_Object object)
984 Lisp_Object fontset, rfont_def, charset;
985 int id;
987 if (ASCII_CHAR_P (c))
989 Lisp_Object font_object;
991 XSETFONT (font_object, face->ascii_face->font);
992 return font_object;
995 xassert (fontset_id_valid_p (face->fontset));
996 fontset = FONTSET_FROM_ID (face->fontset);
997 xassert (!BASE_FONTSET_P (fontset));
998 if (pos < 0)
1000 id = -1;
1001 charset = Qnil;
1003 else
1005 charset = Fget_char_property (make_number (pos), Qcharset, object);
1006 if (CHARSETP (charset))
1008 Lisp_Object val;
1010 val = assq_no_quit (charset, Vfont_encoding_charset_alist);
1011 if (CONSP (val) && CHARSETP (XCDR (val)))
1012 charset = XCDR (val);
1013 id = XINT (CHARSET_SYMBOL_ID (charset));
1015 else
1016 id = -1;
1019 rfont_def = fontset_font (fontset, c, face, id);
1020 return (VECTORP (rfont_def)
1021 ? RFONT_DEF_OBJECT (rfont_def)
1022 : Qnil);
1026 /* Make a realized fontset for ASCII face FACE on frame F from the
1027 base fontset BASE_FONTSET_ID. If BASE_FONTSET_ID is -1, use the
1028 default fontset as the base. Value is the id of the new fontset.
1029 Called from realize_x_face. */
1032 make_fontset_for_ascii_face (FRAME_PTR f, int base_fontset_id, struct face *face)
1034 Lisp_Object base_fontset, fontset, frame;
1036 XSETFRAME (frame, f);
1037 if (base_fontset_id >= 0)
1039 base_fontset = FONTSET_FROM_ID (base_fontset_id);
1040 if (!BASE_FONTSET_P (base_fontset))
1041 base_fontset = FONTSET_BASE (base_fontset);
1042 if (! BASE_FONTSET_P (base_fontset))
1043 abort ();
1045 else
1046 base_fontset = Vdefault_fontset;
1048 fontset = make_fontset (frame, Qnil, base_fontset);
1049 return XINT (FONTSET_ID (fontset));
1054 /* Cache data used by fontset_pattern_regexp. The car part is a
1055 pattern string containing at least one wild card, the cdr part is
1056 the corresponding regular expression. */
1057 static Lisp_Object Vcached_fontset_data;
1059 #define CACHED_FONTSET_NAME SSDATA (XCAR (Vcached_fontset_data))
1060 #define CACHED_FONTSET_REGEX (XCDR (Vcached_fontset_data))
1062 /* If fontset name PATTERN contains any wild card, return regular
1063 expression corresponding to PATTERN. */
1065 static Lisp_Object
1066 fontset_pattern_regexp (Lisp_Object pattern)
1068 if (!strchr (SSDATA (pattern), '*')
1069 && !strchr (SSDATA (pattern), '?'))
1070 /* PATTERN does not contain any wild cards. */
1071 return Qnil;
1073 if (!CONSP (Vcached_fontset_data)
1074 || strcmp (SSDATA (pattern), CACHED_FONTSET_NAME))
1076 /* We must at first update the cached data. */
1077 unsigned char *regex, *p0, *p1;
1078 int ndashes = 0, nstars = 0, nescs = 0;
1080 for (p0 = SDATA (pattern); *p0; p0++)
1082 if (*p0 == '-')
1083 ndashes++;
1084 else if (*p0 == '*')
1085 nstars++;
1086 else if (*p0 == '['
1087 || *p0 == '.' || *p0 == '\\'
1088 || *p0 == '+' || *p0 == '^'
1089 || *p0 == '$')
1090 nescs++;
1093 /* If PATTERN is not full XLFD we convert "*" to ".*". Otherwise
1094 we convert "*" to "[^-]*" which is much faster in regular
1095 expression matching. */
1096 if (ndashes < 14)
1097 p1 = regex = (unsigned char *) alloca (SBYTES (pattern) + 2 * nstars + 2 * nescs + 1);
1098 else
1099 p1 = regex = (unsigned char *) alloca (SBYTES (pattern) + 5 * nstars + 2 * nescs + 1);
1101 *p1++ = '^';
1102 for (p0 = SDATA (pattern); *p0; p0++)
1104 if (*p0 == '*')
1106 if (ndashes < 14)
1107 *p1++ = '.';
1108 else
1109 *p1++ = '[', *p1++ = '^', *p1++ = '-', *p1++ = ']';
1110 *p1++ = '*';
1112 else if (*p0 == '?')
1113 *p1++ = '.';
1114 else if (*p0 == '['
1115 || *p0 == '.' || *p0 == '\\'
1116 || *p0 == '+' || *p0 == '^'
1117 || *p0 == '$')
1118 *p1++ = '\\', *p1++ = *p0;
1119 else
1120 *p1++ = *p0;
1122 *p1++ = '$';
1123 *p1++ = 0;
1125 Vcached_fontset_data = Fcons (build_string (SSDATA (pattern)),
1126 build_string ((char *) regex));
1129 return CACHED_FONTSET_REGEX;
1132 /* Return ID of the base fontset named NAME. If there's no such
1133 fontset, return -1. NAME_PATTERN specifies how to treat NAME as this:
1134 0: pattern containing '*' and '?' as wildcards
1135 1: regular expression
1136 2: literal fontset name
1140 fs_query_fontset (Lisp_Object name, int name_pattern)
1142 Lisp_Object tem;
1143 int i;
1145 name = Fdowncase (name);
1146 if (name_pattern != 1)
1148 tem = Frassoc (name, Vfontset_alias_alist);
1149 if (NILP (tem))
1150 tem = Fassoc (name, Vfontset_alias_alist);
1151 if (CONSP (tem) && STRINGP (XCAR (tem)))
1152 name = XCAR (tem);
1153 else if (name_pattern == 0)
1155 tem = fontset_pattern_regexp (name);
1156 if (STRINGP (tem))
1158 name = tem;
1159 name_pattern = 1;
1164 for (i = 0; i < ASIZE (Vfontset_table); i++)
1166 Lisp_Object fontset, this_name;
1168 fontset = FONTSET_FROM_ID (i);
1169 if (NILP (fontset)
1170 || !BASE_FONTSET_P (fontset))
1171 continue;
1173 this_name = FONTSET_NAME (fontset);
1174 if (name_pattern == 1
1175 ? fast_string_match_ignore_case (name, this_name) >= 0
1176 : !xstrcasecmp (SSDATA (name), SSDATA (this_name)))
1177 return i;
1179 return -1;
1183 DEFUN ("query-fontset", Fquery_fontset, Squery_fontset, 1, 2, 0,
1184 doc: /* Return the name of a fontset that matches PATTERN.
1185 The value is nil if there is no matching fontset.
1186 PATTERN can contain `*' or `?' as a wildcard
1187 just as X font name matching algorithm allows.
1188 If REGEXPP is non-nil, PATTERN is a regular expression. */)
1189 (Lisp_Object pattern, Lisp_Object regexpp)
1191 Lisp_Object fontset;
1192 int id;
1194 (*check_window_system_func) ();
1196 CHECK_STRING (pattern);
1198 if (SCHARS (pattern) == 0)
1199 return Qnil;
1201 id = fs_query_fontset (pattern, !NILP (regexpp));
1202 if (id < 0)
1203 return Qnil;
1205 fontset = FONTSET_FROM_ID (id);
1206 return FONTSET_NAME (fontset);
1209 /* Return a list of base fontset names matching PATTERN on frame F. */
1211 Lisp_Object
1212 list_fontsets (FRAME_PTR f, Lisp_Object pattern, int size)
1214 Lisp_Object frame, regexp, val;
1215 int id;
1217 XSETFRAME (frame, f);
1219 regexp = fontset_pattern_regexp (pattern);
1220 val = Qnil;
1222 for (id = 0; id < ASIZE (Vfontset_table); id++)
1224 Lisp_Object fontset, name;
1226 fontset = FONTSET_FROM_ID (id);
1227 if (NILP (fontset)
1228 || !BASE_FONTSET_P (fontset)
1229 || !EQ (frame, FONTSET_FRAME (fontset)))
1230 continue;
1231 name = FONTSET_NAME (fontset);
1233 if (STRINGP (regexp)
1234 ? (fast_string_match (regexp, name) < 0)
1235 : strcmp (SSDATA (pattern), SSDATA (name)))
1236 continue;
1238 val = Fcons (Fcopy_sequence (FONTSET_NAME (fontset)), val);
1241 return val;
1245 /* Free all realized fontsets whose base fontset is BASE. */
1247 static void
1248 free_realized_fontsets (Lisp_Object base)
1250 int id;
1252 #if 0
1253 /* For the moment, this doesn't work because free_realized_face
1254 doesn't remove FACE from a cache. Until we find a solution, we
1255 suppress this code, and simply use Fclear_face_cache even though
1256 that is not efficient. */
1257 BLOCK_INPUT;
1258 for (id = 0; id < ASIZE (Vfontset_table); id++)
1260 Lisp_Object this = AREF (Vfontset_table, id);
1262 if (EQ (FONTSET_BASE (this), base))
1264 Lisp_Object tail;
1266 for (tail = FONTSET_FACE_ALIST (this); CONSP (tail);
1267 tail = XCDR (tail))
1269 FRAME_PTR f = XFRAME (FONTSET_FRAME (this));
1270 int face_id = XINT (XCDR (XCAR (tail)));
1271 struct face *face = FACE_FROM_ID (f, face_id);
1273 /* Face THIS itself is also freed by the following call. */
1274 free_realized_face (f, face);
1278 UNBLOCK_INPUT;
1279 #else /* not 0 */
1280 /* But, we don't have to call Fclear_face_cache if no fontset has
1281 been realized from BASE. */
1282 for (id = 0; id < ASIZE (Vfontset_table); id++)
1284 Lisp_Object this = AREF (Vfontset_table, id);
1286 if (CHAR_TABLE_P (this) && EQ (FONTSET_BASE (this), base))
1288 Fclear_face_cache (Qt);
1289 break;
1292 #endif /* not 0 */
1296 /* Check validity of NAME as a fontset name and return the
1297 corresponding fontset. If not valid, signal an error.
1299 If NAME is t, return Vdefault_fontset. If NAME is nil, return the
1300 fontset of *FRAME.
1302 Set *FRAME to the actual frame. */
1304 static Lisp_Object
1305 check_fontset_name (Lisp_Object name, Lisp_Object *frame)
1307 int id;
1309 if (NILP (*frame))
1310 *frame = selected_frame;
1311 CHECK_LIVE_FRAME (*frame);
1313 if (EQ (name, Qt))
1314 return Vdefault_fontset;
1315 if (NILP (name))
1317 id = FRAME_FONTSET (XFRAME (*frame));
1319 else
1321 CHECK_STRING (name);
1322 /* First try NAME as literal. */
1323 id = fs_query_fontset (name, 2);
1324 if (id < 0)
1325 /* For backward compatibility, try again NAME as pattern. */
1326 id = fs_query_fontset (name, 0);
1327 if (id < 0)
1328 error ("Fontset `%s' does not exist", SDATA (name));
1330 return FONTSET_FROM_ID (id);
1333 static void
1334 accumulate_script_ranges (Lisp_Object arg, Lisp_Object range, Lisp_Object val)
1336 if (EQ (XCAR (arg), val))
1338 if (CONSP (range))
1339 XSETCDR (arg, Fcons (Fcons (XCAR (range), XCDR (range)), XCDR (arg)));
1340 else
1341 XSETCDR (arg, Fcons (Fcons (range, range), XCDR (arg)));
1346 /* Callback function for map_charset_chars in Fset_fontset_font.
1347 ARG is a vector [ FONTSET FONT_DEF ADD ASCII SCRIPT_RANGE_LIST ].
1349 In FONTSET, set FONT_DEF in a fashion specified by ADD for
1350 characters in RANGE and ranges in SCRIPT_RANGE_LIST before RANGE.
1351 The consumed ranges are popped up from SCRIPT_RANGE_LIST, and the
1352 new SCRIPT_RANGE_LIST is stored in ARG.
1354 If ASCII is nil, don't set FONT_DEF for ASCII characters. It is
1355 assured that SCRIPT_RANGE_LIST doesn't contain ASCII in that
1356 case. */
1358 static void
1359 set_fontset_font (Lisp_Object arg, Lisp_Object range)
1361 Lisp_Object fontset, font_def, add, ascii, script_range_list;
1362 int from = XINT (XCAR (range)), to = XINT (XCDR (range));
1364 fontset = AREF (arg, 0);
1365 font_def = AREF (arg, 1);
1366 add = AREF (arg, 2);
1367 ascii = AREF (arg, 3);
1368 script_range_list = AREF (arg, 4);
1370 if (NILP (ascii) && from < 0x80)
1372 if (to < 0x80)
1373 return;
1374 from = 0x80;
1375 range = Fcons (make_number (0x80), XCDR (range));
1378 #define SCRIPT_FROM XINT (XCAR (XCAR (script_range_list)))
1379 #define SCRIPT_TO XINT (XCDR (XCAR (script_range_list)))
1380 #define POP_SCRIPT_RANGE() script_range_list = XCDR (script_range_list)
1382 for (; CONSP (script_range_list) && SCRIPT_TO < from; POP_SCRIPT_RANGE ())
1383 FONTSET_ADD (fontset, XCAR (script_range_list), font_def, add);
1384 if (CONSP (script_range_list))
1386 if (SCRIPT_FROM < from)
1387 range = Fcons (make_number (SCRIPT_FROM), XCDR (range));
1388 while (CONSP (script_range_list) && SCRIPT_TO <= to)
1389 POP_SCRIPT_RANGE ();
1390 if (CONSP (script_range_list) && SCRIPT_FROM <= to)
1391 XSETCAR (XCAR (script_range_list), make_number (to + 1));
1394 FONTSET_ADD (fontset, range, font_def, add);
1395 ASET (arg, 4, script_range_list);
1398 static void update_auto_fontset_alist (Lisp_Object, Lisp_Object);
1401 DEFUN ("set-fontset-font", Fset_fontset_font, Sset_fontset_font, 3, 5, 0,
1402 doc: /*
1403 Modify fontset NAME to use FONT-SPEC for TARGET characters.
1405 NAME is a fontset name string, nil for the fontset of FRAME, or t for
1406 the default fontset.
1408 TARGET may be a cons; (FROM . TO), where FROM and TO are characters.
1409 In that case, use FONT-SPEC for all characters in the range FROM and
1410 TO (inclusive).
1412 TARGET may be a script name symbol. In that case, use FONT-SPEC for
1413 all characters that belong to the script.
1415 TARGET may be a charset. In that case, use FONT-SPEC for all
1416 characters in the charset.
1418 TARGET may be nil. In that case, use FONT-SPEC for any characters for
1419 that no FONT-SPEC is specified.
1421 FONT-SPEC may one of these:
1422 * A font-spec object made by the function `font-spec' (which see).
1423 * A cons (FAMILY . REGISTRY), where FAMILY is a font family name and
1424 REGISTRY is a font registry name. FAMILY may contain foundry
1425 name, and REGISTRY may contain encoding name.
1426 * A font name string.
1427 * nil, which explicitly specifies that there's no font for TARGET.
1429 Optional 4th argument FRAME is a frame or nil for the selected frame
1430 that is concerned in the case that NAME is nil.
1432 Optional 5th argument ADD, if non-nil, specifies how to add FONT-SPEC
1433 to the font specifications for TARGET previously set. If it is
1434 `prepend', FONT-SPEC is prepended. If it is `append', FONT-SPEC is
1435 appended. By default, FONT-SPEC overrides the previous settings. */)
1436 (Lisp_Object name, Lisp_Object target, Lisp_Object font_spec, Lisp_Object frame, Lisp_Object add)
1438 Lisp_Object fontset;
1439 Lisp_Object font_def, registry, family;
1440 Lisp_Object range_list;
1441 struct charset *charset = NULL;
1442 Lisp_Object fontname;
1443 int ascii_changed = 0;
1445 fontset = check_fontset_name (name, &frame);
1447 fontname = Qnil;
1448 if (CONSP (font_spec))
1450 Lisp_Object spec = Ffont_spec (0, NULL);
1452 font_parse_family_registry (XCAR (font_spec), XCDR (font_spec), spec);
1453 font_spec = spec;
1454 fontname = Ffont_xlfd_name (font_spec, Qnil);
1456 else if (STRINGP (font_spec))
1458 Lisp_Object args[2];
1460 fontname = font_spec;
1461 args[0] = QCname;
1462 args[1] = font_spec;
1463 font_spec = Ffont_spec (2, args);
1465 else if (FONT_SPEC_P (font_spec))
1466 fontname = Ffont_xlfd_name (font_spec, Qnil);
1467 else if (! NILP (font_spec))
1468 Fsignal (Qfont, list2 (build_string ("Invalid font-spec"), font_spec));
1470 if (! NILP (font_spec))
1472 Lisp_Object encoding, repertory;
1474 family = AREF (font_spec, FONT_FAMILY_INDEX);
1475 if (! NILP (family) )
1476 family = SYMBOL_NAME (family);
1477 registry = AREF (font_spec, FONT_REGISTRY_INDEX);
1478 if (! NILP (registry))
1479 registry = Fdowncase (SYMBOL_NAME (registry));
1480 encoding = find_font_encoding (concat3 (family, build_string ("-"),
1481 registry));
1482 if (NILP (encoding))
1483 encoding = Qascii;
1485 if (SYMBOLP (encoding))
1487 CHECK_CHARSET (encoding);
1488 encoding = repertory = CHARSET_SYMBOL_ID (encoding);
1490 else
1492 repertory = XCDR (encoding);
1493 encoding = XCAR (encoding);
1494 CHECK_CHARSET (encoding);
1495 encoding = CHARSET_SYMBOL_ID (encoding);
1496 if (! NILP (repertory) && SYMBOLP (repertory))
1498 CHECK_CHARSET (repertory);
1499 repertory = CHARSET_SYMBOL_ID (repertory);
1502 FONT_DEF_NEW (font_def, font_spec, encoding, repertory);
1504 else
1505 font_def = Qnil;
1507 if (CHARACTERP (target))
1509 if (XFASTINT (target) < 0x80)
1510 error ("Can't set a font for partial ASCII range");
1511 range_list = Fcons (Fcons (target, target), Qnil);
1513 else if (CONSP (target))
1515 Lisp_Object from, to;
1517 from = Fcar (target);
1518 to = Fcdr (target);
1519 CHECK_CHARACTER (from);
1520 CHECK_CHARACTER (to);
1521 if (XFASTINT (from) < 0x80)
1523 if (XFASTINT (from) != 0 || XFASTINT (to) < 0x7F)
1524 error ("Can't set a font for partial ASCII range");
1525 ascii_changed = 1;
1527 range_list = Fcons (target, Qnil);
1529 else if (SYMBOLP (target) && !NILP (target))
1531 Lisp_Object script_list;
1532 Lisp_Object val;
1534 range_list = Qnil;
1535 script_list = XCHAR_TABLE (Vchar_script_table)->extras[0];
1536 if (! NILP (Fmemq (target, script_list)))
1538 if (EQ (target, Qlatin))
1539 ascii_changed = 1;
1540 val = Fcons (target, Qnil);
1541 map_char_table (accumulate_script_ranges, Qnil, Vchar_script_table,
1542 val);
1543 range_list = Fnreverse (XCDR (val));
1545 if (CHARSETP (target))
1547 CHECK_CHARSET_GET_CHARSET (target, charset);
1548 if (charset->ascii_compatible_p)
1549 ascii_changed = 1;
1551 else if (NILP (range_list))
1552 error ("Invalid script or charset name: %s",
1553 SDATA (SYMBOL_NAME (target)));
1555 else if (NILP (target))
1556 range_list = Fcons (Qnil, Qnil);
1557 else
1558 error ("Invalid target for setting a font");
1560 if (ascii_changed)
1562 Lisp_Object val;
1564 if (NILP (font_spec))
1565 error ("Can't set ASCII font to nil");
1566 val = CHAR_TABLE_REF (fontset, 0);
1567 if (! NILP (val) && EQ (add, Qappend))
1568 /* We are going to change just an additional font for ASCII. */
1569 ascii_changed = 0;
1572 if (charset)
1574 Lisp_Object arg;
1576 arg = Fmake_vector (make_number (5), Qnil);
1577 ASET (arg, 0, fontset);
1578 ASET (arg, 1, font_def);
1579 ASET (arg, 2, add);
1580 ASET (arg, 3, ascii_changed ? Qt : Qnil);
1581 ASET (arg, 4, range_list);
1583 map_charset_chars (set_fontset_font, Qnil, arg, charset,
1584 CHARSET_MIN_CODE (charset),
1585 CHARSET_MAX_CODE (charset));
1586 range_list = AREF (arg, 4);
1588 for (; CONSP (range_list); range_list = XCDR (range_list))
1589 FONTSET_ADD (fontset, XCAR (range_list), font_def, add);
1591 if (ascii_changed)
1593 Lisp_Object tail, fr, alist;
1594 int fontset_id = XINT (FONTSET_ID (fontset));
1596 FONTSET_ASCII (fontset) = fontname;
1597 name = FONTSET_NAME (fontset);
1598 FOR_EACH_FRAME (tail, fr)
1600 FRAME_PTR f = XFRAME (fr);
1601 Lisp_Object font_object;
1602 struct face *face;
1604 if (FRAME_INITIAL_P (f) || FRAME_TERMCAP_P (f))
1605 continue;
1606 if (fontset_id != FRAME_FONTSET (f))
1607 continue;
1608 face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
1609 if (face)
1610 font_object = font_load_for_lface (f, face->lface, font_spec);
1611 else
1612 font_object = font_open_by_spec (f, font_spec);
1613 if (! NILP (font_object))
1615 update_auto_fontset_alist (font_object, fontset);
1616 alist = Fcons (Fcons (Qfont, Fcons (name, font_object)), Qnil);
1617 Fmodify_frame_parameters (fr, alist);
1622 /* Free all realized fontsets whose base is FONTSET. This way, the
1623 specified character(s) are surely redisplayed by a correct
1624 font. */
1625 free_realized_fontsets (fontset);
1627 return Qnil;
1631 DEFUN ("new-fontset", Fnew_fontset, Snew_fontset, 2, 2, 0,
1632 doc: /* Create a new fontset NAME from font information in FONTLIST.
1634 FONTLIST is an alist of scripts vs the corresponding font specification list.
1635 Each element of FONTLIST has the form (SCRIPT FONT-SPEC ...), where a
1636 character of SCRIPT is displayed by a font that matches one of
1637 FONT-SPEC.
1639 SCRIPT is a symbol that appears in the first extra slot of the
1640 char-table `char-script-table'.
1642 FONT-SPEC is a vector, a cons, or a string. See the documentation of
1643 `set-fontset-font' for the meaning. */)
1644 (Lisp_Object name, Lisp_Object fontlist)
1646 Lisp_Object fontset;
1647 int id;
1649 CHECK_STRING (name);
1650 CHECK_LIST (fontlist);
1652 name = Fdowncase (name);
1653 id = fs_query_fontset (name, 0);
1654 if (id < 0)
1656 Lisp_Object font_spec = Ffont_spec (0, NULL);
1657 Lisp_Object short_name;
1658 char xlfd[256];
1659 int len;
1661 if (font_parse_xlfd (SSDATA (name), font_spec) < 0)
1662 error ("Fontset name must be in XLFD format");
1663 short_name = AREF (font_spec, FONT_REGISTRY_INDEX);
1664 if (strncmp (SSDATA (SYMBOL_NAME (short_name)), "fontset-", 8)
1665 || SBYTES (SYMBOL_NAME (short_name)) < 9)
1666 error ("Registry field of fontset name must be \"fontset-*\"");
1667 Vfontset_alias_alist = Fcons (Fcons (name, SYMBOL_NAME (short_name)),
1668 Vfontset_alias_alist);
1669 ASET (font_spec, FONT_REGISTRY_INDEX, Qiso8859_1);
1670 fontset = make_fontset (Qnil, name, Qnil);
1671 len = font_unparse_xlfd (font_spec, 0, xlfd, 256);
1672 if (len < 0)
1673 error ("Invalid fontset name (perhaps too long): %s", SDATA (name));
1674 FONTSET_ASCII (fontset) = make_unibyte_string (xlfd, len);
1676 else
1678 fontset = FONTSET_FROM_ID (id);
1679 free_realized_fontsets (fontset);
1680 Fset_char_table_range (fontset, Qt, Qnil);
1683 for (; ! NILP (fontlist); fontlist = Fcdr (fontlist))
1685 Lisp_Object elt, script;
1687 elt = Fcar (fontlist);
1688 script = Fcar (elt);
1689 elt = Fcdr (elt);
1690 if (CONSP (elt) && (NILP (XCDR (elt)) || CONSP (XCDR (elt))))
1691 for (; CONSP (elt); elt = XCDR (elt))
1692 Fset_fontset_font (name, script, XCAR (elt), Qnil, Qappend);
1693 else
1694 Fset_fontset_font (name, script, elt, Qnil, Qappend);
1696 return name;
1700 /* Alist of automatically created fontsets. Each element is a cons
1701 (FONT-SPEC . FONTSET-ID). */
1702 static Lisp_Object auto_fontset_alist;
1704 /* Number of automatically created fontsets. */
1705 static ptrdiff_t num_auto_fontsets;
1707 /* Return a fontset synthesized from FONT-OBJECT. This is called from
1708 x_new_font when FONT-OBJECT is used for the default ASCII font of a
1709 frame, and the returned fontset is used for the default fontset of
1710 that frame. The fontset specifies a font of the same registry as
1711 FONT-OBJECT for all characters in the repertory of the registry
1712 (see Vfont_encoding_alist). If the repertory is not known, the
1713 fontset specifies the font for all Latin characters assuming that a
1714 user intends to use FONT-OBJECT for Latin characters. */
1717 fontset_from_font (Lisp_Object font_object)
1719 Lisp_Object font_name = font_get_name (font_object);
1720 Lisp_Object font_spec = copy_font_spec (font_object);
1721 Lisp_Object registry = AREF (font_spec, FONT_REGISTRY_INDEX);
1722 Lisp_Object fontset_spec, alias, name, fontset;
1723 Lisp_Object val;
1725 val = assoc_no_quit (font_spec, auto_fontset_alist);
1726 if (CONSP (val))
1727 return XINT (FONTSET_ID (XCDR (val)));
1728 if (num_auto_fontsets++ == 0)
1729 alias = intern ("fontset-startup");
1730 else
1732 char temp[sizeof "fontset-auto" + INT_STRLEN_BOUND (ptrdiff_t)];
1734 sprintf (temp, "fontset-auto%"pD"d", num_auto_fontsets - 1);
1735 alias = intern (temp);
1737 fontset_spec = copy_font_spec (font_spec);
1738 ASET (fontset_spec, FONT_REGISTRY_INDEX, alias);
1739 name = Ffont_xlfd_name (fontset_spec, Qnil);
1740 if (NILP (name))
1741 abort ();
1742 fontset = make_fontset (Qnil, name, Qnil);
1743 Vfontset_alias_alist = Fcons (Fcons (name, SYMBOL_NAME (alias)),
1744 Vfontset_alias_alist);
1745 alias = Fdowncase (AREF (font_object, FONT_NAME_INDEX));
1746 Vfontset_alias_alist = Fcons (Fcons (name, alias), Vfontset_alias_alist);
1747 auto_fontset_alist = Fcons (Fcons (font_spec, fontset), auto_fontset_alist);
1748 font_spec = Ffont_spec (0, NULL);
1749 ASET (font_spec, FONT_REGISTRY_INDEX, registry);
1751 Lisp_Object target = find_font_encoding (SYMBOL_NAME (registry));
1753 if (CONSP (target))
1754 target = XCDR (target);
1755 if (! CHARSETP (target))
1756 target = Qlatin;
1757 Fset_fontset_font (name, target, font_spec, Qnil, Qnil);
1758 Fset_fontset_font (name, Qnil, font_spec, Qnil, Qnil);
1761 FONTSET_ASCII (fontset) = font_name;
1763 return XINT (FONTSET_ID (fontset));
1767 /* Update auto_fontset_alist for FONTSET. When an ASCII font of
1768 FONTSET is changed, we delete an entry of FONTSET if any from
1769 auto_fontset_alist so that FONTSET is not re-used by
1770 fontset_from_font. */
1772 static void
1773 update_auto_fontset_alist (Lisp_Object font_object, Lisp_Object fontset)
1775 Lisp_Object prev, tail;
1777 for (prev = Qnil, tail = auto_fontset_alist; CONSP (tail);
1778 prev = tail, tail = XCDR (tail))
1779 if (EQ (fontset, XCDR (XCAR (tail))))
1781 if (NILP (prev))
1782 auto_fontset_alist = XCDR (tail);
1783 else
1784 XSETCDR (prev, XCDR (tail));
1785 break;
1790 /* Return a cons (FONT-OBJECT . GLYPH-CODE).
1791 FONT-OBJECT is the font for the character at POSITION in the current
1792 buffer. This is computed from all the text properties and overlays
1793 that apply to POSITION. POSITION may be nil, in which case,
1794 FONT-SPEC is the font for displaying the character CH with the
1795 default face.
1797 GLYPH-CODE is the glyph code in the font to use for the character.
1799 If the 2nd optional arg CH is non-nil, it is a character to check
1800 the font instead of the character at POSITION.
1802 It returns nil in the following cases:
1804 (1) The window system doesn't have a font for the character (thus
1805 it is displayed by an empty box).
1807 (2) The character code is invalid.
1809 (3) If POSITION is not nil, and the current buffer is not displayed
1810 in any window.
1812 In addition, the returned font name may not take into account of
1813 such redisplay engine hooks as what used in jit-lock-mode if
1814 POSITION is currently not visible. */
1817 DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0,
1818 doc: /* For internal use only. */)
1819 (Lisp_Object position, Lisp_Object ch)
1821 ptrdiff_t pos, pos_byte, dummy;
1822 int face_id;
1823 int c;
1824 struct frame *f;
1825 struct face *face;
1827 if (NILP (position))
1829 CHECK_CHARACTER (ch);
1830 c = XINT (ch);
1831 f = XFRAME (selected_frame);
1832 face_id = lookup_basic_face (f, DEFAULT_FACE_ID);
1833 pos = -1;
1835 else
1837 Lisp_Object window;
1838 struct window *w;
1840 CHECK_NUMBER_COERCE_MARKER (position);
1841 if (! (BEGV <= XINT (position) && XINT (position) < ZV))
1842 args_out_of_range_3 (position, make_number (BEGV), make_number (ZV));
1843 pos = XINT (position);
1844 pos_byte = CHAR_TO_BYTE (pos);
1845 if (NILP (ch))
1846 c = FETCH_CHAR (pos_byte);
1847 else
1849 CHECK_NATNUM (ch);
1850 c = XINT (ch);
1852 window = Fget_buffer_window (Fcurrent_buffer (), Qnil);
1853 if (NILP (window))
1854 return Qnil;
1855 w = XWINDOW (window);
1856 f = XFRAME (w->frame);
1857 face_id = face_at_buffer_position (w, pos, -1, -1, &dummy,
1858 pos + 100, 0, -1);
1860 if (! CHAR_VALID_P (c))
1861 return Qnil;
1862 face_id = FACE_FOR_CHAR (f, FACE_FROM_ID (f, face_id), c, pos, Qnil);
1863 face = FACE_FROM_ID (f, face_id);
1864 if (face->font)
1866 unsigned code = face->font->driver->encode_char (face->font, c);
1867 Lisp_Object font_object;
1869 if (code == FONT_INVALID_CODE)
1870 return Qnil;
1871 XSETFONT (font_object, face->font);
1872 return Fcons (font_object, INTEGER_TO_CONS (code));
1874 return Qnil;
1878 DEFUN ("fontset-info", Ffontset_info, Sfontset_info, 1, 2, 0,
1879 doc: /* Return information about a fontset FONTSET on frame FRAME.
1881 FONTSET is a fontset name string, nil for the fontset of FRAME, or t
1882 for the default fontset. FRAME nil means the selected frame.
1884 The value is a char-table whose elements have this form:
1886 ((FONT OPENED-FONT ...) ...)
1888 FONT is a name of font specified for a range of characters.
1890 OPENED-FONT is a name of a font actually opened.
1892 The char-table has one extra slot. If FONTSET is not the default
1893 fontset, the value the extra slot is a char-table containing the
1894 information about the derived fonts from the default fontset. The
1895 format is the same as above. */)
1896 (Lisp_Object fontset, Lisp_Object frame)
1898 Lisp_Object *realized[2], fontsets[2], tables[2];
1899 Lisp_Object val, elt;
1900 int c, i, j, k;
1902 (*check_window_system_func) ();
1904 fontset = check_fontset_name (fontset, &frame);
1906 /* Recode fontsets realized on FRAME from the base fontset FONTSET
1907 in the table `realized'. */
1908 realized[0] = (Lisp_Object *) alloca (sizeof (Lisp_Object)
1909 * ASIZE (Vfontset_table));
1910 for (i = j = 0; i < ASIZE (Vfontset_table); i++)
1912 elt = FONTSET_FROM_ID (i);
1913 if (!NILP (elt)
1914 && EQ (FONTSET_BASE (elt), fontset)
1915 && EQ (FONTSET_FRAME (elt), frame))
1916 realized[0][j++] = elt;
1918 realized[0][j] = Qnil;
1920 realized[1] = (Lisp_Object *) alloca (sizeof (Lisp_Object)
1921 * ASIZE (Vfontset_table));
1922 for (i = j = 0; ! NILP (realized[0][i]); i++)
1924 elt = FONTSET_DEFAULT (realized[0][i]);
1925 if (! NILP (elt))
1926 realized[1][j++] = elt;
1928 realized[1][j] = Qnil;
1930 tables[0] = Fmake_char_table (Qfontset_info, Qnil);
1931 fontsets[0] = fontset;
1932 if (!EQ (fontset, Vdefault_fontset))
1934 tables[1] = Fmake_char_table (Qnil, Qnil);
1935 XCHAR_TABLE (tables[0])->extras[0] = tables[1];
1936 fontsets[1] = Vdefault_fontset;
1939 /* Accumulate information of the fontset in TABLE. The format of
1940 each element is ((FONT-SPEC OPENED-FONT ...) ...). */
1941 for (k = 0; k <= 1; k++)
1943 for (c = 0; c <= MAX_CHAR; )
1945 int from = c, to = MAX_5_BYTE_CHAR;
1947 if (c <= MAX_5_BYTE_CHAR)
1949 val = char_table_ref_and_range (fontsets[k], c, &from, &to);
1951 else
1953 val = FONTSET_FALLBACK (fontsets[k]);
1954 to = MAX_CHAR;
1956 if (VECTORP (val))
1958 Lisp_Object alist;
1960 /* At first, set ALIST to ((FONT-SPEC) ...). */
1961 for (alist = Qnil, i = 0; i < ASIZE (val); i++)
1962 if (! NILP (AREF (val, i)))
1963 alist = Fcons (Fcons (FONT_DEF_SPEC (AREF (val, i)), Qnil),
1964 alist);
1965 alist = Fnreverse (alist);
1967 /* Then store opened font names to cdr of each elements. */
1968 for (i = 0; ! NILP (realized[k][i]); i++)
1970 if (c <= MAX_5_BYTE_CHAR)
1971 val = FONTSET_REF (realized[k][i], c);
1972 else
1973 val = FONTSET_FALLBACK (realized[k][i]);
1974 if (! CONSP (val) || ! VECTORP (XCDR (val)))
1975 continue;
1976 /* VAL: (int . [[FACE-ID FONT-DEF FONT-OBJECT int] ... ]) */
1977 val = XCDR (val);
1978 for (j = 0; j < ASIZE (val); j++)
1980 elt = AREF (val, j);
1981 if (FONT_OBJECT_P (RFONT_DEF_OBJECT (elt)))
1983 Lisp_Object font_object = RFONT_DEF_OBJECT (elt);
1984 Lisp_Object slot, name;
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));
1994 /* Store ALIST in TBL for characters C..TO. */
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;
2000 /* At last, change each elements to font names. */
2001 for (; CONSP (alist); alist = XCDR (alist))
2003 elt = XCAR (alist);
2004 XSETCAR (elt, Ffont_xlfd_name (XCAR (elt), Qnil));
2007 c = to + 1;
2009 if (EQ (fontset, Vdefault_fontset))
2010 break;
2013 return tables[0];
2017 DEFUN ("fontset-font", Ffontset_font, Sfontset_font, 2, 3, 0,
2018 doc: /* Return a font name pattern for character CH in fontset NAME.
2019 If NAME is t, find a pattern in the default fontset.
2020 If NAME is nil, find a pattern in the fontset of the selected frame.
2022 The value has the form (FAMILY . REGISTRY), where FAMILY is a font
2023 family name and REGISTRY is a font registry name. This is actually
2024 the first font name pattern for CH in the fontset or in the default
2025 fontset.
2027 If the 2nd optional arg ALL is non-nil, return a list of all font name
2028 patterns. */)
2029 (Lisp_Object name, Lisp_Object ch, Lisp_Object all)
2031 int c;
2032 Lisp_Object fontset, elt, list, repertory, val;
2033 int i, j;
2034 Lisp_Object frame;
2036 frame = Qnil;
2037 fontset = check_fontset_name (name, &frame);
2039 CHECK_CHARACTER (ch);
2040 c = XINT (ch);
2041 list = Qnil;
2042 while (1)
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++)
2049 Lisp_Object family, registry;
2051 val = AREF (elt, j);
2052 if (NILP (val))
2053 return Qnil;
2054 repertory = AREF (val, 1);
2055 if (INTEGERP (repertory))
2057 struct charset *charset = CHARSET_FROM_ID (XINT (repertory));
2059 if (! CHAR_CHARSET_P (c, charset))
2060 continue;
2062 else if (CHAR_TABLE_P (repertory))
2064 if (NILP (CHAR_TABLE_REF (repertory, c)))
2065 continue;
2067 val = AREF (val, 0);
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);
2076 if (NILP (all))
2077 return val;
2078 list = Fcons (val, list);
2080 if (EQ (fontset, Vdefault_fontset))
2081 break;
2082 fontset = Vdefault_fontset;
2084 return (Fnreverse (list));
2087 DEFUN ("fontset-list", Ffontset_list, Sfontset_list, 0, 0, 0,
2088 doc: /* Return a list of all defined fontset names. */)
2089 (void)
2091 Lisp_Object fontset, list;
2092 int i;
2094 list = Qnil;
2095 for (i = 0; i < ASIZE (Vfontset_table); i++)
2097 fontset = FONTSET_FROM_ID (i);
2098 if (!NILP (fontset)
2099 && BASE_FONTSET_P (fontset))
2100 list = Fcons (FONTSET_NAME (fontset), list);
2103 return list;
2107 #ifdef FONTSET_DEBUG
2109 Lisp_Object dump_fontset (Lisp_Object) EXTERNALLY_VISIBLE;
2111 Lisp_Object
2112 dump_fontset (Lisp_Object fontset)
2114 Lisp_Object vec;
2116 vec = Fmake_vector (make_number (3), Qnil);
2117 ASET (vec, 0, FONTSET_ID (fontset));
2119 if (BASE_FONTSET_P (fontset))
2121 ASET (vec, 1, FONTSET_NAME (fontset));
2123 else
2125 Lisp_Object frame;
2127 frame = FONTSET_FRAME (fontset);
2128 if (FRAMEP (frame))
2130 FRAME_PTR f = XFRAME (frame);
2132 if (FRAME_LIVE_P (f))
2133 ASET (vec, 1,
2134 Fcons (FONTSET_NAME (FONTSET_BASE (fontset)), f->name));
2135 else
2136 ASET (vec, 1,
2137 Fcons (FONTSET_NAME (FONTSET_BASE (fontset)), Qnil));
2139 if (!NILP (FONTSET_DEFAULT (fontset)))
2140 ASET (vec, 2, FONTSET_ID (FONTSET_DEFAULT (fontset)));
2142 return vec;
2145 DEFUN ("fontset-list-all", Ffontset_list_all, Sfontset_list_all, 0, 0, 0,
2146 doc: /* Return a brief summary of all fontsets for debug use. */)
2147 (void)
2149 Lisp_Object val;
2150 int i;
2152 for (i = 0, val = Qnil; i < ASIZE (Vfontset_table); i++)
2153 if (! NILP (AREF (Vfontset_table, i)))
2154 val = Fcons (dump_fontset (AREF (Vfontset_table, i)), val);
2155 return (Fnreverse (val));
2157 #endif /* FONTSET_DEBUG */
2159 void
2160 syms_of_fontset (void)
2162 DEFSYM (Qfontset, "fontset");
2163 Fput (Qfontset, Qchar_table_extra_slots, make_number (9));
2164 DEFSYM (Qfontset_info, "fontset-info");
2165 Fput (Qfontset_info, Qchar_table_extra_slots, make_number (1));
2167 DEFSYM (Qprepend, "prepend");
2168 DEFSYM (Qappend, "append");
2169 DEFSYM (Qlatin, "latin");
2171 Vcached_fontset_data = Qnil;
2172 staticpro (&Vcached_fontset_data);
2174 Vfontset_table = Fmake_vector (make_number (32), Qnil);
2175 staticpro (&Vfontset_table);
2177 Vdefault_fontset = Fmake_char_table (Qfontset, Qnil);
2178 staticpro (&Vdefault_fontset);
2179 FONTSET_ID (Vdefault_fontset) = make_number (0);
2180 FONTSET_NAME (Vdefault_fontset)
2181 = make_pure_c_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default");
2182 ASET (Vfontset_table, 0, Vdefault_fontset);
2183 next_fontset_id = 1;
2185 auto_fontset_alist = Qnil;
2186 staticpro (&auto_fontset_alist);
2188 DEFVAR_LISP ("font-encoding-charset-alist", Vfont_encoding_charset_alist,
2189 doc: /*
2190 Alist of charsets vs the charsets to determine the preferred font encoding.
2191 Each element looks like (CHARSET . ENCODING-CHARSET),
2192 where ENCODING-CHARSET is a charset registered in the variable
2193 `font-encoding-alist' as ENCODING.
2195 When a text has a property `charset' and the value is CHARSET, a font
2196 whose encoding corresponds to ENCODING-CHARSET is preferred. */);
2197 Vfont_encoding_charset_alist = Qnil;
2199 DEFVAR_LISP ("use-default-ascent", Vuse_default_ascent,
2200 doc: /*
2201 Char table of characters whose ascent values should be ignored.
2202 If an entry for a character is non-nil, the ascent value of the glyph
2203 is assumed to be specified by _MULE_DEFAULT_ASCENT property of a font.
2205 This affects how a composite character which contains
2206 such a character is displayed on screen. */);
2207 Vuse_default_ascent = Qnil;
2209 DEFVAR_LISP ("ignore-relative-composition", Vignore_relative_composition,
2210 doc: /*
2211 Char table of characters which are not composed relatively.
2212 If an entry for a character is non-nil, a composition sequence
2213 which contains that character is displayed so that
2214 the glyph of that character is put without considering
2215 an ascent and descent value of a previous character. */);
2216 Vignore_relative_composition = Qnil;
2218 DEFVAR_LISP ("alternate-fontname-alist", Valternate_fontname_alist,
2219 doc: /* Alist of fontname vs list of the alternate fontnames.
2220 When a specified font name is not found, the corresponding
2221 alternate fontnames (if any) are tried instead. */);
2222 Valternate_fontname_alist = Qnil;
2224 DEFVAR_LISP ("fontset-alias-alist", Vfontset_alias_alist,
2225 doc: /* Alist of fontset names vs the aliases. */);
2226 Vfontset_alias_alist = Fcons (Fcons (FONTSET_NAME (Vdefault_fontset),
2227 make_pure_c_string ("fontset-default")),
2228 Qnil);
2230 DEFVAR_LISP ("vertical-centering-font-regexp",
2231 Vvertical_centering_font_regexp,
2232 doc: /* Regexp matching font names that require vertical centering on display.
2233 When a character is displayed with such fonts, the character is displayed
2234 at the vertical center of lines. */);
2235 Vvertical_centering_font_regexp = Qnil;
2237 DEFVAR_LISP ("otf-script-alist", Votf_script_alist,
2238 doc: /* Alist of OpenType script tags vs the corresponding script names. */);
2239 Votf_script_alist = Qnil;
2241 defsubr (&Squery_fontset);
2242 defsubr (&Snew_fontset);
2243 defsubr (&Sset_fontset_font);
2244 defsubr (&Sinternal_char_font);
2245 defsubr (&Sfontset_info);
2246 defsubr (&Sfontset_font);
2247 defsubr (&Sfontset_list);
2248 #ifdef FONTSET_DEBUG
2249 defsubr (&Sfontset_list_all);
2250 #endif