3 Copyright (C) 2001-2016 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 (at
17 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/>. */
31 #include "blockinput.h"
32 #include "character.h"
35 #include "dispextern.h"
37 #ifdef HAVE_WINDOW_SYSTEM
39 #endif /* HAVE_WINDOW_SYSTEM */
44 A fontset is a collection of font related information to give
45 similar appearance (style, etc) of characters. A fontset has two
46 roles. One is to use for the frame parameter `font' as if it is an
47 ASCII font. In that case, Emacs uses the font specified for
48 `ascii' script for the frame's default font.
50 Another role, the more important one, is to provide information
51 about which font to use for each non-ASCII character.
53 There are two kinds of fontsets; base and realized. A base fontset
54 is created by `new-fontset' from Emacs Lisp explicitly. A realized
55 fontset is created implicitly when a face is realized for ASCII
56 characters. A face is also realized for non-ASCII characters based
57 on an ASCII face. All of non-ASCII faces based on the same ASCII
58 face share the same realized fontset.
60 A fontset object is implemented by a char-table whose default value
61 and parent are always nil.
63 An element of a base fontset is a vector of FONT-DEFs which themselves
64 are vectors of the form [ FONT-SPEC ENCODING REPERTORY ].
66 An element of a realized fontset is nil, t, 0, or a cons that has
69 (CHARSET-ORDERED-LIST-TICK . FONT-GROUP)
71 CHARSET_ORDERED_LIST_TICK is the same as charset_ordered_list_tick or -1.
73 FONT-GROUP is a vector of elements that have this form:
75 [ 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 considering the current
82 charset priority list, the current language environment, and
83 priorities determined by font-backends.
85 RFONT-DEFn may not be a vector in the following cases.
87 The value nil means that we have not yet generated the above vector
88 from the base of the fontset.
90 The value t means that no font is available for the corresponding
93 The value 0 means that no font is available for the corresponding
94 range of characters in this fontset, but may be available in the
95 fallback font-group or in the default fontset.
97 A fontset has 8 extra slots.
100 base: the ID number of the fontset
104 base: the name of the fontset
108 base: the font name for ASCII characters
113 realized: the base fontset
117 realized: the frame that the fontset belongs to
121 realized: the ID number of a face to use for characters that
122 has no font in a realized fontset.
126 realized: If the base is not the default fontset, a fontset
127 realized from the default fontset, else nil.
130 base: Same as element value (but for fallback fonts).
133 All fontsets are recorded in the vector Vfontset_table.
138 There's a special base fontset named `default fontset' which
139 defines the default font specifications. When a base fontset
140 doesn't specify a font for a specific character, the corresponding
141 value in the default fontset is used.
143 The parent of a realized fontset created for such a face that has
144 no fontset is the default fontset.
147 These structures are hidden from the other codes than this file.
148 The other codes handle fontsets only by their ID numbers. They
149 usually use the variable name `fontset' for IDs. But, in this
150 file, we always use variable name `id' for IDs, and name `fontset'
151 for an actual fontset object, i.e., char-table.
155 /********** VARIABLES and FUNCTION PROTOTYPES **********/
157 /* Vector containing all fontsets. */
158 static Lisp_Object Vfontset_table
;
160 /* Next possibly free fontset ID. Usually this keeps the minimum
161 fontset ID not yet used. */
162 static int next_fontset_id
;
164 /* The default fontset. This gives default FAMILY and REGISTRY of
165 font for each character. */
166 static Lisp_Object Vdefault_fontset
;
168 /* Prototype declarations for static functions. */
169 static Lisp_Object
make_fontset (Lisp_Object
, Lisp_Object
, Lisp_Object
);
171 /* Return true if ID is a valid fontset id.
172 Optimized away if ENABLE_CHECKING is not defined. */
175 fontset_id_valid_p (int id
)
177 return (id
>= 0 && id
< ASIZE (Vfontset_table
) - 1);
182 /********** MACROS AND FUNCTIONS TO HANDLE FONTSET **********/
184 /* Return the fontset with ID. No check of ID's validness. */
185 #define FONTSET_FROM_ID(id) AREF (Vfontset_table, id)
187 /* Access special values of FONTSET. */
189 #define FONTSET_ID(fontset) XCHAR_TABLE (fontset)->extras[0]
191 set_fontset_id (Lisp_Object fontset
, Lisp_Object id
)
193 set_char_table_extras (fontset
, 0, id
);
196 /* Access special values of (base) FONTSET. */
198 #define FONTSET_NAME(fontset) XCHAR_TABLE (fontset)->extras[1]
200 set_fontset_name (Lisp_Object fontset
, Lisp_Object name
)
202 set_char_table_extras (fontset
, 1, name
);
205 #define FONTSET_ASCII(fontset) XCHAR_TABLE (fontset)->extras[2]
207 set_fontset_ascii (Lisp_Object fontset
, Lisp_Object ascii
)
209 set_char_table_extras (fontset
, 2, ascii
);
212 /* Access special values of (realized) FONTSET. */
214 #define FONTSET_BASE(fontset) XCHAR_TABLE (fontset)->extras[3]
216 set_fontset_base (Lisp_Object fontset
, Lisp_Object base
)
218 set_char_table_extras (fontset
, 3, base
);
221 #define FONTSET_FRAME(fontset) XCHAR_TABLE (fontset)->extras[4]
223 set_fontset_frame (Lisp_Object fontset
, Lisp_Object frame
)
225 set_char_table_extras (fontset
, 4, frame
);
228 #define FONTSET_NOFONT_FACE(fontset) XCHAR_TABLE (fontset)->extras[5]
230 set_fontset_nofont_face (Lisp_Object fontset
, Lisp_Object face
)
232 set_char_table_extras (fontset
, 5, face
);
235 #define FONTSET_DEFAULT(fontset) XCHAR_TABLE (fontset)->extras[6]
237 set_fontset_default (Lisp_Object fontset
, Lisp_Object def
)
239 set_char_table_extras (fontset
, 6, def
);
242 /* For both base and realized fontset. */
244 #define FONTSET_FALLBACK(fontset) XCHAR_TABLE (fontset)->extras[7]
246 set_fontset_fallback (Lisp_Object fontset
, Lisp_Object fallback
)
248 set_char_table_extras (fontset
, 7, fallback
);
251 #define BASE_FONTSET_P(fontset) (NILP (FONTSET_BASE (fontset)))
253 /* Macros for FONT-DEF and RFONT-DEF of fontset. */
254 #define FONT_DEF_NEW(font_def, font_spec, encoding, repertory) \
256 (font_def) = make_uninit_vector (3); \
257 ASET ((font_def), 0, font_spec); \
258 ASET ((font_def), 1, encoding); \
259 ASET ((font_def), 2, repertory); \
262 #define FONT_DEF_SPEC(font_def) AREF (font_def, 0)
263 #define FONT_DEF_ENCODING(font_def) AREF (font_def, 1)
264 #define FONT_DEF_REPERTORY(font_def) AREF (font_def, 2)
266 #define RFONT_DEF_FACE(rfont_def) AREF (rfont_def, 0)
267 #define RFONT_DEF_SET_FACE(rfont_def, face_id) \
268 ASET ((rfont_def), 0, make_number (face_id))
269 #define RFONT_DEF_FONT_DEF(rfont_def) AREF (rfont_def, 1)
270 #define RFONT_DEF_SPEC(rfont_def) FONT_DEF_SPEC (AREF (rfont_def, 1))
271 #define RFONT_DEF_OBJECT(rfont_def) AREF (rfont_def, 2)
272 #define RFONT_DEF_SET_OBJECT(rfont_def, object) \
273 ASET ((rfont_def), 2, (object))
274 /* Score of RFONT_DEF is an integer value; the lowest 8 bits represent
275 the order of listing by font backends, the higher bits represents
276 the order given by charset priority list. The smaller value is
278 #define RFONT_DEF_SCORE(rfont_def) XINT (AREF (rfont_def, 3))
279 #define RFONT_DEF_SET_SCORE(rfont_def, score) \
280 ASET ((rfont_def), 3, make_number (score))
281 #define RFONT_DEF_NEW(rfont_def, font_def) \
283 (rfont_def) = Fmake_vector (make_number (4), Qnil); \
284 ASET ((rfont_def), 1, (font_def)); \
285 RFONT_DEF_SET_SCORE ((rfont_def), 0); \
289 /* Return the element of FONTSET for the character C. If FONTSET is a
290 base fontset other then the default fontset and FONTSET doesn't
291 contain information for C, return the information in the default
294 #define FONTSET_REF(fontset, c) \
295 (EQ (fontset, Vdefault_fontset) \
296 ? CHAR_TABLE_REF (fontset, c) \
297 : fontset_ref ((fontset), (c)))
300 fontset_ref (Lisp_Object fontset
, int c
)
304 elt
= CHAR_TABLE_REF (fontset
, c
);
305 if (NILP (elt
) && ! EQ (fontset
, Vdefault_fontset
)
306 /* Don't check Vdefault_fontset for a realized fontset. */
307 && NILP (FONTSET_BASE (fontset
)))
308 elt
= CHAR_TABLE_REF (Vdefault_fontset
, c
);
312 /* Set elements of FONTSET for characters in RANGE to the value ELT.
313 RANGE is a cons (FROM . TO), where FROM and TO are character codes
314 specifying a range. */
316 #define FONTSET_SET(fontset, range, elt) \
317 Fset_char_table_range ((fontset), (range), (elt))
320 /* Modify the elements of FONTSET for characters in RANGE by replacing
321 with ELT or adding ELT. RANGE is a cons (FROM . TO), where FROM
322 and TO are character codes specifying a range. If ADD is nil,
323 replace with ELT, if ADD is `prepend', prepend ELT, otherwise,
326 #define FONTSET_ADD(fontset, range, elt, add) \
329 ? (set_fontset_fallback \
330 (fontset, Fmake_vector (make_number (1), (elt)))) \
332 Fset_char_table_range (fontset, range, \
333 Fmake_vector (make_number (1), elt)))) \
334 : fontset_add ((fontset), (range), (elt), (add)))
337 fontset_add (Lisp_Object fontset
, Lisp_Object range
, Lisp_Object elt
, Lisp_Object add
)
340 int idx
= (EQ (add
, Qappend
) ? 0 : 1);
342 args
[1 - idx
] = Fmake_vector (make_number (1), elt
);
346 int from
= XINT (XCAR (range
));
347 int to
= XINT (XCDR (range
));
351 from1
= from
, to1
= to
;
352 args
[idx
] = char_table_ref_and_range (fontset
, from
, &from1
, &to1
);
353 char_table_set_range (fontset
, from
, to1
,
354 (NILP (args
[idx
]) ? args
[1 - idx
]
355 : CALLMANY (Fvconcat
, args
)));
361 args
[idx
] = FONTSET_FALLBACK (fontset
);
362 set_fontset_fallback (fontset
,
363 (NILP (args
[idx
]) ? args
[1 - idx
]
364 : CALLMANY (Fvconcat
, args
)));
369 fontset_compare_rfontdef (const void *val1
, const void *val2
)
371 return (RFONT_DEF_SCORE (*(Lisp_Object
*) val1
)
372 - RFONT_DEF_SCORE (*(Lisp_Object
*) val2
));
375 /* Update a cons cell which has this form:
376 (CHARSET-ORDERED-LIST-TICK . FONT-GROUP)
377 where FONT-GROUP is of the form
378 [ PREFERRED-RFONT-DEF RFONT-DEF0 RFONT-DEF1 ... ]
379 Reorder RFONT-DEFs according to the current language, and update
380 CHARSET-ORDERED-LIST-TICK. */
383 reorder_font_vector (Lisp_Object font_group
, struct font
*font
)
385 Lisp_Object vec
, font_object
;
388 bool score_changed
= false;
391 XSETFONT (font_object
, font
);
395 vec
= XCDR (font_group
);
397 /* Exclude the tailing nil element from the reordering. */
398 if (NILP (AREF (vec
, size
- 1)))
401 for (i
= 0; i
< size
; i
++)
403 Lisp_Object rfont_def
= AREF (vec
, i
);
404 Lisp_Object font_def
= RFONT_DEF_FONT_DEF (rfont_def
);
405 Lisp_Object font_spec
= FONT_DEF_SPEC (font_def
);
406 int score
= RFONT_DEF_SCORE (rfont_def
) & 0xFF;
407 Lisp_Object otf_spec
= Ffont_get (font_spec
, QCotf
);
409 if (! NILP (otf_spec
))
410 /* A font-spec with :otf is preferable regardless of encoding
413 else if (! font_match_p (font_spec
, font_object
))
415 Lisp_Object encoding
= FONT_DEF_ENCODING (font_def
);
417 if (! NILP (encoding
))
419 /* This spec specifies an encoding by a charset set
420 name. Reflect the preference order of that charset
421 in the upper bits of SCORE. */
424 for (tail
= Vcharset_ordered_list
;
425 ! EQ (tail
, Vcharset_non_preferred_head
) && CONSP (tail
);
427 if (EQ (encoding
, XCAR (tail
)))
429 else if (score
<= min (INT_MAX
, MOST_POSITIVE_FIXNUM
) - 0x100)
434 /* This spec does not specify an encoding. If the spec
435 specifies a language, and the language is not for the
436 current language environment, make the score
438 Lisp_Object lang
= Ffont_get (font_spec
, QClang
);
441 && ! EQ (lang
, Vcurrent_iso639_language
)
442 && (! CONSP (Vcurrent_iso639_language
)
443 || NILP (Fmemq (lang
, Vcurrent_iso639_language
))))
447 if (RFONT_DEF_SCORE (rfont_def
) != score
)
449 RFONT_DEF_SET_SCORE (rfont_def
, score
);
450 score_changed
= true;
455 qsort (XVECTOR (vec
)->contents
, size
, word_size
,
456 fontset_compare_rfontdef
);
457 EMACS_INT low_tick_bits
= charset_ordered_list_tick
& MOST_POSITIVE_FIXNUM
;
458 XSETCAR (font_group
, make_number (low_tick_bits
));
461 /* Return a font-group (actually a cons (CHARSET_ORDERED_LIST_TICK
462 . FONT-GROUP)) for character C or a fallback font-group in the
463 realized fontset FONTSET. The elements of FONT-GROUP are
464 RFONT-DEFs. The value may not be a cons. See the comment at the
465 head of this file for the detail of the return value. */
468 fontset_get_font_group (Lisp_Object fontset
, int c
)
470 Lisp_Object font_group
;
471 Lisp_Object base_fontset
;
472 int from
= 0, to
= MAX_CHAR
, i
;
474 eassert (! BASE_FONTSET_P (fontset
));
476 font_group
= CHAR_TABLE_REF (fontset
, c
);
478 font_group
= FONTSET_FALLBACK (fontset
);
479 if (! NILP (font_group
))
480 /* We have already realized FONT-DEFs of this font group for C or
481 for fallback (FONT_GROUP is a cons), or we have already found
482 that no appropriate font was found (FONT_GROUP is t or 0). */
484 base_fontset
= FONTSET_BASE (fontset
);
485 if (NILP (base_fontset
))
486 /* Actually we never come here because FONTSET is a realized one,
487 and thus it should have a base. */
490 font_group
= char_table_ref_and_range (base_fontset
, c
, &from
, &to
);
492 font_group
= FONTSET_FALLBACK (base_fontset
);
494 /* FONT_GROUP not being a vector means that no fonts are specified
495 for C, or the fontset does not have fallback fonts. */
496 if (NILP (font_group
))
498 font_group
= make_number (0);
500 /* Record that FONTSET does not specify fonts for C. As
501 there's a possibility that a font is found in a fallback
502 font group, we set 0 at the moment. */
503 char_table_set_range (fontset
, from
, to
, font_group
);
506 if (!VECTORP (font_group
))
509 /* Now realize FONT-DEFs of this font group, and update the realized
511 font_group
= Fcopy_sequence (font_group
);
512 for (i
= 0; i
< ASIZE (font_group
); i
++)
513 if (! NILP (AREF (font_group
, i
)))
515 Lisp_Object rfont_def
;
517 RFONT_DEF_NEW (rfont_def
, AREF (font_group
, i
));
518 /* Remember the original order. */
519 RFONT_DEF_SET_SCORE (rfont_def
, i
);
520 ASET (font_group
, i
, rfont_def
);
522 font_group
= Fcons (make_number (-1), font_group
);
524 char_table_set_range (fontset
, from
, to
, font_group
);
526 set_fontset_fallback (fontset
, font_group
);
530 /* Return RFONT-DEF (vector) in the realized fontset FONTSET for the
531 character C. If no font is found, return Qnil or 0 if there's a
532 possibility that the default fontset or the fallback font groups
533 have a proper font, and return Qt if not.
535 If a font is found but is not yet opened, open it (if FACE is not
536 NULL) or return Qnil (if FACE is NULL).
538 CHARSET_ID is a charset-id that must be preferred, or -1 meaning no
541 If FALLBACK, search only fallback fonts. */
544 fontset_find_font (Lisp_Object fontset
, int c
, struct face
*face
,
545 int charset_id
, bool fallback
)
547 Lisp_Object vec
, font_group
;
548 int i
, charset_matched
= 0, found_index
;
549 struct frame
*f
= (FRAMEP (FONTSET_FRAME (fontset
))
550 ? XFRAME (FONTSET_FRAME (fontset
))
551 : XFRAME (selected_frame
));
552 Lisp_Object rfont_def
;
554 font_group
= fontset_get_font_group (fontset
, fallback
? -1 : c
);
555 if (! CONSP (font_group
))
557 vec
= XCDR (font_group
);
558 if (ASIZE (vec
) == 0)
563 if (XINT (XCAR (font_group
)) != charset_ordered_list_tick
)
564 /* We have just created the font-group,
565 or the charset priorities were changed. */
566 reorder_font_vector (font_group
, face
->ascii_face
->font
);
568 /* Find a spec matching with CHARSET_ID to try it at
570 for (i
= 0; i
< ASIZE (vec
); i
++)
572 Lisp_Object repertory
;
574 rfont_def
= AREF (vec
, i
);
575 if (NILP (rfont_def
))
577 repertory
= FONT_DEF_REPERTORY (RFONT_DEF_FONT_DEF (rfont_def
));
579 if (XINT (repertory
) == charset_id
)
587 /* Find the first available font in the vector of RFONT-DEF. If
588 CHARSET_MATCHED > 0, try the corresponding RFONT-DEF first, then
590 for (i
= 0; i
< ASIZE (vec
); i
++)
592 Lisp_Object font_def
;
593 Lisp_Object font_entity
, font_object
;
598 if (charset_matched
> 0)
600 /* Try the element matching with CHARSET_ID at first. */
601 found_index
= charset_matched
;
602 /* Make this negative so that we don't come here in the
604 charset_matched
= - charset_matched
;
605 /* We must try the first element in the next loop. */
609 else if (i
== - charset_matched
)
611 /* We have already tried this element and the followings
612 that have the same font specifications in the first
613 iteration. So, skip them all. */
614 rfont_def
= AREF (vec
, i
);
615 font_def
= RFONT_DEF_FONT_DEF (rfont_def
);
616 for (; i
+ 1 < ASIZE (vec
); i
++)
618 rfont_def
= AREF (vec
, i
+ 1);
619 if (NILP (rfont_def
))
621 if (! EQ (RFONT_DEF_FONT_DEF (rfont_def
), font_def
))
627 rfont_def
= AREF (vec
, found_index
);
628 if (NILP (rfont_def
))
632 /* This is a sign of not to try the other fonts. */
635 if (INTEGERP (RFONT_DEF_FACE (rfont_def
))
636 && XINT (RFONT_DEF_FACE (rfont_def
)) < 0)
637 /* We couldn't open this font last time. */
640 font_object
= RFONT_DEF_OBJECT (rfont_def
);
641 if (NILP (font_object
))
643 font_def
= RFONT_DEF_FONT_DEF (rfont_def
);
646 /* We have not yet opened the font. */
648 /* Find a font best-matching with the spec without checking
649 the support of the character C. That checking is costly,
650 and even without the checking, the found font supports C
651 in high possibility. */
652 font_entity
= font_find_for_lface (f
, face
->lface
,
653 FONT_DEF_SPEC (font_def
), -1);
654 if (NILP (font_entity
))
656 /* Record that no font matches the spec. */
657 RFONT_DEF_SET_FACE (rfont_def
, -1);
660 font_object
= font_open_for_lface (f
, font_entity
, face
->lface
,
661 FONT_DEF_SPEC (font_def
));
662 if (NILP (font_object
))
664 /* Something strange happened, perhaps because of a
665 Font-backend problem. To avoid crashing, record
666 that this spec is unusable. It may be better to find
667 another font of the same spec, but currently we don't
668 have such an API in font-backend. */
669 RFONT_DEF_SET_FACE (rfont_def
, -1);
672 RFONT_DEF_SET_OBJECT (rfont_def
, font_object
);
675 if (font_has_char (f
, font_object
, c
))
678 /* Find a font already opened, matching with the current spec,
680 font_def
= RFONT_DEF_FONT_DEF (rfont_def
);
681 for (; found_index
+ 1 < ASIZE (vec
); found_index
++)
683 rfont_def
= AREF (vec
, found_index
+ 1);
684 if (NILP (rfont_def
))
686 if (! EQ (RFONT_DEF_FONT_DEF (rfont_def
), font_def
))
688 font_object
= RFONT_DEF_OBJECT (rfont_def
);
689 if (! NILP (font_object
) && font_has_char (f
, font_object
, c
))
696 /* Find a font-entity with the current spec and supporting C. */
697 font_entity
= font_find_for_lface (f
, face
->lface
,
698 FONT_DEF_SPEC (font_def
), c
);
699 if (! NILP (font_entity
))
701 /* We found a font. Open it and insert a new element for
706 font_object
= font_open_for_lface (f
, font_entity
, face
->lface
,
708 if (NILP (font_object
))
710 RFONT_DEF_NEW (rfont_def
, font_def
);
711 RFONT_DEF_SET_OBJECT (rfont_def
, font_object
);
712 RFONT_DEF_SET_SCORE (rfont_def
, RFONT_DEF_SCORE (rfont_def
));
713 new_vec
= Fmake_vector (make_number (ASIZE (vec
) + 1), Qnil
);
715 for (j
= 0; j
< found_index
; j
++)
716 ASET (new_vec
, j
, AREF (vec
, j
));
717 ASET (new_vec
, j
, rfont_def
);
718 for (j
++; j
< ASIZE (new_vec
); j
++)
719 ASET (new_vec
, j
, AREF (vec
, j
- 1));
720 XSETCDR (font_group
, new_vec
);
728 /* Record that no font in this font group supports C. */
729 FONTSET_SET (fontset
, make_number (c
), make_number (0));
733 if (fallback
&& found_index
> 0)
735 /* The order of fonts in the fallback font-group is not that
736 important, and it is better to move the found font to the
737 first of the group so that the next try will find it
739 for (i
= found_index
; i
> 0; i
--)
740 ASET (vec
, i
, AREF (vec
, i
- 1));
741 ASET (vec
, 0, rfont_def
);
747 /* Return RFONT-DEF (vector) corresponding to the font for character
748 C. The value is not a vector if no font is found for C. */
751 fontset_font (Lisp_Object fontset
, int c
, struct face
*face
, int id
)
753 Lisp_Object rfont_def
, default_rfont_def
IF_LINT (= Qnil
);
754 Lisp_Object base_fontset
;
756 /* Try a font-group of FONTSET. */
757 FONT_DEFERRED_LOG ("current fontset: font for", make_number (c
), Qnil
);
758 rfont_def
= fontset_find_font (fontset
, c
, face
, id
, 0);
759 if (VECTORP (rfont_def
))
761 if (NILP (rfont_def
))
762 FONTSET_SET (fontset
, make_number (c
), make_number (0));
764 /* Try a font-group of the default fontset. */
765 base_fontset
= FONTSET_BASE (fontset
);
766 if (! EQ (base_fontset
, Vdefault_fontset
))
768 if (NILP (FONTSET_DEFAULT (fontset
)))
771 make_fontset (FONTSET_FRAME (fontset
), Qnil
, Vdefault_fontset
));
772 FONT_DEFERRED_LOG ("default fontset: font for", make_number (c
), Qnil
);
774 = fontset_find_font (FONTSET_DEFAULT (fontset
), c
, face
, id
, 0);
775 if (VECTORP (default_rfont_def
))
776 return default_rfont_def
;
777 if (NILP (default_rfont_def
))
778 FONTSET_SET (FONTSET_DEFAULT (fontset
), make_number (c
),
782 /* Try a fallback font-group of FONTSET. */
783 if (! EQ (rfont_def
, Qt
))
785 FONT_DEFERRED_LOG ("current fallback: font for", make_number (c
), Qnil
);
786 rfont_def
= fontset_find_font (fontset
, c
, face
, id
, 1);
787 if (VECTORP (rfont_def
))
789 /* Remember that FONTSET has no font for C. */
790 FONTSET_SET (fontset
, make_number (c
), Qt
);
793 /* Try a fallback font-group of the default fontset. */
794 if (! EQ (base_fontset
, Vdefault_fontset
)
795 && ! EQ (default_rfont_def
, Qt
))
797 FONT_DEFERRED_LOG ("default fallback: font for", make_number (c
), Qnil
);
798 rfont_def
= fontset_find_font (FONTSET_DEFAULT (fontset
), c
, face
, id
, 1);
799 if (VECTORP (rfont_def
))
801 /* Remember that the default fontset has no font for C. */
802 FONTSET_SET (FONTSET_DEFAULT (fontset
), make_number (c
), Qt
);
808 /* Return a newly created fontset with NAME. If BASE is nil, make a
809 base fontset. Otherwise make a realized fontset whose base is
813 make_fontset (Lisp_Object frame
, Lisp_Object name
, Lisp_Object base
)
816 int size
= ASIZE (Vfontset_table
);
817 int id
= next_fontset_id
;
819 /* Find a free slot in Vfontset_table. Usually, next_fontset_id is
820 the next available fontset ID. So it is expected that this loop
821 terminates quickly. In addition, as the last element of
822 Vfontset_table is always nil, we don't have to check the range of
824 while (!NILP (AREF (Vfontset_table
, id
))) id
++;
827 Vfontset_table
= larger_vector (Vfontset_table
, 1, -1);
829 fontset
= Fmake_char_table (Qfontset
, Qnil
);
831 set_fontset_id (fontset
, make_number (id
));
833 set_fontset_name (fontset
, name
);
836 set_fontset_name (fontset
, Qnil
);
837 set_fontset_frame (fontset
, frame
);
838 set_fontset_base (fontset
, base
);
841 ASET (Vfontset_table
, id
, fontset
);
842 next_fontset_id
= id
+ 1;
847 /********** INTERFACES TO xfaces.c, xfns.c, and dispextern.h **********/
849 /* Return the name of the fontset who has ID. */
852 fontset_name (int id
)
856 fontset
= FONTSET_FROM_ID (id
);
857 return FONTSET_NAME (fontset
);
861 /* Return the ASCII font name of the fontset who has ID. */
864 fontset_ascii (int id
)
866 Lisp_Object fontset
, elt
;
868 fontset
= FONTSET_FROM_ID (id
);
869 elt
= FONTSET_ASCII (fontset
);
875 /* Free fontset of FACE defined on frame F. Called from
876 free_realized_face. */
879 free_face_fontset (struct frame
*f
, struct face
*face
)
883 fontset
= FONTSET_FROM_ID (face
->fontset
);
886 eassert (! BASE_FONTSET_P (fontset
));
887 eassert (f
== XFRAME (FONTSET_FRAME (fontset
)));
888 ASET (Vfontset_table
, face
->fontset
, Qnil
);
889 if (face
->fontset
< next_fontset_id
)
890 next_fontset_id
= face
->fontset
;
891 if (! NILP (FONTSET_DEFAULT (fontset
)))
893 int id
= XINT (FONTSET_ID (FONTSET_DEFAULT (fontset
)));
895 fontset
= AREF (Vfontset_table
, id
);
896 eassert (!NILP (fontset
) && ! BASE_FONTSET_P (fontset
));
897 eassert (f
== XFRAME (FONTSET_FRAME (fontset
)));
898 ASET (Vfontset_table
, id
, Qnil
);
899 if (id
< next_fontset_id
)
900 next_fontset_id
= face
->fontset
;
905 /* Return ID of face suitable for displaying character C at buffer position
906 POS on frame F. FACE must be realized for ASCII characters in advance.
907 Called from the macro FACE_FOR_CHAR. */
910 face_for_char (struct frame
*f
, struct face
*face
, int c
,
911 ptrdiff_t pos
, Lisp_Object object
)
913 Lisp_Object fontset
, rfont_def
, charset
;
917 eassert (fontset_id_valid_p (face
->fontset
));
919 if (ASCII_CHAR_P (c
) || CHAR_BYTE8_P (c
))
920 return face
->ascii_face
->id
;
922 if (c
> 0 && EQ (CHAR_TABLE_REF (Vchar_script_table
, c
), Qsymbol
))
924 /* Fonts often have characters for punctuation and other
925 symbols, even if they don't match the 'symbol' script. So
926 check if the character is present in the current ASCII face
927 first, and if so, use the same font as used by that face.
928 This avoids unnecessarily switching to another font when the
929 frame's default font will do. We only do this for symbols so
930 that users could still setup fontsets to force Emacs to use
931 specific fonts for characters from other scripts, because
932 choice of fonts is frequently affected by cultural
933 preferences and font features, not by font coverage.
934 However, these considerations are unlikely to be relevant to
935 punctuation and other symbols, since the latter generally
936 aren't specific to any culture, and don't require
937 sophisticated OTF features. */
938 Lisp_Object font_object
;
940 if (face
->ascii_face
->font
)
942 XSETFONT (font_object
, face
->ascii_face
->font
);
943 if (font_has_char (f
, font_object
, c
))
944 return face
->ascii_face
->id
;
948 /* Try the current face. Disabled because it can cause
949 counter-intuitive results, whereby the font used for some
950 character depends on the characters that precede it on
951 display. See the discussion of bug #15138. Note that the
952 original bug reported in #15138 was in a situation where face
953 == face->ascii_face, so the above code solves that situation
954 without risking the undesirable consequences. */
957 XSETFONT (font_object
, face
->font
);
958 if (font_has_char (f
, font_object
, c
)) return face
->id
;
963 fontset
= FONTSET_FROM_ID (face
->fontset
);
964 eassert (!BASE_FONTSET_P (fontset
));
973 charset
= Fget_char_property (make_number (pos
), Qcharset
, object
);
974 if (CHARSETP (charset
))
978 val
= assq_no_quit (charset
, Vfont_encoding_charset_alist
);
979 if (CONSP (val
) && CHARSETP (XCDR (val
)))
980 charset
= XCDR (val
);
981 id
= XINT (CHARSET_SYMBOL_ID (charset
));
987 rfont_def
= fontset_font (fontset
, c
, face
, id
);
988 if (VECTORP (rfont_def
))
990 if (INTEGERP (RFONT_DEF_FACE (rfont_def
)))
991 face_id
= XINT (RFONT_DEF_FACE (rfont_def
));
994 Lisp_Object font_object
;
996 font_object
= RFONT_DEF_OBJECT (rfont_def
);
997 face_id
= face_for_font (f
, font_object
, face
);
998 RFONT_DEF_SET_FACE (rfont_def
, face_id
);
1003 if (INTEGERP (FONTSET_NOFONT_FACE (fontset
)))
1004 face_id
= XINT (FONTSET_NOFONT_FACE (fontset
));
1007 face_id
= face_for_font (f
, Qnil
, face
);
1008 set_fontset_nofont_face (fontset
, make_number (face_id
));
1011 eassert (face_id
>= 0);
1017 font_for_char (struct face
*face
, int c
, ptrdiff_t pos
, Lisp_Object object
)
1019 Lisp_Object fontset
, rfont_def
, charset
;
1022 if (ASCII_CHAR_P (c
))
1024 Lisp_Object font_object
;
1026 XSETFONT (font_object
, face
->ascii_face
->font
);
1030 eassert (fontset_id_valid_p (face
->fontset
));
1031 fontset
= FONTSET_FROM_ID (face
->fontset
);
1032 eassert (!BASE_FONTSET_P (fontset
));
1040 charset
= Fget_char_property (make_number (pos
), Qcharset
, object
);
1041 if (CHARSETP (charset
))
1045 val
= assq_no_quit (charset
, Vfont_encoding_charset_alist
);
1046 if (CONSP (val
) && CHARSETP (XCDR (val
)))
1047 charset
= XCDR (val
);
1048 id
= XINT (CHARSET_SYMBOL_ID (charset
));
1054 rfont_def
= fontset_font (fontset
, c
, face
, id
);
1055 return (VECTORP (rfont_def
)
1056 ? RFONT_DEF_OBJECT (rfont_def
)
1061 /* Make a realized fontset for ASCII face FACE on frame F from the
1062 base fontset BASE_FONTSET_ID. If BASE_FONTSET_ID is -1, use the
1063 default fontset as the base. Value is the id of the new fontset.
1064 Called from realize_x_face. */
1067 make_fontset_for_ascii_face (struct frame
*f
, int base_fontset_id
, struct face
*face
)
1069 Lisp_Object base_fontset
, fontset
, frame
;
1071 XSETFRAME (frame
, f
);
1072 if (base_fontset_id
>= 0)
1074 base_fontset
= FONTSET_FROM_ID (base_fontset_id
);
1075 if (!BASE_FONTSET_P (base_fontset
))
1076 base_fontset
= FONTSET_BASE (base_fontset
);
1077 eassert (BASE_FONTSET_P (base_fontset
));
1080 base_fontset
= Vdefault_fontset
;
1082 fontset
= make_fontset (frame
, Qnil
, base_fontset
);
1083 return XINT (FONTSET_ID (fontset
));
1088 /* Cache data used by fontset_pattern_regexp. The car part is a
1089 pattern string containing at least one wild card, the cdr part is
1090 the corresponding regular expression. */
1091 static Lisp_Object Vcached_fontset_data
;
1093 #define CACHED_FONTSET_NAME SSDATA (XCAR (Vcached_fontset_data))
1094 #define CACHED_FONTSET_REGEX (XCDR (Vcached_fontset_data))
1096 /* If fontset name PATTERN contains any wild card, return regular
1097 expression corresponding to PATTERN. */
1100 fontset_pattern_regexp (Lisp_Object pattern
)
1102 if (!strchr (SSDATA (pattern
), '*')
1103 && !strchr (SSDATA (pattern
), '?'))
1104 /* PATTERN does not contain any wild cards. */
1107 if (!CONSP (Vcached_fontset_data
)
1108 || strcmp (SSDATA (pattern
), CACHED_FONTSET_NAME
))
1110 /* We must at first update the cached data. */
1111 unsigned char *regex
, *p0
, *p1
;
1112 int ndashes
= 0, nstars
= 0, nescs
= 0;
1114 for (p0
= SDATA (pattern
); *p0
; p0
++)
1118 else if (*p0
== '*')
1121 || *p0
== '.' || *p0
== '\\'
1122 || *p0
== '+' || *p0
== '^'
1127 /* If PATTERN is not full XLFD we convert "*" to ".*". Otherwise
1128 we convert "*" to "[^-]*" which is much faster in regular
1129 expression matching. */
1130 ptrdiff_t regexsize
= (SBYTES (pattern
)
1131 + (ndashes
< 14 ? 2 : 5) * nstars
1134 p1
= regex
= SAFE_ALLOCA (regexsize
);
1137 for (p0
= SDATA (pattern
); *p0
; p0
++)
1144 *p1
++ = '[', *p1
++ = '^', *p1
++ = '-', *p1
++ = ']';
1147 else if (*p0
== '?')
1150 || *p0
== '.' || *p0
== '\\'
1151 || *p0
== '+' || *p0
== '^'
1153 *p1
++ = '\\', *p1
++ = *p0
;
1160 Vcached_fontset_data
= Fcons (build_string (SSDATA (pattern
)),
1161 build_string ((char *) regex
));
1165 return CACHED_FONTSET_REGEX
;
1168 /* Return ID of the base fontset named NAME. If there's no such
1169 fontset, return -1. NAME_PATTERN specifies how to treat NAME as this:
1170 0: pattern containing '*' and '?' as wildcards
1171 1: regular expression
1172 2: literal fontset name
1176 fs_query_fontset (Lisp_Object name
, int name_pattern
)
1181 name
= Fdowncase (name
);
1182 if (name_pattern
!= 1)
1184 tem
= Frassoc (name
, Vfontset_alias_alist
);
1186 tem
= Fassoc (name
, Vfontset_alias_alist
);
1187 if (CONSP (tem
) && STRINGP (XCAR (tem
)))
1189 else if (name_pattern
== 0)
1191 tem
= fontset_pattern_regexp (name
);
1200 for (i
= 0; i
< ASIZE (Vfontset_table
); i
++)
1202 Lisp_Object fontset
, this_name
;
1204 fontset
= FONTSET_FROM_ID (i
);
1206 || !BASE_FONTSET_P (fontset
))
1209 this_name
= FONTSET_NAME (fontset
);
1210 if (name_pattern
== 1
1211 ? fast_string_match_ignore_case (name
, this_name
) >= 0
1212 : !xstrcasecmp (SSDATA (name
), SSDATA (this_name
)))
1219 DEFUN ("query-fontset", Fquery_fontset
, Squery_fontset
, 1, 2, 0,
1220 doc
: /* Return the name of a fontset that matches PATTERN.
1221 The value is nil if there is no matching fontset.
1222 PATTERN can contain `*' or `?' as a wildcard
1223 just as X font name matching algorithm allows.
1224 If REGEXPP is non-nil, PATTERN is a regular expression. */)
1225 (Lisp_Object pattern
, Lisp_Object regexpp
)
1227 Lisp_Object fontset
;
1230 check_window_system (NULL
);
1232 CHECK_STRING (pattern
);
1234 if (SCHARS (pattern
) == 0)
1237 id
= fs_query_fontset (pattern
, !NILP (regexpp
));
1241 fontset
= FONTSET_FROM_ID (id
);
1242 return FONTSET_NAME (fontset
);
1245 /* Return a list of base fontset names matching PATTERN on frame F. */
1248 list_fontsets (struct frame
*f
, Lisp_Object pattern
, int size
)
1250 Lisp_Object frame
, regexp
, val
;
1253 XSETFRAME (frame
, f
);
1255 regexp
= fontset_pattern_regexp (pattern
);
1258 for (id
= 0; id
< ASIZE (Vfontset_table
); id
++)
1260 Lisp_Object fontset
, name
;
1262 fontset
= FONTSET_FROM_ID (id
);
1264 || !BASE_FONTSET_P (fontset
)
1265 || !EQ (frame
, FONTSET_FRAME (fontset
)))
1267 name
= FONTSET_NAME (fontset
);
1269 if (STRINGP (regexp
)
1270 ? (fast_string_match (regexp
, name
) < 0)
1271 : strcmp (SSDATA (pattern
), SSDATA (name
)))
1274 val
= Fcons (Fcopy_sequence (FONTSET_NAME (fontset
)), val
);
1281 /* Free all realized fontsets whose base fontset is BASE. */
1284 free_realized_fontsets (Lisp_Object base
)
1289 /* For the moment, this doesn't work because free_realized_face
1290 doesn't remove FACE from a cache. Until we find a solution, we
1291 suppress this code, and simply use Fclear_face_cache even though
1292 that is not efficient. */
1294 for (id
= 0; id
< ASIZE (Vfontset_table
); id
++)
1296 Lisp_Object
this = AREF (Vfontset_table
, id
);
1298 if (EQ (FONTSET_BASE (this), base
))
1302 for (tail
= FONTSET_FACE_ALIST (this); CONSP (tail
);
1305 struct frame
*f
= XFRAME (FONTSET_FRAME (this));
1306 int face_id
= XINT (XCDR (XCAR (tail
)));
1307 struct face
*face
= FACE_FROM_ID (f
, face_id
);
1309 /* Face THIS itself is also freed by the following call. */
1310 free_realized_face (f
, face
);
1316 /* But, we don't have to call Fclear_face_cache if no fontset has
1317 been realized from BASE. */
1318 for (id
= 0; id
< ASIZE (Vfontset_table
); id
++)
1320 Lisp_Object
this = AREF (Vfontset_table
, id
);
1322 if (CHAR_TABLE_P (this) && EQ (FONTSET_BASE (this), base
))
1324 Fclear_face_cache (Qt
);
1332 /* Check validity of NAME as a fontset name and return the
1333 corresponding fontset. If not valid, signal an error.
1335 If NAME is t, return Vdefault_fontset. If NAME is nil, return the
1338 Set *FRAME to the actual frame. */
1341 check_fontset_name (Lisp_Object name
, Lisp_Object
*frame
)
1344 struct frame
*f
= decode_live_frame (*frame
);
1346 XSETFRAME (*frame
, f
);
1349 return Vdefault_fontset
;
1351 id
= FRAME_FONTSET (f
);
1354 CHECK_STRING (name
);
1355 /* First try NAME as literal. */
1356 id
= fs_query_fontset (name
, 2);
1358 /* For backward compatibility, try again NAME as pattern. */
1359 id
= fs_query_fontset (name
, 0);
1361 error ("Fontset `%s' does not exist", SDATA (name
));
1363 return FONTSET_FROM_ID (id
);
1367 accumulate_script_ranges (Lisp_Object arg
, Lisp_Object range
, Lisp_Object val
)
1369 if (EQ (XCAR (arg
), val
))
1372 XSETCDR (arg
, Fcons (Fcons (XCAR (range
), XCDR (range
)), XCDR (arg
)));
1374 XSETCDR (arg
, Fcons (Fcons (range
, range
), XCDR (arg
)));
1379 /* Callback function for map_charset_chars in Fset_fontset_font.
1380 ARG is a vector [ FONTSET FONT_DEF ADD ASCII SCRIPT_RANGE_LIST ].
1382 In FONTSET, set FONT_DEF in a fashion specified by ADD for
1383 characters in RANGE and ranges in SCRIPT_RANGE_LIST before RANGE.
1384 The consumed ranges are popped up from SCRIPT_RANGE_LIST, and the
1385 new SCRIPT_RANGE_LIST is stored in ARG.
1387 If ASCII is nil, don't set FONT_DEF for ASCII characters. It is
1388 assured that SCRIPT_RANGE_LIST doesn't contain ASCII in that
1392 set_fontset_font (Lisp_Object arg
, Lisp_Object range
)
1394 Lisp_Object fontset
, font_def
, add
, ascii
, script_range_list
;
1395 int from
= XINT (XCAR (range
)), to
= XINT (XCDR (range
));
1397 fontset
= AREF (arg
, 0);
1398 font_def
= AREF (arg
, 1);
1399 add
= AREF (arg
, 2);
1400 ascii
= AREF (arg
, 3);
1401 script_range_list
= AREF (arg
, 4);
1403 if (NILP (ascii
) && from
< 0x80)
1408 range
= Fcons (make_number (0x80), XCDR (range
));
1411 #define SCRIPT_FROM XINT (XCAR (XCAR (script_range_list)))
1412 #define SCRIPT_TO XINT (XCDR (XCAR (script_range_list)))
1413 #define POP_SCRIPT_RANGE() script_range_list = XCDR (script_range_list)
1415 for (; CONSP (script_range_list
) && SCRIPT_TO
< from
; POP_SCRIPT_RANGE ())
1416 FONTSET_ADD (fontset
, XCAR (script_range_list
), font_def
, add
);
1417 if (CONSP (script_range_list
))
1419 if (SCRIPT_FROM
< from
)
1420 range
= Fcons (make_number (SCRIPT_FROM
), XCDR (range
));
1421 while (CONSP (script_range_list
) && SCRIPT_TO
<= to
)
1422 POP_SCRIPT_RANGE ();
1423 if (CONSP (script_range_list
) && SCRIPT_FROM
<= to
)
1424 XSETCAR (XCAR (script_range_list
), make_number (to
+ 1));
1427 FONTSET_ADD (fontset
, range
, font_def
, add
);
1428 ASET (arg
, 4, script_range_list
);
1431 static void update_auto_fontset_alist (Lisp_Object
, Lisp_Object
);
1434 DEFUN ("set-fontset-font", Fset_fontset_font
, Sset_fontset_font
, 3, 5, 0,
1436 Modify fontset NAME to use FONT-SPEC for TARGET characters.
1438 NAME is a fontset name string, nil for the fontset of FRAME, or t for
1439 the default fontset.
1441 TARGET may be a single character to use FONT-SPEC for.
1443 Target may be a cons (FROM . TO), where FROM and TO are characters.
1444 In that case, use FONT-SPEC for all characters in the range FROM
1447 TARGET may be a script name symbol. In that case, use FONT-SPEC for
1448 all characters that belong to the script.
1450 TARGET may be a charset. In that case, use FONT-SPEC for all
1451 characters in the charset.
1453 TARGET may be nil. In that case, use FONT-SPEC for any characters for
1454 that no FONT-SPEC is specified.
1456 FONT-SPEC may one of these:
1457 * A font-spec object made by the function `font-spec' (which see).
1458 * A cons (FAMILY . REGISTRY), where FAMILY is a font family name and
1459 REGISTRY is a font registry name. FAMILY may contain foundry
1460 name, and REGISTRY may contain encoding name.
1461 * A font name string.
1462 * nil, which explicitly specifies that there's no font for TARGET.
1464 Optional 4th argument FRAME is a frame or nil for the selected frame
1465 that is concerned in the case that NAME is nil.
1467 Optional 5th argument ADD, if non-nil, specifies how to add FONT-SPEC
1468 to the font specifications for TARGET previously set. If it is
1469 `prepend', FONT-SPEC is prepended. If it is `append', FONT-SPEC is
1470 appended. By default, FONT-SPEC overrides the previous settings. */)
1471 (Lisp_Object name
, Lisp_Object target
, Lisp_Object font_spec
, Lisp_Object frame
, Lisp_Object add
)
1473 Lisp_Object fontset
;
1474 Lisp_Object font_def
, registry
, family
;
1475 Lisp_Object range_list
;
1476 struct charset
*charset
= NULL
;
1477 Lisp_Object fontname
;
1478 bool ascii_changed
= 0;
1480 fontset
= check_fontset_name (name
, &frame
);
1483 if (CONSP (font_spec
))
1485 Lisp_Object spec
= Ffont_spec (0, NULL
);
1487 font_parse_family_registry (XCAR (font_spec
), XCDR (font_spec
), spec
);
1489 fontname
= Ffont_xlfd_name (font_spec
, Qnil
);
1491 else if (STRINGP (font_spec
))
1493 fontname
= font_spec
;
1494 font_spec
= CALLN (Ffont_spec
, QCname
, fontname
);
1496 else if (FONT_SPEC_P (font_spec
))
1497 fontname
= Ffont_xlfd_name (font_spec
, Qnil
);
1498 else if (! NILP (font_spec
))
1499 Fsignal (Qfont
, list2 (build_string ("Invalid font-spec"), font_spec
));
1501 if (! NILP (font_spec
))
1503 Lisp_Object encoding
, repertory
;
1505 family
= AREF (font_spec
, FONT_FAMILY_INDEX
);
1506 if (! NILP (family
) )
1507 family
= SYMBOL_NAME (family
);
1508 registry
= AREF (font_spec
, FONT_REGISTRY_INDEX
);
1509 if (! NILP (registry
))
1510 registry
= Fdowncase (SYMBOL_NAME (registry
));
1511 AUTO_STRING (dash
, "-");
1512 encoding
= find_font_encoding (concat3 (family
, dash
, registry
));
1513 if (NILP (encoding
))
1516 if (SYMBOLP (encoding
))
1518 CHECK_CHARSET (encoding
);
1519 encoding
= repertory
= CHARSET_SYMBOL_ID (encoding
);
1523 repertory
= XCDR (encoding
);
1524 encoding
= XCAR (encoding
);
1525 CHECK_CHARSET (encoding
);
1526 encoding
= CHARSET_SYMBOL_ID (encoding
);
1527 if (! NILP (repertory
) && SYMBOLP (repertory
))
1529 CHECK_CHARSET (repertory
);
1530 repertory
= CHARSET_SYMBOL_ID (repertory
);
1533 FONT_DEF_NEW (font_def
, font_spec
, encoding
, repertory
);
1538 if (CHARACTERP (target
))
1540 if (XFASTINT (target
) < 0x80)
1541 error ("Can't set a font for partial ASCII range");
1542 range_list
= list1 (Fcons (target
, target
));
1544 else if (CONSP (target
))
1546 Lisp_Object from
, to
;
1548 from
= Fcar (target
);
1550 CHECK_CHARACTER (from
);
1551 CHECK_CHARACTER (to
);
1552 if (XFASTINT (from
) < 0x80)
1554 if (XFASTINT (from
) != 0 || XFASTINT (to
) < 0x7F)
1555 error ("Can't set a font for partial ASCII range");
1558 range_list
= list1 (target
);
1560 else if (SYMBOLP (target
) && !NILP (target
))
1562 Lisp_Object script_list
;
1566 script_list
= XCHAR_TABLE (Vchar_script_table
)->extras
[0];
1567 if (! NILP (Fmemq (target
, script_list
)))
1569 if (EQ (target
, Qlatin
))
1571 val
= list1 (target
);
1572 map_char_table (accumulate_script_ranges
, Qnil
, Vchar_script_table
,
1574 range_list
= Fnreverse (XCDR (val
));
1576 if (CHARSETP (target
))
1578 CHECK_CHARSET_GET_CHARSET (target
, charset
);
1579 if (charset
->ascii_compatible_p
)
1582 else if (NILP (range_list
))
1583 error ("Invalid script or charset name: %s",
1584 SDATA (SYMBOL_NAME (target
)));
1586 else if (NILP (target
))
1587 range_list
= list1 (Qnil
);
1589 error ("Invalid target for setting a font");
1595 if (NILP (font_spec
))
1596 error ("Can't set ASCII font to nil");
1597 val
= CHAR_TABLE_REF (fontset
, 0);
1598 if (! NILP (val
) && EQ (add
, Qappend
))
1599 /* We are going to change just an additional font for ASCII. */
1607 arg
= make_uninit_vector (5);
1608 ASET (arg
, 0, fontset
);
1609 ASET (arg
, 1, font_def
);
1611 ASET (arg
, 3, ascii_changed
? Qt
: Qnil
);
1612 ASET (arg
, 4, range_list
);
1614 map_charset_chars (set_fontset_font
, Qnil
, arg
, charset
,
1615 CHARSET_MIN_CODE (charset
),
1616 CHARSET_MAX_CODE (charset
));
1617 range_list
= AREF (arg
, 4);
1619 for (; CONSP (range_list
); range_list
= XCDR (range_list
))
1620 FONTSET_ADD (fontset
, XCAR (range_list
), font_def
, add
);
1624 Lisp_Object tail
, fr
;
1625 int fontset_id
= XINT (FONTSET_ID (fontset
));
1627 set_fontset_ascii (fontset
, fontname
);
1628 name
= FONTSET_NAME (fontset
);
1629 FOR_EACH_FRAME (tail
, fr
)
1631 struct frame
*f
= XFRAME (fr
);
1632 Lisp_Object font_object
;
1635 if (FRAME_INITIAL_P (f
) || FRAME_TERMCAP_P (f
))
1637 if (fontset_id
!= FRAME_FONTSET (f
))
1639 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
1641 font_object
= font_load_for_lface (f
, face
->lface
, font_spec
);
1643 font_object
= font_open_by_spec (f
, font_spec
);
1644 if (! NILP (font_object
))
1646 update_auto_fontset_alist (font_object
, fontset
);
1647 AUTO_FRAME_ARG (arg
, Qfont
, Fcons (name
, font_object
));
1648 Fmodify_frame_parameters (fr
, arg
);
1653 /* Free all realized fontsets whose base is FONTSET. This way, the
1654 specified character(s) are surely redisplayed by a correct
1656 free_realized_fontsets (fontset
);
1662 DEFUN ("new-fontset", Fnew_fontset
, Snew_fontset
, 2, 2, 0,
1663 doc
: /* Create a new fontset NAME from font information in FONTLIST.
1665 FONTLIST is an alist of scripts vs the corresponding font specification list.
1666 Each element of FONTLIST has the form (SCRIPT FONT-SPEC ...), where a
1667 character of SCRIPT is displayed by a font that matches one of
1670 SCRIPT is a symbol that appears in the first extra slot of the
1671 char-table `char-script-table'.
1673 FONT-SPEC is a vector, a cons, or a string. See the documentation of
1674 `set-fontset-font' for the meaning. */)
1675 (Lisp_Object name
, Lisp_Object fontlist
)
1677 Lisp_Object fontset
;
1680 CHECK_STRING (name
);
1681 CHECK_LIST (fontlist
);
1683 name
= Fdowncase (name
);
1684 id
= fs_query_fontset (name
, 0);
1687 Lisp_Object font_spec
= Ffont_spec (0, NULL
);
1688 Lisp_Object short_name
;
1692 if (font_parse_xlfd (SSDATA (name
), SBYTES (name
), font_spec
) < 0)
1693 error ("Fontset name must be in XLFD format");
1694 short_name
= AREF (font_spec
, FONT_REGISTRY_INDEX
);
1695 if (strncmp (SSDATA (SYMBOL_NAME (short_name
)), "fontset-", 8)
1696 || SBYTES (SYMBOL_NAME (short_name
)) < 9)
1697 error ("Registry field of fontset name must be \"fontset-*\"");
1698 Vfontset_alias_alist
= Fcons (Fcons (name
, SYMBOL_NAME (short_name
)),
1699 Vfontset_alias_alist
);
1700 ASET (font_spec
, FONT_REGISTRY_INDEX
, Qiso8859_1
);
1701 fontset
= make_fontset (Qnil
, name
, Qnil
);
1702 len
= font_unparse_xlfd (font_spec
, 0, xlfd
, 256);
1704 error ("Invalid fontset name (perhaps too long): %s", SDATA (name
));
1705 set_fontset_ascii (fontset
, make_unibyte_string (xlfd
, len
));
1709 fontset
= FONTSET_FROM_ID (id
);
1710 free_realized_fontsets (fontset
);
1711 Fset_char_table_range (fontset
, Qt
, Qnil
);
1714 for (; CONSP (fontlist
); fontlist
= XCDR (fontlist
))
1716 Lisp_Object elt
, script
;
1718 elt
= XCAR (fontlist
);
1719 script
= Fcar (elt
);
1721 if (CONSP (elt
) && (NILP (XCDR (elt
)) || CONSP (XCDR (elt
))))
1722 for (; CONSP (elt
); elt
= XCDR (elt
))
1723 Fset_fontset_font (name
, script
, XCAR (elt
), Qnil
, Qappend
);
1725 Fset_fontset_font (name
, script
, elt
, Qnil
, Qappend
);
1731 /* Alist of automatically created fontsets. Each element is a cons
1732 (FONT-SPEC . FONTSET-ID). */
1733 static Lisp_Object auto_fontset_alist
;
1735 /* Number of automatically created fontsets. */
1736 static ptrdiff_t num_auto_fontsets
;
1738 /* Return a fontset synthesized from FONT-OBJECT. This is called from
1739 x_new_font when FONT-OBJECT is used for the default ASCII font of a
1740 frame, and the returned fontset is used for the default fontset of
1741 that frame. The fontset specifies a font of the same registry as
1742 FONT-OBJECT for all characters in the repertory of the registry
1743 (see Vfont_encoding_alist). If the repertory is not known, the
1744 fontset specifies the font for all Latin characters assuming that a
1745 user intends to use FONT-OBJECT for Latin characters. */
1748 fontset_from_font (Lisp_Object font_object
)
1750 Lisp_Object font_name
= font_get_name (font_object
);
1751 Lisp_Object font_spec
= copy_font_spec (font_object
);
1752 Lisp_Object registry
= AREF (font_spec
, FONT_REGISTRY_INDEX
);
1753 Lisp_Object fontset_spec
, alias
, name
, fontset
;
1756 val
= assoc_no_quit (font_spec
, auto_fontset_alist
);
1758 return XINT (FONTSET_ID (XCDR (val
)));
1759 if (num_auto_fontsets
++ == 0)
1760 alias
= intern ("fontset-startup");
1763 char temp
[sizeof "fontset-auto" + INT_STRLEN_BOUND (ptrdiff_t)];
1765 sprintf (temp
, "fontset-auto%"pD
"d", num_auto_fontsets
- 1);
1766 alias
= intern (temp
);
1768 fontset_spec
= copy_font_spec (font_spec
);
1769 ASET (fontset_spec
, FONT_REGISTRY_INDEX
, alias
);
1770 name
= Ffont_xlfd_name (fontset_spec
, Qnil
);
1771 eassert (!NILP (name
));
1772 fontset
= make_fontset (Qnil
, name
, Qnil
);
1773 Vfontset_alias_alist
= Fcons (Fcons (name
, SYMBOL_NAME (alias
)),
1774 Vfontset_alias_alist
);
1775 alias
= Fdowncase (AREF (font_object
, FONT_NAME_INDEX
));
1776 Vfontset_alias_alist
= Fcons (Fcons (name
, alias
), Vfontset_alias_alist
);
1777 auto_fontset_alist
= Fcons (Fcons (font_spec
, fontset
), auto_fontset_alist
);
1778 font_spec
= Ffont_spec (0, NULL
);
1779 ASET (font_spec
, FONT_REGISTRY_INDEX
, registry
);
1781 Lisp_Object target
= find_font_encoding (SYMBOL_NAME (registry
));
1784 target
= XCDR (target
);
1785 if (! CHARSETP (target
))
1787 Fset_fontset_font (name
, target
, font_spec
, Qnil
, Qnil
);
1788 Fset_fontset_font (name
, Qnil
, font_spec
, Qnil
, Qnil
);
1791 set_fontset_ascii (fontset
, font_name
);
1793 return XINT (FONTSET_ID (fontset
));
1797 /* Update auto_fontset_alist for FONTSET. When an ASCII font of
1798 FONTSET is changed, we delete an entry of FONTSET if any from
1799 auto_fontset_alist so that FONTSET is not re-used by
1800 fontset_from_font. */
1803 update_auto_fontset_alist (Lisp_Object font_object
, Lisp_Object fontset
)
1805 Lisp_Object prev
, tail
;
1807 for (prev
= Qnil
, tail
= auto_fontset_alist
; CONSP (tail
);
1808 prev
= tail
, tail
= XCDR (tail
))
1809 if (EQ (fontset
, XCDR (XCAR (tail
))))
1812 auto_fontset_alist
= XCDR (tail
);
1814 XSETCDR (prev
, XCDR (tail
));
1820 DEFUN ("fontset-info", Ffontset_info
, Sfontset_info
, 1, 2, 0,
1821 doc
: /* Return information about a fontset FONTSET on frame FRAME.
1823 FONTSET is a fontset name string, nil for the fontset of FRAME, or t
1824 for the default fontset. FRAME nil means the selected frame.
1826 The value is a char-table whose elements have this form:
1828 ((FONT OPENED-FONT ...) ...)
1830 FONT is a name of font specified for a range of characters.
1832 OPENED-FONT is a name of a font actually opened.
1834 The char-table has one extra slot. If FONTSET is not the default
1835 fontset, the value the extra slot is a char-table containing the
1836 information about the derived fonts from the default fontset. The
1837 format is the same as above. */)
1838 (Lisp_Object fontset
, Lisp_Object frame
)
1840 Lisp_Object
*realized
[2], fontsets
[2], tables
[2];
1841 Lisp_Object val
, elt
;
1844 check_window_system (NULL
);
1845 fontset
= check_fontset_name (fontset
, &frame
);
1847 /* Recode fontsets realized on FRAME from the base fontset FONTSET
1848 in the table `realized'. */
1850 SAFE_ALLOCA_LISP (realized
[0], 2 * ASIZE (Vfontset_table
));
1851 realized
[1] = realized
[0] + ASIZE (Vfontset_table
);
1852 for (i
= j
= 0; i
< ASIZE (Vfontset_table
); i
++)
1854 elt
= FONTSET_FROM_ID (i
);
1856 && EQ (FONTSET_BASE (elt
), fontset
)
1857 && EQ (FONTSET_FRAME (elt
), frame
))
1858 realized
[0][j
++] = elt
;
1860 realized
[0][j
] = Qnil
;
1862 for (i
= j
= 0; ! NILP (realized
[0][i
]); i
++)
1864 elt
= FONTSET_DEFAULT (realized
[0][i
]);
1866 realized
[1][j
++] = elt
;
1868 realized
[1][j
] = Qnil
;
1870 tables
[0] = Fmake_char_table (Qfontset_info
, Qnil
);
1871 fontsets
[0] = fontset
;
1872 if (!EQ (fontset
, Vdefault_fontset
))
1874 tables
[1] = Fmake_char_table (Qnil
, Qnil
);
1875 set_char_table_extras (tables
[0], 0, tables
[1]);
1876 fontsets
[1] = Vdefault_fontset
;
1879 /* Accumulate information of the fontset in TABLE. The format of
1880 each element is ((FONT-SPEC OPENED-FONT ...) ...). */
1881 for (k
= 0; k
<= 1; k
++)
1883 for (c
= 0; c
<= MAX_CHAR
; )
1885 int from
= c
, to
= MAX_5_BYTE_CHAR
;
1887 if (c
<= MAX_5_BYTE_CHAR
)
1889 val
= char_table_ref_and_range (fontsets
[k
], c
, &from
, &to
);
1893 val
= FONTSET_FALLBACK (fontsets
[k
]);
1900 /* At first, set ALIST to ((FONT-SPEC) ...). */
1901 for (alist
= Qnil
, i
= 0; i
< ASIZE (val
); i
++)
1902 if (! NILP (AREF (val
, i
)))
1903 alist
= Fcons (Fcons (FONT_DEF_SPEC (AREF (val
, i
)), Qnil
),
1905 alist
= Fnreverse (alist
);
1907 /* Then store opened font names to cdr of each elements. */
1908 for (i
= 0; ! NILP (realized
[k
][i
]); i
++)
1910 if (c
<= MAX_5_BYTE_CHAR
)
1911 val
= FONTSET_REF (realized
[k
][i
], c
);
1913 val
= FONTSET_FALLBACK (realized
[k
][i
]);
1914 if (! CONSP (val
) || ! VECTORP (XCDR (val
)))
1916 /* VAL: (int . [[FACE-ID FONT-DEF FONT-OBJECT int] ... ]) */
1918 for (j
= 0; j
< ASIZE (val
); j
++)
1920 elt
= AREF (val
, j
);
1921 if (!NILP (elt
) && FONT_OBJECT_P (RFONT_DEF_OBJECT (elt
)))
1923 Lisp_Object font_object
= RFONT_DEF_OBJECT (elt
);
1924 Lisp_Object slot
, name
;
1926 slot
= Fassq (RFONT_DEF_SPEC (elt
), alist
);
1927 name
= AREF (font_object
, FONT_NAME_INDEX
);
1928 if (NILP (Fmember (name
, XCDR (slot
))))
1929 nconc2 (slot
, list1 (name
));
1934 /* Store ALIST in TBL for characters C..TO. */
1935 if (c
<= MAX_5_BYTE_CHAR
)
1936 char_table_set_range (tables
[k
], c
, to
, alist
);
1938 set_char_table_defalt (tables
[k
], alist
);
1940 /* At last, change each elements to font names. */
1941 for (; CONSP (alist
); alist
= XCDR (alist
))
1944 XSETCAR (elt
, Ffont_xlfd_name (XCAR (elt
), Qnil
));
1949 if (EQ (fontset
, Vdefault_fontset
))
1958 DEFUN ("fontset-font", Ffontset_font
, Sfontset_font
, 2, 3, 0,
1959 doc
: /* Return a font name pattern for character CH in fontset NAME.
1960 If NAME is t, find a pattern in the default fontset.
1961 If NAME is nil, find a pattern in the fontset of the selected frame.
1963 The value has the form (FAMILY . REGISTRY), where FAMILY is a font
1964 family name and REGISTRY is a font registry name. This is actually
1965 the first font name pattern for CH in the fontset or in the default
1968 If the 2nd optional arg ALL is non-nil, return a list of all font name
1970 (Lisp_Object name
, Lisp_Object ch
, Lisp_Object all
)
1973 Lisp_Object fontset
, elt
, list
, repertory
, val
;
1978 fontset
= check_fontset_name (name
, &frame
);
1980 CHECK_CHARACTER (ch
);
1985 for (i
= 0, elt
= FONTSET_REF (fontset
, c
); i
< 2;
1986 i
++, elt
= FONTSET_FALLBACK (fontset
))
1988 for (j
= 0; j
< ASIZE (elt
); j
++)
1990 Lisp_Object family
, registry
;
1992 val
= AREF (elt
, j
);
1995 repertory
= AREF (val
, 1);
1996 if (INTEGERP (repertory
))
1998 struct charset
*charset
= CHARSET_FROM_ID (XINT (repertory
));
2000 if (! CHAR_CHARSET_P (c
, charset
))
2003 else if (CHAR_TABLE_P (repertory
))
2005 if (NILP (CHAR_TABLE_REF (repertory
, c
)))
2008 val
= AREF (val
, 0);
2009 /* VAL is a FONT-SPEC */
2010 family
= AREF (val
, FONT_FAMILY_INDEX
);
2011 if (! NILP (family
))
2012 family
= SYMBOL_NAME (family
);
2013 registry
= AREF (val
, FONT_REGISTRY_INDEX
);
2014 if (! NILP (registry
))
2015 registry
= SYMBOL_NAME (registry
);
2016 val
= Fcons (family
, registry
);
2019 list
= Fcons (val
, list
);
2021 if (EQ (fontset
, Vdefault_fontset
))
2023 fontset
= Vdefault_fontset
;
2025 return (Fnreverse (list
));
2028 DEFUN ("fontset-list", Ffontset_list
, Sfontset_list
, 0, 0, 0,
2029 doc
: /* Return a list of all defined fontset names. */)
2032 Lisp_Object fontset
, list
;
2036 for (i
= 0; i
< ASIZE (Vfontset_table
); i
++)
2038 fontset
= FONTSET_FROM_ID (i
);
2040 && BASE_FONTSET_P (fontset
))
2041 list
= Fcons (FONTSET_NAME (fontset
), list
);
2048 #ifdef ENABLE_CHECKING
2050 Lisp_Object
dump_fontset (Lisp_Object
) EXTERNALLY_VISIBLE
;
2053 dump_fontset (Lisp_Object fontset
)
2057 vec
= Fmake_vector (make_number (3), Qnil
);
2058 ASET (vec
, 0, FONTSET_ID (fontset
));
2060 if (BASE_FONTSET_P (fontset
))
2062 ASET (vec
, 1, FONTSET_NAME (fontset
));
2068 frame
= FONTSET_FRAME (fontset
);
2071 struct frame
*f
= XFRAME (frame
);
2073 if (FRAME_LIVE_P (f
))
2075 Fcons (FONTSET_NAME (FONTSET_BASE (fontset
)),
2079 Fcons (FONTSET_NAME (FONTSET_BASE (fontset
)), Qnil
));
2081 if (!NILP (FONTSET_DEFAULT (fontset
)))
2082 ASET (vec
, 2, FONTSET_ID (FONTSET_DEFAULT (fontset
)));
2087 DEFUN ("fontset-list-all", Ffontset_list_all
, Sfontset_list_all
, 0, 0, 0,
2088 doc
: /* Return a brief summary of all fontsets for debug use. */)
2094 for (i
= 0, val
= Qnil
; i
< ASIZE (Vfontset_table
); i
++)
2095 if (! NILP (AREF (Vfontset_table
, i
)))
2096 val
= Fcons (dump_fontset (AREF (Vfontset_table
, i
)), val
);
2097 return (Fnreverse (val
));
2099 #endif /* ENABLE_CHECKING */
2102 syms_of_fontset (void)
2104 DEFSYM (Qfontset
, "fontset");
2105 Fput (Qfontset
, Qchar_table_extra_slots
, make_number (8));
2106 DEFSYM (Qfontset_info
, "fontset-info");
2107 Fput (Qfontset_info
, Qchar_table_extra_slots
, make_number (1));
2109 DEFSYM (Qappend
, "append");
2110 DEFSYM (Qlatin
, "latin");
2112 Vcached_fontset_data
= Qnil
;
2113 staticpro (&Vcached_fontset_data
);
2115 Vfontset_table
= Fmake_vector (make_number (32), Qnil
);
2116 staticpro (&Vfontset_table
);
2118 Vdefault_fontset
= Fmake_char_table (Qfontset
, Qnil
);
2119 staticpro (&Vdefault_fontset
);
2120 set_fontset_id (Vdefault_fontset
, make_number (0));
2123 build_pure_c_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default"));
2124 ASET (Vfontset_table
, 0, Vdefault_fontset
);
2125 next_fontset_id
= 1;
2127 auto_fontset_alist
= Qnil
;
2128 staticpro (&auto_fontset_alist
);
2130 DEFVAR_LISP ("font-encoding-charset-alist", Vfont_encoding_charset_alist
,
2132 Alist of charsets vs the charsets to determine the preferred font encoding.
2133 Each element looks like (CHARSET . ENCODING-CHARSET),
2134 where ENCODING-CHARSET is a charset registered in the variable
2135 `font-encoding-alist' as ENCODING.
2137 When a text has a property `charset' and the value is CHARSET, a font
2138 whose encoding corresponds to ENCODING-CHARSET is preferred. */);
2139 Vfont_encoding_charset_alist
= Qnil
;
2141 DEFVAR_LISP ("use-default-ascent", Vuse_default_ascent
,
2143 Char table of characters whose ascent values should be ignored.
2144 If an entry for a character is non-nil, the ascent value of the glyph
2145 is assumed to be specified by _MULE_DEFAULT_ASCENT property of a font.
2147 This affects how a composite character which contains
2148 such a character is displayed on screen. */);
2149 Vuse_default_ascent
= Qnil
;
2151 DEFVAR_LISP ("ignore-relative-composition", Vignore_relative_composition
,
2153 Char table of characters which are not composed relatively.
2154 If an entry for a character is non-nil, a composition sequence
2155 which contains that character is displayed so that
2156 the glyph of that character is put without considering
2157 an ascent and descent value of a previous character. */);
2158 Vignore_relative_composition
= Qnil
;
2160 DEFVAR_LISP ("alternate-fontname-alist", Valternate_fontname_alist
,
2161 doc
: /* Alist of fontname vs list of the alternate fontnames.
2162 When a specified font name is not found, the corresponding
2163 alternate fontnames (if any) are tried instead. */);
2164 Valternate_fontname_alist
= Qnil
;
2166 DEFVAR_LISP ("fontset-alias-alist", Vfontset_alias_alist
,
2167 doc
: /* Alist of fontset names vs the aliases. */);
2168 Vfontset_alias_alist
2169 = list1 (Fcons (FONTSET_NAME (Vdefault_fontset
),
2170 build_pure_c_string ("fontset-default")));
2172 DEFVAR_LISP ("vertical-centering-font-regexp",
2173 Vvertical_centering_font_regexp
,
2174 doc
: /* Regexp matching font names that require vertical centering on display.
2175 When a character is displayed with such fonts, the character is displayed
2176 at the vertical center of lines. */);
2177 Vvertical_centering_font_regexp
= Qnil
;
2179 DEFVAR_LISP ("otf-script-alist", Votf_script_alist
,
2180 doc
: /* Alist of OpenType script tags vs the corresponding script names. */);
2181 Votf_script_alist
= Qnil
;
2183 defsubr (&Squery_fontset
);
2184 defsubr (&Snew_fontset
);
2185 defsubr (&Sset_fontset_font
);
2186 defsubr (&Sfontset_info
);
2187 defsubr (&Sfontset_font
);
2188 defsubr (&Sfontset_list
);
2189 #ifdef ENABLE_CHECKING
2190 defsubr (&Sfontset_list_all
);