Fix Bug#20943.
[emacs.git] / src / fontset.c
blob50fcc64854803daa06168aac67e86b689be92d11
1 /* Fontset handler.
3 Copyright (C) 2001-2015 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 #include <config.h>
28 #include <stdio.h>
30 #include "lisp.h"
31 #include "blockinput.h"
32 #include "character.h"
33 #include "buffer.h"
34 #include "charset.h"
35 #include "ccl.h"
36 #include "keyboard.h"
37 #include "frame.h"
38 #include "dispextern.h"
39 #include "intervals.h"
40 #include "fontset.h"
41 #include "window.h"
42 #ifdef HAVE_WINDOW_SYSTEM
43 #include TERM_HEADER
44 #endif /* HAVE_WINDOW_SYSTEM */
45 #include "termhooks.h"
46 #include "font.h"
48 /* FONTSET
50 A fontset is a collection of font related information to give
51 similar appearance (style, etc) of characters. A fontset has two
52 roles. One is to use for the frame parameter `font' as if it is an
53 ASCII font. In that case, Emacs uses the font specified for
54 `ascii' script for the frame's default font.
56 Another role, the more important one, is to provide information
57 about which font to use for each non-ASCII character.
59 There are two kinds of fontsets; base and realized. A base fontset
60 is created by `new-fontset' from Emacs Lisp explicitly. A realized
61 fontset is created implicitly when a face is realized for ASCII
62 characters. A face is also realized for non-ASCII characters based
63 on an ASCII face. All of non-ASCII faces based on the same ASCII
64 face share the same realized fontset.
66 A fontset object is implemented by a char-table whose default value
67 and parent are always nil.
69 An element of a base fontset is a vector of FONT-DEFs which themselves
70 are vectors of the form [ FONT-SPEC ENCODING REPERTORY ].
72 An element of a realized fontset is nil, t, 0, or a vector of this
73 form:
75 [ PREFERRED-RFONT-DEF RFONT-DEF0 RFONT-DEF1 ... ]
77 Each RFONT-DEFn (i.e. Realized FONT-DEF) has this form:
79 [ FACE-ID FONT-DEF FONT-OBJECT SORTING-SCORE ]
81 RFONT-DEFn are automatically reordered by the current charset
82 priority list.
84 The value nil means that we have not yet generated the above vector
85 from the base of the fontset.
87 The value t means that no font is available for the corresponding
88 range of characters.
90 The value 0 means that no font is available for the corresponding
91 range of characters in this fontset, but may be available in the
92 default fontset.
94 A fontset has 8 extra slots.
96 The 1st slot:
97 base: the ID number of the fontset
98 realized: Likewise
100 The 2nd slot:
101 base: the name of the fontset
102 realized: nil
104 The 3rd slot:
105 base: the font name for ASCII characters
106 realized: nil
108 The 4th slot:
109 base: nil
110 realized: the base fontset
112 The 5th slot:
113 base: nil
114 realized: the frame that the fontset belongs to
116 The 6th slot:
117 base: nil
118 realized: the ID number of a face to use for characters that
119 has no font in a realized fontset.
121 The 7th slot:
122 base: nil
123 realized: If the base is not the default fontset, a fontset
124 realized from the default fontset, else nil.
126 The 8th slot:
127 base: Same as element value (but for fallback fonts).
128 realized: Likewise.
130 All fontsets are recorded in the vector Vfontset_table.
133 DEFAULT FONTSET
135 There's a special base fontset named `default fontset' which
136 defines the default font specifications. When a base fontset
137 doesn't specify a font for a specific character, the corresponding
138 value in the default fontset is used.
140 The parent of a realized fontset created for such a face that has
141 no fontset is the default fontset.
144 These structures are hidden from the other codes than this file.
145 The other codes handle fontsets only by their ID numbers. They
146 usually use the variable name `fontset' for IDs. But, in this
147 file, we always use variable name `id' for IDs, and name `fontset'
148 for an actual fontset object, i.e., char-table.
152 /********** VARIABLES and FUNCTION PROTOTYPES **********/
154 /* Vector containing all fontsets. */
155 static Lisp_Object Vfontset_table;
157 /* Next possibly free fontset ID. Usually this keeps the minimum
158 fontset ID not yet used. */
159 static int next_fontset_id;
161 /* The default fontset. This gives default FAMILY and REGISTRY of
162 font for each character. */
163 static Lisp_Object Vdefault_fontset;
165 /* Prototype declarations for static functions. */
166 static Lisp_Object make_fontset (Lisp_Object, Lisp_Object, Lisp_Object);
168 /* Return true if ID is a valid fontset id.
169 Optimized away if ENABLE_CHECKING is not defined. */
171 static bool
172 fontset_id_valid_p (int id)
174 return (id >= 0 && id < ASIZE (Vfontset_table) - 1);
179 /********** MACROS AND FUNCTIONS TO HANDLE FONTSET **********/
181 /* Return the fontset with ID. No check of ID's validness. */
182 #define FONTSET_FROM_ID(id) AREF (Vfontset_table, id)
184 /* Access special values of FONTSET. */
186 #define FONTSET_ID(fontset) XCHAR_TABLE (fontset)->extras[0]
187 static void
188 set_fontset_id (Lisp_Object fontset, Lisp_Object id)
190 set_char_table_extras (fontset, 0, id);
193 /* Access special values of (base) FONTSET. */
195 #define FONTSET_NAME(fontset) XCHAR_TABLE (fontset)->extras[1]
196 static void
197 set_fontset_name (Lisp_Object fontset, Lisp_Object name)
199 set_char_table_extras (fontset, 1, name);
202 #define FONTSET_ASCII(fontset) XCHAR_TABLE (fontset)->extras[2]
203 static void
204 set_fontset_ascii (Lisp_Object fontset, Lisp_Object ascii)
206 set_char_table_extras (fontset, 2, ascii);
209 /* Access special values of (realized) FONTSET. */
211 #define FONTSET_BASE(fontset) XCHAR_TABLE (fontset)->extras[3]
212 static void
213 set_fontset_base (Lisp_Object fontset, Lisp_Object base)
215 set_char_table_extras (fontset, 3, base);
218 #define FONTSET_FRAME(fontset) XCHAR_TABLE (fontset)->extras[4]
219 static void
220 set_fontset_frame (Lisp_Object fontset, Lisp_Object frame)
222 set_char_table_extras (fontset, 4, frame);
225 #define FONTSET_NOFONT_FACE(fontset) XCHAR_TABLE (fontset)->extras[5]
226 static void
227 set_fontset_nofont_face (Lisp_Object fontset, Lisp_Object face)
229 set_char_table_extras (fontset, 5, face);
232 #define FONTSET_DEFAULT(fontset) XCHAR_TABLE (fontset)->extras[6]
233 static void
234 set_fontset_default (Lisp_Object fontset, Lisp_Object def)
236 set_char_table_extras (fontset, 6, def);
239 /* For both base and realized fontset. */
241 #define FONTSET_FALLBACK(fontset) XCHAR_TABLE (fontset)->extras[7]
242 static void
243 set_fontset_fallback (Lisp_Object fontset, Lisp_Object fallback)
245 set_char_table_extras (fontset, 7, fallback);
248 #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) = make_uninit_vector (3); \
254 ASET ((font_def), 0, font_spec); \
255 ASET ((font_def), 1, encoding); \
256 ASET ((font_def), 2, repertory); \
257 } while (0)
259 #define FONT_DEF_SPEC(font_def) AREF (font_def, 0)
260 #define FONT_DEF_ENCODING(font_def) AREF (font_def, 1)
261 #define FONT_DEF_REPERTORY(font_def) AREF (font_def, 2)
263 #define RFONT_DEF_FACE(rfont_def) AREF (rfont_def, 0)
264 #define RFONT_DEF_SET_FACE(rfont_def, face_id) \
265 ASET ((rfont_def), 0, make_number (face_id))
266 #define RFONT_DEF_FONT_DEF(rfont_def) AREF (rfont_def, 1)
267 #define RFONT_DEF_SPEC(rfont_def) FONT_DEF_SPEC (AREF (rfont_def, 1))
268 #define RFONT_DEF_OBJECT(rfont_def) AREF (rfont_def, 2)
269 #define RFONT_DEF_SET_OBJECT(rfont_def, object) \
270 ASET ((rfont_def), 2, (object))
271 /* Score of RFONT_DEF is an integer value; the lowest 8 bits represent
272 the order of listing by font backends, the higher bits represents
273 the order given by charset priority list. The smaller value is
274 preferable. */
275 #define RFONT_DEF_SCORE(rfont_def) XINT (AREF (rfont_def, 3))
276 #define RFONT_DEF_SET_SCORE(rfont_def, score) \
277 ASET ((rfont_def), 3, make_number (score))
278 #define RFONT_DEF_NEW(rfont_def, font_def) \
279 do { \
280 (rfont_def) = Fmake_vector (make_number (4), Qnil); \
281 ASET ((rfont_def), 1, (font_def)); \
282 RFONT_DEF_SET_SCORE ((rfont_def), 0); \
283 } while (0)
286 /* Return the element of FONTSET for the character C. If FONTSET is a
287 base fontset other then the default fontset and FONTSET doesn't
288 contain information for C, return the information in the default
289 fontset. */
291 #define FONTSET_REF(fontset, c) \
292 (EQ (fontset, Vdefault_fontset) \
293 ? CHAR_TABLE_REF (fontset, c) \
294 : fontset_ref ((fontset), (c)))
296 static Lisp_Object
297 fontset_ref (Lisp_Object fontset, int c)
299 Lisp_Object elt;
301 elt = CHAR_TABLE_REF (fontset, c);
302 if (NILP (elt) && ! EQ (fontset, Vdefault_fontset)
303 /* Don't check Vdefault_fontset for a realized fontset. */
304 && NILP (FONTSET_BASE (fontset)))
305 elt = CHAR_TABLE_REF (Vdefault_fontset, c);
306 return elt;
309 /* Set elements of FONTSET for characters in RANGE to the value ELT.
310 RANGE is a cons (FROM . TO), where FROM and TO are character codes
311 specifying a range. */
313 #define FONTSET_SET(fontset, range, elt) \
314 Fset_char_table_range ((fontset), (range), (elt))
317 /* Modify the elements of FONTSET for characters in RANGE by replacing
318 with ELT or adding ELT. RANGE is a cons (FROM . TO), where FROM
319 and TO are character codes specifying a range. If ADD is nil,
320 replace with ELT, if ADD is `prepend', prepend ELT, otherwise,
321 append ELT. */
323 #define FONTSET_ADD(fontset, range, elt, add) \
324 (NILP (add) \
325 ? (NILP (range) \
326 ? (set_fontset_fallback \
327 (fontset, Fmake_vector (make_number (1), (elt)))) \
328 : ((void) \
329 Fset_char_table_range (fontset, range, \
330 Fmake_vector (make_number (1), elt)))) \
331 : fontset_add ((fontset), (range), (elt), (add)))
333 static void
334 fontset_add (Lisp_Object fontset, Lisp_Object range, Lisp_Object elt, Lisp_Object add)
336 Lisp_Object args[2];
337 int idx = (EQ (add, Qappend) ? 0 : 1);
339 args[1 - idx] = Fmake_vector (make_number (1), elt);
341 if (CONSP (range))
343 int from = XINT (XCAR (range));
344 int to = XINT (XCDR (range));
345 int from1, to1;
347 do {
348 from1 = from, to1 = to;
349 args[idx] = char_table_ref_and_range (fontset, from, &from1, &to1);
350 char_table_set_range (fontset, from, to1,
351 (NILP (args[idx]) ? args[1 - idx]
352 : CALLMANY (Fvconcat, args)));
353 from = to1 + 1;
354 } while (from < to);
356 else
358 args[idx] = FONTSET_FALLBACK (fontset);
359 set_fontset_fallback (fontset,
360 (NILP (args[idx]) ? args[1 - idx]
361 : CALLMANY (Fvconcat, args)));
365 static int
366 fontset_compare_rfontdef (const void *val1, const void *val2)
368 return (RFONT_DEF_SCORE (*(Lisp_Object *) val1)
369 - RFONT_DEF_SCORE (*(Lisp_Object *) val2));
372 /* Update a cons cell which has this form:
373 (CHARSET-ORDERED-LIST-TICK . FONT-GROUP)
374 where FONT-GROUP is of the form
375 [ PREFERRED-RFONT-DEF RFONT-DEF0 RFONT-DEF1 ... ]
376 Reorder RFONT-DEFs according to the current language, and update
377 CHARSET-ORDERED-LIST-TICK. */
379 static void
380 reorder_font_vector (Lisp_Object font_group, struct font *font)
382 Lisp_Object vec, font_object;
383 int size;
384 int i;
385 bool score_changed = false;
387 if (font)
388 XSETFONT (font_object, font);
389 else
390 font_object = Qnil;
392 vec = XCDR (font_group);
393 size = ASIZE (vec);
394 /* Exclude the tailing nil element from the reordering. */
395 if (NILP (AREF (vec, size - 1)))
396 size--;
398 for (i = 0; i < size; i++)
400 Lisp_Object rfont_def = AREF (vec, i);
401 Lisp_Object font_def = RFONT_DEF_FONT_DEF (rfont_def);
402 Lisp_Object font_spec = FONT_DEF_SPEC (font_def);
403 int score = RFONT_DEF_SCORE (rfont_def) & 0xFF;
404 Lisp_Object otf_spec = Ffont_get (font_spec, QCotf);
406 if (! NILP (otf_spec))
407 /* A font-spec with :otf is preferable regardless of encoding
408 and language.. */
410 else if (! font_match_p (font_spec, font_object))
412 Lisp_Object encoding = FONT_DEF_ENCODING (font_def);
414 if (! NILP (encoding))
416 Lisp_Object tail;
418 for (tail = Vcharset_ordered_list;
419 ! EQ (tail, Vcharset_non_preferred_head) && CONSP (tail);
420 tail = XCDR (tail))
421 if (EQ (encoding, XCAR (tail)))
422 break;
423 else if (score <= min (INT_MAX, MOST_POSITIVE_FIXNUM) - 0x100)
424 score += 0x100;
426 else
428 Lisp_Object lang = Ffont_get (font_spec, QClang);
430 if (! NILP (lang)
431 && ! EQ (lang, Vcurrent_iso639_language)
432 && (! CONSP (Vcurrent_iso639_language)
433 || NILP (Fmemq (lang, Vcurrent_iso639_language))))
434 score |= 0x100;
437 if (RFONT_DEF_SCORE (rfont_def) != score)
439 RFONT_DEF_SET_SCORE (rfont_def, score);
440 score_changed = true;
444 if (score_changed)
445 qsort (XVECTOR (vec)->contents, size, word_size,
446 fontset_compare_rfontdef);
447 EMACS_INT low_tick_bits = charset_ordered_list_tick & MOST_POSITIVE_FIXNUM;
448 XSETCAR (font_group, make_number (low_tick_bits));
451 /* Return a font-group (actually a cons (-1 . FONT-GROUP-VECTOR)) for
452 character C in FONTSET. If C is -1, return a fallback font-group.
453 If C is not -1, the value may be Qt (FONTSET doesn't have a font
454 for C even in the fallback group), or 0 (a font for C may be found
455 only in the fallback group). */
457 static Lisp_Object
458 fontset_get_font_group (Lisp_Object fontset, int c)
460 Lisp_Object font_group;
461 Lisp_Object base_fontset;
462 int from = 0, to = MAX_CHAR, i;
464 eassert (! BASE_FONTSET_P (fontset));
465 if (c >= 0)
466 font_group = CHAR_TABLE_REF (fontset, c);
467 else
468 font_group = FONTSET_FALLBACK (fontset);
469 if (! NILP (font_group))
470 return font_group;
471 base_fontset = FONTSET_BASE (fontset);
472 if (NILP (base_fontset))
473 font_group = Qnil;
474 else if (c >= 0)
475 font_group = char_table_ref_and_range (base_fontset, c, &from, &to);
476 else
477 font_group = FONTSET_FALLBACK (base_fontset);
478 if (NILP (font_group))
480 font_group = make_number (0);
481 if (c >= 0)
482 char_table_set_range (fontset, from, to, font_group);
483 return font_group;
485 if (!VECTORP (font_group))
486 return font_group;
487 font_group = Fcopy_sequence (font_group);
488 for (i = 0; i < ASIZE (font_group); i++)
489 if (! NILP (AREF (font_group, i)))
491 Lisp_Object rfont_def;
493 RFONT_DEF_NEW (rfont_def, AREF (font_group, i));
494 /* Remember the original order. */
495 RFONT_DEF_SET_SCORE (rfont_def, i);
496 ASET (font_group, i, rfont_def);
498 font_group = Fcons (make_number (-1), font_group);
499 if (c >= 0)
500 char_table_set_range (fontset, from, to, font_group);
501 else
502 set_fontset_fallback (fontset, font_group);
503 return font_group;
506 /* Return RFONT-DEF (vector) in the realized fontset FONTSET for the
507 character C. If no font is found, return Qnil if there's a
508 possibility that the default fontset or the fallback font groups
509 have a proper font, and return Qt if not.
511 If a font is found but is not yet opened, open it (if FACE is not
512 NULL) or return Qnil (if FACE is NULL).
514 ID is a charset-id that must be preferred, or -1 meaning no
515 preference.
517 If FALLBACK, search only fallback fonts. */
519 static Lisp_Object
520 fontset_find_font (Lisp_Object fontset, int c, struct face *face, int id,
521 bool fallback)
523 Lisp_Object vec, font_group;
524 int i, charset_matched = 0, found_index;
525 struct frame *f = (FRAMEP (FONTSET_FRAME (fontset))
526 ? XFRAME (FONTSET_FRAME (fontset))
527 : XFRAME (selected_frame));
528 Lisp_Object rfont_def;
530 font_group = fontset_get_font_group (fontset, fallback ? -1 : c);
531 if (! CONSP (font_group))
532 return font_group;
533 vec = XCDR (font_group);
534 if (ASIZE (vec) == 0)
535 return Qnil;
537 if (ASIZE (vec) > 1)
539 if (XINT (XCAR (font_group)) != charset_ordered_list_tick)
540 /* We have just created the font-group,
541 or the charset priorities were changed. */
542 reorder_font_vector (font_group, face->ascii_face->font);
543 if (id >= 0)
544 /* Find a spec matching with the charset ID to try at
545 first. */
546 for (i = 0; i < ASIZE (vec); i++)
548 Lisp_Object repertory;
550 rfont_def = AREF (vec, i);
551 if (NILP (rfont_def))
552 break;
553 repertory = FONT_DEF_REPERTORY (RFONT_DEF_FONT_DEF (rfont_def));
555 if (XINT (repertory) == id)
557 charset_matched = i;
558 break;
563 /* Find the first available font in the vector of RFONT-DEF. */
564 for (i = 0; i < ASIZE (vec); i++)
566 Lisp_Object font_def;
567 Lisp_Object font_entity, font_object;
569 found_index = i;
570 if (i == 0)
572 if (charset_matched > 0)
574 /* Try the element matching with the charset ID at first. */
575 found_index = charset_matched;
576 /* Make this negative so that we don't come here in the
577 next loop. */
578 charset_matched = - charset_matched;
579 /* We must try the first element in the next loop. */
580 i--;
583 else if (i == - charset_matched)
585 /* We have already tried this element and the followings
586 that have the same font specifications in the first
587 iteration. So, skip them all. */
588 rfont_def = AREF (vec, i);
589 font_def = RFONT_DEF_FONT_DEF (rfont_def);
590 for (; i + 1 < ASIZE (vec); i++)
592 rfont_def = AREF (vec, i + 1);
593 if (NILP (rfont_def))
594 break;
595 if (! EQ (RFONT_DEF_FONT_DEF (rfont_def), font_def))
596 break;
598 continue;
601 rfont_def = AREF (vec, found_index);
602 if (NILP (rfont_def))
604 if (i < 0)
605 continue;
606 /* This is a sign of not to try the other fonts. */
607 return Qt;
609 if (INTEGERP (RFONT_DEF_FACE (rfont_def))
610 && XINT (RFONT_DEF_FACE (rfont_def)) < 0)
611 /* We couldn't open this font last time. */
612 continue;
614 font_object = RFONT_DEF_OBJECT (rfont_def);
615 if (NILP (font_object))
617 font_def = RFONT_DEF_FONT_DEF (rfont_def);
619 if (! face)
620 /* We have not yet opened the font. */
621 return Qnil;
622 /* Find a font best-matching with the spec without checking
623 the support of the character C. That checking is costly,
624 and even without the checking, the found font supports C
625 in high possibility. */
626 font_entity = font_find_for_lface (f, face->lface,
627 FONT_DEF_SPEC (font_def), -1);
628 if (NILP (font_entity))
630 /* Record that no font matches the spec. */
631 RFONT_DEF_SET_FACE (rfont_def, -1);
632 continue;
634 font_object = font_open_for_lface (f, font_entity, face->lface,
635 FONT_DEF_SPEC (font_def));
636 if (NILP (font_object))
638 /* Something strange happened, perhaps because of a
639 Font-backend problem. Too avoid crashing, record
640 that this spec is unusable. It may be better to find
641 another font of the same spec, but currently we don't
642 have such an API. */
643 RFONT_DEF_SET_FACE (rfont_def, -1);
644 continue;
646 RFONT_DEF_SET_OBJECT (rfont_def, font_object);
649 if (font_has_char (f, font_object, c))
650 goto found;
652 /* Find a font already opened, matching with the current spec,
653 and supporting C. */
654 font_def = RFONT_DEF_FONT_DEF (rfont_def);
655 for (; found_index + 1 < ASIZE (vec); found_index++)
657 rfont_def = AREF (vec, found_index + 1);
658 if (NILP (rfont_def))
659 break;
660 if (! EQ (RFONT_DEF_FONT_DEF (rfont_def), font_def))
661 break;
662 font_object = RFONT_DEF_OBJECT (rfont_def);
663 if (! NILP (font_object) && font_has_char (f, font_object, c))
665 found_index++;
666 goto found;
670 /* Find a font-entity with the current spec and supporting C. */
671 font_entity = font_find_for_lface (f, face->lface,
672 FONT_DEF_SPEC (font_def), c);
673 if (! NILP (font_entity))
675 /* We found a font. Open it and insert a new element for
676 that font in VEC. */
677 Lisp_Object new_vec;
678 int j;
680 font_object = font_open_for_lface (f, font_entity, face->lface,
681 Qnil);
682 if (NILP (font_object))
683 continue;
684 RFONT_DEF_NEW (rfont_def, font_def);
685 RFONT_DEF_SET_OBJECT (rfont_def, font_object);
686 RFONT_DEF_SET_SCORE (rfont_def, RFONT_DEF_SCORE (rfont_def));
687 new_vec = Fmake_vector (make_number (ASIZE (vec) + 1), Qnil);
688 found_index++;
689 for (j = 0; j < found_index; j++)
690 ASET (new_vec, j, AREF (vec, j));
691 ASET (new_vec, j, rfont_def);
692 for (j++; j < ASIZE (new_vec); j++)
693 ASET (new_vec, j, AREF (vec, j - 1));
694 XSETCDR (font_group, new_vec);
695 vec = new_vec;
696 goto found;
698 if (i >= 0)
699 i = found_index;
702 FONTSET_SET (fontset, make_number (c), make_number (0));
703 return Qnil;
705 found:
706 if (fallback && found_index > 0)
708 /* The order of fonts in the fallback font-group is not that
709 important, and it is better to move the found font to the
710 first of the group so that the next try will find it
711 quickly. */
712 for (i = found_index; i > 0; i--)
713 ASET (vec, i, AREF (vec, i - 1));
714 ASET (vec, 0, rfont_def);
716 return rfont_def;
720 static Lisp_Object
721 fontset_font (Lisp_Object fontset, int c, struct face *face, int id)
723 Lisp_Object rfont_def, default_rfont_def IF_LINT (= Qnil);
724 Lisp_Object base_fontset;
726 /* Try a font-group of FONTSET. */
727 FONT_DEFERRED_LOG ("current fontset: font for", make_number (c), Qnil);
728 rfont_def = fontset_find_font (fontset, c, face, id, 0);
729 if (VECTORP (rfont_def))
730 return rfont_def;
731 if (NILP (rfont_def))
732 FONTSET_SET (fontset, make_number (c), make_number (0));
734 /* Try a font-group of the default fontset. */
735 base_fontset = FONTSET_BASE (fontset);
736 if (! EQ (base_fontset, Vdefault_fontset))
738 if (NILP (FONTSET_DEFAULT (fontset)))
739 set_fontset_default
740 (fontset,
741 make_fontset (FONTSET_FRAME (fontset), Qnil, Vdefault_fontset));
742 FONT_DEFERRED_LOG ("default fontset: font for", make_number (c), Qnil);
743 default_rfont_def
744 = fontset_find_font (FONTSET_DEFAULT (fontset), c, face, id, 0);
745 if (VECTORP (default_rfont_def))
746 return default_rfont_def;
747 if (NILP (default_rfont_def))
748 FONTSET_SET (FONTSET_DEFAULT (fontset), make_number (c),
749 make_number (0));
752 /* Try a fallback font-group of FONTSET. */
753 if (! EQ (rfont_def, Qt))
755 FONT_DEFERRED_LOG ("current fallback: font for", make_number (c), Qnil);
756 rfont_def = fontset_find_font (fontset, c, face, id, 1);
757 if (VECTORP (rfont_def))
758 return rfont_def;
759 /* Remember that FONTSET has no font for C. */
760 FONTSET_SET (fontset, make_number (c), Qt);
763 /* Try a fallback font-group of the default fontset. */
764 if (! EQ (base_fontset, Vdefault_fontset)
765 && ! EQ (default_rfont_def, Qt))
767 FONT_DEFERRED_LOG ("default fallback: font for", make_number (c), Qnil);
768 rfont_def = fontset_find_font (FONTSET_DEFAULT (fontset), c, face, id, 1);
769 if (VECTORP (rfont_def))
770 return rfont_def;
771 /* Remember that the default fontset has no font for C. */
772 FONTSET_SET (FONTSET_DEFAULT (fontset), make_number (c), Qt);
775 return Qnil;
778 /* Return a newly created fontset with NAME. If BASE is nil, make a
779 base fontset. Otherwise make a realized fontset whose base is
780 BASE. */
782 static Lisp_Object
783 make_fontset (Lisp_Object frame, Lisp_Object name, Lisp_Object base)
785 Lisp_Object fontset;
786 int size = ASIZE (Vfontset_table);
787 int id = next_fontset_id;
789 /* Find a free slot in Vfontset_table. Usually, next_fontset_id is
790 the next available fontset ID. So it is expected that this loop
791 terminates quickly. In addition, as the last element of
792 Vfontset_table is always nil, we don't have to check the range of
793 id. */
794 while (!NILP (AREF (Vfontset_table, id))) id++;
796 if (id + 1 == size)
797 Vfontset_table = larger_vector (Vfontset_table, 1, -1);
799 fontset = Fmake_char_table (Qfontset, Qnil);
801 set_fontset_id (fontset, make_number (id));
802 if (NILP (base))
803 set_fontset_name (fontset, name);
804 else
806 set_fontset_name (fontset, Qnil);
807 set_fontset_frame (fontset, frame);
808 set_fontset_base (fontset, base);
811 ASET (Vfontset_table, id, fontset);
812 next_fontset_id = id + 1;
813 return fontset;
817 /********** INTERFACES TO xfaces.c, xfns.c, and dispextern.h **********/
819 /* Return the name of the fontset who has ID. */
821 Lisp_Object
822 fontset_name (int id)
824 Lisp_Object fontset;
826 fontset = FONTSET_FROM_ID (id);
827 return FONTSET_NAME (fontset);
831 /* Return the ASCII font name of the fontset who has ID. */
833 Lisp_Object
834 fontset_ascii (int id)
836 Lisp_Object fontset, elt;
838 fontset= FONTSET_FROM_ID (id);
839 elt = FONTSET_ASCII (fontset);
840 if (CONSP (elt))
841 elt = XCAR (elt);
842 return elt;
845 /* Free fontset of FACE defined on frame F. Called from
846 free_realized_face. */
848 void
849 free_face_fontset (struct frame *f, struct face *face)
851 Lisp_Object fontset;
853 fontset = FONTSET_FROM_ID (face->fontset);
854 if (NILP (fontset))
855 return;
856 eassert (! BASE_FONTSET_P (fontset));
857 eassert (f == XFRAME (FONTSET_FRAME (fontset)));
858 ASET (Vfontset_table, face->fontset, Qnil);
859 if (face->fontset < next_fontset_id)
860 next_fontset_id = face->fontset;
861 if (! NILP (FONTSET_DEFAULT (fontset)))
863 int id = XINT (FONTSET_ID (FONTSET_DEFAULT (fontset)));
865 fontset = AREF (Vfontset_table, id);
866 eassert (!NILP (fontset) && ! BASE_FONTSET_P (fontset));
867 eassert (f == XFRAME (FONTSET_FRAME (fontset)));
868 ASET (Vfontset_table, id, Qnil);
869 if (id < next_fontset_id)
870 next_fontset_id = face->fontset;
872 face->fontset = -1;
875 /* Return ID of face suitable for displaying character C at buffer position
876 POS on frame F. FACE must be realized for ASCII characters in advance.
877 Called from the macro FACE_FOR_CHAR. */
880 face_for_char (struct frame *f, struct face *face, int c,
881 ptrdiff_t pos, Lisp_Object object)
883 Lisp_Object fontset, rfont_def, charset;
884 int face_id;
885 int id;
887 eassert (fontset_id_valid_p (face->fontset));
889 if (ASCII_CHAR_P (c) || CHAR_BYTE8_P (c))
890 return face->ascii_face->id;
892 if (c > 0 && EQ (CHAR_TABLE_REF (Vchar_script_table, c), Qsymbol))
894 /* Fonts often have characters for punctuation and other
895 symbols, even if they don't match the 'symbol' script. So
896 check if the character is present in the current ASCII face
897 first, and if so, use the same font as used by that face.
898 This avoids unnecessarily switching to another font when the
899 frame's default font will do. We only do this for symbols so
900 that users could still setup fontsets to force Emacs to use
901 specific fonts for characters from other scripts, because
902 choice of fonts is frequently affected by cultural
903 preferences and font features, not by font coverage.
904 However, these considerations are unlikely to be relevant to
905 punctuation and other symbols, since the latter generally
906 aren't specific to any culture, and don't require
907 sophisticated OTF features. */
908 Lisp_Object font_object;
910 if (face->ascii_face->font)
912 XSETFONT (font_object, face->ascii_face->font);
913 if (font_has_char (f, font_object, c))
914 return face->ascii_face->id;
917 #if 0
918 /* Try the current face. Disabled because it can cause
919 counter-intuitive results, whereby the font used for some
920 character depends on the characters that precede it on
921 display. See the discussion of bug #15138. Note that the
922 original bug reported in #15138 was in a situation where face
923 == face->ascii_face, so the above code solves that situation
924 without risking the undesirable consequences. */
925 if (face->font)
927 XSETFONT (font_object, face->font);
928 if (font_has_char (f, font_object, c)) return face->id;
930 #endif
933 fontset = FONTSET_FROM_ID (face->fontset);
934 eassert (!BASE_FONTSET_P (fontset));
936 if (pos < 0)
938 id = -1;
939 charset = Qnil;
941 else
943 charset = Fget_char_property (make_number (pos), Qcharset, object);
944 if (CHARSETP (charset))
946 Lisp_Object val;
948 val = assq_no_quit (charset, Vfont_encoding_charset_alist);
949 if (CONSP (val) && CHARSETP (XCDR (val)))
950 charset = XCDR (val);
951 id = XINT (CHARSET_SYMBOL_ID (charset));
953 else
954 id = -1;
957 rfont_def = fontset_font (fontset, c, face, id);
958 if (VECTORP (rfont_def))
960 if (INTEGERP (RFONT_DEF_FACE (rfont_def)))
961 face_id = XINT (RFONT_DEF_FACE (rfont_def));
962 else
964 Lisp_Object font_object;
966 font_object = RFONT_DEF_OBJECT (rfont_def);
967 face_id = face_for_font (f, font_object, face);
968 RFONT_DEF_SET_FACE (rfont_def, face_id);
971 else
973 if (INTEGERP (FONTSET_NOFONT_FACE (fontset)))
974 face_id = XINT (FONTSET_NOFONT_FACE (fontset));
975 else
977 face_id = face_for_font (f, Qnil, face);
978 set_fontset_nofont_face (fontset, make_number (face_id));
981 eassert (face_id >= 0);
982 return face_id;
986 Lisp_Object
987 font_for_char (struct face *face, int c, ptrdiff_t pos, Lisp_Object object)
989 Lisp_Object fontset, rfont_def, charset;
990 int id;
992 if (ASCII_CHAR_P (c))
994 Lisp_Object font_object;
996 XSETFONT (font_object, face->ascii_face->font);
997 return font_object;
1000 eassert (fontset_id_valid_p (face->fontset));
1001 fontset = FONTSET_FROM_ID (face->fontset);
1002 eassert (!BASE_FONTSET_P (fontset));
1003 if (pos < 0)
1005 id = -1;
1006 charset = Qnil;
1008 else
1010 charset = Fget_char_property (make_number (pos), Qcharset, object);
1011 if (CHARSETP (charset))
1013 Lisp_Object val;
1015 val = assq_no_quit (charset, Vfont_encoding_charset_alist);
1016 if (CONSP (val) && CHARSETP (XCDR (val)))
1017 charset = XCDR (val);
1018 id = XINT (CHARSET_SYMBOL_ID (charset));
1020 else
1021 id = -1;
1024 rfont_def = fontset_font (fontset, c, face, id);
1025 return (VECTORP (rfont_def)
1026 ? RFONT_DEF_OBJECT (rfont_def)
1027 : Qnil);
1031 /* Make a realized fontset for ASCII face FACE on frame F from the
1032 base fontset BASE_FONTSET_ID. If BASE_FONTSET_ID is -1, use the
1033 default fontset as the base. Value is the id of the new fontset.
1034 Called from realize_x_face. */
1037 make_fontset_for_ascii_face (struct frame *f, int base_fontset_id, struct face *face)
1039 Lisp_Object base_fontset, fontset, frame;
1041 XSETFRAME (frame, f);
1042 if (base_fontset_id >= 0)
1044 base_fontset = FONTSET_FROM_ID (base_fontset_id);
1045 if (!BASE_FONTSET_P (base_fontset))
1046 base_fontset = FONTSET_BASE (base_fontset);
1047 eassert (BASE_FONTSET_P (base_fontset));
1049 else
1050 base_fontset = Vdefault_fontset;
1052 fontset = make_fontset (frame, Qnil, base_fontset);
1053 return XINT (FONTSET_ID (fontset));
1058 /* Cache data used by fontset_pattern_regexp. The car part is a
1059 pattern string containing at least one wild card, the cdr part is
1060 the corresponding regular expression. */
1061 static Lisp_Object Vcached_fontset_data;
1063 #define CACHED_FONTSET_NAME SSDATA (XCAR (Vcached_fontset_data))
1064 #define CACHED_FONTSET_REGEX (XCDR (Vcached_fontset_data))
1066 /* If fontset name PATTERN contains any wild card, return regular
1067 expression corresponding to PATTERN. */
1069 static Lisp_Object
1070 fontset_pattern_regexp (Lisp_Object pattern)
1072 if (!strchr (SSDATA (pattern), '*')
1073 && !strchr (SSDATA (pattern), '?'))
1074 /* PATTERN does not contain any wild cards. */
1075 return Qnil;
1077 if (!CONSP (Vcached_fontset_data)
1078 || strcmp (SSDATA (pattern), CACHED_FONTSET_NAME))
1080 /* We must at first update the cached data. */
1081 unsigned char *regex, *p0, *p1;
1082 int ndashes = 0, nstars = 0, nescs = 0;
1084 for (p0 = SDATA (pattern); *p0; p0++)
1086 if (*p0 == '-')
1087 ndashes++;
1088 else if (*p0 == '*')
1089 nstars++;
1090 else if (*p0 == '['
1091 || *p0 == '.' || *p0 == '\\'
1092 || *p0 == '+' || *p0 == '^'
1093 || *p0 == '$')
1094 nescs++;
1097 /* If PATTERN is not full XLFD we convert "*" to ".*". Otherwise
1098 we convert "*" to "[^-]*" which is much faster in regular
1099 expression matching. */
1100 ptrdiff_t regexsize = (SBYTES (pattern)
1101 + (ndashes < 14 ? 2 : 5) * nstars
1102 + 2 * nescs + 3);
1103 USE_SAFE_ALLOCA;
1104 p1 = regex = SAFE_ALLOCA (regexsize);
1106 *p1++ = '^';
1107 for (p0 = SDATA (pattern); *p0; p0++)
1109 if (*p0 == '*')
1111 if (ndashes < 14)
1112 *p1++ = '.';
1113 else
1114 *p1++ = '[', *p1++ = '^', *p1++ = '-', *p1++ = ']';
1115 *p1++ = '*';
1117 else if (*p0 == '?')
1118 *p1++ = '.';
1119 else if (*p0 == '['
1120 || *p0 == '.' || *p0 == '\\'
1121 || *p0 == '+' || *p0 == '^'
1122 || *p0 == '$')
1123 *p1++ = '\\', *p1++ = *p0;
1124 else
1125 *p1++ = *p0;
1127 *p1++ = '$';
1128 *p1++ = 0;
1130 Vcached_fontset_data = Fcons (build_string (SSDATA (pattern)),
1131 build_string ((char *) regex));
1132 SAFE_FREE ();
1135 return CACHED_FONTSET_REGEX;
1138 /* Return ID of the base fontset named NAME. If there's no such
1139 fontset, return -1. NAME_PATTERN specifies how to treat NAME as this:
1140 0: pattern containing '*' and '?' as wildcards
1141 1: regular expression
1142 2: literal fontset name
1146 fs_query_fontset (Lisp_Object name, int name_pattern)
1148 Lisp_Object tem;
1149 int i;
1151 name = Fdowncase (name);
1152 if (name_pattern != 1)
1154 tem = Frassoc (name, Vfontset_alias_alist);
1155 if (NILP (tem))
1156 tem = Fassoc (name, Vfontset_alias_alist);
1157 if (CONSP (tem) && STRINGP (XCAR (tem)))
1158 name = XCAR (tem);
1159 else if (name_pattern == 0)
1161 tem = fontset_pattern_regexp (name);
1162 if (STRINGP (tem))
1164 name = tem;
1165 name_pattern = 1;
1170 for (i = 0; i < ASIZE (Vfontset_table); i++)
1172 Lisp_Object fontset, this_name;
1174 fontset = FONTSET_FROM_ID (i);
1175 if (NILP (fontset)
1176 || !BASE_FONTSET_P (fontset))
1177 continue;
1179 this_name = FONTSET_NAME (fontset);
1180 if (name_pattern == 1
1181 ? fast_string_match_ignore_case (name, this_name) >= 0
1182 : !xstrcasecmp (SSDATA (name), SSDATA (this_name)))
1183 return i;
1185 return -1;
1189 DEFUN ("query-fontset", Fquery_fontset, Squery_fontset, 1, 2, 0,
1190 doc: /* Return the name of a fontset that matches PATTERN.
1191 The value is nil if there is no matching fontset.
1192 PATTERN can contain `*' or `?' as a wildcard
1193 just as X font name matching algorithm allows.
1194 If REGEXPP is non-nil, PATTERN is a regular expression. */)
1195 (Lisp_Object pattern, Lisp_Object regexpp)
1197 Lisp_Object fontset;
1198 int id;
1200 check_window_system (NULL);
1202 CHECK_STRING (pattern);
1204 if (SCHARS (pattern) == 0)
1205 return Qnil;
1207 id = fs_query_fontset (pattern, !NILP (regexpp));
1208 if (id < 0)
1209 return Qnil;
1211 fontset = FONTSET_FROM_ID (id);
1212 return FONTSET_NAME (fontset);
1215 /* Return a list of base fontset names matching PATTERN on frame F. */
1217 Lisp_Object
1218 list_fontsets (struct frame *f, Lisp_Object pattern, int size)
1220 Lisp_Object frame, regexp, val;
1221 int id;
1223 XSETFRAME (frame, f);
1225 regexp = fontset_pattern_regexp (pattern);
1226 val = Qnil;
1228 for (id = 0; id < ASIZE (Vfontset_table); id++)
1230 Lisp_Object fontset, name;
1232 fontset = FONTSET_FROM_ID (id);
1233 if (NILP (fontset)
1234 || !BASE_FONTSET_P (fontset)
1235 || !EQ (frame, FONTSET_FRAME (fontset)))
1236 continue;
1237 name = FONTSET_NAME (fontset);
1239 if (STRINGP (regexp)
1240 ? (fast_string_match (regexp, name) < 0)
1241 : strcmp (SSDATA (pattern), SSDATA (name)))
1242 continue;
1244 val = Fcons (Fcopy_sequence (FONTSET_NAME (fontset)), val);
1247 return val;
1251 /* Free all realized fontsets whose base fontset is BASE. */
1253 static void
1254 free_realized_fontsets (Lisp_Object base)
1256 int id;
1258 #if 0
1259 /* For the moment, this doesn't work because free_realized_face
1260 doesn't remove FACE from a cache. Until we find a solution, we
1261 suppress this code, and simply use Fclear_face_cache even though
1262 that is not efficient. */
1263 block_input ();
1264 for (id = 0; id < ASIZE (Vfontset_table); id++)
1266 Lisp_Object this = AREF (Vfontset_table, id);
1268 if (EQ (FONTSET_BASE (this), base))
1270 Lisp_Object tail;
1272 for (tail = FONTSET_FACE_ALIST (this); CONSP (tail);
1273 tail = XCDR (tail))
1275 struct frame *f = XFRAME (FONTSET_FRAME (this));
1276 int face_id = XINT (XCDR (XCAR (tail)));
1277 struct face *face = FACE_FROM_ID (f, face_id);
1279 /* Face THIS itself is also freed by the following call. */
1280 free_realized_face (f, face);
1284 unblock_input ();
1285 #else /* not 0 */
1286 /* But, we don't have to call Fclear_face_cache if no fontset has
1287 been realized from BASE. */
1288 for (id = 0; id < ASIZE (Vfontset_table); id++)
1290 Lisp_Object this = AREF (Vfontset_table, id);
1292 if (CHAR_TABLE_P (this) && EQ (FONTSET_BASE (this), base))
1294 Fclear_face_cache (Qt);
1295 break;
1298 #endif /* not 0 */
1302 /* Check validity of NAME as a fontset name and return the
1303 corresponding fontset. If not valid, signal an error.
1305 If NAME is t, return Vdefault_fontset. If NAME is nil, return the
1306 fontset of *FRAME.
1308 Set *FRAME to the actual frame. */
1310 static Lisp_Object
1311 check_fontset_name (Lisp_Object name, Lisp_Object *frame)
1313 int id;
1314 struct frame *f = decode_live_frame (*frame);
1316 XSETFRAME (*frame, f);
1318 if (EQ (name, Qt))
1319 return Vdefault_fontset;
1320 if (NILP (name))
1321 id = FRAME_FONTSET (f);
1322 else
1324 CHECK_STRING (name);
1325 /* First try NAME as literal. */
1326 id = fs_query_fontset (name, 2);
1327 if (id < 0)
1328 /* For backward compatibility, try again NAME as pattern. */
1329 id = fs_query_fontset (name, 0);
1330 if (id < 0)
1331 error ("Fontset `%s' does not exist", SDATA (name));
1333 return FONTSET_FROM_ID (id);
1336 static void
1337 accumulate_script_ranges (Lisp_Object arg, Lisp_Object range, Lisp_Object val)
1339 if (EQ (XCAR (arg), val))
1341 if (CONSP (range))
1342 XSETCDR (arg, Fcons (Fcons (XCAR (range), XCDR (range)), XCDR (arg)));
1343 else
1344 XSETCDR (arg, Fcons (Fcons (range, range), XCDR (arg)));
1349 /* Callback function for map_charset_chars in Fset_fontset_font.
1350 ARG is a vector [ FONTSET FONT_DEF ADD ASCII SCRIPT_RANGE_LIST ].
1352 In FONTSET, set FONT_DEF in a fashion specified by ADD for
1353 characters in RANGE and ranges in SCRIPT_RANGE_LIST before RANGE.
1354 The consumed ranges are popped up from SCRIPT_RANGE_LIST, and the
1355 new SCRIPT_RANGE_LIST is stored in ARG.
1357 If ASCII is nil, don't set FONT_DEF for ASCII characters. It is
1358 assured that SCRIPT_RANGE_LIST doesn't contain ASCII in that
1359 case. */
1361 static void
1362 set_fontset_font (Lisp_Object arg, Lisp_Object range)
1364 Lisp_Object fontset, font_def, add, ascii, script_range_list;
1365 int from = XINT (XCAR (range)), to = XINT (XCDR (range));
1367 fontset = AREF (arg, 0);
1368 font_def = AREF (arg, 1);
1369 add = AREF (arg, 2);
1370 ascii = AREF (arg, 3);
1371 script_range_list = AREF (arg, 4);
1373 if (NILP (ascii) && from < 0x80)
1375 if (to < 0x80)
1376 return;
1377 from = 0x80;
1378 range = Fcons (make_number (0x80), XCDR (range));
1381 #define SCRIPT_FROM XINT (XCAR (XCAR (script_range_list)))
1382 #define SCRIPT_TO XINT (XCDR (XCAR (script_range_list)))
1383 #define POP_SCRIPT_RANGE() script_range_list = XCDR (script_range_list)
1385 for (; CONSP (script_range_list) && SCRIPT_TO < from; POP_SCRIPT_RANGE ())
1386 FONTSET_ADD (fontset, XCAR (script_range_list), font_def, add);
1387 if (CONSP (script_range_list))
1389 if (SCRIPT_FROM < from)
1390 range = Fcons (make_number (SCRIPT_FROM), XCDR (range));
1391 while (CONSP (script_range_list) && SCRIPT_TO <= to)
1392 POP_SCRIPT_RANGE ();
1393 if (CONSP (script_range_list) && SCRIPT_FROM <= to)
1394 XSETCAR (XCAR (script_range_list), make_number (to + 1));
1397 FONTSET_ADD (fontset, range, font_def, add);
1398 ASET (arg, 4, script_range_list);
1401 static void update_auto_fontset_alist (Lisp_Object, Lisp_Object);
1404 DEFUN ("set-fontset-font", Fset_fontset_font, Sset_fontset_font, 3, 5, 0,
1405 doc: /*
1406 Modify fontset NAME to use FONT-SPEC for TARGET characters.
1408 NAME is a fontset name string, nil for the fontset of FRAME, or t for
1409 the default fontset.
1411 TARGET may be a single character to use FONT-SPEC for.
1413 Target may be a cons (FROM . TO), where FROM and TO are characters.
1414 In that case, use FONT-SPEC for all characters in the range FROM
1415 and TO (inclusive).
1417 TARGET may be a script name symbol. In that case, use FONT-SPEC for
1418 all characters that belong to the script.
1420 TARGET may be a charset. In that case, use FONT-SPEC for all
1421 characters in the charset.
1423 TARGET may be nil. In that case, use FONT-SPEC for any characters for
1424 that no FONT-SPEC is specified.
1426 FONT-SPEC may one of these:
1427 * A font-spec object made by the function `font-spec' (which see).
1428 * A cons (FAMILY . REGISTRY), where FAMILY is a font family name and
1429 REGISTRY is a font registry name. FAMILY may contain foundry
1430 name, and REGISTRY may contain encoding name.
1431 * A font name string.
1432 * nil, which explicitly specifies that there's no font for TARGET.
1434 Optional 4th argument FRAME is a frame or nil for the selected frame
1435 that is concerned in the case that NAME is nil.
1437 Optional 5th argument ADD, if non-nil, specifies how to add FONT-SPEC
1438 to the font specifications for TARGET previously set. If it is
1439 `prepend', FONT-SPEC is prepended. If it is `append', FONT-SPEC is
1440 appended. By default, FONT-SPEC overrides the previous settings. */)
1441 (Lisp_Object name, Lisp_Object target, Lisp_Object font_spec, Lisp_Object frame, Lisp_Object add)
1443 Lisp_Object fontset;
1444 Lisp_Object font_def, registry, family;
1445 Lisp_Object range_list;
1446 struct charset *charset = NULL;
1447 Lisp_Object fontname;
1448 bool ascii_changed = 0;
1450 fontset = check_fontset_name (name, &frame);
1452 fontname = Qnil;
1453 if (CONSP (font_spec))
1455 Lisp_Object spec = Ffont_spec (0, NULL);
1457 font_parse_family_registry (XCAR (font_spec), XCDR (font_spec), spec);
1458 font_spec = spec;
1459 fontname = Ffont_xlfd_name (font_spec, Qnil);
1461 else if (STRINGP (font_spec))
1463 fontname = font_spec;
1464 font_spec = CALLN (Ffont_spec, QCname, fontname);
1466 else if (FONT_SPEC_P (font_spec))
1467 fontname = Ffont_xlfd_name (font_spec, Qnil);
1468 else if (! NILP (font_spec))
1469 Fsignal (Qfont, list2 (build_string ("Invalid font-spec"), font_spec));
1471 if (! NILP (font_spec))
1473 Lisp_Object encoding, repertory;
1475 family = AREF (font_spec, FONT_FAMILY_INDEX);
1476 if (! NILP (family) )
1477 family = SYMBOL_NAME (family);
1478 registry = AREF (font_spec, FONT_REGISTRY_INDEX);
1479 if (! NILP (registry))
1480 registry = Fdowncase (SYMBOL_NAME (registry));
1481 AUTO_STRING (dash, "-");
1482 encoding = find_font_encoding (concat3 (family, dash, registry));
1483 if (NILP (encoding))
1484 encoding = Qascii;
1486 if (SYMBOLP (encoding))
1488 CHECK_CHARSET (encoding);
1489 encoding = repertory = CHARSET_SYMBOL_ID (encoding);
1491 else
1493 repertory = XCDR (encoding);
1494 encoding = XCAR (encoding);
1495 CHECK_CHARSET (encoding);
1496 encoding = CHARSET_SYMBOL_ID (encoding);
1497 if (! NILP (repertory) && SYMBOLP (repertory))
1499 CHECK_CHARSET (repertory);
1500 repertory = CHARSET_SYMBOL_ID (repertory);
1503 FONT_DEF_NEW (font_def, font_spec, encoding, repertory);
1505 else
1506 font_def = Qnil;
1508 if (CHARACTERP (target))
1510 if (XFASTINT (target) < 0x80)
1511 error ("Can't set a font for partial ASCII range");
1512 range_list = list1 (Fcons (target, target));
1514 else if (CONSP (target))
1516 Lisp_Object from, to;
1518 from = Fcar (target);
1519 to = Fcdr (target);
1520 CHECK_CHARACTER (from);
1521 CHECK_CHARACTER (to);
1522 if (XFASTINT (from) < 0x80)
1524 if (XFASTINT (from) != 0 || XFASTINT (to) < 0x7F)
1525 error ("Can't set a font for partial ASCII range");
1526 ascii_changed = 1;
1528 range_list = list1 (target);
1530 else if (SYMBOLP (target) && !NILP (target))
1532 Lisp_Object script_list;
1533 Lisp_Object val;
1535 range_list = Qnil;
1536 script_list = XCHAR_TABLE (Vchar_script_table)->extras[0];
1537 if (! NILP (Fmemq (target, script_list)))
1539 if (EQ (target, Qlatin))
1540 ascii_changed = 1;
1541 val = list1 (target);
1542 map_char_table (accumulate_script_ranges, Qnil, Vchar_script_table,
1543 val);
1544 range_list = Fnreverse (XCDR (val));
1546 if (CHARSETP (target))
1548 CHECK_CHARSET_GET_CHARSET (target, charset);
1549 if (charset->ascii_compatible_p)
1550 ascii_changed = 1;
1552 else if (NILP (range_list))
1553 error ("Invalid script or charset name: %s",
1554 SDATA (SYMBOL_NAME (target)));
1556 else if (NILP (target))
1557 range_list = list1 (Qnil);
1558 else
1559 error ("Invalid target for setting a font");
1561 if (ascii_changed)
1563 Lisp_Object val;
1565 if (NILP (font_spec))
1566 error ("Can't set ASCII font to nil");
1567 val = CHAR_TABLE_REF (fontset, 0);
1568 if (! NILP (val) && EQ (add, Qappend))
1569 /* We are going to change just an additional font for ASCII. */
1570 ascii_changed = 0;
1573 if (charset)
1575 Lisp_Object arg;
1577 arg = make_uninit_vector (5);
1578 ASET (arg, 0, fontset);
1579 ASET (arg, 1, font_def);
1580 ASET (arg, 2, add);
1581 ASET (arg, 3, ascii_changed ? Qt : Qnil);
1582 ASET (arg, 4, range_list);
1584 map_charset_chars (set_fontset_font, Qnil, arg, charset,
1585 CHARSET_MIN_CODE (charset),
1586 CHARSET_MAX_CODE (charset));
1587 range_list = AREF (arg, 4);
1589 for (; CONSP (range_list); range_list = XCDR (range_list))
1590 FONTSET_ADD (fontset, XCAR (range_list), font_def, add);
1592 if (ascii_changed)
1594 Lisp_Object tail, fr;
1595 int fontset_id = XINT (FONTSET_ID (fontset));
1597 set_fontset_ascii (fontset, fontname);
1598 name = FONTSET_NAME (fontset);
1599 FOR_EACH_FRAME (tail, fr)
1601 struct frame *f = XFRAME (fr);
1602 Lisp_Object font_object;
1603 struct face *face;
1605 if (FRAME_INITIAL_P (f) || FRAME_TERMCAP_P (f))
1606 continue;
1607 if (fontset_id != FRAME_FONTSET (f))
1608 continue;
1609 face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
1610 if (face)
1611 font_object = font_load_for_lface (f, face->lface, font_spec);
1612 else
1613 font_object = font_open_by_spec (f, font_spec);
1614 if (! NILP (font_object))
1616 update_auto_fontset_alist (font_object, fontset);
1617 AUTO_FRAME_ARG (arg, Qfont, Fcons (name, font_object));
1618 Fmodify_frame_parameters (fr, arg);
1623 /* Free all realized fontsets whose base is FONTSET. This way, the
1624 specified character(s) are surely redisplayed by a correct
1625 font. */
1626 free_realized_fontsets (fontset);
1628 return Qnil;
1632 DEFUN ("new-fontset", Fnew_fontset, Snew_fontset, 2, 2, 0,
1633 doc: /* Create a new fontset NAME from font information in FONTLIST.
1635 FONTLIST is an alist of scripts vs the corresponding font specification list.
1636 Each element of FONTLIST has the form (SCRIPT FONT-SPEC ...), where a
1637 character of SCRIPT is displayed by a font that matches one of
1638 FONT-SPEC.
1640 SCRIPT is a symbol that appears in the first extra slot of the
1641 char-table `char-script-table'.
1643 FONT-SPEC is a vector, a cons, or a string. See the documentation of
1644 `set-fontset-font' for the meaning. */)
1645 (Lisp_Object name, Lisp_Object fontlist)
1647 Lisp_Object fontset;
1648 int id;
1650 CHECK_STRING (name);
1651 CHECK_LIST (fontlist);
1653 name = Fdowncase (name);
1654 id = fs_query_fontset (name, 0);
1655 if (id < 0)
1657 Lisp_Object font_spec = Ffont_spec (0, NULL);
1658 Lisp_Object short_name;
1659 char xlfd[256];
1660 int len;
1662 if (font_parse_xlfd (SSDATA (name), SBYTES (name), font_spec) < 0)
1663 error ("Fontset name must be in XLFD format");
1664 short_name = AREF (font_spec, FONT_REGISTRY_INDEX);
1665 if (strncmp (SSDATA (SYMBOL_NAME (short_name)), "fontset-", 8)
1666 || SBYTES (SYMBOL_NAME (short_name)) < 9)
1667 error ("Registry field of fontset name must be \"fontset-*\"");
1668 Vfontset_alias_alist = Fcons (Fcons (name, SYMBOL_NAME (short_name)),
1669 Vfontset_alias_alist);
1670 ASET (font_spec, FONT_REGISTRY_INDEX, Qiso8859_1);
1671 fontset = make_fontset (Qnil, name, Qnil);
1672 len = font_unparse_xlfd (font_spec, 0, xlfd, 256);
1673 if (len < 0)
1674 error ("Invalid fontset name (perhaps too long): %s", SDATA (name));
1675 set_fontset_ascii (fontset, make_unibyte_string (xlfd, len));
1677 else
1679 fontset = FONTSET_FROM_ID (id);
1680 free_realized_fontsets (fontset);
1681 Fset_char_table_range (fontset, Qt, Qnil);
1684 for (; CONSP (fontlist); fontlist = XCDR (fontlist))
1686 Lisp_Object elt, script;
1688 elt = XCAR (fontlist);
1689 script = Fcar (elt);
1690 elt = Fcdr (elt);
1691 if (CONSP (elt) && (NILP (XCDR (elt)) || CONSP (XCDR (elt))))
1692 for (; CONSP (elt); elt = XCDR (elt))
1693 Fset_fontset_font (name, script, XCAR (elt), Qnil, Qappend);
1694 else
1695 Fset_fontset_font (name, script, elt, Qnil, Qappend);
1697 return name;
1701 /* Alist of automatically created fontsets. Each element is a cons
1702 (FONT-SPEC . FONTSET-ID). */
1703 static Lisp_Object auto_fontset_alist;
1705 /* Number of automatically created fontsets. */
1706 static ptrdiff_t num_auto_fontsets;
1708 /* Return a fontset synthesized from FONT-OBJECT. This is called from
1709 x_new_font when FONT-OBJECT is used for the default ASCII font of a
1710 frame, and the returned fontset is used for the default fontset of
1711 that frame. The fontset specifies a font of the same registry as
1712 FONT-OBJECT for all characters in the repertory of the registry
1713 (see Vfont_encoding_alist). If the repertory is not known, the
1714 fontset specifies the font for all Latin characters assuming that a
1715 user intends to use FONT-OBJECT for Latin characters. */
1718 fontset_from_font (Lisp_Object font_object)
1720 Lisp_Object font_name = font_get_name (font_object);
1721 Lisp_Object font_spec = copy_font_spec (font_object);
1722 Lisp_Object registry = AREF (font_spec, FONT_REGISTRY_INDEX);
1723 Lisp_Object fontset_spec, alias, name, fontset;
1724 Lisp_Object val;
1726 val = assoc_no_quit (font_spec, auto_fontset_alist);
1727 if (CONSP (val))
1728 return XINT (FONTSET_ID (XCDR (val)));
1729 if (num_auto_fontsets++ == 0)
1730 alias = intern ("fontset-startup");
1731 else
1733 char temp[sizeof "fontset-auto" + INT_STRLEN_BOUND (ptrdiff_t)];
1735 sprintf (temp, "fontset-auto%"pD"d", num_auto_fontsets - 1);
1736 alias = intern (temp);
1738 fontset_spec = copy_font_spec (font_spec);
1739 ASET (fontset_spec, FONT_REGISTRY_INDEX, alias);
1740 name = Ffont_xlfd_name (fontset_spec, Qnil);
1741 eassert (!NILP (name));
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 set_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, &dummy,
1858 pos + 100, false, -1);
1860 if (! CHAR_VALID_P (c))
1861 return Qnil;
1862 if (!FRAME_WINDOW_P (f))
1863 return Qnil;
1864 /* We need the basic faces to be valid below, so recompute them if
1865 some code just happened to clear the face cache. */
1866 if (FRAME_FACE_CACHE (f)->used == 0)
1867 recompute_basic_faces (f);
1868 face_id = FACE_FOR_CHAR (f, FACE_FROM_ID (f, face_id), c, pos, Qnil);
1869 face = FACE_FROM_ID (f, face_id);
1870 if (face->font)
1872 unsigned code = face->font->driver->encode_char (face->font, c);
1873 Lisp_Object font_object;
1875 if (code == FONT_INVALID_CODE)
1876 return Qnil;
1877 XSETFONT (font_object, face->font);
1878 return Fcons (font_object, INTEGER_TO_CONS (code));
1880 return Qnil;
1884 DEFUN ("fontset-info", Ffontset_info, Sfontset_info, 1, 2, 0,
1885 doc: /* Return information about a fontset FONTSET on frame FRAME.
1887 FONTSET is a fontset name string, nil for the fontset of FRAME, or t
1888 for the default fontset. FRAME nil means the selected frame.
1890 The value is a char-table whose elements have this form:
1892 ((FONT OPENED-FONT ...) ...)
1894 FONT is a name of font specified for a range of characters.
1896 OPENED-FONT is a name of a font actually opened.
1898 The char-table has one extra slot. If FONTSET is not the default
1899 fontset, the value the extra slot is a char-table containing the
1900 information about the derived fonts from the default fontset. The
1901 format is the same as above. */)
1902 (Lisp_Object fontset, Lisp_Object frame)
1904 Lisp_Object *realized[2], fontsets[2], tables[2];
1905 Lisp_Object val, elt;
1906 int c, i, j, k;
1908 check_window_system (NULL);
1909 fontset = check_fontset_name (fontset, &frame);
1911 /* Recode fontsets realized on FRAME from the base fontset FONTSET
1912 in the table `realized'. */
1913 USE_SAFE_ALLOCA;
1914 SAFE_ALLOCA_LISP (realized[0], 2 * ASIZE (Vfontset_table));
1915 realized[1] = realized[0] + ASIZE (Vfontset_table);
1916 for (i = j = 0; i < ASIZE (Vfontset_table); i++)
1918 elt = FONTSET_FROM_ID (i);
1919 if (!NILP (elt)
1920 && EQ (FONTSET_BASE (elt), fontset)
1921 && EQ (FONTSET_FRAME (elt), frame))
1922 realized[0][j++] = elt;
1924 realized[0][j] = Qnil;
1926 for (i = j = 0; ! NILP (realized[0][i]); i++)
1928 elt = FONTSET_DEFAULT (realized[0][i]);
1929 if (! NILP (elt))
1930 realized[1][j++] = elt;
1932 realized[1][j] = Qnil;
1934 tables[0] = Fmake_char_table (Qfontset_info, Qnil);
1935 fontsets[0] = fontset;
1936 if (!EQ (fontset, Vdefault_fontset))
1938 tables[1] = Fmake_char_table (Qnil, Qnil);
1939 set_char_table_extras (tables[0], 0, tables[1]);
1940 fontsets[1] = Vdefault_fontset;
1943 /* Accumulate information of the fontset in TABLE. The format of
1944 each element is ((FONT-SPEC OPENED-FONT ...) ...). */
1945 for (k = 0; k <= 1; k++)
1947 for (c = 0; c <= MAX_CHAR; )
1949 int from = c, to = MAX_5_BYTE_CHAR;
1951 if (c <= MAX_5_BYTE_CHAR)
1953 val = char_table_ref_and_range (fontsets[k], c, &from, &to);
1955 else
1957 val = FONTSET_FALLBACK (fontsets[k]);
1958 to = MAX_CHAR;
1960 if (VECTORP (val))
1962 Lisp_Object alist;
1964 /* At first, set ALIST to ((FONT-SPEC) ...). */
1965 for (alist = Qnil, i = 0; i < ASIZE (val); i++)
1966 if (! NILP (AREF (val, i)))
1967 alist = Fcons (Fcons (FONT_DEF_SPEC (AREF (val, i)), Qnil),
1968 alist);
1969 alist = Fnreverse (alist);
1971 /* Then store opened font names to cdr of each elements. */
1972 for (i = 0; ! NILP (realized[k][i]); i++)
1974 if (c <= MAX_5_BYTE_CHAR)
1975 val = FONTSET_REF (realized[k][i], c);
1976 else
1977 val = FONTSET_FALLBACK (realized[k][i]);
1978 if (! CONSP (val) || ! VECTORP (XCDR (val)))
1979 continue;
1980 /* VAL: (int . [[FACE-ID FONT-DEF FONT-OBJECT int] ... ]) */
1981 val = XCDR (val);
1982 for (j = 0; j < ASIZE (val); j++)
1984 elt = AREF (val, j);
1985 if (!NILP (elt) && FONT_OBJECT_P (RFONT_DEF_OBJECT (elt)))
1987 Lisp_Object font_object = RFONT_DEF_OBJECT (elt);
1988 Lisp_Object slot, name;
1990 slot = Fassq (RFONT_DEF_SPEC (elt), alist);
1991 name = AREF (font_object, FONT_NAME_INDEX);
1992 if (NILP (Fmember (name, XCDR (slot))))
1993 nconc2 (slot, list1 (name));
1998 /* Store ALIST in TBL for characters C..TO. */
1999 if (c <= MAX_5_BYTE_CHAR)
2000 char_table_set_range (tables[k], c, to, alist);
2001 else
2002 set_char_table_defalt (tables[k], alist);
2004 /* At last, change each elements to font names. */
2005 for (; CONSP (alist); alist = XCDR (alist))
2007 elt = XCAR (alist);
2008 XSETCAR (elt, Ffont_xlfd_name (XCAR (elt), Qnil));
2011 c = to + 1;
2013 if (EQ (fontset, Vdefault_fontset))
2014 break;
2017 SAFE_FREE ();
2018 return tables[0];
2022 DEFUN ("fontset-font", Ffontset_font, Sfontset_font, 2, 3, 0,
2023 doc: /* Return a font name pattern for character CH in fontset NAME.
2024 If NAME is t, find a pattern in the default fontset.
2025 If NAME is nil, find a pattern in the fontset of the selected frame.
2027 The value has the form (FAMILY . REGISTRY), where FAMILY is a font
2028 family name and REGISTRY is a font registry name. This is actually
2029 the first font name pattern for CH in the fontset or in the default
2030 fontset.
2032 If the 2nd optional arg ALL is non-nil, return a list of all font name
2033 patterns. */)
2034 (Lisp_Object name, Lisp_Object ch, Lisp_Object all)
2036 int c;
2037 Lisp_Object fontset, elt, list, repertory, val;
2038 int i, j;
2039 Lisp_Object frame;
2041 frame = Qnil;
2042 fontset = check_fontset_name (name, &frame);
2044 CHECK_CHARACTER (ch);
2045 c = XINT (ch);
2046 list = Qnil;
2047 while (1)
2049 for (i = 0, elt = FONTSET_REF (fontset, c); i < 2;
2050 i++, elt = FONTSET_FALLBACK (fontset))
2051 if (VECTORP (elt))
2052 for (j = 0; j < ASIZE (elt); j++)
2054 Lisp_Object family, registry;
2056 val = AREF (elt, j);
2057 if (NILP (val))
2058 return Qnil;
2059 repertory = AREF (val, 1);
2060 if (INTEGERP (repertory))
2062 struct charset *charset = CHARSET_FROM_ID (XINT (repertory));
2064 if (! CHAR_CHARSET_P (c, charset))
2065 continue;
2067 else if (CHAR_TABLE_P (repertory))
2069 if (NILP (CHAR_TABLE_REF (repertory, c)))
2070 continue;
2072 val = AREF (val, 0);
2073 /* VAL is a FONT-SPEC */
2074 family = AREF (val, FONT_FAMILY_INDEX);
2075 if (! NILP (family))
2076 family = SYMBOL_NAME (family);
2077 registry = AREF (val, FONT_REGISTRY_INDEX);
2078 if (! NILP (registry))
2079 registry = SYMBOL_NAME (registry);
2080 val = Fcons (family, registry);
2081 if (NILP (all))
2082 return val;
2083 list = Fcons (val, list);
2085 if (EQ (fontset, Vdefault_fontset))
2086 break;
2087 fontset = Vdefault_fontset;
2089 return (Fnreverse (list));
2092 DEFUN ("fontset-list", Ffontset_list, Sfontset_list, 0, 0, 0,
2093 doc: /* Return a list of all defined fontset names. */)
2094 (void)
2096 Lisp_Object fontset, list;
2097 int i;
2099 list = Qnil;
2100 for (i = 0; i < ASIZE (Vfontset_table); i++)
2102 fontset = FONTSET_FROM_ID (i);
2103 if (!NILP (fontset)
2104 && BASE_FONTSET_P (fontset))
2105 list = Fcons (FONTSET_NAME (fontset), list);
2108 return list;
2112 #ifdef ENABLE_CHECKING
2114 Lisp_Object dump_fontset (Lisp_Object) EXTERNALLY_VISIBLE;
2116 Lisp_Object
2117 dump_fontset (Lisp_Object fontset)
2119 Lisp_Object vec;
2121 vec = Fmake_vector (make_number (3), Qnil);
2122 ASET (vec, 0, FONTSET_ID (fontset));
2124 if (BASE_FONTSET_P (fontset))
2126 ASET (vec, 1, FONTSET_NAME (fontset));
2128 else
2130 Lisp_Object frame;
2132 frame = FONTSET_FRAME (fontset);
2133 if (FRAMEP (frame))
2135 struct frame *f = XFRAME (frame);
2137 if (FRAME_LIVE_P (f))
2138 ASET (vec, 1,
2139 Fcons (FONTSET_NAME (FONTSET_BASE (fontset)),
2140 f->name));
2141 else
2142 ASET (vec, 1,
2143 Fcons (FONTSET_NAME (FONTSET_BASE (fontset)), Qnil));
2145 if (!NILP (FONTSET_DEFAULT (fontset)))
2146 ASET (vec, 2, FONTSET_ID (FONTSET_DEFAULT (fontset)));
2148 return vec;
2151 DEFUN ("fontset-list-all", Ffontset_list_all, Sfontset_list_all, 0, 0, 0,
2152 doc: /* Return a brief summary of all fontsets for debug use. */)
2153 (void)
2155 Lisp_Object val;
2156 int i;
2158 for (i = 0, val = Qnil; i < ASIZE (Vfontset_table); i++)
2159 if (! NILP (AREF (Vfontset_table, i)))
2160 val = Fcons (dump_fontset (AREF (Vfontset_table, i)), val);
2161 return (Fnreverse (val));
2163 #endif /* ENABLE_CHECKING */
2165 void
2166 syms_of_fontset (void)
2168 DEFSYM (Qfontset, "fontset");
2169 Fput (Qfontset, Qchar_table_extra_slots, make_number (8));
2170 DEFSYM (Qfontset_info, "fontset-info");
2171 Fput (Qfontset_info, Qchar_table_extra_slots, make_number (1));
2173 DEFSYM (Qappend, "append");
2174 DEFSYM (Qlatin, "latin");
2176 Vcached_fontset_data = Qnil;
2177 staticpro (&Vcached_fontset_data);
2179 Vfontset_table = Fmake_vector (make_number (32), Qnil);
2180 staticpro (&Vfontset_table);
2182 Vdefault_fontset = Fmake_char_table (Qfontset, Qnil);
2183 staticpro (&Vdefault_fontset);
2184 set_fontset_id (Vdefault_fontset, make_number (0));
2185 set_fontset_name
2186 (Vdefault_fontset,
2187 build_pure_c_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default"));
2188 ASET (Vfontset_table, 0, Vdefault_fontset);
2189 next_fontset_id = 1;
2191 auto_fontset_alist = Qnil;
2192 staticpro (&auto_fontset_alist);
2194 DEFVAR_LISP ("font-encoding-charset-alist", Vfont_encoding_charset_alist,
2195 doc: /*
2196 Alist of charsets vs the charsets to determine the preferred font encoding.
2197 Each element looks like (CHARSET . ENCODING-CHARSET),
2198 where ENCODING-CHARSET is a charset registered in the variable
2199 `font-encoding-alist' as ENCODING.
2201 When a text has a property `charset' and the value is CHARSET, a font
2202 whose encoding corresponds to ENCODING-CHARSET is preferred. */);
2203 Vfont_encoding_charset_alist = Qnil;
2205 DEFVAR_LISP ("use-default-ascent", Vuse_default_ascent,
2206 doc: /*
2207 Char table of characters whose ascent values should be ignored.
2208 If an entry for a character is non-nil, the ascent value of the glyph
2209 is assumed to be specified by _MULE_DEFAULT_ASCENT property of a font.
2211 This affects how a composite character which contains
2212 such a character is displayed on screen. */);
2213 Vuse_default_ascent = Qnil;
2215 DEFVAR_LISP ("ignore-relative-composition", Vignore_relative_composition,
2216 doc: /*
2217 Char table of characters which are not composed relatively.
2218 If an entry for a character is non-nil, a composition sequence
2219 which contains that character is displayed so that
2220 the glyph of that character is put without considering
2221 an ascent and descent value of a previous character. */);
2222 Vignore_relative_composition = Qnil;
2224 DEFVAR_LISP ("alternate-fontname-alist", Valternate_fontname_alist,
2225 doc: /* Alist of fontname vs list of the alternate fontnames.
2226 When a specified font name is not found, the corresponding
2227 alternate fontnames (if any) are tried instead. */);
2228 Valternate_fontname_alist = Qnil;
2230 DEFVAR_LISP ("fontset-alias-alist", Vfontset_alias_alist,
2231 doc: /* Alist of fontset names vs the aliases. */);
2232 Vfontset_alias_alist
2233 = list1 (Fcons (FONTSET_NAME (Vdefault_fontset),
2234 build_pure_c_string ("fontset-default")));
2236 DEFVAR_LISP ("vertical-centering-font-regexp",
2237 Vvertical_centering_font_regexp,
2238 doc: /* Regexp matching font names that require vertical centering on display.
2239 When a character is displayed with such fonts, the character is displayed
2240 at the vertical center of lines. */);
2241 Vvertical_centering_font_regexp = Qnil;
2243 DEFVAR_LISP ("otf-script-alist", Votf_script_alist,
2244 doc: /* Alist of OpenType script tags vs the corresponding script names. */);
2245 Votf_script_alist = Qnil;
2247 defsubr (&Squery_fontset);
2248 defsubr (&Snew_fontset);
2249 defsubr (&Sset_fontset_font);
2250 defsubr (&Sinternal_char_font);
2251 defsubr (&Sfontset_info);
2252 defsubr (&Sfontset_font);
2253 defsubr (&Sfontset_list);
2254 #ifdef ENABLE_CHECKING
2255 defsubr (&Sfontset_list_all);
2256 #endif